Merge branch 'master' into sponge-PRECISION

Author: pilcrow

.travis.yml

@@ -1,6 +1,9 @@
 language: perl
 perl:
+  - "5.20"
+  - "5.20-extras"
   - "5.18"
+  - "5.18-extras"
   - "5.16"
   - "5.14"
   - "5.12"

Changes

@@ -6,12 +6,48 @@ DBI::Changes - List of significant changes to the DBI
 
 =cut
 
-=head2 Changes in DBI 1.632
+=head2 Changes in DBI 1.634
 
+    Fixed support for DBD prefixes with numbers (Jens Rehsack)
+
+    Added extra initializer for DBI::DBD::SqlEngine based DBD's (Jens Rehsack)
+
+=head2 Changes in DBI 1.633 - 11th Jan 2015
+
+    Fixed selectrow_*ref to return undef on error in list context
+        instead if an empty list.
+    Changed t/42prof_data.t more informative
+    Changed $sth->{TYPE} to be NUMERIC in DBD::File drivers as per the
+        DBI docs. Note TYPE_NAME is now also available. [H.Merijn Brand]
+    Fixed compilation error on bleadperl due DEFSV no longer being an lvalue
+        [Dagfinn Ilmari Manns�ker]
+
+    Added docs for escaping placeholders using a backslash.
+    Added docs for get_info(9000) indicating ability to escape placeholders.
+    Added multi_ prefix for DBD::Multi (Dan Wright) and ad2_ prefix for
+        DBD::AnyData2
+
+=head2 Changes in DBI 1.632 - 9th Nov 2014
+
+    Fixed risk of memory corruption with many arguments to methods
+        originally reported by OSCHWALD for Callbacks but may apply
+        to other functionality in DBI method dispatch RT#86744.
     Fixed DBD::PurePerl to not set $sth->{Active} true by default
         drivers are expected to set it true as needed.
     Fixed DBI::DBD::SqlEngine to complain loudly when prerequite
         driver_prefix is not fulfilled (RT#93204) [Jens Rehsack]
+    Fixed redundant sprintf argument warning RT#97062 [Reini Urban]
+    Fixed security issue where DBD::File drivers would open files
+        from folders other than specifically passed using the
+        f_dir attribute RT#99508 [H.Merijn Brand]
+
+    Changed delete $h->{$key} to work for keys with 'private_' prefix
+        per request in RT#83156. local $h->{$key} works as before.
+
+    Added security notice to DBD::Proxy and DBI::ProxyServer because they
+        use Storable which is insecure. Thanks to ppisar@redhat.com RT#90475
+    Added note to AutoInactiveDestroy docs strongly recommending that it
+        is enabled in all new code.
 
 =head2 Changes in DBI 1.631 - 20th Jan 2014
 

DBI.pm

@@ -11,7 +11,7 @@ package DBI;
 require 5.008_001;
 
 BEGIN {
-our $XS_VERSION = our $VERSION = "1.631"; # ==> ALSO update the version in the pod text below!
+our $XS_VERSION = our $VERSION = "1.633"; # ==> ALSO update the version in the pod text below!
 $VERSION = eval $VERSION;
 }
 
@@ -144,7 +144,7 @@ sure that your issue isn't related to the driver you're using.
 
 =head2 NOTES
 
-This is the DBI specification that corresponds to DBI version 1.631
+This is the DBI specification that corresponds to DBI version 1.633
 (see L<DBI::Changes> for details).
 
 The DBI is evolving at a steady pace, so it's good to check that
@@ -328,6 +328,7 @@ sub DBI::var::STORE    { Carp::croak("Can't modify \$DBI::${$_[0]} special varia
 
 my $dbd_prefix_registry = {
   ad_          => { class => 'DBD::AnyData',        },
+  ad2_         => { class => 'DBD::AnyData2',       },
   ado_         => { class => 'DBD::ADO',            },
   amzn_        => { class => 'DBD::Amazon',         },
   best_        => { class => 'DBD::BestWins',       },
@@ -350,6 +351,7 @@ my $dbd_prefix_registry = {
   msql_        => { class => 'DBD::mSQL',           },
   mvsftp_      => { class => 'DBD::MVS_FTPSQL',     },
   mysql_       => { class => 'DBD::mysql',          },
+  multi_       => { class => 'DBD::Multi'           },
   mx_          => { class => 'DBD::Multiplex',      },
   neo_         => { class => 'DBD::Neo4p',          },
   nullp_       => { class => 'DBD::NullP',          },
@@ -411,6 +413,7 @@ my $keeperr = { O=>0x0004 };
 	'FIRSTKEY'	=> $keeperr,
 	'NEXTKEY'	=> $keeperr,
 	'STORE'		=> { O=>0x0418 | 0x4 },
+	'DELETE'	=> { O=>0x0404 },
 	can		=> { O=>0x0100 }, # special case, see dispatch
 	debug 	 	=> { U =>[1,2,'[$debug_level]'],	O=>0x0004 }, # old name for trace
 	dump_handle 	=> { U =>[1,3,'[$message [, $level]]'],	O=>0x0004 },
@@ -1388,7 +1391,7 @@ sub _new_sth {	# called by DBD::<drivername>::db::prepare)
 	    unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
 	my ($driver, $subtype) = ($1, $2);
 	Carp::croak("invalid method name '$method'")
-	    unless $method =~ m/^([a-z]+_)\w+$/;
+	    unless $method =~ m/^([a-z][a-z0-9]*_)\w+$/;
 	my $prefix = $1;
 	my $reg_info = $dbd_prefix_registry->{$prefix};
 	Carp::carp("method name prefix '$prefix' is not associated with a registered driver") unless $reg_info;
@@ -1635,9 +1638,9 @@ sub _new_sth {	# called by DBD::<drivername>::db::prepare)
     sub _do_selectrow {
 	my ($method, $dbh, $stmt, $attr, @bind) = @_;
 	my $sth = ((ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr))
-	    or return;
+	    or return undef;
 	$sth->execute(@bind)
-	    or return;
+	    or return undef;
 	my $row = $sth->$method()
 	    and $sth->finish;
 	return $row;
@@ -2417,6 +2420,11 @@ If the C<:>I<N> form of placeholder is supported by the driver you're using,
 then you should be able to use either L</bind_param> or L</execute> to bind
 values. Check your driver documentation.
 
+Some drivers allow you to prevent the recognition of a placeholder by placing a
+single backslash character (C<\>) immediately before it. The driver will remove
+the backslash character and ignore the placeholder, passing it unchanged to the
+backend. If the driver supports this then L</get_info>(9000) will return true.
+
 With most drivers, placeholders can't be used for any element of a
 statement that would prevent the database server from validating the
 statement and creating a query execution plan for it. For example:
@@ -3689,8 +3697,8 @@ the destruction of inherited handles cause the corresponding handles in the
 parent process to cease working.
 
 Either the parent or the child process, but not both, should set
-C<InactiveDestroy> true on all their shared handles. Alternatively the
-L</AutoInactiveDestroy> can be set in the parent on connect.
+C<InactiveDestroy> true on all their shared handles. Alternatively, and
+preferably, the L</AutoInactiveDestroy> can be set in the parent on connect.
 
 To help tracing applications using fork the process id is shown in
 the trace log whenever a DBI or handle trace() method is called.
@@ -3703,12 +3711,15 @@ from the DBI's method dispatcher, e.g. >= 9.
 Type: boolean, inherited
 
 The L</InactiveDestroy> attribute, described above, needs to be explicitly set
-in the child process after a fork(). This is a problem if the code that performs
-the fork() is not under your control, perhaps in a third-party module.
-Use C<AutoInactiveDestroy> to get around this situation.
+in the child process after a fork(), on every active database and statement handle.
+This is a problem if the code that performs the fork() is not under your
+control, perhaps in a third-party module.  Use C<AutoInactiveDestroy> to get
+around this situation.
 
 If set true, the DESTROY method will check the process id of the handle and, if
 different from the current process id, it will set the I<InactiveDestroy> attribute.
+It is strongly recommended that C<AutoInactiveDestroy> is enabled on all new code
+(it's only not enabled by default to avoid backwards compatibility problems).
 
 This is the example it's designed to deal with:
 
@@ -4963,6 +4974,13 @@ of information types to ensure the DBI itself works properly:
    41  SQL_CATALOG_NAME_SEPARATOR  '.'           '@'
   114  SQL_CATALOG_LOCATION        1             2
 
+Values from 9000 to 9999 for get_info are officially reserved for use by Perl DBI.
+Values in that range which have been assigned a meaning are defined here:
+
+C<9000>: true if a backslash character (C<\>) before placeholder-like text
+(e.g. C<?>, C<:foo>) will prevent it being treated as a placeholder by the driver.
+The backslash will be removed before the text is passed to the backend.
+
 =head3 C<table_info>
 
   $sth = $dbh->table_info( $catalog, $schema, $table, $type );
@@ -7078,7 +7096,7 @@ For example:
   my $sth2 = $dbh->prepare( $sth1->{Statement} );
   my $ParamValues = $sth1->{ParamValues} || {};
   my $ParamTypes  = $sth1->{ParamTypes}  || {};
-  $sth2->bind_param($_, $ParamValues->{$_} $ParamTypes->{$_})
+  $sth2->bind_param($_, $ParamValues->{$_}, $ParamTypes->{$_})
     for keys %{ {%$ParamValues, %$ParamTypes} };
   $sth2->execute();
 

DBI.xs

@@ -2900,7 +2900,7 @@ dbi_profile(SV *h, imp_xxh_t *imp_xxh, SV *statement_sv, SV *method, NV t1, NV t
                 PUSHs( sv_2mortal(newSVpv(method_pv,0)));
                 PUTBACK;
                 SAVE_DEFSV; /* local($_) = $statement */
-                DEFSV = statement_sv;
+                DEFSV_set(statement_sv);
                 items = call_sv(code_sv, G_ARRAY);
                 SPAGAIN;
                 SP -= items ;
@@ -3147,6 +3147,7 @@ XS(XS_DBI_dispatch);            /* prototype to pass -Wmissing-prototypes */
 XS(XS_DBI_dispatch)
 {
     dXSARGS;
+    dORIGMARK;
     dMY_CXT;
 
     SV *h   = ST(0);            /* the DBI handle we are working with   */
@@ -3447,6 +3448,7 @@ XS(XS_DBI_dispatch)
                     XPUSHs(*hp);
                     PUTBACK;
                     call_method("DESTROY", G_DISCARD|G_EVAL|G_KEEPERR);
+                    MSPAGAIN;
                 }
                 else {
                     imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ *hp, 0);
@@ -3539,8 +3541,8 @@ XS(XS_DBI_dispatch)
         SV *code = SvRV(*hook_svp);
         I32 skip_dispatch = 0;
         if (trace_level)
-            PerlIO_printf(DBILOGFP, "%c   {{ %s callback %s being invoked\n",
-                (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0));
+            PerlIO_printf(DBILOGFP, "%c   {{ %s callback %s being invoked with %ld args\n",
+                (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0), (long)items);
 
         /* we don't use ENTER,SAVETMPS & FREETMPS,LEAVE because we may need mortal
          * results to live long enough to be returned to our caller
@@ -3552,7 +3554,7 @@ XS(XS_DBI_dispatch)
          */
         orig_defsv = DEFSV; /* remember the current $_ */
         SAVE_DEFSV;         /* local($_) = $method_name */
-        DEFSV = sv_2mortal(newSVpv(meth_name,0));
+        DEFSV_set(sv_2mortal(newSVpv(meth_name,0)));
 
         EXTEND(SP, items+1);
         PUSHMARK(SP);
@@ -3562,14 +3564,14 @@ XS(XS_DBI_dispatch)
         }
         PUTBACK;
         outitems = call_sv(code, G_ARRAY); /* call the callback code */
-        SPAGAIN;
+        MSPAGAIN;
 
         /* The callback code can undef $_ to indicate to skip dispatch */
         skip_dispatch = !SvOK(DEFSV);
         /* put $_ back now, but with an incremented ref count to compensate
          * for the ref count decrement that will happen when we exit the scope.
          */
-        DEFSV = SvREFCNT_inc(orig_defsv);
+        DEFSV_set(SvREFCNT_inc(orig_defsv));
 
         if (trace_level)
             PerlIO_printf(DBILOGFP, "%c   }} %s callback %s returned%s\n",
@@ -3890,7 +3892,7 @@ XS(XS_DBI_dispatch)
                 XPUSHs(&PL_sv_yes);
                 PUTBACK;
                 call_method("STORE", G_DISCARD);
-                SPAGAIN;
+                MSPAGAIN;
             }
         }
     }
@@ -4047,7 +4049,7 @@ XS(XS_DBI_dispatch)
             XPUSHs( result );
             PUTBACK;
             items = call_sv(*hook_svp, G_SCALAR);
-            SPAGAIN;
+            MSPAGAIN;
             status = (items) ? POPs : &PL_sv_undef;
             PUTBACK;
             if (trace_level)
@@ -4155,7 +4157,7 @@ preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept, void *foo)
     char rt_comment = '\0';
     char *dest, *start;
     const char *src;
-    const char *style = "", *laststyle = '\0';
+    const char *style = "", *laststyle = NULL;
     SV *new_stmt_sv;
 
     (void)foo;
@@ -5445,6 +5447,19 @@ FETCH(h, keysv)
     ST(0) = dbih_get_attr_k(h, keysv, 0);
     (void)cv;
 
+void
+DELETE(h, keysv)
+    SV *        h
+    SV *        keysv
+    CODE:
+    /* only private_* keys can be deleted, for others DELETE acts like FETCH */
+    /* because the DBI internals rely on certain handle attributes existing  */
+    if (strnEQ(SvPV_nolen(keysv),"private_",8))
+        ST(0) = hv_delete_ent((HV*)SvRV(h), keysv, 0, 0);
+    else
+        ST(0) = dbih_get_attr_k(h, keysv, 0);
+    (void)cv;
+
 
 void
 private_data(h)

Makefile.PL

@@ -64,6 +64,7 @@ my %opts = (
 	    MailingList => 'mailto:dbi-dev@perl.org',
 	    license     => 'http://dev.perl.org/licenses/',
 	    homepage    => 'http://dbi.perl.org/',
+	    IRC		=> 'irc://irc.perl.org/#dbi',
 	},
 	suggests => {
 	    'RPC::PlServer'  => 0.2001,