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