"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "lib/DBI/PurePerl.pm" between
DBI-1.642.tar.gz and DBI-1.643.tar.gz

About: DBI - The Perl Database Interface (requires one or more "driver" modules DBD::* to talk to databases).

PurePerl.pm  (DBI-1.642):PurePerl.pm  (DBI-1.643)
skipping to change at line 152 skipping to change at line 152
Taint Taint
TaintIn TaintIn
TaintOut TaintOut
InactiveDestroy InactiveDestroy
AutoInactiveDestroy AutoInactiveDestroy
LongTruncOk LongTruncOk
MultiThread MultiThread
PrintError PrintError
PrintWarn PrintWarn
RaiseError RaiseError
RaiseWarn
ShowErrorStatement ShowErrorStatement
Warn Warn
); );
my %is_valid_attribute = map {$_ =>1 } (keys %is_flag_attribute, qw( my %is_valid_attribute = map {$_ =>1 } (keys %is_flag_attribute, qw(
ActiveKids ActiveKids
Attribution Attribution
BegunWork BegunWork
CachedKids CachedKids
Callbacks Callbacks
ChildHandles ChildHandles
skipping to change at line 366 skipping to change at line 367
$DBI::err = $h->{err}; $DBI::err = $h->{err};
$DBI::errstr = $h->{errstr}; $DBI::errstr = $h->{errstr};
$DBI::state = $h->{state}; $DBI::state = $h->{state};
if ( !$keep_error if ( !$keep_error
&& defined(my $err = $h->{err}) && defined(my $err = $h->{err})
&& ($call_depth <= 1 && !$h->{dbi_pp_parent}{dbi_pp_call_depth}) && ($call_depth <= 1 && !$h->{dbi_pp_parent}{dbi_pp_call_depth})
) { ) {
my($pe,$pw,$re,$he) = @{$h}{qw(PrintError PrintWarn RaiseError Handle Error)}; my($pe,$pw,$re,$rw,$he) = @{$h}{qw(PrintError PrintWarn RaiseError Ra iseWarn HandleError)};
my $msg; my $msg;
if ($err && ($pe || $re || $he) # error if ($err && ($pe || $re || $he) # error
or (!$err && length($err) && $pw) # warning or (!$err && length($err) && ($pw || $rw)) # warning
) { ) {
my $last = ($DBI::last_method_except{$method_name}) my $last = ($DBI::last_method_except{$method_name})
? ($h->{'dbi_pp_last_method'}||$method_name) : $method_name; ? ($h->{'dbi_pp_last_method'}||$method_name) : $method_name;
my $errstr = $h->{errstr} || $DBI::errstr || $err || ''; my $errstr = $h->{errstr} || $DBI::errstr || $err || '';
my $msg = sprintf "%s %s %s: %s", $imp, $last, my $msg = sprintf "%s %s %s: %s", $imp, $last,
($err eq "0") ? "warning" : "failed", $errstr; ($err eq "0") ? "warning" : "failed", $errstr;
if ($h->{'ShowErrorStatement'} and my $Statement = $h->{Statement }) { if ($h->{'ShowErrorStatement'} and my $Statement = $h->{Statement }) {
$msg .= ' [for Statement "' . $Statement; $msg .= ' [for Statement "' . $Statement;
if (my $ParamValues = $h->FETCH('ParamValues')) { if (my $ParamValues = $h->FETCH('ParamValues')) {
$msg .= '" with ParamValues: '; $msg .= '" with ParamValues: ';
$msg .= DBI::_concat_hash_sorted($ParamValues, "=", ", ", 1, undef); $msg .= DBI::_concat_hash_sorted($ParamValues, "=", ", ", 1, undef);
$msg .= "]"; $msg .= "]";
} }
else { else {
$msg .= '"]'; $msg .= '"]';
} }
} }
if ($err eq "0") { # is 'warning' (not info) if ($err eq "0") { # is 'warning' (not info)
carp $msg if $pw; carp $msg if $pw;
my $do_croak = $rw;
if ((my $subsub = $h->{'HandleError'}) && $do_croak) {
$do_croak = 0 if &$subsub($msg,$h,$ret[0]);
}
die $msg if $do_croak;
} }
else { else {
my $do_croak = 1; my $do_croak = 1;
if (my $subsub = $h->{'HandleError'}) { if (my $subsub = $h->{'HandleError'}) {
$do_croak = 0 if &$subsub($msg,$h,$ret[0]); $do_croak = 0 if &$subsub($msg,$h,$ret[0]);
} }
if ($do_croak) { if ($do_croak) {
printf $DBI::tfh " $method_name has failed ($h->{Print Error},$h->{RaiseError})\n" printf $DBI::tfh " $method_name has failed ($h->{Print Error},$h->{RaiseError})\n"
if ($DBI::dbi_debug & 0xF) >= 4; if ($DBI::dbi_debug & 0xF) >= 4;
carp $msg if $pe; carp $msg if $pe;
skipping to change at line 499 skipping to change at line 505
my $h_inner = tied(%$h) || $h; my $h_inner = tied(%$h) || $h;
if (($DBI::dbi_debug & 0xF) >= 4) { if (($DBI::dbi_debug & 0xF) >= 4) {
local $^W; local $^W;
print $DBI::tfh " _setup_handle(@_)\n"; print $DBI::tfh " _setup_handle(@_)\n";
} }
$h_inner->{"imp_data"} = $imp_data; $h_inner->{"imp_data"} = $imp_data;
$h_inner->{"ImplementorClass"} = $imp_class; $h_inner->{"ImplementorClass"} = $imp_class;
$h_inner->{"Kids"} = $h_inner->{"ActiveKids"} = 0; # XXX not maintained $h_inner->{"Kids"} = $h_inner->{"ActiveKids"} = 0; # XXX not maintained
if ($parent) { if ($parent) {
foreach (qw( foreach (qw(
RaiseError PrintError PrintWarn HandleError HandleSetErr RaiseError PrintError RaiseWarn PrintWarn HandleError HandleSetErr
Warn LongTruncOk ChopBlanks AutoCommit ReadOnly Warn LongTruncOk ChopBlanks AutoCommit ReadOnly
ShowErrorStatement FetchHashKeyName LongReadLen CompatMode ShowErrorStatement FetchHashKeyName LongReadLen CompatMode
)) { )) {
$h_inner->{$_} = $parent->{$_} $h_inner->{$_} = $parent->{$_}
if exists $parent->{$_} && !exists $h_inner->{$_}; if exists $parent->{$_} && !exists $h_inner->{$_};
} }
if (ref($parent) =~ /::db$/) { # is sth if (ref($parent) =~ /::db$/) { # is sth
$h_inner->{Database} = $parent; $h_inner->{Database} = $parent;
$parent->{Statement} = $h_inner->{Statement}; $parent->{Statement} = $h_inner->{Statement};
$h_inner->{NUM_OF_PARAMS} = 0; $h_inner->{NUM_OF_PARAMS} = 0;
 End of changes. 5 change blocks. 
3 lines changed or deleted 9 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)