10examp.t

SinFP是一种新的识别对方计算机操作系统类型的工具

ok($row_b->{SIZE} == $row_a[1]);
ok($row_b->{NAME} eq $row_a[2]);

print "fetchrow_hashref('ParamValues')\n";
ok($csr_b->execute());
ok(!defined eval { $csr_b->fetchrow_hashref('ParamValues') } ); # PurePerl croaks

print "FetchHashKeyName\n";
ok($csr_b->execute());
$row_b = $csr_b->fetchrow_hashref();
ok($row_b);
ok(keys(%$row_b) == 3);
ok($row_b->{MODE} == $row_a[0]);
ok($row_b->{SIZE} == $row_a[1]);
ok($row_b->{NAME} eq $row_a[2]);

print "fetchall_arrayref\n";
ok($csr_b->execute());
$r = $csr_b->fetchall_arrayref;
ok($r);
ok(@$r);
ok($r->[0]->[0] == $row_a[0]);
ok($r->[0]->[1] == $row_a[1]);
ok($r->[0]->[2] eq $row_a[2]);

print "fetchall_arrayref array slice\n";
ok($csr_b->execute());
$r = $csr_b->fetchall_arrayref([2,1]);
ok($r && @$r);
ok($r->[0]->[1] == $row_a[1]);
ok($r->[0]->[0] eq $row_a[2]);

print "fetchall_arrayref hash slice\n";
ok($csr_b->execute());
#$csr_b->trace(9);
$r = $csr_b->fetchall_arrayref({ SizE=>1, nAMe=>1});
ok($r && @$r);
ok($r->[0]->{SizE} == $row_a[1]);
ok($r->[0]->{nAMe} eq $row_a[2]);

#$csr_b->trace(4);
print "fetchall_arrayref hash\n";
ok($csr_b->execute());
$r = $csr_b->fetchall_arrayref({});
ok($r);
ok(keys %{$r->[0]} == 3);
ok("@{$r->[0]}{qw(MODE SIZE NAME)}" eq "@row_a", "'@{$r->[0]}{qw(MODE SIZE NAME)}' ne '@row_a'");
#$csr_b->trace(0);

# use Data::Dumper; warn Dumper([\@row_a, $r]);

$rows = $csr_b->rows;
ok($rows > 0, "row count $rows");
ok($rows == @$r, "$rows vs ".@$r);
ok($rows == $DBI::rows, "$rows vs $DBI::rows");
#$csr_b->trace(0);

# ---

print "selectrow_array\n";
@row_b = $dbh->selectrow_array($std_sql, undef, $dir);
ok(@row_b == 3);
ok("@row_b" eq "@row_a");

print "selectrow_hashref\n";
$r = $dbh->selectrow_hashref($std_sql, undef, $dir);
ok(keys %$r == 3);
ok($r->{MODE} eq $row_a[0]);
ok($r->{SIZE} eq $row_a[1]);
ok($r->{NAME} eq $row_a[2]);

print "selectall_arrayref\n";
$r = $dbh->selectall_arrayref($std_sql, undef, $dir);
ok($r);
ok(@{$r->[0]} == 3);
ok("@{$r->[0]}" eq "@row_a");
ok(@$r == $rows);

print "selectall_arrayref Slice array slice\n";
$r = $dbh->selectall_arrayref($std_sql, { Slice => [ 2, 0 ] }, $dir);
ok($r);
ok(@{$r->[0]} == 2);
ok("@{$r->[0]}" eq "$row_a[2] $row_a[0]", qq{"@{$r->[0]}" eq "$row_a[2] $row_a[0]"});
ok(@$r == $rows);

print "selectall_arrayref Columns array slice\n";
$r = $dbh->selectall_arrayref($std_sql, { Columns => [ 3, 1 ] }, $dir);
ok($r);
ok(@{$r->[0]} == 2);
ok("@{$r->[0]}" eq "$row_a[2] $row_a[0]", qq{"@{$r->[0]}" eq "$row_a[2] $row_a[0]"});
ok(@$r == $rows);

print "selectall_arrayref hash slice\n";
$r = $dbh->selectall_arrayref($std_sql, { Columns => { MoDe=>1, NamE=>1 } }, $dir);
ok($r);
ok(keys %{$r->[0]} == 2);
ok(exists $r->[0]{MoDe});
ok(exists $r->[0]{NamE});
ok($r->[0]{MoDe} eq $row_a[0]);
ok($r->[0]{NamE} eq $row_a[2]);
ok(@$r == $rows);

print "selectall_hashref\n";
$r = $dbh->selectall_hashref($std_sql, 'NAME', undef, $dir);
ok($r, "selectall_hashref result");
is(ref $r, 'HASH', "selectall_hashref HASH: ".ref $r);
is(scalar keys %$r, $rows);
is($r->{ $row_a[2] }{SIZE}, $row_a[1], qq{$r->{ $row_a[2] }{SIZE} eq $row_a[1]});

