Author: timbo
Date: Wed Feb 21 08:24:42 2007
New Revision: 9149

Modified:
   dbi/trunk/Changes
   dbi/trunk/DBI.pm
   dbi/trunk/DBI.xs
   dbi/trunk/lib/DBD/Gofer.pm
   dbi/trunk/lib/DBI/Gofer/Execute.pm
   dbi/trunk/t/10examp.t

Log:
Force quote and quote_identifier to gofer for now - will ass policy later.
Set sth not active initially.
Handle both go_current_rowset and go_current_rowset_err being undef better.
Assorted doc changes.


Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes   (original)
+++ dbi/trunk/Changes   Wed Feb 21 08:24:42 2007
@@ -18,6 +18,8 @@
 Refactor http transport like the others re timeout
 Call method on transport timeout so transport can cleanup/reset it it wants
 
+XXX quote and quote_info policy control
+
 =head2 Changes in DBI 1.54 (svn rev 9140),  19th February 2007
 
   NOTE: This release includes the 'next big thing' for DBI: DBD::Gofer.

Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm    (original)
+++ dbi/trunk/DBI.pm    Wed Feb 21 08:24:42 2007
@@ -7520,9 +7520,10 @@
 
 =head1 AUTHORS
 
-DBI by Tim Bunce.  This pod text by Tim Bunce, J. Douglas Dunlop,
-Jonathan Leffler and others.  Perl by Larry Wall and the
-C<perl5-porters>.
+DBI by Tim Bunce, L<http://www.linkedin.com/in/timbunce>
+
+This pod text by Tim Bunce, J. Douglas Dunlop, Jonathan Leffler and others.
+Perl by Larry Wall and the C<perl5-porters>.
 
 =head1 COPYRIGHT
 
@@ -7696,28 +7697,6 @@
 (If you offer professional DBI related training services,
 please send me your details so I can add them here.)
 
-=head1 FREQUENTLY ASKED QUESTIONS
-
-See the DBI FAQ for a more comprehensive list of FAQs. Use the
-C<perldoc DBI::FAQ> command to read it.
-
-=head2 Why doesn't my CGI script work right?
-
-Read the information in the references below.  Please do I<not> post
-CGI related questions to the I<dbi-users> mailing list (or to me).
-
- http://www.perl.com/cgi-bin/pace/pub/doc/FAQs/cgi/perl-cgi-faq.html
- http://www3.pair.com/webthing/docs/cgi/faqs/cgifaq.shtml
- http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
- http://www.boutell.com/faq/
- http://www.perl.com/perl/faq/
-
-=head2 How can I maintain a WWW connection to a database?
-
-For information on the Apache httpd server and the C<mod_perl> module see
-
-  http://perl.apache.org/
-
 =head1 OTHER RELATED WORK AND PERL MODULES
 
 =over 4
@@ -7729,19 +7708,6 @@
 remains open for the lifetime of the HTTP daemon. This way the CGI
 connect and disconnect for every database access becomes superfluous.
 
