Hello community, here is the log from the commit of package perl-DBI for openSUSE:Factory checked in at 2017-09-04 12:18:31 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-DBI (Old) and /work/SRC/openSUSE:Factory/.perl-DBI.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-DBI" Mon Sep 4 12:18:31 2017 rev:43 rq:519301 version:1.637 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-DBI/perl-DBI.changes 2016-06-03 16:34:24.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-DBI.new/perl-DBI.changes 2017-09-04 12:18:36.196986480 +0200 @@ -1,0 +2,27 @@ +Fri Aug 18 05:16:23 UTC 2017 - [email protected] + +- updated to 1.637 + see /usr/share/doc/packages/perl-DBI/Changes + + =head2 Changes in DBI 1.637 - ... + + Fix use of externally controlled format string (CWE-134) thanks to pali #44 + This could cause a crash if, for example, a db error contained a %. + https://cwe.mitre.org/data/definitions/134.html + Fix extension detection for DBD::File related drivers + Fix tests for perl without dot in @INC RT#120443 + Fix loss of error message on parent handle, thanks to charsbar #34 + Fix disappearing $_ inside callbacks, thanks to robschaber #47 + + Allow objects to be used as passwords without throwing an error, thanks to demerphq #40 + Allow $sth NAME_* attributes to be set from Perl code, re #45 + Added support for DBD::XMLSimple thanks to nigelhorne #38 + + Documentation updates: + Improve examples using eval to be more correct, thanks to pali #39 + Add cautionary note to prepare_cached docs re refs in %attr #46 + Small POD changes (Getting Help -> Online) thanks to openstrike #33 + Adds links to more module names and fix typo, thanks to oalders #43 + Typo fix thanks to bor #37 + +------------------------------------------------------------------- Old: ---- DBI-1.636.tar.gz New: ---- DBI-1.637.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-DBI.spec ++++++ --- /var/tmp/diff_new_pack.CbRpsL/_old 2017-09-04 12:18:38.088720538 +0200 +++ /var/tmp/diff_new_pack.CbRpsL/_new 2017-09-04 12:18:38.088720538 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-DBI # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,14 +17,14 @@ Name: perl-DBI -Version: 1.636 +Version: 1.637 Release: 0 %define cpan_name DBI Summary: Database independent interface for Perl License: Artistic-1.0 or GPL-1.0+ Group: Development/Libraries/Perl Url: http://search.cpan.org/dist/DBI/ -Source0: http://www.cpan.org/authors/id/T/TI/TIMB/%{cpan_name}-%{version}.tar.gz +Source0: https://cpan.metacpan.org/authors/id/T/TI/TIMB/%{cpan_name}-%{version}.tar.gz Source1: perl-DBI.rpmlintrc Source2: cpanspec.yml BuildRoot: %{_tmppath}/%{name}-%{version}-build @@ -68,6 +68,7 @@ %files -f %{name}.files %defattr(-,root,root,755) -%doc Changes Driver.xst LICENSE README.md +%doc Changes Driver.xst README.md +%license LICENSE %changelog ++++++ DBI-1.636.tar.gz -> DBI-1.637.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/Changes new/DBI-1.637/Changes --- old/DBI-1.636/Changes 2016-04-25 00:01:47.000000000 +0200 +++ new/DBI-1.637/Changes 2017-08-14 00:02:28.000000000 +0200 @@ -6,6 +6,27 @@ =cut +=head2 Changes in DBI 1.637 - ... + + Fix use of externally controlled format string (CWE-134) thanks to pali #44 + This could cause a crash if, for example, a db error contained a %. + https://cwe.mitre.org/data/definitions/134.html + Fix extension detection for DBD::File related drivers + Fix tests for perl without dot in @INC RT#120443 + Fix loss of error message on parent handle, thanks to charsbar #34 + Fix disappearing $_ inside callbacks, thanks to robschaber #47 + + Allow objects to be used as passwords without throwing an error, thanks to demerphq #40 + Allow $sth NAME_* attributes to be set from Perl code, re #45 + Added support for DBD::XMLSimple thanks to nigelhorne #38 + + Documentation updates: + Improve examples using eval to be more correct, thanks to pali #39 + Add cautionary note to prepare_cached docs re refs in %attr #46 + Small POD changes (Getting Help -> Online) thanks to openstrike #33 + Adds links to more module names and fix typo, thanks to oalders #43 + Typo fix thanks to bor #37 + =head2 Changes in DBI 1.636 - 24th April 2016 Fix compilation for threaded perl <= 5.12 broken in 1.635 RT#113955 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/DBI.pm new/DBI-1.637/DBI.pm --- old/DBI-1.636/DBI.pm 2016-04-25 00:03:23.000000000 +0200 +++ new/DBI-1.637/DBI.pm 2017-08-14 10:04:12.000000000 +0200 @@ -11,7 +11,7 @@ require 5.008_001; BEGIN { -our $XS_VERSION = our $VERSION = "1.636"; # ==> ALSO update the version in the pod text below! +our $XS_VERSION = our $VERSION = "1.637"; # ==> ALSO update the version in the pod text below! $VERSION = eval $VERSION; } @@ -122,15 +122,12 @@ =head3 Online StackOverflow has a DBI tag L<http://stackoverflow.com/questions/tagged/dbi> -with over 400 questions. +with over 800 questions. The DBI home page at L<http://dbi.perl.org/> and the DBI FAQ at L<http://faq.dbi-support.com/> may be worth a visit. They include links to other resources, but I<are rather out-dated>. -I don't recommend the DBI cpanforum (at http://www.cpanforum.com/dist/DBI) -because relatively few people read it compared with [email protected]. - =head3 Reporting a Bug If you think you've found a bug then please read @@ -146,7 +143,7 @@ =head2 NOTES -This is the DBI specification that corresponds to DBI version 1.636 +This is the DBI specification that corresponds to DBI version 1.637 (see L<DBI::Changes> for details). The DBI is evolving at a steady pace, so it's good to check that @@ -174,6 +171,7 @@ # The POD text continues at the end of the file. +use Scalar::Util (); use Carp(); use DynaLoader (); use Exporter (); @@ -303,14 +301,6 @@ DBI->trace_msg("DBI connect via $DBI::connect_via in $INC{'Apache/DBI.pm'}\n"); } -# check for weaken support, used by ChildHandles -my $HAS_WEAKEN = eval { - require Scalar::Util; - # this will croak() if this Scalar::Util doesn't have a working weaken(). - Scalar::Util::weaken( \my $test ); # same test as in t/72childhandles.t - 1; -}; - %DBI::installed_drh = (); # maps driver names to installed driver handles sub installed_drivers { %DBI::installed_drh } %DBI::installed_methods = (); # XXX undocumented, may change @@ -385,6 +375,7 @@ wmi_ => { class => 'DBD::WMI', }, x_ => { }, # for private use xbase_ => { class => 'DBD::XBase', }, + xmlsimple_ => { class => 'DBD::XMLSimple', }, xl_ => { class => 'DBD::Excel', }, yaswi_ => { class => 'DBD::Yaswi', }, }; @@ -535,7 +526,6 @@ # End of init code - END { return unless defined &DBI::trace_msg; # return unless bootstrap'd ok local ($!,$?); @@ -616,7 +606,8 @@ DBI->trace_msg(" -> $class->$connect_meth(".join(", ",@args).")\n"); } Carp::croak('Usage: $class->connect([$dsn [,$user [,$passwd [,\%attr]]]])') - if (ref $old_driver or ($attr and not ref $attr) or ref $pass); + if (ref $old_driver or ($attr and not ref $attr) or + (ref $pass and not defined Scalar::Util::blessed($pass))); # extract dbi:driver prefix from $dsn into $1 $dsn =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i @@ -2755,7 +2746,7 @@ will die on a driver installation failure and will only return C<undef> on a connect failure, in which case C<$DBI::errstr> will hold the error message. -Use C<eval { ... }> if you need to catch the "C<install_driver>" error. +Use C<eval> if you need to catch the "C<install_driver>" error. The C<$data_source> argument (with the "C<dbi:...:>" prefix removed) and the C<$username> and C<$password> arguments are then passed to the driver for @@ -3807,23 +3798,24 @@ If you turn C<RaiseError> on then you'd normally turn C<PrintError> off. If C<PrintError> is also on, then the C<PrintError> is done first (naturally). -Typically C<RaiseError> is used in conjunction with C<eval { ... }> -to catch the exception that's been thrown and followed by an -C<if ($@) { ... }> block to handle the caught exception. +Typically C<RaiseError> is used in conjunction with C<eval>, +or a module like L<Try::Tiny> or L<TryCatch>, +to catch the exception that's been thrown and handle it. For example: - eval { + use Try::Tiny; + + try { ... $sth->execute(); ... - }; - if ($@) { + } catch { # $sth->err and $DBI::err will be true if error was from DBI - warn $@; # print the error + warn $_; # print the error (which Try::Tiny puts into $_) ... # do whatever you need to deal with the error - } + }; -In that eval block the $DBI::lasth variable can be useful for +In the catch block the $DBI::lasth variable can be useful for diagnosis and reporting if you can't be sure which handle triggered the error. For example, $DBI::lasth->{Type} and $DBI::lasth->{Statement}. @@ -4597,7 +4589,7 @@ data from the statement. The C<$statement> parameter can be a previously prepared statement handle, in which case the C<prepare> is skipped. -If any method fails, and L</RaiseError> is not set, C<selectrow_array> +If any method fails, and L</RaiseError> is not set, C<selectrow_arrayref> will return undef. @@ -4788,7 +4780,7 @@ stored in a hash associated with the C<$dbh>. If another call is made to C<prepare_cached> with the same C<$statement> and C<%attr> parameter values, then the corresponding cached C<$sth> will be returned without contacting the -database server. +database server. Be sure to understand the cautions and caveats noted below. The C<$if_active> parameter lets you adjust the behaviour if an already cached statement handle is still Active. There are several @@ -4871,6 +4863,12 @@ which will ensure that prepare_cached only returns statements cached by that line of code in that source file. +Also, to ensure the attributes passed are always the same, avoid passing +references inline. For example, the Slice attribute is specified as a +reference. Be sure to declare it external to the call to prepare_cached(), such +that a new hash reference is not created on every call. See L</connect_cached> +for more details and examples. + If you'd like the cache to managed intelligently, you can tie the hashref returned by C<CachedKids> to an appropriate caching module, such as L<Tie::Cache::LRU>: @@ -7251,19 +7249,19 @@ with various types of databases. The recommended way to implement robust transactions in Perl -applications is to use C<RaiseError> and S<C<eval { ... }>> -(which is very fast, unlike S<C<eval "...">>). For example: +applications is to enable L</RaiseError> and catch the error that's 'thrown' as +an exception. For example, using L<Try::Tiny>: + use Try::Tiny; $dbh->{AutoCommit} = 0; # enable transactions, if possible $dbh->{RaiseError} = 1; - eval { + try { foo(...) # do lots of work here bar(...) # including inserts baz(...) # and updates $dbh->commit; # commit the changes if we get this far - }; - if ($@) { - warn "Transaction aborted because $@"; + } catch { + warn "Transaction aborted because $_"; # Try::Tiny copies $@ into $_ # now rollback to undo the incomplete changes # but do it in an eval{} as it may also fail eval { $dbh->rollback }; @@ -7486,18 +7484,23 @@ arrives and then to call alarm($seconds) to schedule an ALRM signal to be delivered $seconds in the future. For example: + my $failed; eval { local $SIG{ALRM} = sub { die "TIMEOUT\n" }; # N.B. \n required eval { alarm($seconds); ... code to execute with timeout here (which may die) ... - }; + 1; + } or $failed = 1; # outer eval catches alarm that might fire JUST before this alarm(0) alarm(0); # cancel alarm (if code ran fast) - die "$@" if $@; - }; - if ( $@ eq "TIMEOUT\n" ) { ... } - elsif ($@) { ... } # some other error + die "$@" if $failed; + 1; + } or $failed = 1; + if ( $failed ) { + if ( defined $@ and $@ eq "TIMEOUT\n" ) { ... } + else { ... } # some other error + } The first (outer) eval is used to avoid the unlikely but possible chance that the "code to execute" dies and the alarm fires before it @@ -7530,17 +7533,20 @@ my $oldaction = POSIX::SigAction->new(); sigaction( SIGALRM, $action, $oldaction ); my $dbh; + my $failed; eval { eval { alarm(5); # seconds before time out $dbh = DBI->connect("dbi:Oracle:$dsn" ... ); - }; + 1; + } or $failed = 1; alarm(0); # cancel alarm (if connect worked fast) - die "$@\n" if $@; # connect died - }; + die "$@\n" if $failed; # connect died + 1; + } or $failed = 1; sigaction( SIGALRM, $oldaction ); # restore original signal handler - if ( $@ ) { - if ($@ eq "connect timeout\n") {...} + if ( $failed ) { + if ( defined $@ and $@ eq "connect timeout\n" ) {...} else { # connect died } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/DBI.xs new/DBI-1.637/DBI.xs --- old/DBI-1.636/DBI.xs 2016-04-24 23:12:16.000000000 +0200 +++ new/DBI-1.637/DBI.xs 2017-08-13 22:48:19.000000000 +0200 @@ -85,10 +85,10 @@ #endif #ifndef warn_sv -static void warn_sv(SV *sv) { dTHX; warn(SvPV_nolen(sv)); } +static void warn_sv(SV *sv) { dTHX; warn("%s", SvPV_nolen(sv)); } #endif #ifndef croak_sv -static void croak_sv(SV *sv) { dTHX; croak(SvPV_nolen(sv)); } +static void croak_sv(SV *sv) { dTHX; croak("%s", SvPV_nolen(sv)); } #endif /* types of method name */ @@ -494,7 +494,7 @@ /* handy for embedding into condition expression for debugging */ /* -static int warn1(char *s) { warn(s); return 1; } +static int warn1(char *s) { warn("%s", s); return 1; } static int dump1(SV *sv) { dTHX; sv_dump(sv); return 1; } */ @@ -736,7 +736,8 @@ parent = DBIc_PARENT_H(imp_xxh); if (parent && SvROK(parent)) { SV *tmp_sv = *hv_fetch((HV*)SvRV(h), "Statement", 9, 1); - (void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(tmp_sv), 0); + if (SvOK(tmp_sv)) + (void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(tmp_sv), 0); } } @@ -2267,6 +2268,16 @@ ) ) { cacheit = 1; } + /* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */ + else if ((keylen==7 || keylen==9 || keylen==12) + && strnEQ(key, "NAME_", 5) + && ( (keylen==9 && strEQ(key, "NAME_hash")) + || ((key[5]=='u' || key[5]=='l') && key[6] == 'c' + && (!key[7] || strnEQ(&key[7], "_hash", 5))) + ) + ) { + cacheit = 1; + } else { /* XXX should really be an event ? */ if (isUPPER(*key)) { char *msg = "Can't set %s->{%s}: unrecognised attribute name or invalid value%s"; @@ -3571,6 +3582,7 @@ && SvROK(*hook_svp) ) { SV *orig_defsv; + SV *temp_defsv; SV *code = SvRV(*hook_svp); I32 skip_dispatch = 0; if (trace_level) @@ -3587,7 +3599,11 @@ */ orig_defsv = DEFSV; /* remember the current $_ */ SAVE_DEFSV; /* local($_) = $method_name */ - DEFSV_set(sv_2mortal(newSVpv(meth_name,0))); + temp_defsv = sv_2mortal(newSVpv(meth_name,0)); +# ifdef SvTEMP_off + SvTEMP_off(temp_defsv); +# endif + DEFSV_set(temp_defsv); EXTEND(SP, items+1); PUSHMARK(SP); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/META.json new/DBI-1.637/META.json --- old/DBI-1.636/META.json 2016-04-25 00:09:37.000000000 +0200 +++ new/DBI-1.637/META.json 2017-08-16 10:45:44.000000000 +0200 @@ -4,7 +4,7 @@ "Tim Bunce ([email protected])" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240", + "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], @@ -58,7 +58,8 @@ "x_IRC" : "irc://irc.perl.org/#dbi", "x_MailingList" : "mailto:[email protected]"; }, - "version" : "1.636", + "version" : "1.637", + "x_serialization_backend" : "JSON::PP version 2.27203", "x_suggests" : { "Clone" : 0.34, "DB_File" : 0, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/META.yml new/DBI-1.637/META.yml --- old/DBI-1.636/META.yml 2016-04-25 00:09:37.000000000 +0200 +++ new/DBI-1.637/META.yml 2017-08-16 10:45:44.000000000 +0200 @@ -16,7 +16,7 @@ DBD::RAM: '0.072' SQL::Statement: '1.33' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240' +generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -34,7 +34,8 @@ homepage: http://dbi.perl.org/ license: http://dev.perl.org/licenses/ repository: https://github.com/perl5-dbi/dbi -version: '1.636' +version: '1.637' +x_serialization_backend: 'CPAN::Meta::YAML version 0.012' x_suggests: Clone: 0.34 DB_File: 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/dbipport.h new/DBI-1.637/dbipport.h --- old/DBI-1.636/dbipport.h 2016-04-22 16:25:43.000000000 +0200 +++ new/DBI-1.637/dbipport.h 2017-08-13 22:48:19.000000000 +0200 @@ -4794,7 +4794,7 @@ PUTBACK; if (croak_on_error && SvTRUE(GvSV(errgv))) - croak(SvPVx(GvSV(errgv), na)); + croak("%s", SvPVx(GvSV(errgv), na)); return sv; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/lib/DBD/File.pm new/DBI-1.637/lib/DBD/File.pm --- old/DBI-1.636/lib/DBD/File.pm 2015-05-26 17:20:06.000000000 +0200 +++ new/DBI-1.637/lib/DBD/File.pm 2016-11-09 11:11:37.000000000 +0100 @@ -593,7 +593,7 @@ } } - # (my $tbl = $file) =~ s/$ext$//i; + # (my $tbl = $file) =~ s/\Q$ext\E$//i; my ($tbl, $basename, $dir, $fn_ext, $user_spec_file, $searchdir); if ($file_is_table and defined $meta->{f_file}) { $tbl = $file; @@ -602,7 +602,7 @@ $user_spec_file = 1; } else { - ($basename, $dir, undef) = File::Basename::fileparse ($file, $ext); + ($basename, $dir, undef) = File::Basename::fileparse ($file, qr{\Q$ext\E}); # $dir is returned with trailing (back)slash. We just need to check # if it is ".", "./", or ".\" or "[]" (VMS) if ($dir =~ m{^(?:[.][/\\]?|\[\])$} && ref $meta->{f_dir_search} eq "ARRAY") { @@ -673,12 +673,12 @@ } @f > 0 && @f <= 2 and $file = $f[0]; !$respect_case && $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED - ($tbl = $file) =~ s/$ext$//i; + ($tbl = $file) =~ s/\Q$ext\E$//i; my $tmpfn = $file; if ($ext && $req) { # File extension required - $tmpfn =~ s/$ext$//i or return; + $tmpfn =~ s/\Q$ext\E$//i or return; } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/lib/DBI/ProfileData.pm new/DBI-1.637/lib/DBI/ProfileData.pm --- old/DBI-1.636/lib/DBI/ProfileData.pm 2013-06-24 23:03:21.000000000 +0200 +++ new/DBI-1.637/lib/DBI/ProfileData.pm 2017-08-13 22:48:19.000000000 +0200 @@ -56,7 +56,7 @@ =head1 DESCRIPTION This module offers the ability to read, manipulate and format -DBI::ProfileDumper profile data. +L<DBI::ProfileDumper> profile data. Conceptually, a profile consists of a series of records, or nodes, each of each has a set of statistics and set of keys. Each record @@ -116,7 +116,7 @@ If true, the files are deleted after being read. -Actually the files are renamed with a C.deleteme> suffix before being read, +Actually the files are renamed with a C<deleteme> suffix before being read, and then, after reading all the files, they're all deleted together. The files are locked while being read which, combined with the rename, makes it @@ -360,7 +360,7 @@ =head2 $header = $prof->header(); Returns a reference to a hash of header values. These are the key -value pairs included in the header section of the DBI::ProfileDumper +value pairs included in the header section of the L<DBI::ProfileDumper> data format. For example: $header = { @@ -380,7 +380,7 @@ Returns a reference the sorted nodes array. Each element in the array is a single record in the data set. The first seven elements are the -same as the elements provided by DBI::Profile. After that each key is +same as the elements provided by L<DBI::Profile>. After that each key is in a separate element. For example: $nodes = [ @@ -580,7 +580,7 @@ =head2 $Data = $prof->Data() -Returns the same Data hash structure as seen in DBI::Profile. This +Returns the same Data hash structure as seen in L<DBI::Profile>. This structure is not sorted. The nodes() structure probably makes more sense for most analysis. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/06attrs.t new/DBI-1.637/t/06attrs.t --- old/DBI-1.636/t/06attrs.t 2014-09-21 14:44:07.000000000 +0200 +++ new/DBI-1.637/t/06attrs.t 2017-08-13 22:48:19.000000000 +0200 @@ -1,6 +1,7 @@ #!perl -w use strict; +use Storable qw(dclone); use Test::More; @@ -255,6 +256,15 @@ cmp_ok($nhash_uc->{CTIME}, '==', 0, '... checking values returned'); cmp_ok($nhash_uc->{NAME}, '==', 1, '... checking values returned'); +unless ($using_autoproxy) { + # set ability to set sth attributes that are usually set internally + for $a (qw(NAME NAME_lc NAME_uc NAME_hash NAME_lc_hash NAME_uc_hash)) { + my $v = $sth->{$a}; + ok(eval { $sth->{$a} = dclone($sth->{$a}) }, "Can set sth $a"); + is_deeply($sth->{$a}, $v, "Can get set sth $a"); + } +} + my $type = $sth->{TYPE}; is(ref($type), 'ARRAY', '... checking type of TYPE attribute for sth'); cmp_ok(scalar(@{$type}), '==', 2, '... checking number of elements returned'); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/10examp.t new/DBI-1.637/t/10examp.t --- old/DBI-1.636/t/10examp.t 2016-04-21 16:50:23.000000000 +0200 +++ new/DBI-1.637/t/10examp.t 2017-08-13 22:48:19.000000000 +0200 @@ -14,7 +14,7 @@ require File::Spec; require VMS::Filespec if $^O eq 'VMS'; -use Test::More tests => 238; +use Test::More tests => 242; do { # provide some protection against growth in size of '.' during the test @@ -35,6 +35,31 @@ like($@, qr/install_driver\(NoneSuch\) failed/, '... we should have an exception here'); ok(!$dbh, '... $dbh2 should not be defined'); +{ + my ($error, $tdbh); + eval { + $tdbh = DBI->connect('dbi:ExampleP:', '', []); + } or do { + $error= $@ || "Zombie Error"; + }; + like($error,qr/Usage:/,"connect with unblessed ref password should fail"); + ok(!defined($tdbh), '... $dbh should not be defined'); +} +{ + package Test::Secret; + use overload '""' => sub { return "" }; +} +{ + my ($error,$tdbh); + eval { + $tdbh = DBI->connect('dbi:ExampleP:', '', bless [], "Test::Secret"); + } or do { + $error= $@ || "Zombie Error"; + }; + ok(!$error,"connect with blessed ref password should not fail"); + ok(defined($tdbh), '... $dbh should be defined'); +} + $dbh = DBI->connect('dbi:ExampleP:', '', ''); sub check_connect_cached { @@ -139,7 +164,7 @@ ok("@{[sort keys %{$csr_b->{NAME_uc_hash}}]}" eq "MODE NAME SIZE"); ok("@{[sort values %{$csr_b->{NAME_uc_hash}}]}" eq "0 1 2"); -do "t/lib.pl"; +do "./t/lib.pl"; # get a dir always readable on all platforms #my $dir = getcwd() || cwd(); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/49dbd_file.t new/DBI-1.637/t/49dbd_file.t --- old/DBI-1.636/t/49dbd_file.t 2015-05-26 17:20:06.000000000 +0200 +++ new/DBI-1.637/t/49dbd_file.t 2017-08-13 22:48:19.000000000 +0200 @@ -17,7 +17,7 @@ use_ok ("DBI"); use_ok ("DBD::File"); -do "t/lib.pl"; +do "./t/lib.pl"; my $dir = test_dir (); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/50dbm_simple.t new/DBI-1.637/t/50dbm_simple.t --- old/DBI-1.636/t/50dbm_simple.t 2013-04-05 00:17:19.000000000 +0200 +++ new/DBI-1.637/t/50dbm_simple.t 2017-08-13 22:48:19.000000000 +0200 @@ -81,7 +81,7 @@ my $dbi_sql_nano = not DBD::DBM::Statement->isa('SQL::Statement'); -do "t/lib.pl"; +do "./t/lib.pl"; my $dir = test_dir (); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/51dbm_file.t new/DBI-1.637/t/51dbm_file.t --- old/DBI-1.636/t/51dbm_file.t 2013-06-26 18:43:36.000000000 +0200 +++ new/DBI-1.637/t/51dbm_file.t 2017-08-13 22:48:19.000000000 +0200 @@ -13,7 +13,7 @@ use DBI; -do "t/lib.pl"; +do "./t/lib.pl"; my $dir = test_dir(); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/52dbm_complex.t new/DBI-1.637/t/52dbm_complex.t --- old/DBI-1.636/t/52dbm_complex.t 2013-04-05 00:17:19.000000000 +0200 +++ new/DBI-1.637/t/52dbm_complex.t 2017-08-13 22:48:19.000000000 +0200 @@ -93,7 +93,7 @@ plan skip_all => "DBI::SQL::Nano is being used" unless ( $haveSS ); plan skip_all => "Not running with MLDBM" unless ( @mldbm_types ); -do "t/lib.pl"; +do "./t/lib.pl"; my $dir = test_dir (); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/53sqlengine_adv.t new/DBI-1.637/t/53sqlengine_adv.t --- old/DBI-1.636/t/53sqlengine_adv.t 2015-05-26 17:20:06.000000000 +0200 +++ new/DBI-1.637/t/53sqlengine_adv.t 2017-08-13 22:48:19.000000000 +0200 @@ -21,7 +21,7 @@ # <[Sno]> what I could do is create a new test case where inserting into a DBD::DBM and after that clone the meta into a DBD::File $dbh # <[Sno]> would that help to get a better picture? -do "t/lib.pl"; +do "./t/lib.pl"; my $dir = test_dir(); my $dbm_dbh = DBI->connect( 'dbi:DBM:', undef, undef, { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/70callbacks.t new/DBI-1.637/t/70callbacks.t --- old/DBI-1.636/t/70callbacks.t 2014-09-21 15:57:56.000000000 +0200 +++ new/DBI-1.637/t/70callbacks.t 2017-08-13 22:48:19.000000000 +0200 @@ -27,7 +27,9 @@ ok $dbh->{Callbacks} = { ping => sub { - is $_, 'ping', '$_ holds method name'; + my $m = $_; + is $m, 'ping', '$m holds method name'; + is $_, 'ping', '$_ holds method name (not stolen)'; is @_, 1, '@_ holds 1 values'; is ref $_[0], 'DBI::db', 'first is $dbh'; ok tied(%{$_[0]}), '$dbh is tied (outer) handle' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.636/t/85gofer.t new/DBI-1.637/t/85gofer.t --- old/DBI-1.636/t/85gofer.t 2013-06-24 23:03:21.000000000 +0200 +++ new/DBI-1.637/t/85gofer.t 2017-08-13 22:48:19.000000000 +0200 @@ -20,7 +20,7 @@ if $ap !~ /policy=pedantic\b/i; } -do "t/lib.pl"; +do "./t/lib.pl"; # 0=SQL::Statement if avail, 1=DBI::SQL::Nano # next line forces use of Nano rather than default behaviour