print "selectall_hashref by column number\n";
$r = $dbh->selectall_hashref($std_sql, 3, undef, $dir);
ok($r);
ok($r->{ $row_a[2] }{SIZE} eq $row_a[1], qq{$r->{ $row_a[2] }{SIZE} eq $row_a[1]});

print "selectcol_arrayref\n";
$r = $dbh->selectcol_arrayref($std_sql, undef, $dir);
ok($r);
ok(@$r == $rows);
ok($r->[0] eq $row_b[0]);

print "selectcol_arrayref column slice\n";
$r = $dbh->selectcol_arrayref($std_sql, { Columns => [3,2] }, $dir);
ok($r);
# use Data::Dumper; warn Dumper([\@row_b, $r]);
ok(@$r == $rows * 2);
ok($r->[0] eq $row_b[2]);
ok($r->[1] eq $row_b[1]);

# ---

print "begin_work...\n";
ok($dbh->{AutoCommit});
ok(!$dbh->{BegunWork});

ok($dbh->begin_work);
ok(!$dbh->{AutoCommit});
ok($dbh->{BegunWork});

$dbh->commit;
ok($dbh->{AutoCommit});
ok(!$dbh->{BegunWork});

ok($dbh->begin_work({}));
$dbh->rollback;
ok($dbh->{AutoCommit});
ok(!$dbh->{BegunWork});

# ---

print "others...\n";
my $csr_c;
$csr_c = $dbh->prepare("select unknown_field_name1 from ?");
ok(!defined $csr_c);
ok($DBI::errstr =~ m/Unknown field names: unknown_field_name1/);

print "RaiseError & PrintError & ShowErrorStatement\n";
$dbh->{RaiseError} = 1;
ok($dbh->{RaiseError});
$dbh->{ShowErrorStatement} = 1;
ok($dbh->{ShowErrorStatement});

my $error_sql = "select unknown_field_name2 from ?";

ok(! eval { $csr_c = $dbh->prepare($error_sql); 1; });
#print "$@\n";
ok($@ =~ m/\Q$error_sql/, $@); # ShowErrorStatement
ok($@ =~ m/.*Unknown field names: unknown_field_name2/, $@);

my $se_sth1 = $dbh->prepare("select mode from ?");
ok($se_sth1->{RaiseError});
ok($se_sth1->{ShowErrorStatement});

# check that $dbh->{Statement} tracks last _executed_ sth
ok($se_sth1->{Statement} eq "select mode from ?");
ok($dbh->{Statement}     eq "select mode from ?") or print "got: $dbh->{Statement}\n";
my $se_sth2 = $dbh->prepare("select name from ?");
ok($se_sth2->{Statement} eq "select name from ?");
ok($dbh->{Statement}     eq "select name from ?");
$se_sth1->execute('.');
ok($dbh->{Statement}     eq "select mode from ?");

# show error param values
ok(! eval { $se_sth1->execute('first','second') });	# too many params
ok($@ =~ /\b1='first'/, $@);
ok($@ =~ /\b2='second'/, $@);

$se_sth1->finish;
$se_sth2->finish;

$dbh->{RaiseError} = 0;
ok(!$dbh->{RaiseError});
$dbh->{ShowErrorStatement} = 0;
ok(!$dbh->{ShowErrorStatement});

{
  my @warn;
  local($SIG{__WARN__}) = sub { push @warn, @_ };
  $dbh->{PrintError} = 1;
  ok($dbh->{PrintError});
  ok(! $dbh->selectall_arrayref("select unknown_field_name3 from ?"));
  ok("@warn" =~ m/Unknown field names: unknown_field_name3/);
  $dbh->{PrintError} = 0;
  ok(!$dbh->{PrintError});
}


print "HandleError\n";
my $HandleErrorReturn;
my $HandleError = sub {
    my $msg = sprintf "HandleError: %s [h=%s, rv=%s, #=%d]",
		$_[0],$_[1],(defined($_[2])?$_[2]:'undef'),scalar(@_);
    die $msg   if $HandleErrorReturn < 0;
    print "$msg\n";
    $_[2] = 42 if $HandleErrorReturn == 2;
    return $HandleErrorReturn;
};

$dbh->{HandleError} = $HandleError;
ok($dbh->{HandleError});
ok($dbh->{HandleError} == $HandleError);

$dbh->{RaiseError} = 1;
$dbh->{PrintError} = 0;
$error_sql = "select unknown_field_name2 from ?";

print "HandleError -> die\n";
$HandleErrorReturn = -1;
ok(! eval { $csr_c = $dbh->prepare($error_sql); 1; });
ok($@ =~ m/^HandleError:/, $@);

