view release on metacpan or  search on metacpan

ex/unicode_test.pl  view on Meta::CPAN

    $h->disconnect;
}

sub drop_table {
    my ($h, $table) = @_;

    eval {
        local $h->{PrintError} = 0;
        $table = $h->quote_identifier ($table);
        my $s = $h->prepare(qq/drop table $table/);
        $s->execute;
    };
    $h->commit if $driver eq 'Unify';
    # DBD::CSV seems to get upset by the mixed_lob_unicode_data test
    # and fails to drop the table with:
    # Execution ERROR: utf8 "\x89" does not map to Unicode at /usr/lib/perl/5.10/IO/Handle.pm line 167.
    unlink 'fred.csv' if $driver eq 'CSV';
    #diag($@) if $@;
}

# create the named table with columns specified in $columns which is
# an arrayref with each element a hash of name and type
sub create_table {
    my ($h, $testmsg, $table, $columns) = @_;

    $table = $h->quote_identifier ($table);
    my $sql = qq/create table $table ( / .
	join(",", map {join " " => $h->quote_identifier ($_->{name}), $_->{type}} @$columns) . ')';

    return lives_ok {
        diag ($sql);
        my $s = $h->prepare($sql);
        $s->execute;
	$dbd eq "DBD::Unify" and $h->commit;
    } $testmsg;
}

sub unicode_in_table_name {
    my $h = shift;

    my $table = "fred\x{0100}";
    drop_table($h, $table);

    my $created =
	create_table($h, 'unicode table name supported', $table,
		     [{name => 'a', type => 'int'}]);
  SKIP: {
      skip "Failed to create unicode table name", 2 unless $created;

      find_table($h, $table);

      drop_table($h, $table);
    }
}

# NOTE: some DBs may uppercase table names
sub find_table {
    my ($h, $table) = @_;

    # won't find a match if the returned data is not utf8 decoded
    my $s = $h->table_info(undef, undef, undef, 'TABLE');
    my $r = $s->fetchall_arrayref;
    my $found = first { $_->[2] =~ /$table/i} @$r;
    ok($found, 'unicode table found in unqualified table_info');

    SKIP: {
          skip "table found via table_info", 1 if $found;

          $found = first { Encode::decode_utf8($_->[2]) =~ /$table/i} @$r;
          ok(!$found, "Table not found initially but when table name decoded it was found as $table");
    };
    my $found_some_utf8_tables;
    foreach ($r) {
        $found_some_utf8_tables++ if Encode::is_utf8($_->[2]);
    }
    note(($found_some_utf8_tables ? 'Found' : 'Did not find') ,
         ' tables with utf8 on');

    $s = $h->table_info(undef, undef, $table, 'TABLE');
    $r = $s->fetchall_arrayref;
    $found = first {$_->[2] =~ /$table/i} @$r;
    ok($found, 'unicode table found by qualified table_info');
    SKIP: {
          skip "table not found", 1 if !$found;

          ok(Encode::is_utf8($found->[2]),
             'utf8 flag set on unicode table name');
    }
}

sub find_column {
    my ($h, $table, $column) = @_;

    my $s = $h->column_info(undef, undef, $table, undef);
    if (!$s) {
	note("This driver does not seem to support column_info");
	note("Skipping this test");
	return;
    }
    my $r = $s->fetchall_arrayref;
    my $found = first {$_->[3] =~ /$column/i} @$r;
    ok($found, 'unicode column found in unqualified column_info');

    $s = $h->column_info(undef, undef, $table, $column);
    $r = $s->fetchall_arrayref;
    $found = first {$_->[3] =~ /$column/i} @$r;
    ok($found, 'unicode column found by qualified column_info');
}

sub unicode_in_column_name {
    my $h = shift;

    my $table = 'fred';
    my $column = "dave\x{0100}";

    drop_table($h, $table);

    my $created =
	create_table($h, 'unicode column name supported', $table,
		     [{name => $column, type => 'int'}]);
  SKIP: {
      skip "table with unicode column not created", 2 unless $created;

      find_column($h, $table, $column);

      drop_table($h, $table);
    };
}

sub unicode_data {