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 - coolo@suse.com
+
+- 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 Lhttp://stackoverflow.com/questions/tagged/dbi
-with over 400 questions.
+with over 800 questions.
The DBI home page at Lhttp://dbi.perl.org/ and the DBI FAQ
at Lhttp://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 dbi-users@perl.org.
-
=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 LDBI::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 if you need to catch the "C" error.
+Use C<eval> if you need to catch the "C" error.
The C<$data_source> argument (with the "Cdbi:...:" 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
-to catch the exception that's been thrown and followed by an
-C block to handle the caught exception.
+Typically C<RaiseError> is used in conjunction with C<eval>,
+or a module like LTry::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
+If any method fails, and L</RaiseError> is not set, C
will return undef.
@@ -4788,7 +4780,7 @@
stored in a hash associated with the C<$dbh>. If another call is made to
C 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
+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 LTie::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>
-(which is very fast, unlike S>). For example:
+applications is to enable L</RaiseError> and catch the error that's 'thrown' as
+an exception. For example, using LTry::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 (dbi-users@perl.org)"
],
"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:dbi-dev@perl.org"
},
- "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.
+LDBI::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 LDBI::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 LDBI::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 LDBI::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