Author: timbo
Date: Wed Sep 26 14:03:25 2007
New Revision: 10002
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/lib/DBD/DBM.pm
dbi/trunk/lib/DBD/ExampleP.pm
dbi/trunk/lib/DBD/File.pm
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBD/Multiplex.pm
dbi/trunk/lib/DBD/Sponge.pm
dbi/trunk/lib/DBI/DBD.pm
dbi/trunk/lib/DBI/Gofer/Execute.pm
dbi/trunk/lib/DBI/PurePerl.pm
Log:
Use $DBI::stderr instead of 1 as generic err value.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Wed Sep 26 14:03:25 2007
@@ -47,7 +47,6 @@
Fixed t/05thrclone.t to work with Test::More >= 0.71
thanks to Jerry D. Hedden and Michael G Schwern.
-
=head2 Changes in DBI 1.59 (svn rev 9874), 23rd August 2007
Fixed DBI::ProfileData to unescape headers lines read from data file.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Wed Sep 26 14:03:25 2007
@@ -245,6 +245,7 @@
$DBI::dbi_debug = 0;
$DBI::neat_maxlen = 400;
+$DBI::stderr = 2_000_000_000; # a very round number below 2**31
# If you get an error here like "Can't find loadable object ..."
# then you haven't installed the DBI correctly. Read the README
@@ -1665,7 +1666,7 @@
sub begin_work {
my $dbh = shift;
- return $dbh->set_err(1, "Already in a transaction")
+ return $dbh->set_err($DBI::stderr, "Already in a transaction")
unless $dbh->FETCH('AutoCommit');
$dbh->STORE('AutoCommit', 0); # will croak if driver doesn't support it
$dbh->STORE('BegunWork', 1); # trigger post commit/rollback action
@@ -1785,13 +1786,13 @@
my $sth = shift;
my ($p_id, $value_array, $attr) = @_;
- return $sth->set_err(1, "Value for parameter $p_id must be a scalar or
an arrayref, not a ".ref($value_array))
+ return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be a
scalar or an arrayref, not a ".ref($value_array))
if defined $value_array and ref $value_array and ref $value_array
ne 'ARRAY';
- return $sth->set_err(1, "Can't use named placeholder '$p_id' for
non-driver supported bind_param_array")
+ return $sth->set_err($DBI::stderr, "Can't use named placeholder '$p_id'
for non-driver supported bind_param_array")
unless DBI::looks_like_number($p_id); # because we rely on
execute(@ary) here
- return $sth->set_err(1, "Placeholder '$p_id' is out of range")
+ return $sth->set_err($DBI::stderr, "Placeholder '$p_id' is out of
range")
if $p_id <= 0; # can't easily/reliably test for too big
# get/create arrayref to hold params
@@ -1816,14 +1817,14 @@
# and then return an error
my ($p_num, $value_array, $attr) = @_;
$sth->bind_param_array($p_num, $value_array, $attr);
- return $sth->set_err(1, "bind_param_inout_array not supported");
+ return $sth->set_err($DBI::stderr, "bind_param_inout_array not
supported");
}
sub bind_columns {
my $sth = shift;
my $fields = $sth->FETCH('NUM_OF_FIELDS') || 0;
if ($fields <= 0 && !$sth->{Active}) {
- return $sth->set_err(1, "Statement has no result columns to bind"
+ return $sth->set_err($DBI::stderr, "Statement has no result columns
to bind"
." (perhaps you need to successfully call execute first)");
}
# Backwards compatibility for old-style call with attribute hash
@@ -1835,7 +1836,7 @@
$sth->bind_col(++$idx, shift, $attr) or return
while (@_ and $idx < $fields);
- return $sth->set_err(1, "bind_columns called with ".([EMAIL
PROTECTED])." values but $fields are needed")
+ return $sth->set_err($DBI::stderr, "bind_columns called with ".([EMAIL
PROTECTED])." values but $fields are needed")
if @_ or $idx != $fields;
return 1;
@@ -1848,13 +1849,13 @@
# get tuple status array or hash attribute
my $tuple_sts = $attr->{ArrayTupleStatus};
- return $sth->set_err(1, "ArrayTupleStatus attribute must be an
arrayref")
+ return $sth->set_err($DBI::stderr, "ArrayTupleStatus attribute must be
an arrayref")
if $tuple_sts and ref $tuple_sts ne 'ARRAY';
# bind all supplied arrays
if (@array_of_arrays) {
$sth->{ParamArrays} = { }; # clear out old params
- return $sth->set_err(1,
+ return $sth->set_err($DBI::stderr,
@array_of_arrays." bind values supplied but $NUM_OF_PARAMS
expected")
if defined ($NUM_OF_PARAMS) && @array_of_arrays !=
$NUM_OF_PARAMS;
$sth->bind_param_array($_, $array_of_arrays[$_-1]) or return
@@ -1865,31 +1866,31 @@
if ($fetch_tuple_sub = $attr->{ArrayTupleFetch}) { # fetch on
demand
- return $sth->set_err(1,
+ return $sth->set_err($DBI::stderr,
"Can't use both ArrayTupleFetch and explicit bind values")
if @array_of_arrays; # previous bind_param_array calls will
simply be ignored
if (UNIVERSAL::isa($fetch_tuple_sub,'DBI::st')) {
my $fetch_sth = $fetch_tuple_sub;
- return $sth->set_err(1,
+ return $sth->set_err($DBI::stderr,
"ArrayTupleFetch sth is not Active, need to execute()
it first")
unless $fetch_sth->{Active};
# check column count match to give more friendly message
my $NUM_OF_FIELDS = $fetch_sth->{NUM_OF_FIELDS};
- return $sth->set_err(1,
+ return $sth->set_err($DBI::stderr,
"$NUM_OF_FIELDS columns from ArrayTupleFetch sth but
$NUM_OF_PARAMS expected")
if defined($NUM_OF_FIELDS) && defined($NUM_OF_PARAMS)
&& $NUM_OF_FIELDS != $NUM_OF_PARAMS;
$fetch_tuple_sub = sub { $fetch_sth->fetchrow_arrayref };
}
elsif (!UNIVERSAL::isa($fetch_tuple_sub,'CODE')) {
- return $sth->set_err(1, "ArrayTupleFetch '$fetch_tuple_sub' is
not a code ref or statement handle");
+ return $sth->set_err($DBI::stderr, "ArrayTupleFetch
'$fetch_tuple_sub' is not a code ref or statement handle");
}
}
else {
my $NUM_OF_PARAMS_given = keys %{ $sth->{ParamArrays} || {} };
- return $sth->set_err(1,
+ return $sth->set_err($DBI::stderr,
"$NUM_OF_PARAMS_given bind values supplied but
$NUM_OF_PARAMS expected")
if defined($NUM_OF_PARAMS) && $NUM_OF_PARAMS !=
$NUM_OF_PARAMS_given;
@@ -1940,7 +1941,7 @@
}
}
my $tuples = @$tuple_status;
- return $sth->set_err(1, "executing $tuples generated $err_count
errors")
+ return $sth->set_err($DBI::stderr, "executing $tuples generated
$err_count errors")
if $err_count;
$tuples ||= "0E0";
return $tuples unless wantarray;
@@ -2003,7 +2004,7 @@
foreach (@key_fields) {
my $index = $names_hash->{$_}; # perl index not column
$index = $_ - 1 if !defined $index && DBI::looks_like_number($_) &&
$_>=1 && $_ <= $num_of_fields;
- return $sth->set_err(1, "Field '$_' does not exist (not one of
@{[keys %$names_hash]})")
+ return $sth->set_err($DBI::stderr, "Field '$_' does not exist (not
one of @{[keys %$names_hash]})")
unless defined $index;
push @key_indexes, $index;
}
Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm (original)
+++ dbi/trunk/lib/DBD/DBM.pm Wed Sep 26 14:03:25 2007
@@ -163,7 +163,7 @@
#
if ( $attrib ne 'dbm_valid_attrs' # gotta start somewhere :-)
and !$dbh->{dbm_valid_attrs}->{$attrib} ) {
- return $dbh->set_err( 1,"Invalid attribute '$attrib'!");
+ return $dbh->set_err( $DBI::stderr,"Invalid attribute '$attrib'!");
}
else {
@@ -186,7 +186,7 @@
#
if ( $attrib ne 'dbm_valid_attrs' # gotta start somewhere :-)
and !$dbh->{dbm_valid_attrs}->{$attrib} ) {
- return $dbh->set_err( 1,"Invalid attribute '$attrib'");
+ return $dbh->set_err( $DBI::stderr,"Invalid attribute '$attrib'");
}
else {
@@ -243,8 +243,8 @@
sub dbm_schema {
my($sth,$tname)[EMAIL PROTECTED];
- return $sth->set_err(1,'No table name supplied!') unless $tname;
- return $sth->set_err(1,"Unknown table '$tname'!")
+ return $sth->set_err($DBI::stderr,'No table name supplied!') unless $tname;
+ return $sth->set_err($DBI::stderr,"Unknown table '$tname'!")
unless $sth->{Database}->{dbm_tables}
and $sth->{Database}->{dbm_tables}->{$tname};
return $sth->{Database}->{dbm_tables}->{$tname}->{schema};
Modified: dbi/trunk/lib/DBD/ExampleP.pm
==============================================================================
--- dbi/trunk/lib/DBD/ExampleP.pm (original)
+++ dbi/trunk/lib/DBD/ExampleP.pm Wed Sep 26 14:03:25 2007
@@ -95,7 +95,7 @@
: split(/\s*,\s*/, $fields);
}
else {
- return $dbh->set_err(1, "Syntax error in select statement
(\"$statement\")")
+ return $dbh->set_err($DBI::stderr, "Syntax error in select
statement (\"$statement\")")
unless $statement =~ m/^\s*set\s+/;
# the SET syntax is just a hack so the ExampleP driver can
# be used to test non-select statements.
@@ -110,7 +110,7 @@
my @bad = map {
defined $DBD::ExampleP::statnames{$_} ? () : $_
} @fields;
- return $dbh->set_err(1, "Unknown field names: @bad")
+ return $dbh->set_err($DBI::stderr, "Unknown field names: @bad")
if @bad;
$outer->STORE('NUM_OF_FIELDS' => scalar(@fields));
@@ -356,7 +356,7 @@
}
else { # normal mode
my $dh = $sth->{dbd_datahandle}
- or return $sth->set_err(1, "fetch without successful execute");
+ or return $sth->set_err($DBI::stderr, "fetch without
successful execute");
my $f = readdir($dh);
unless ($f) {
$sth->finish;
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Wed Sep 26 14:03:25 2007
@@ -129,7 +129,7 @@
$attr->{'f_dir'} : $haveFileSpec ? File::Spec->curdir() : '.';
my($dirh) = Symbol::gensym();
if (!opendir($dirh, $dir)) {
- $drh->set_err(1, "Cannot open directory $dir: $!");
+ $drh->set_err($DBI::stderr, "Cannot open directory $dir: $!");
return undef;
}
my($file, @dsns, %names, $driver);
@@ -195,7 +195,7 @@
$stmt = eval { $class->new($statement) };
}
if ($@) {
- $dbh->set_err(1, $@);
+ $dbh->set_err($DBI::stderr, $@);
undef $sth;
} else {
$sth->STORE('f_stmt', $stmt);
@@ -259,14 +259,14 @@
# if ( !$dbh->{f_valid_attrs}->{$attrib}
# and !$dbh->{sql_valid_attrs}->{$attrib}
# ) {
- # return $dbh->set_err( 1,"Invalid attribute '$attrib'");
+ # return $dbh->set_err( $DBI::stderr,"Invalid attribute '$attrib'");
# }
# else {
# $dbh->{$attrib} = $value;
# }
if ($attrib eq 'f_dir') {
- return $dbh->set_err( 1,"No such directory '$value'")
+ return $dbh->set_err( $DBI::stderr,"No such directory '$value'")
unless -d $value;
}
$dbh->{$attrib} = $value;
@@ -332,7 +332,7 @@
my($dir) = $dbh->{f_dir};
my($dirh) = Symbol::gensym();
if (!opendir($dirh, $dir)) {
- $dbh->set_err(1, "Cannot open directory $dir: $!");
+ $dbh->set_err($DBI::stderr, "Cannot open directory $dir: $!");
return undef;
}
my($file, @tables, %names);
@@ -343,7 +343,7 @@
}
}
if (!closedir($dirh)) {
- $dbh->set_err(1, "Cannot close directory $dir: $!");
+ $dbh->set_err($DBI::stderr, "Cannot close directory $dir: $!");
return undef;
}
@@ -351,7 +351,7 @@
if (!$dbh2) {
$dbh2 = $dbh->{'csv_sponge_driver'} = DBI->connect("DBI:Sponge:");
if (!$dbh2) {
- $dbh->set_err(1, $DBI::errstr);
+ $dbh->set_err($DBI::stderr, $DBI::errstr);
return undef;
}
}
@@ -362,7 +362,7 @@
my $sth = $dbh2->prepare("TABLE_INFO", { 'rows' => [EMAIL PROTECTED],
'NAMES' => $names });
if (!$sth) {
- $dbh->set_err(1, $dbh2->errstr);
+ $dbh->set_err($DBI::stderr, $dbh2->errstr);
}
$sth;
}
@@ -439,7 +439,7 @@
$sth->finish;
my $stmt = $sth->{'f_stmt'};
my $result = eval { $stmt->execute($sth, $params); };
- return $sth->set_err(1,$@) if $@;
+ return $sth->set_err($DBI::stderr,$@) if $@;
if ($stmt->{'NUM_OF_FIELDS'}) { # is a SELECT statement
$sth->STORE(Active => 1);
$sth->STORE('NUM_OF_FIELDS', $stmt->{'NUM_OF_FIELDS'})
@@ -457,7 +457,7 @@
my $sth = shift;
my $data = $sth->{f_stmt}->{data};
if (!$data || ref($data) ne 'ARRAY') {
- $sth->set_err(1, "Attempt to fetch row from a Non-SELECT statement");
+ $sth->set_err($DBI::stderr, "Attempt to fetch row from a Non-SELECT
statement");
return undef;
}
my $dav = shift @$data;
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Wed Sep 26 14:03:25 2007
@@ -106,7 +106,7 @@
$sub = sub { return shift->go_dbh_method(undef, $method, @_) };
}
else {
- $sub = sub { shift->set_err(1, "Can't call \$${type}h->$method
when using DBD::Gofer"); return; };
+ $sub = sub { shift->set_err($DBI::stderr, "Can't call
\$${type}h->$method when using DBD::Gofer"); return; };
}
no strict 'refs';
*$driver_method = $sub;
@@ -136,7 +136,7 @@
# first remove dsn= and everything after it
my $remote_dsn = ($dsn =~ s/;?\bdsn=(.*)$// && $1)
- or return $drh->set_err(1, "No dsn= argument in '$orig_dsn'");
+ or return $drh->set_err($DBI::stderr, "No dsn= argument in
'$orig_dsn'");
if ($attr->{go_bypass}) { # don't use DBD::Gofer for this connection
# useful for testing with DBI_AUTOPROXY, e.g., t/03handle.t
@@ -159,10 +159,10 @@
$policy_class = "DBD::Gofer::Policy::$policy_class"
unless $policy_class =~ /::/;
_load_class($policy_class)
- or return $drh->set_err(1, "Can't load $policy_class: $@");
+ or return $drh->set_err($DBI::stderr, "Can't load
$policy_class: $@");
# replace policy name in %go_attr with policy object
$go_attr{go_policy} = eval { $policy_class->new(\%go_attr) }
- or return $drh->set_err(1, "Can't instanciate $policy_class:
$@");
+ or return $drh->set_err($DBI::stderr, "Can't instanciate
$policy_class: $@");
}
# policy object is left in $go_attr{go_policy} so transport can see it
my $go_policy = $go_attr{go_policy};
@@ -171,13 +171,13 @@
my $go_connect_method = delete $go_attr{go_connect_method};
my $transport_class = delete $go_attr{go_transport}
- or return $drh->set_err(1, "No transport= argument in
'$orig_dsn'");
+ or return $drh->set_err($DBI::stderr, "No transport= argument in
'$orig_dsn'");
$transport_class = "DBD::Gofer::Transport::$transport_class"
unless $transport_class =~ /::/;
_load_class($transport_class)
- or return $drh->set_err(1, "Can't load $transport_class: $@");
+ or return $drh->set_err($DBI::stderr, "Can't load
$transport_class: $@");
my $go_transport = eval { $transport_class->new(\%go_attr) }
- or return $drh->set_err(1, "Can't instanciate $transport_class:
$@");
+ or return $drh->set_err($DBI::stderr, "Can't instanciate
$transport_class: $@");
my $request_class = "DBI::Gofer::Request";
my $go_request = eval {
@@ -196,7 +196,7 @@
$request_class->new({
dbh_connect_call => [ $go_connect_method, $remote_dsn, $user,
$auth, $go_attr ],
})
- } or return $drh->set_err(1, "Can't instanciate $request_class: $@");
+ } or return $drh->set_err($DBI::stderr, "Can't instanciate
$request_class: $@");
my ($dbh, $dbh_inner) = DBI::_new_dbh($drh, {
'Name' => $dsn,
@@ -215,7 +215,7 @@
if (not $skip_connect_check) {
if (not $dbh->go_dbh_method(undef, 'ping')) {
return undef if $dbh->err; # error already recorded, typically
- return $dbh->set_err(1, "ping failed");
+ return $dbh->set_err($DBI::stderr, "ping failed");
}
}
@@ -264,7 +264,7 @@
if $meta->{go_last_insert_id_args};
my $transport = $dbh->{go_transport}
- or return $dbh->set_err(1, "Not connected (no transport)");
+ or return $dbh->set_err($DBI::stderr, "Not connected (no
transport)");
my ($response, $retransmit_sub) =
$transport->transmit_request($request);
$response ||= $transport->receive_response($request, $retransmit_sub);
@@ -408,7 +408,7 @@
begin_work commit rollback
)) {
no strict 'refs';
- *$method = sub { return shift->set_err(1, "$method not available with
DBD::Gofer") }
+ *$method = sub { return shift->set_err($DBI::stderr, "$method not
available with DBD::Gofer") }
}
@@ -478,7 +478,7 @@
# dbh attributes are set at connect-time - see connect()
carp("Can't alter \$dbh->{$attrib} after handle created with
DBD::Gofer") if $dbh->FETCH('Warn');
- return $dbh->set_err(1, "Can't alter \$dbh->{$attrib} after handle
created with DBD::Gofer");
+ return $dbh->set_err($DBI::stderr, "Can't alter \$dbh->{$attrib} after
handle created with DBD::Gofer");
}
sub disconnect {
@@ -490,7 +490,7 @@
sub prepare {
my ($dbh, $statement, $attr)= @_;
- return $dbh->set_err(1, "Can't prepare when disconnected")
+ return $dbh->set_err($DBI::stderr, "Can't prepare when disconnected")
unless $dbh->FETCH('Active');
$attr = { %$attr } if $attr; # copy so we can edit
@@ -582,7 +582,7 @@
or $dbh->{go_request_count}==1;
my $transport = $sth->{go_transport}
- or return $sth->set_err(1, "Not connected (no transport)");
+ or return $sth->set_err($DBI::stderr, "Not connected (no
transport)");
my ($response, $retransmit_sub) =
$transport->transmit_request($request);
$response ||= $transport->receive_response($request, $retransmit_sub);
@@ -645,7 +645,7 @@
};
my $resultset_list = $response->sth_resultsets
- or return $sth->set_err(1, "No sth_resultsets");
+ or return $sth->set_err($DBI::stderr, "No sth_resultsets");
my $meta = shift @$resultset_list
or return undef; # no more result sets
@@ -746,7 +746,7 @@
# do the store locally anyway, just in case
$sth->SUPER::STORE($attrib => $value);
- return $sth->set_err(1, $msg);
+ return $sth->set_err($DBI::stderr, $msg);
}
# sub bind_param_array
Modified: dbi/trunk/lib/DBD/Multiplex.pm
==============================================================================
--- dbi/trunk/lib/DBD/Multiplex.pm (original)
+++ dbi/trunk/lib/DBD/Multiplex.pm Wed Sep 26 14:03:25 2007
@@ -319,7 +319,7 @@
push @dsn_list, @{ delete $attr->{mx_dsns} } if $attr->{mx_dsns};
push @dsn_list, @dsn_list if $attr->{mx_double};
push @dsn_list, @dsn_list, @dsn_list if $attr->{mx_triple};
- return $drh->set_err(1, "No dsn given") unless @dsn_list;
+ return $drh->set_err($DBI::stderr, "No dsn given") unless @dsn_list;
my @orig_dsn_list = @dsn_list; # @dsn_list gets edited below
# exit_mode decides when to exit the foreach loop.
Modified: dbi/trunk/lib/DBD/Sponge.pm
==============================================================================
--- dbi/trunk/lib/DBD/Sponge.pm (original)
+++ dbi/trunk/lib/DBD/Sponge.pm Wed Sep 26 14:03:25 2007
@@ -53,7 +53,7 @@
sub prepare {
my($dbh, $statement, $attribs) = @_;
my $rows = delete $attribs->{'rows'}
- or return $dbh->set_err(1,"No rows attribute supplied to prepare");
+ or return $dbh->set_err($DBI::stderr,"No rows attribute supplied to
prepare");
my ($outer, $sth) = DBI::_new_sth($dbh, {
'Statement' => $statement,
'rows' => $rows,
@@ -69,7 +69,7 @@
if ($statement =~ /^\s*insert\b/) { # very basic, just for testing
execute_array()
$sth->{is_insert} = 1;
my $NUM_OF_PARAMS = $attribs->{NUM_OF_PARAMS}
- or return $dbh->set_err(1,"NUM_OF_PARAMS not specified for
INSERT statement");
+ or return $dbh->set_err($DBI::stderr,"NUM_OF_PARAMS not
specified for INSERT statement");
$sth->STORE('NUM_OF_PARAMS' => $attribs->{NUM_OF_PARAMS} );
}
else { #assume select
@@ -85,7 +85,7 @@
} elsif (my $firstrow = $rows->[0]) {
$numFields = scalar @$firstrow;
} else {
- return $dbh->set_err(1, 'Cannot determine NUM_OF_FIELDS');
+ return $dbh->set_err($DBI::stderr, 'Cannot determine
NUM_OF_FIELDS');
}
$sth->STORE('NUM_OF_FIELDS' => $numFields);
$sth->{NAME} = $attribs->{NAME}
@@ -174,7 +174,7 @@
my $row;
$row = (@_) ? [ @_ ] : die "bind_param not supported yet" ;
my $NUM_OF_PARAMS = $sth->{NUM_OF_PARAMS};
- return $sth->set_err(1, @$row." values bound (@$row) but
$NUM_OF_PARAMS expected")
+ return $sth->set_err($DBI::stderr, @$row." values bound (@$row) but
$NUM_OF_PARAMS expected")
if @$row != $NUM_OF_PARAMS;
{ local $^W; $sth->trace_msg("inserting (@$row)\n"); }
push @{ $sth->{rows} }, $row;
Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm (original)
+++ dbi/trunk/lib/DBI/DBD.pm Wed Sep 26 14:03:25 2007
@@ -817,7 +817,7 @@
# here, that is, the DSN looks like var1=val1;...;varN=valN
foreach my $var ( split /;/, $dr_dsn ) {
my ($attr_name, $attr_value) = split '=', $var, 2;
- return $drh->set_err(1, "Can't parse DSN part '$var'")
+ return $drh->set_err($DBI::stderr, "Can't parse DSN part '$var'")
unless defined $attr_value;
# add driver prefix to attribute name if it doesn't have it already
@@ -832,13 +832,13 @@
# Get the attributes we'll use to connect.
# We use delete here because these no need to STORE them
my $db = delete $attr->{drv_database} || delete $attr->{drv_db}
- or return $drh->set_err(1, "No database name given in DSN
'$dr_dsn'");
+ or return $drh->set_err($DBI::stderr, "No database name given in DSN
'$dr_dsn'");
my $host = delete $attr->{drv_host} || 'localhost';
my $port = delete $attr->{drv_port} || 123456;
# Assume you can attach to your database via drv_connect:
my $connection = drv_connect($db, $host, $port, $user, $auth)
- or return $drh->set_err(1, "Can't connect to $dr_dsn: ...");
+ or return $drh->set_err($DBI::stderr, "Can't connect to $dr_dsn:
...");
# create a 'blank' dbh (call superclass constructor)
my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dr_dsn });
@@ -1136,7 +1136,7 @@
my $params = (@bind_values) ?
[EMAIL PROTECTED] : $sth->{drv_params};
my $numParam = $sth->FETCH('NUM_OF_PARAMS');
- return $sth->set_err(1, "Wrong number of parameters")
+ return $sth->set_err($DBI::stderr, "Wrong number of parameters")
if @$params != $numParam;
my $statement = $sth->{'Statement'};
for (my $i = 0; $i < $numParam; $i++) {
Modified: dbi/trunk/lib/DBI/Gofer/Execute.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Execute.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Execute.pm Wed Sep 26 14:03:25 2007
@@ -626,7 +626,7 @@
}
if ($fail) {
undef $_; # tell DBI to not call the method
- return $h->set_err(1, "fake error from $method method induced by
DBI_GOFER_RANDOM env var ($fail_percent%)");
+ return $h->set_err($DBI::stderr, "fake error from $method method
induced by DBI_GOFER_RANDOM env var ($fail_percent%)");
}
return;
}
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Wed Sep 26 14:03:25 2007
@@ -689,7 +689,7 @@
my ($h1, $h2) = @_;
# can't make this work till we can get the outer handle from the inner one
# probably via a WeakRef
- return $h1->set_err(1, "swap_inner_handle not currently supported by
DBI::PurePerl");
+ return $h1->set_err($DBI::stderr, "swap_inner_handle not currently
supported by DBI::PurePerl");
}
sub trace { # XXX should set per-handle level, not global