-=item JDBC Server by Stuart 'Zen' Bishop [EMAIL PROTECTED]
-
-The server is written in Perl. The client classes that talk to it are
-of course in Java. Thus, a Java applet or application will be able to
-comunicate via the JDBC API with any database that has a DBI driver installed.
-The URL used is in the form C<jdbc:dbi://host.domain.etc:999/Driver/DBName>.
-It seems to be very similar to some commercial products, such as jdbcKona.
-
-=item Remote Proxy DBD support
-
-As of DBI 1.02, a complete implementation of a DBD::Proxy driver and the
-DBI::ProxyServer are part of the DBI distribution.
-
 =item SQL Parser
 
 See also the L<SQL::Statement> module, SQL parser and engine.

Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs    (original)
+++ dbi/trunk/DBI.xs    Wed Feb 21 08:24:42 2007
@@ -1303,7 +1303,8 @@
        if (DBIc_TYPE(imp_xxh) <= DBIt_DB) {
            imp_dbh_t *imp_dbh = (imp_dbh_t*)imp_xxh; /* works for DRH also */
            if (DBIc_CACHED_KIDS(imp_dbh)) {
-               warn("DBI handle 0x%lx cleared whilst still holding %d cached 
kids",
+               warn("DBI %s handle 0x%lx cleared whilst still holding %d 
cached kids",
+                        dbih_htype_name(DBIc_TYPE(imp_xxh)),
                        (unsigned long)DBIc_MY_H(imp_xxh), 
(int)HvKEYS(DBIc_CACHED_KIDS(imp_dbh)) );
                SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* may recurse */
                DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
@@ -1315,19 +1316,22 @@
             if (DBIc_TYPE(imp_xxh) >= DBIt_ST
             || (DBIc_ACTIVE_KIDS(imp_xxh) || !DBIc_has(imp_xxh, 
DBIcf_AutoCommit))
             ) {
-                warn("DBI handle 0x%lx cleared whilst still active", (unsigned 
long)DBIc_MY_H(imp_xxh));
+                warn("DBI %s handle 0x%lx cleared whilst still active",
+                        dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned 
long)DBIc_MY_H(imp_xxh));
                 dump = TRUE;
             }
        }
 
        /* check that the implementor has done its own housekeeping     */
        if (DBIc_IMPSET(imp_xxh)) {
-           warn("DBI handle 0x%lx has uncleared implementors data", (unsigned 
long)DBIc_MY_H(imp_xxh));
+           warn("DBI %s handle 0x%lx has uncleared implementors data",
+                    dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned 
long)DBIc_MY_H(imp_xxh));
            dump = TRUE;
        }
 
        if (DBIc_KIDS(imp_xxh)) {
-           warn("DBI handle 0x%lx has %d uncleared child handles",
+           warn("DBI %s handle 0x%lx has %d uncleared child handles",
+                    dbih_htype_name(DBIc_TYPE(imp_xxh)),
                    (unsigned long)DBIc_MY_H(imp_xxh), (int)DBIc_KIDS(imp_xxh));
            dump = TRUE;
        }
@@ -1718,15 +1722,15 @@
        if (DBIc_NUM_FIELDS(imp_sth) > 0        /* don't change NUM_FIELDS! */
         &&  DBIc_ACTIVE(imp_sth)                /* if sth is Active */
         ) {
-           croak("Can't change NUM_OF_FIELDS (already set to %d)", 
DBIc_NUM_FIELDS(imp_sth));
+           croak("Can't change NUM_OF_FIELDS of Active handle (already set to 
%d)", DBIc_NUM_FIELDS(imp_sth));
         }
         if (DBIc_NUM_FIELDS(imp_sth) > 0
         && SvIV(valuesv) != DBIc_NUM_FIELDS(imp_sth)
         && DBIc_TRACE_LEVEL(imp_sth)
         && DBIc_FIELDS_AV(imp_sth)
         ) {
-            PerlIO_printf(DBILOGFP,"Warning: changing NUM_OF_FIELDS (from %d 
to %d) after row buffer already allocated",
-                    (int)SvIV(valuesv), DBIc_NUM_FIELDS(imp_sth));
+            PerlIO_printf(DBILOGFP,"Changing NUM_OF_FIELDS (from %d to %d) 
after row buffer already allocated\n",
+                    DBIc_NUM_FIELDS(imp_sth), (int)SvIV(valuesv));
         }
        DBIc_NUM_FIELDS(imp_sth) = (SvOK(valuesv)) ? SvIV(valuesv) : -1;
        cacheit = 1;
@@ -3246,7 +3250,7 @@
                break;
            default:
                if (DBIc_WARN(imp_xxh)) {
-                   PerlIO_printf(DBILOGFP,"Don't know how to taint contents of 
returned %s (type %d)",
+                   PerlIO_printf(DBILOGFP,"Don't know how to taint contents of 
returned %s (type %d)\n",
                        neatsvpv(agg,0), (int)SvTYPE(agg));
                }
            }

Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm  (original)
+++ dbi/trunk/lib/DBD/Gofer.pm  Wed Feb 21 08:24:42 2007
@@ -263,6 +263,16 @@
         *$method = sub { return shift->go_dbh_method(undef, $method, @_) }
     }
 
+    # Methods that should be forwarded if policy says so
+    for my $method (qw(
+        quote
+        quote_identifier
+    )) {
+        no strict 'refs';
+        # XXX add policy checks
+        *$method = sub { return shift->go_dbh_method(undef, $method, @_) }
+    }
+
     # Methods that should always fail
     for my $method (qw(
         begin_work commit rollback
@@ -360,6 +370,7 @@
             go_trans => $dbh->{go_trans},
             go_policy => $policy,
         });
