Author: timbo
Date: Thu Jul 1 05:19:57 2004
New Revision: 375
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
dbi/trunk/ToDo
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/01basics.t
Log:
Changed getting or setting an invalid attribute to no longer be
a fatal error but generate a warning instead.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Thu Jul 1 05:19:57 2004
@@ -22,6 +22,8 @@
Fixed DBD::Sponge not to generate warning with threads.
Fixed DBI_AUTOPROXY to work more than once thanks to Steven Hirsch.
+ Changed getting or setting an invalid attribute to no longer be
+ a fatal error but generate a warning instead.
Changed selectall_arrayref() to call finish() if
$attr->{MaxRows} is defined.
Changed all tests to use Test::More and enhanced the tests thanks
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Thu Jul 1 05:19:57 2004
@@ -1541,12 +1541,8 @@
char *hint = "";
if (strEQ(key, "NUM_FIELDS"))
hint = ", perhaps you meant NUM_OF_FIELDS";
- /* special dispensation for DBI::ProxyServer to reduce problems */
- /* when clients are using newer version of the DBI. Ought to be a */
- /* more general mechanism (eg event with event handler in proxysvr) */
- (gv_fetchpv("DBI::ProxyServer::ISA", FALSE, SVt_PVAV))
- ? warn( msg, neatsvpv(h,0), key, hint)
- : croak(msg, neatsvpv(h,0), key, hint);
+ warn(msg, neatsvpv(h,0), key, hint);
+ return FALSE; /* don't store it */
}
/* Allow private_* attributes to be stored in the cache. */
/* This is designed to make life easier for people subclassing */
@@ -1845,21 +1841,20 @@
/* finally check the actual hash just in case */
if (valuesv == Nullsv) {
+ valuesv = &sv_undef;
+ cacheit = 0;
svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE);
if (svp)
valuesv = newSVsv(*svp); /* take copy to mortalize */
- else if (!isUPPER(*key)) /* dbd_*, private_* etc */
- valuesv = &sv_undef;
- else if ( (*key=='H' && strEQ(key, "HandleError"))
+ else if (!( (*key=='H' && strEQ(key, "HandleError"))
|| (*key=='H' && strEQ(key, "HandleSetErr"))
|| (*key=='S' && strEQ(key, "Statement"))
|| (*key=='P' && strEQ(key, "ParamValues"))
|| (*key=='P' && strEQ(key, "Profile"))
|| (*key=='C' && strEQ(key, "CursorName"))
- )
- valuesv = &sv_undef;
- else
- croak("Can't get %s->{%s}: unrecognised attribute",neatsvpv(h,0),key);
+ || !isUPPER(*key) /* dbd_*, private_* etc */
+ ))
+ warn("Can't get %s->{%s}: unrecognised attribute",neatsvpv(h,0),key);
}
if (cacheit) {
Modified: dbi/trunk/ToDo
==============================================================================
--- dbi/trunk/ToDo (original)
+++ dbi/trunk/ToDo Thu Jul 1 05:19:57 2004
@@ -390,6 +390,11 @@
alternate rows - return RV to AV[row % 2]
row set - return RV to AV[++row]
+Enable fetchall_arrayref() to reuse a cached rowset so the overhead
+of allocating and freeing the individual row arrays and the rowset
+array can be avoided. fetchall_arrayref would then return the same
+arrayref each time. Most useful when combined with $maxrows.
+
Bless row into DBI::Row ?
Bless row set into DBI::Rowset ?
Give get/set access to entire rowset via method calls?
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Thu Jul 1 05:19:57 2004
@@ -626,7 +626,7 @@
return $DBI::dbi_debug if $key eq 'TraceLevel';
if (!$is_valid_attribute{$key} and $key =~ m/^[A-Z]/) {
local $^W; # hide undef warnings
- Carp::croak( sprintf "Can't get %s->{%s}: unrecognised attribute (@{[ %$h
]})",$h,$key )
+ Carp::carp( sprintf "Can't get %s->{%s}: unrecognised attribute (@{[ %$h
]})",$h,$key )
}
}
return $v;
@@ -647,7 +647,7 @@
return 1;
}
elsif (!$is_valid_attribute{$key} && $key =~ /^[A-Z]/ && !exists $h->{$key}) {
- Carp::croak(sprintf "Can't set %s->{%s}: unrecognised attribute or invalid
value %s",
+ Carp::carp(sprintf "Can't set %s->{%s}: unrecognised attribute or invalid
value %s",
$h,$key,$value);
}
$h->{$key} = $is_flag_attribute{$key} ? !!$value : $value;
Modified: dbi/trunk/t/01basics.t
==============================================================================
--- dbi/trunk/t/01basics.t (original)
+++ dbi/trunk/t/01basics.t Thu Jul 1 05:19:57 2004
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 109;
+use Test::More tests => 110;
## ----------------------------------------------------------------------------
## 01basic.t - test of some basic DBI functions
@@ -195,17 +195,21 @@
ok($switch->{Active}, '... Active flag is true');
-# test attribute exceptions
-
-eval {
+# test attribute warnings
+{
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= "@_" };
$switch->{FooBarUnknown} = 1;
-};
-like($@, qr/Can't set.*FooBarUnknown/, '... we should get an exception here');
+ like($warn, qr/Can't set.*FooBarUnknown/, '... we should get a warning here');
-eval {
+ $warn = "";
$_ = $switch->{BarFooUnknown};
-};
-like($@, qr/Can't get.*BarFooUnknown/, '... we should get an exception here');
+ like($warn, qr/Can't get.*BarFooUnknown/, '... we should get a warning here');
+
+ $warn = "";
+ my $dummy = $switch->{$_} for qw(private_foo dbd_foo dbi_foo); # special cases
+ cmp_ok($warn, 'eq', "", '... we should get no warnings here');
+}
# is this here for a reason? Are we testing anything?
