1#!perl -w 2 3use strict; 4use warnings; 5 6use DBI; 7use Test::More; 8 9my $skip_error; 10my $skip_warn; 11my $handled_errstr; 12sub error_sub { 13 my ($errstr, $dbh, $ret) = @_; 14 $handled_errstr = $errstr; 15 $handled_errstr =~ s/.* set_err (?:failed|warning): //; 16 return $ret unless ($skip_error and $errstr =~ / set_err failed: /) or ($skip_warn and $errstr =~ / set_err warning:/); 17 $dbh->set_err(undef, undef); 18 return 1; 19} 20 21my $dbh = DBI->connect('dbi:ExampleP:.', undef, undef, { PrintError => 0, RaiseError => 0, PrintWarn => 0, RaiseWarn => 0, HandleError => \&error_sub }); 22 23sub clear_err { 24 $dbh->set_err(undef, undef); 25 $handled_errstr = undef; 26} 27 28### 29 30ok eval { $dbh->set_err('', 'string 1'); 1 } or diag($@); 31is $dbh->err, ''; 32is $dbh->errstr, 'string 1'; 33is $handled_errstr, undef; 34clear_err; 35 36ok eval { $dbh->set_err(0, 'string 2'); 1 } or diag($@); 37is $dbh->err, 0; 38is $dbh->errstr, 'string 2'; 39is $handled_errstr, undef; 40clear_err; 41 42ok eval { $dbh->set_err(1, 'string 3'); 1 } or diag($@); 43is $dbh->err, 1; 44is $dbh->errstr, 'string 3'; 45is $handled_errstr, 'string 3'; 46clear_err; 47 48### 49 50$dbh->{RaiseError} = 1; 51 52ok eval { $dbh->set_err('', 'string 4'); 1 } or diag($@); 53is $dbh->err, ''; 54is $dbh->errstr, 'string 4'; 55is $handled_errstr, undef; 56clear_err; 57 58ok eval { $dbh->set_err(0, 'string 5'); 1 } or diag($@); 59is $dbh->err, 0; 60is $dbh->errstr, 'string 5'; 61is $handled_errstr, undef; 62clear_err; 63 64ok !eval { $dbh->set_err(1, 'string 6'); 1 }; 65is $dbh->err, 1; 66is $dbh->errstr, 'string 6'; 67is $handled_errstr, 'string 6'; 68clear_err; 69 70$dbh->{RaiseError} = 0; 71 72### 73 74$dbh->{RaiseWarn} = 1; 75 76ok eval { $dbh->set_err('', 'string 7'); 1 } or diag($@); 77is $dbh->err, ''; 78is $dbh->errstr, 'string 7'; 79is $handled_errstr, undef; 80clear_err; 81 82ok !eval { $dbh->set_err(0, 'string 8'); 1 }; 83is $dbh->err, 0; 84is $dbh->errstr, 'string 8'; 85is $handled_errstr, 'string 8'; 86clear_err; 87 88ok eval { $dbh->set_err(1, 'string 9'); 1 } or diag($@); 89is $dbh->err, 1; 90is $dbh->errstr, 'string 9'; 91is $handled_errstr, 'string 9'; 92clear_err; 93 94$dbh->{RaiseWarn} = 0; 95 96### 97 98$dbh->{RaiseError} = 1; 99$dbh->{RaiseWarn} = 1; 100 101ok eval { $dbh->set_err('', 'string 10'); 1 } or diag($@); 102is $dbh->err, ''; 103is $dbh->errstr, 'string 10'; 104is $handled_errstr, undef; 105clear_err; 106 107ok !eval { $dbh->set_err(0, 'string 11'); 1 }; 108is $dbh->err, 0; 109is $dbh->errstr, 'string 11'; 110is $handled_errstr, 'string 11'; 111clear_err; 112 113ok !eval { $dbh->set_err(1, 'string 12'); 1 }; 114is $dbh->err, 1; 115is $dbh->errstr, 'string 12'; 116is $handled_errstr, 'string 12'; 117clear_err; 118 119$dbh->{RaiseError} = 0; 120$dbh->{RaiseWarn} = 0; 121 122### 123 124$dbh->{RaiseError} = 1; 125$skip_error = 1; 126 127ok eval { $dbh->set_err('', 'string 13'); 1 } or diag($@); 128is $dbh->err, ''; 129is $dbh->errstr, 'string 13'; 130is $handled_errstr, undef; 131clear_err; 132 133ok eval { $dbh->set_err(0, 'string 14'); 1 } or diag($@); 134is $dbh->err, 0; 135is $dbh->errstr, 'string 14'; 136is $handled_errstr, undef; 137clear_err; 138 139ok eval { $dbh->set_err(1, 'string 15'); 1 } or diag($@); 140is $dbh->err, undef; 141is $dbh->errstr, undef; 142is $handled_errstr, 'string 15'; 143clear_err; 144 145$dbh->{RaiseError} = 0; 146$skip_error = 0; 147 148### 149 150$dbh->{RaiseWarn} = 1; 151$skip_warn = 1; 152 153ok eval { $dbh->set_err('', 'string 16'); 1 } or diag($@); 154is $dbh->err, ''; 155is $dbh->errstr, 'string 16'; 156is $handled_errstr, undef; 157clear_err; 158 159ok eval { $dbh->set_err(0, 'string 17'); 1 } or diag($@); 160is $dbh->err, undef; 161is $dbh->errstr, undef; 162is $handled_errstr, 'string 17'; 163clear_err; 164 165ok eval { $dbh->set_err(1, 'string 18'); 1 } or diag($@); 166is $dbh->err, 1; 167is $dbh->errstr, 'string 18'; 168is $handled_errstr, 'string 18'; 169clear_err; 170 171$dbh->{RaiseWarn} = 0; 172$skip_error = 0; 173 174### 175 176$dbh->{RaiseError} = 1; 177$dbh->{RaiseWarn} = 1; 178$skip_error = 1; 179$skip_warn = 1; 180 181ok eval { $dbh->set_err('', 'string 19'); 1 } or diag($@); 182is $dbh->err, ''; 183is $dbh->errstr, 'string 19'; 184is $handled_errstr, undef; 185clear_err; 186 187ok eval { $dbh->set_err(0, 'string 20'); 1 } or diag($@); 188is $dbh->err, undef; 189is $dbh->errstr, undef; 190is $handled_errstr, 'string 20'; 191clear_err; 192 193ok eval { $dbh->set_err(1, 'string 21'); 1 } or diag($@); 194is $dbh->err, undef; 195is $dbh->errstr, undef; 196is $handled_errstr, 'string 21'; 197clear_err; 198 199$dbh->{RaiseError} = 0; 200$dbh->{RaiseWarn} = 0; 201$skip_error = 0; 202 203### 204 205done_testing; 206