#!/usr/bin/perl -w -I./t # $Id: 10handler.t 11680 2008-08-28 08:23:27Z mjevans $ use Test::More; use strict; $| = 1; my $has_test_nowarnings = 1; eval "require Test::NoWarnings"; $has_test_nowarnings = undef if $@; my $tests = 11; $tests += 1 if $has_test_nowarnings; plan tests => $tests; use_ok('ODBCTEST'); use_ok('Data::Dumper'); BEGIN { if (!defined $ENV{DBI_DSN}) { plan skip_all => "DBI_DSN is undefined"; } } END { Test::NoWarnings::had_no_warnings() if ($has_test_nowarnings); } my $dbh = DBI->connect(); unless($dbh) { BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n"); exit 0; } $dbh->{PrintError} = 0; $dbh->{RaiseError} = 1; # # check error handler is called, the right args are passed and the error # is propagated if the handler returns true # my ($errmsg, $errstate, $errnative, $handler_called); my $handler_return = 1; $handler_called = 0; sub err_handler { ($errstate, $errmsg, $errnative) = @_; $handler_called++; #diag "===> state: $errstate\n"; #diag "===> msg: $errmsg\n"; #diag "===> nativeerr: $errnative\n"; return $handler_return; } $dbh->{odbc_err_handler} = \&err_handler; my $evalret = eval { # this sql is supposed to be invalid my $sth = $dbh->prepare('select * from'); $sth->execute; return 99; }; my $eval = $@; #diag "eval returned " . ($evalret ? $evalret : "undef") . "\n"; #diag '$@: ' . ($eval ? $eval : "undef") . "\n"; ok($handler_called >= 1, 'Error handler called'); ok($errstate, 'Error handler called - state seen'); ok($errmsg, 'Error handler called - message seen'); ok($errnative, 'Error handler called - native seen'); ok(!defined($evalret), 'Error handler called - error passed on'); ok($eval, 'Error handler called - error propagated'); # # check we can reset the error handler (bug in 1.14 prevented this) # ($errmsg, $errstate, $errnative, $handler_called) = (undef, undef, undef, 0); $dbh->{odbc_err_handler} = undef; $evalret = eval { # this sql is supposed to be invalid my $sth = $dbh->prepare('select * from'); $sth->execute; return 99; }; is($handler_called, 0, 'Handler cancelled'); # # check we can filter error messages in the handler by returning 0 from # the handler # ($errmsg, $errstate, $errnative, $handler_called) = (undef, undef, undef, 0); $dbh->{odbc_err_handler} = \&err_handler; $handler_return = 0; $evalret = eval { # this sql is supposed to be invalid my $sth = $dbh->prepare('select * from'); $sth->execute if $sth; return 99; }; $eval = $@; ok(!$eval, 'Handler filtered all messages'); is($evalret, 99, 'eval complete'); $dbh->disconnect; exit 0; # get rid of use once warnings print $DBI::errstr;