print "HandleError -> 0 -> RaiseError\n";
$HandleErrorReturn = 0;
ok(! eval { $csr_c = $dbh->prepare($error_sql); 1; });
ok($@ =~ m/^DBD::(ExampleP|Multiplex)::db prepare failed:/, $@);

print "HandleError -> 1 -> return (original)undef\n";
$HandleErrorReturn = 1;
$r = eval { $csr_c = $dbh->prepare($error_sql); };
ok(!$@, $@);
ok(!defined($r), $r);

#$dbh->trace(4);

print "HandleError -> 2 -> return (modified)42\n";
$HandleErrorReturn = 2;
$r = eval { $csr_c = $dbh->prepare($error_sql); };
ok(!$@, $@);
ok($r==42) unless $dbh->{mx_handle_list} && ok(1); # skip for Multiplex

$dbh->{HandleError} = undef;
ok(!$dbh->{HandleError});

#$dbh->trace(0); die;

{
	# dump_results;
	my $sth = $dbh->prepare($std_sql);
	
	isa_ok($sth, "DBI::st");
	
	if ($haveFileSpec && length(File::Spec->updir)) {
	  ok($sth->execute(File::Spec->updir));
	} else {
	  ok($sth->execute('../'));
	}
	
	my $dump_dir = ($ENV{TMP}           || 
					$ENV{TEMP}          || 
					$ENV{TMPDIR}        || 
					$ENV{'SYS$SCRATCH'} || 
					'/tmp');
	my $dump_file = ($haveFileSpec) ? 
						File::Spec->catfile($dump_dir, 'dumpcsr.tst')
						: 
						"$dump_dir/dumpcsr.tst";
	($dump_file) = ($dump_file =~ m/^(.*)$/);	# untaint

	SKIP: {
		skip "# dump_results test skipped: unable to open $dump_file: $!\n", 2 unless (open(DUMP_RESULTS, ">$dump_file"));
		ok($sth->dump_results("10", "\n", ",\t", \*DUMP_RESULTS));
		close(DUMP_RESULTS);
		ok(-s $dump_file > 0);
	}

	is( unlink( $dump_file ), 1, "Remove $dump_file" );
	ok( !-e $dump_file, "Actually gone" );

}

print "table_info\n";
# First generate a list of all subdirectories
$dir = $haveFileSpec ? File::Spec->curdir() : ".";
ok(opendir(DIR, $dir));
my(%dirs, %unexpected, %missing);
while (defined(my $file = readdir(DIR))) {
    $dirs{$file} = 1 if -d $file;
}
closedir(DIR);
my $sth = $dbh->table_info(undef, undef, "%", "TABLE");
ok($sth);
%unexpected = %dirs;
%missing = ();
while (my $ref = $sth->fetchrow_hashref()) {
    if (exists($unexpected{$ref->{'TABLE_NAME'}})) {
		delete $unexpected{$ref->{'TABLE_NAME'}};
    } else {
		$missing{$ref->{'TABLE_NAME'}} = 1;
    }
}
ok(keys %unexpected == 0)
    or print "Unexpected directories: ", join(",", keys %unexpected), "\n";
ok(keys %missing == 0)
    or print "Missing directories: ", join(",", keys %missing), "\n";


print "tables\n";
my @tables_expected = (
    q{"schema"."table"},
    q{"sch-ema"."table"},
    q{"schema"."ta-ble"},
    q{"sch ema"."table"},
    q{"schema"."ta ble"},
);
my @tables = $dbh->tables(undef, undef, "%", "VIEW");
ok(@tables == @tables_expected, "Table count mismatch".@tables_expected." vs ".@tables);
ok($tables[$_] eq $tables_expected[$_], "$tables[$_] ne $tables_expected[$_]")
	foreach (0..$#tables_expected);


for (my $i = 0;  $i < 300;  $i += 100) {
	print "Testing the fake directories ($i).\n";
    ok($csr_a = $dbh->prepare("SELECT name, mode FROM long_list_$i"));
    ok($csr_a->execute(), $DBI::errstr);
    my $ary = $csr_a->fetchall_arrayref;
    ok(@$ary == $i, @$ary." rows instead of $i");
    if ($i) {
		my @n1 = map { $_->[0] } @$ary;
		my @n2 = reverse map { "file$_" } 1..$i;
		ok("@n1" eq "@n2", "'@n1' ne '@n2'");
    }
    else {
		ok(1);
    }
}


print "Testing \$dbh->func().\n";
my %tables;
unless ($dbh->{mx_handle_list}) {
	%tables = map { $_ =~ /lib/ ? ($_, 1) : () } $dbh->tables();
	foreach my $t ($dbh->func('lib', 'examplep_tables')) {
		defined(delete $tables{$t}) or print "Unexpected table: $t\n";
	}
}
ok((%tables == 0));

$dbh->disconnect;
ok(!$dbh->{Active});

1;