+        $sth->STORE(Active => 0);
 
         my $skip_prepare_check = $policy->skip_prepare_check($attr, $dbh, 
$statement, $attr, $sth);
         if (not $skip_prepare_check) {
@@ -480,6 +491,7 @@
         # copy meta attributes into attribute cache
         my $NUM_OF_FIELDS = delete $meta->{NUM_OF_FIELDS};
         $sth->STORE('NUM_OF_FIELDS', $NUM_OF_FIELDS);
+        # XXX need to use STORE for some?
         $sth->{$_} = $meta->{$_} for keys %$meta;
 
         if (($NUM_OF_FIELDS||0) > 0) {
@@ -496,8 +508,12 @@
 
     sub fetchrow_arrayref {
        my ($sth) = @_;
-       my $resultset = $sth->{go_current_rowset}
-            or return $sth->set_err( @{ $sth->{go_current_rowset_err} } );
+       my $resultset = $sth->{go_current_rowset} || do {
+            # should only happen if fetch called after execute failed
+            my $rowset_err = $sth->{go_current_rowset_err}
+                || [ 1, 'no result set (did execute fail)' ];
+            return $sth->set_err( @$rowset_err );
+        };
         return $sth->_set_fbav(shift @$resultset) if @$resultset;
        $sth->finish;     # no more data so finish
        return undef;
@@ -644,7 +660,7 @@
 
 There are naturally a some constraints imposed by DBD::Gofer. But not many:
 
-=head2 You can't change database handle attributes
+=head2 You can't change database handle attributes after connect()
 
 You can't change database handle attributes after you've connected.
 Use the connect() call to specify all the attribute settings you want.
@@ -652,6 +668,10 @@
 This is because it's critical that when a request is complete the database
 handle is left in the same state it was when first connected.
 
+=head2 You can't change statement handle attributes after prepare()
+
+You can't change statment handle attributes after prepare.
+
 =head2 You can't use transactions.
 
 AutoCommit only. Transactions aren't supported.
@@ -683,8 +703,6 @@
 
 =head2 Driver-private Database Handle Attributes
 
-Driver-private drh attributes can be set in the connect() call.
-
 Some driver-private dbh attributes may not be available if the driver does not
 implemented the private_attribute_info() method (added in DBI 1.54).
 
@@ -757,7 +775,8 @@
 this transport very slow. It's useful, however, both as a proof of concept and
 as a base class for the stream driver.
 
-It doesn't take any parameters.
+This transport supports a timeout parameter in the dsn which specifies
+the maximum time it can take to send a requestor receive a response.
 
 =head3 stream
 
@@ -770,7 +789,8 @@
 to easily access any databases that's accessible from any system you can login 
to.
 You also get all the benefits of ssh, including encryption and optional 
compression.
 
-It's also likely that this transport will support safe timeouts in future.
+This transport supports a timeout parameter in the dsn which specifies the
+maximum time it can take to send a requestor receive a response.
 
 See L</DBI_AUTOPROXY> below for an example.
 
@@ -778,6 +798,8 @@
 
 The http driver uses the http protocol to send Gofer requests and receive 
replies.
 
+It's also very likely that this transport will support safe timeouts in 
future. XXX
+
 The DBI::Gofer::Transport::mod_perl module implements the corresponding 
server-side
 transport.
 

Modified: dbi/trunk/lib/DBI/Gofer/Execute.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Execute.pm  (original)
+++ dbi/trunk/lib/DBI/Gofer/Execute.pm  Wed Feb 21 08:24:42 2007
@@ -223,7 +223,7 @@
             ?        $dbh->$meth(@$args)
             : scalar $dbh->$meth(@$args);
         [EMAIL PROTECTED];
-    };
+    } || [];
     my $response = $self->new_response_with_err($rv_ref, $@);
 
     return $response if not $dbh;

Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t       (original)
+++ dbi/trunk/t/10examp.t       Wed Feb 21 08:24:42 2007
@@ -183,9 +183,9 @@
 ok(@row_a);
 
 # check bind_columns
-ok($row_a[0] eq $col0) or print "$row_a[0] ne $col0\n";
-ok($row_a[1] eq $col1) or print "$row_a[1] ne $col1\n";
-ok($row_a[2] eq $col2) or print "$row_a[2] ne $col2\n";
+is($row_a[0], $col0);
+is($row_a[1], $col1);
+is($row_a[2], $col2);
 #$csr_a->trace(0);
 
 ok( ! $csr_a->bind_columns(undef, \($col0, $col1)) );

Reply via email to