Hello community,
here is the log from the commit of package perl-DBI for openSUSE:Factory checked in at 2015-10-01 09:27:27
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-DBI (Old)
and /work/SRC/openSUSE:Factory/.perl-DBI.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-DBI"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-DBI/perl-DBI.changes 2015-04-22 01:14:15.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.perl-DBI.new/perl-DBI.changes 2015-10-01 09:27:29.000000000 +0200
@@ -1,0 +2,26 @@
+Sun Sep 20 15:44:57 UTC 2015 - coolo@suse.com
+
+- updated to 1.634
+ see /usr/share/doc/packages/perl-DBI/Changes
+
+ =head2 Changes in DBI 1.634 - 3rd August 2015
+
+ Enabled strictures on all modules (Jose Luis Perez Diez) #22
+ Note that this might cause new exceptions in existing code.
+ Please take time for extra testing before deploying to production.
+ Improved handling of row counts for compiled drivers and enable them to
+ return larger row counts (IV type) by defining new *_iv macros.
+ Fixed quote_identifier that was adding a trailing separator when there
+ was only a catalog (Martin J. Evans)
+
+ Removed redundant keys() call in fetchall_arrayref with hash slice (ilmari) #24
+ Corrected pod xref to Placeholders section (Matthew D. Fuller)
+ Corrected pod grammar (Nick Tonkin) #25
+
+ Added support for tables('', '', '', '%') special case (Martin J. Evans)
+ Added support for DBD prefixes with numbers (Jens Rehsack) #19
+ Added extra initializer for DBI::DBD::SqlEngine based DBD's (Jens Rehsack)
+ Added Memory Leaks section to the DBI docs (Tim)
+ Added Artistic v1 & GPL v1 LICENSE file (Jose Luis Perez Diez) #21
+
+-------------------------------------------------------------------
Old:
----
DBI-1.633.tar.gz
New:
----
DBI-1.634.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-DBI.spec ++++++
--- /var/tmp/diff_new_pack.kQIztp/_old 2015-10-01 09:27:30.000000000 +0200
+++ /var/tmp/diff_new_pack.kQIztp/_new 2015-10-01 09:27:30.000000000 +0200
@@ -17,7 +17,7 @@
Name: perl-DBI
-Version: 1.633
+Version: 1.634
Release: 0
%define cpan_name DBI
Summary: Database independent interface for Perl
++++++ DBI-1.633.tar.gz -> DBI-1.634.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/Changes new/DBI-1.634/Changes
--- old/DBI-1.633/Changes 2015-01-11 14:22:12.000000000 +0100
+++ new/DBI-1.634/Changes 2015-08-03 16:38:14.000000000 +0200
@@ -6,6 +6,26 @@
=cut
+=head2 Changes in DBI 1.634 - 3rd August 2015
+
+ Enabled strictures on all modules (Jose Luis Perez Diez) #22
+ Note that this might cause new exceptions in existing code.
+ Please take time for extra testing before deploying to production.
+ Improved handling of row counts for compiled drivers and enable them to
+ return larger row counts (IV type) by defining new *_iv macros.
+ Fixed quote_identifier that was adding a trailing separator when there
+ was only a catalog (Martin J. Evans)
+
+ Removed redundant keys() call in fetchall_arrayref with hash slice (ilmari) #24
+ Corrected pod xref to Placeholders section (Matthew D. Fuller)
+ Corrected pod grammar (Nick Tonkin) #25
+
+ Added support for tables('', '', '', '%') special case (Martin J. Evans)
+ Added support for DBD prefixes with numbers (Jens Rehsack) #19
+ Added extra initializer for DBI::DBD::SqlEngine based DBD's (Jens Rehsack)
+ Added Memory Leaks section to the DBI docs (Tim)
+ Added Artistic v1 & GPL v1 LICENSE file (Jose Luis Perez Diez) #21
+
=head2 Changes in DBI 1.633 - 11th Jan 2015
Fixed selectrow_*ref to return undef on error in list context
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/DBI.pm new/DBI-1.634/DBI.pm
--- old/DBI-1.633/DBI.pm 2015-01-11 14:22:26.000000000 +0100
+++ new/DBI-1.634/DBI.pm 2015-08-03 16:38:42.000000000 +0200
@@ -11,7 +11,7 @@
require 5.008_001;
BEGIN {
-our $XS_VERSION = our $VERSION = "1.633"; # ==> ALSO update the version in the pod text below!
+our $XS_VERSION = our $VERSION = "1.634"; # ==> ALSO update the version in the pod text below!
$VERSION = eval $VERSION;
}
@@ -137,6 +137,8 @@
"How to Report Bugs Effectively" by Simon Tatham:
Lhttp://www.chiark.greenend.org.uk/~sgtatham/bugs.html.
+If you think you've found a memory leak then read L.
+
Your problem is most likely related to the specific DBD driver module you're
using. If that's the case then click on the 'Bugs' link on the Lhttp://metacpan.org
page for your driver. Only submit a bug report against the DBI itself if you're
@@ -144,7 +146,7 @@
=head2 NOTES
-This is the DBI specification that corresponds to DBI version 1.633
+This is the DBI specification that corresponds to DBI version 1.634
(see LDBI::Changes for details).
The DBI is evolving at a steady pace, so it's good to check that
@@ -1391,7 +1393,7 @@
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;
@@ -1588,9 +1590,13 @@
my $quoted_id = join '.', grep { defined } @id;
if ($catalog) { # add catalog correctly
- $quoted_id = ($info->[2] == 2) # SQL_CL_END
- ? $quoted_id . $info->[1] . $catalog
- : $catalog . $info->[1] . $quoted_id;
+ if ($quoted_id) {
+ $quoted_id = ($info->[2] == 2) # SQL_CL_END
+ ? $quoted_id . $info->[1] . $catalog
+ : $catalog . $info->[1] . $quoted_id;
+ } else {
+ $quoted_id = $catalog;
+ }
}
return $quoted_id;
}
@@ -1761,7 +1767,11 @@
my $sth = $dbh->table_info(@args[0,1,2,3,4]) or return;
my $tables = $sth->fetchall_arrayref or return;
my @tables;
- if ($dbh->get_info(29)) { # SQL_IDENTIFIER_QUOTE_CHAR
+ if (defined($args[3]) && $args[3] eq '%' # special case for tables('','','','%')
+ && grep {defined($_) && $_ eq ''} @args[0,1,2]
+ ) {
+ @tables = map { $_->[3] } @$tables;
+ } elsif ($dbh->get_info(29)) { # SQL_IDENTIFIER_QUOTE_CHAR
@tables = map { $dbh->quote_identifier( @{$_}[0,1,2] ) } @$tables;
}
else { # temporary old style hack (yeach)
@@ -2060,8 +2070,7 @@
}
}
elsif ($mode eq 'HASH') {
- if (keys %$slice) {
- keys %$slice; # reset the iterator
+ if (keys %$slice) { # resets the iterator
my $name2idx = $sth->FETCH('NAME_lc_hash');
while ( my ($name, $unused) = each %$slice ) {
my $idx = $name2idx->{lc $name};
@@ -3643,7 +3652,7 @@
The ChildHandles attribute contains a reference to an array of all the
handles created by this handle which are still accessible. The
contents of the array are weak-refs and will become undef when the
-handle goes out of scope.
+handle goes out of scope. (They're cleared out occasionally.)
C<ChildHandles> returns undef if your perl version does not support weak
references (check the LScalar::Util|Scalar::Util module). The referenced
@@ -4635,7 +4644,7 @@
passing to C.
You may often want to fetch an array of rows where each row is stored as a
-hash. That can be done simple using:
+hash. That can be done simply using:
my $emps = $dbh->selectall_arrayref(
"SELECT ename FROM emp ORDER BY ename",
@@ -4731,7 +4740,8 @@
has been called. Portable applications should take this into account.
In general, DBI drivers do not parse the contents of the statement
-(other than simply counting any L</Placeholders>). The statement is
+(other than simply counting any L).
+The statement is
passed directly to the database engine, sometimes known as pass-thru
mode. This has advantages and disadvantages. On the plus side, you can
access all the functionality of the engine being used. On the downside,
@@ -5995,7 +6005,7 @@
$sth->execute;
DBI::dump_results($sth);
-See L"Placeholders and Bind Values"> for more information.
+See L for more information.
B<Data Types for Placeholders>
@@ -6047,7 +6057,7 @@
The C<CONVERT> function used here is just an example. The actual function
and syntax will vary between different databases and is non-portable.
-See also L"Placeholders and Bind Values"> for more information.
+See also L for more information.
=head3 C
@@ -6073,7 +6083,7 @@
returned. The only cost of using a larger value than needed is wasted memory.
Undefined values or C<undef> are used to indicate null values.
-See also L"Placeholders and Bind Values"> for more information.
+See also L for more information.
=head3 C
@@ -7663,6 +7673,23 @@
via C<$h-E<gt>{private_..._*}>. See the entry under L for info and important caveats.
+=head2 Memory Leaks
+
+When tracking down memory leaks using tools like LDevel::Leak
+you'll find that some DBI internals are reported as 'leaking' memory.
+This is very unlikely to be a real leak. The DBI has various caches to improve
+performance and the apparrent leaks are simply the normal operation of these
+caches.
+
+The most frequent sources of the apparrent leaks are L</ChildHandles>,
+L and L.
+
+For example http://stackoverflow.com/questions/13338308/perl-dbi-memory-leak
+
+Given how widely the DBI is used, you can rest assured that if a new release of
+the DBI did have a real leak it would be discovered, reported, and fixed
+immediately. The leak you're looking for is probably elsewhere. Good luck!
+
=head1 TRACING
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/DBI.xs new/DBI-1.634/DBI.xs
--- old/DBI-1.633/DBI.xs 2015-01-07 16:37:19.000000000 +0100
+++ new/DBI-1.634/DBI.xs 2015-07-19 15:34:45.000000000 +0200
@@ -1372,7 +1372,7 @@
if (DBIc_TYPE(imp) == DBIt_ST) {
imp_sth_t *imp_sth = (imp_sth_t*)imp;
- DBIc_ROW_COUNT(imp_sth) = -1;
+ DBIc_ROW_COUNT(imp_sth) = -1;
}
DBIc_COMSET_on(imp); /* common data now set up */
@@ -3802,7 +3802,7 @@
if (trace_level >= (is_nested_call ? 3 : 1)) {
PerlIO *logfp = DBILOGFP;
const int is_fetch = (meth_type == methtype_fetch_star && DBIc_TYPE(imp_xxh)==DBIt_ST);
- const int row_count = (is_fetch) ? DBIc_ROW_COUNT((imp_sth_t*)imp_xxh) : 0;
+ const IV row_count = (is_fetch) ? DBIc_ROW_COUNT((imp_sth_t*)imp_xxh) : 0;
if (is_fetch && row_count>=2 && trace_level<=4 && SvOK(ST(0))) {
/* skip the 'middle' rows to reduce output */
goto skip_meth_return_trace;
@@ -3861,7 +3861,7 @@
PerlIO_printf(logfp," ) [%d items]", outitems);
}
if (is_fetch && row_count) {
- PerlIO_printf(logfp," row%d", row_count);
+ PerlIO_printf(logfp," row%"IVdf, row_count);
}
if (qsv) /* flag as quick and peek at the first arg (still on the stack) */
PerlIO_printf(logfp," (%s from cache)", neatsvpv(st1,0));
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/Driver.xst new/DBI-1.634/Driver.xst
--- old/DBI-1.633/Driver.xst 2013-06-26 18:46:16.000000000 +0200
+++ new/DBI-1.634/Driver.xst 2015-08-02 18:45:40.000000000 +0200
@@ -8,6 +8,27 @@
#include "Driver_xst.h"
+# Historically dbd_db_do4, dbd_st_execute, and dbd_st_rows returned an 'int' type.
+# That's only 32 bits (31+sign) so isn't sufficient for very large row counts
+# So now instead of defining those macros, drivers can define dbd_db_do4_iv,
+# dbd_st_execute_iv, and dbd_st_rows_iv to be the names of functions that
+# return an 'IV' type. They could also set DBIc_ROW_COUNT(imp_sth).
+#
+# To save a mess of #ifdef's we arrange for dbd_st_execute (etc) to work
+# as dbd_st_execute_iv if that's defined
+#
+#if defined(dbd_st_execute_iv)
+#undef dbd_st_execute
+#define dbd_st_execute dbd_st_execute_iv
+#endif
+#if defined(dbd_st_rows_iv)
+#undef dbd_st_rows
+#define dbd_st_rows dbd_st_rows_iv
+#endif
+#if defined(dbd_db_do4_iv)
+#undef dbd_db_do4
+#define dbd_db_do4 dbd_db_do4_iv
+#endif
MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~
@@ -240,7 +261,7 @@
{
D_imp_dbh(dbh);
IV retval;
- retval = dbd_db_do4(dbh, imp_dbh, statement, params);
+ retval = dbd_db_do4(dbh, imp_dbh, statement, params); /* might be dbd_db_do4_iv via macro */
/* remember that dbd_db_do4 must return <= -2 for error */
if (retval == 0) /* ok with no rows affected */
XST_mPV(0, "0E0"); /* (true but zero) */
@@ -582,16 +603,15 @@
SV * sth
CODE:
D_imp_sth(sth);
- int retval;
+ IV retval;
if (items > 1) { /* need to bind params */
if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
XSRETURN_UNDEF;
}
}
/* XXX this code is duplicated in selectrow_arrayref above */
- if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
- DBIc_ROW_COUNT(imp_sth) = 0;
- retval = dbd_st_execute(sth, imp_sth);
+ DBIc_ROW_COUNT(imp_sth) = 0;
+ retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
/* remember that dbd_st_execute must return <= -2 for error */
if (retval == 0) /* ok with no rows affected */
XST_mPV(0, "0E0"); /* (true but zero) */
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/META.json new/DBI-1.634/META.json
--- old/DBI-1.633/META.json 2015-01-11 14:24:38.000000000 +0100
+++ new/DBI-1.634/META.json 2015-08-03 16:51:29.000000000 +0200
@@ -4,7 +4,7 @@
"Tim Bunce (dbi-users@perl.org)"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.142690",
+ "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.633",
+ "version" : "1.634",
+ "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.633/META.yml new/DBI-1.634/META.yml
--- old/DBI-1.633/META.yml 2015-01-11 14:24:38.000000000 +0100
+++ new/DBI-1.634/META.yml 2015-08-03 16:51:29.000000000 +0200
@@ -16,7 +16,7 @@
DBD::RAM: '0.072'
SQL::Statement: '1.33'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.142690'
+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.633'
+version: '1.634'
+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.633/Perl.xs new/DBI-1.634/Perl.xs
--- old/DBI-1.633/Perl.xs 2013-04-05 00:17:19.000000000 +0200
+++ new/DBI-1.634/Perl.xs 2015-07-22 16:49:44.000000000 +0200
@@ -27,7 +27,7 @@
#define dbd_discon_all(drh, imp_drh) (drh=drh,imp_drh=imp_drh,1)
#define dbd_dr_data_sources(drh, imp_drh, attr) (drh=drh,imp_drh=imp_drh,Nullav)
-#define dbd_db_do4(dbh,imp_dbh,p3,p4) (dbh=dbh,imp_dbh=imp_dbh,p3=p3,p4=p4,-2)
+#define dbd_db_do4_iv(dbh,imp_dbh,p3,p4) (dbh=dbh,imp_dbh=imp_dbh,p3=p3,p4=p4,-2)
#define dbd_db_last_insert_id(dbh, imp_dbh, p3,p4,p5,p6, attr) \
(dbh=dbh,imp_dbh=imp_dbh,p3=p3,p4=p4,p5=p5,p6=p6,&PL_sv_undef)
#define dbd_take_imp_data(h, imp_xxh, p3) (h=h,imp_xxh=imp_xxh,&PL_sv_undef)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/dbd_xsh.h new/DBI-1.634/dbd_xsh.h
--- old/DBI-1.633/dbd_xsh.h 2013-04-05 00:17:19.000000000 +0200
+++ new/DBI-1.634/dbd_xsh.h 2015-07-22 17:13:50.000000000 +0200
@@ -27,7 +27,8 @@
/* Note: interface of dbd_db_do changed in v1.33 */
/* Old prototype: dbd_db_do _((SV *sv, char *statement)); */
/* dbd_db_do: optional: defined by a driver if the DBI default version is too slow */
-int dbd_db_do4 _((SV *dbh, imp_dbh_t *imp_dbh, char *statement, SV *params));
+int dbd_db_do4 _((SV *dbh, imp_dbh_t *imp_dbh, char *statement, SV *params));
+IV dbd_db_do4_iv _((SV *dbh, imp_dbh_t *imp_dbh, char *statement, SV *params));
int dbd_db_commit _((SV *dbh, imp_dbh_t *imp_dbh));
int dbd_db_rollback _((SV *dbh, imp_dbh_t *imp_dbh));
int dbd_db_disconnect _((SV *dbh, imp_dbh_t *imp_dbh));
@@ -40,7 +41,9 @@
int dbd_st_prepare _((SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs));
int dbd_st_prepare_sv _((SV *sth, imp_sth_t *imp_sth, SV *statement, SV *attribs));
int dbd_st_rows _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_execute _((SV *sth, imp_sth_t *imp_sth));
+IV dbd_st_rows_iv _((SV *sth, imp_sth_t *imp_sth));
+int dbd_st_execute _((SV *sth, imp_sth_t *imp_sth));
+IV dbd_st_execute_iv _((SV *sth, imp_sth_t *imp_sth));
AV *dbd_st_fetch _((SV *sth, imp_sth_t *imp_sth));
int dbd_st_finish3 _((SV *sth, imp_sth_t *imp_sth, int from_destroy));
int dbd_st_finish _((SV *sth, imp_sth_t *imp_sth)); /* deprecated */
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/Bundle/DBI.pm new/DBI-1.634/lib/Bundle/DBI.pm
--- old/DBI-1.633/lib/Bundle/DBI.pm 2013-06-24 23:03:21.000000000 +0200
+++ new/DBI-1.634/lib/Bundle/DBI.pm 2015-05-26 17:26:53.000000000 +0200
@@ -2,6 +2,7 @@
package Bundle::DBI;
+use strict;
our $VERSION = "12.008696";
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBD/ExampleP.pm new/DBI-1.634/lib/DBD/ExampleP.pm
--- old/DBI-1.633/lib/DBD/ExampleP.pm 2013-11-14 12:44:07.000000000 +0100
+++ new/DBI-1.634/lib/DBD/ExampleP.pm 2015-05-26 17:26:53.000000000 +0200
@@ -1,11 +1,15 @@
{
package DBD::ExampleP;
+ use strict;
use Symbol;
use DBI qw(:sql_types);
require File::Spec;
+
+ our (@EXPORT,$VERSION,@statnames,%statnames,@stattypes,%stattypes,
+ @statprec,%statprec,$drh,);
@EXPORT = qw(); # Do NOT @EXPORT anything.
$VERSION = "12.014311";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBD/File.pm new/DBI-1.634/lib/DBD/File.pm
--- old/DBI-1.633/lib/DBD/File.pm 2014-12-11 12:04:20.000000000 +0100
+++ new/DBI-1.634/lib/DBD/File.pm 2015-05-26 17:20:06.000000000 +0200
@@ -956,6 +956,8 @@
$meta->{lockfh} and $meta->{lockfh}->close ();
undef $meta->{fh};
undef $meta->{lockfh};
+
+ $self->SUPER::DESTROY();
} # DESTROY
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBD/NullP.pm new/DBI-1.634/lib/DBD/NullP.pm
--- old/DBI-1.633/lib/DBD/NullP.pm 2013-11-14 12:44:07.000000000 +0100
+++ new/DBI-1.634/lib/DBD/NullP.pm 2015-07-22 17:15:00.000000000 +0200
@@ -1,11 +1,12 @@
+use strict;
{
package DBD::NullP;
require DBI;
require Carp;
- @EXPORT = qw(); # Do NOT @EXPORT anything.
- $VERSION = "12.014715";
+ our @EXPORT = qw(); # Do NOT @EXPORT anything.
+ our $VERSION = "12.014715";
# $Id: NullP.pm 14714 2011-02-22 17:27:07Z Tim $
#
@@ -14,7 +15,7 @@
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
- $drh = undef; # holds driver handle once initialised
+ our $drh = undef; # holds driver handle once initialised
sub driver{
return $drh if $drh;
@@ -35,7 +36,7 @@
{ package DBD::NullP::dr; # ====== DRIVER ======
- $imp_data_size = 0;
+ our $imp_data_size = 0;
use strict;
sub connect { # normally overridden, but a handy default
@@ -51,10 +52,46 @@
{ package DBD::NullP::db; # ====== DATABASE ======
- $imp_data_size = 0;
+ our $imp_data_size = 0;
use strict;
use Carp qw(croak);
+ # Added get_info to support tests in 10examp.t
+ sub get_info {
+ my ($dbh, $type) = @_;
+
+ if ($type == 29) { # identifier quote
+ return '"';
+ }
+ return;
+ }
+
+ # Added table_info to support tests in 10examp.t
+ sub table_info {
+ my ($dbh, $catalog, $schema, $table, $type) = @_;
+
+ my ($outer, $sth) = DBI::_new_sth($dbh, {
+ 'Statement' => 'tables',
+ });
+ if (defined($type) && $type eq '%' && # special case for tables('','','','%')
+ grep {defined($_) && $_ eq ''} ($catalog, $schema, $table)) {
+ $outer->{dbd_nullp_data} = [[undef, undef, undef, 'TABLE', undef],
+ [undef, undef, undef, 'VIEW', undef],
+ [undef, undef, undef, 'ALIAS', undef]];
+ } elsif (defined($catalog) && $catalog eq '%' && # special case for tables('%','','')
+ grep {defined($_) && $_ eq ''} ($schema, $table)) {
+ $outer->{dbd_nullp_data} = [['catalog1', undef, undef, undef, undef],
+ ['catalog2', undef, undef, undef, undef]];
+ } else {
+ $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table1', 'TABLE']];
+ $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table2', 'TABLE']];
+ $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table3', 'TABLE']];
+ }
+ $outer->STORE(NUM_OF_FIELDS => 5);
+ $sth->STORE(Active => 1);
+ return $outer;
+ }
+
sub prepare {
my ($dbh, $statement)= @_;
@@ -99,7 +136,7 @@
{ package DBD::NullP::st; # ====== STATEMENT ======
- $imp_data_size = 0;
+ our $imp_data_size = 0;
use strict;
sub bind_param {
@@ -141,12 +178,12 @@
sub fetchrow_arrayref {
my $sth = shift;
- my $data = $sth->{dbd_nullp_data};
+ my $data = shift @{$sth->{dbd_nullp_data}};
if (!$data || !@$data) {
$sth->finish; # no more data so finish
return undef;
}
- return $sth->_set_fbav(shift @$data);
+ return $sth->_set_fbav($data);
}
*fetch = \&fetchrow_arrayref; # alias
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBD/Sponge.pm new/DBI-1.634/lib/DBD/Sponge.pm
--- old/DBI-1.633/lib/DBD/Sponge.pm 2013-06-24 23:03:21.000000000 +0200
+++ new/DBI-1.634/lib/DBD/Sponge.pm 2015-05-26 17:26:53.000000000 +0200
@@ -1,3 +1,4 @@
+use strict;
{
package DBD::Sponge;
@@ -14,7 +15,7 @@
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
- $drh = undef; # holds driver handle once initialised
+ our $drh = undef; # holds driver handle once initialised
my $methods_already_installed;
sub driver{
@@ -40,13 +41,13 @@
{ package DBD::Sponge::dr; # ====== DRIVER ======
- $imp_data_size = 0;
+ our $imp_data_size = 0;
# we use default (dummy) connect method
}
{ package DBD::Sponge::db; # ====== DATABASE ======
- $imp_data_size = 0;
+ our $imp_data_size = 0;
use strict;
sub prepare {
@@ -156,7 +157,7 @@
{ package DBD::Sponge::st; # ====== STATEMENT ======
- $imp_data_size = 0;
+ our $imp_data_size = 0;
use strict;
sub execute {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBI/Const/GetInfo/ANSI.pm new/DBI-1.634/lib/DBI/Const/GetInfo/ANSI.pm
--- old/DBI-1.633/lib/DBI/Const/GetInfo/ANSI.pm 2013-06-24 23:03:21.000000000 +0200
+++ new/DBI-1.634/lib/DBI/Const/GetInfo/ANSI.pm 2015-05-26 17:26:53.000000000 +0200
@@ -7,9 +7,12 @@
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
+use strict;
package DBI::Const::GetInfo::ANSI;
+our (%InfoTypes,%ReturnTypes,%ReturnValues,);
+
=head1 NAME
DBI::Const::GetInfo::ANSI - ISO/IEC SQL/CLI Constants for GetInfo
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBI/Const/GetInfo/ODBC.pm new/DBI-1.634/lib/DBI/Const/GetInfo/ODBC.pm
--- old/DBI-1.633/lib/DBI/Const/GetInfo/ODBC.pm 2013-06-24 23:03:21.000000000 +0200
+++ new/DBI-1.634/lib/DBI/Const/GetInfo/ODBC.pm 2015-05-26 17:26:53.000000000 +0200
@@ -7,9 +7,10 @@
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
-
+use strict;
package DBI::Const::GetInfo::ODBC;
+our (%InfoTypes,%ReturnTypes,%ReturnValues,);
=head1 NAME
DBI::Const::GetInfo::ODBC - ODBC Constants for GetInfo
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBI/DBD/Metadata.pm new/DBI-1.634/lib/DBI/DBD/Metadata.pm
--- old/DBI-1.633/lib/DBI/DBD/Metadata.pm 2013-06-24 23:03:21.000000000 +0200
+++ new/DBI-1.634/lib/DBI/DBD/Metadata.pm 2015-05-26 17:29:17.000000000 +0200
@@ -8,19 +8,19 @@
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
+use strict;
+
use Exporter ();
use Carp;
use DBI;
use DBI::Const::GetInfoType qw(%GetInfoType);
-# Perl 5.005_03 does not recognize 'our'
-@ISA = qw(Exporter);
-@EXPORT = qw(write_getinfo_pm write_typeinfo_pm);
+our @ISA = qw(Exporter);
+our @EXPORT = qw(write_getinfo_pm write_typeinfo_pm);
-$VERSION = "2.014214";
+our $VERSION = "2.014214";
-use strict;
=head1 NAME
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBI/DBD/SqlEngine/HowTo.pod new/DBI-1.634/lib/DBI/DBD/SqlEngine/HowTo.pod
--- old/DBI-1.633/lib/DBI/DBD/SqlEngine/HowTo.pod 2014-03-09 20:51:54.000000000 +0100
+++ new/DBI-1.634/lib/DBI/DBD/SqlEngine/HowTo.pod 2015-05-26 17:20:06.000000000 +0200
@@ -194,10 +194,10 @@
modifications are still allowed.
Primarily DBI::DBD::SqlEngine provides access via the setters
-C, C, C,
-C and C. Those methods are
-easily accessible by the users via the C<< $dbh->func () >> interface
-provided by DBI. Well, many users don't feel comfortize when calling
+C, C, C,
+C, C and C.
+Those methods are easily accessible by the users via the C<< $dbh->func () >>
+interface provided by DBI. Well, many users don't feel comfortize when calling
# don't require extension for tables cars
$dbh->func ("cars", "f_ext", ".csv", "set_sql_engine_meta");
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBI/DBD/SqlEngine.pm new/DBI-1.634/lib/DBI/DBD/SqlEngine.pm
--- old/DBI-1.633/lib/DBI/DBD/SqlEngine.pm 2014-03-09 20:51:54.000000000 +0100
+++ new/DBI-1.634/lib/DBI/DBD/SqlEngine.pm 2015-05-26 17:20:06.000000000 +0200
@@ -41,6 +41,7 @@
my %accessors = (
versions => "get_driver_versions",
+ new_meta => "new_sql_engine_meta",
get_meta => "get_sql_engine_meta",
set_meta => "set_sql_engine_meta",
clear_meta => "clear_sql_engine_meta",
@@ -392,6 +393,7 @@
sql_init_phase => 1, # Only during initialization
sql_meta => 1, # meta data for tables
sql_meta_map => 1, # mapping table for identifier case
+ sql_data_source => 1, # reasonable datasource class
};
$dbh->{sql_readonly_attrs} = {
sql_engine_version => 1, # DBI::DBD::SqlEngine version
@@ -771,7 +773,7 @@
and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
ref $table || ref $attr
- or return &$gstm( $dbh, $table, $attr );
+ or return $gstm->( $dbh, $table, $attr );
ref $table or $table = [$table];
ref $attr or $attr = [$attr];
@@ -789,7 +791,7 @@
my %tattrs;
foreach my $aname ( @{$attr} )
{
- $tattrs{$aname} = &$gstm( $dbh, $tname, $aname );
+ $tattrs{$aname} = $gstm->( $dbh, $tname, $aname );
}
$results{$tname} = \%tattrs;
}
@@ -797,6 +799,31 @@
return \%results;
} # get_sql_engine_meta
+sub new_sql_engine_meta
+{
+ my ( $dbh, $table, $values ) = @_;
+ my $respect_case = 0;
+
+ "HASH" eq ref $values
+ or croak "Invalid argument for \$values - SCALAR or HASH expected but got " . ref $values;
+
+ $table =~ s/^\"// and $respect_case = 1; # handle quoted identifiers
+ $table =~ s/\"$//;
+
+ unless ($respect_case)
+ {
+ defined $dbh->{sql_meta_map}{$table} and $table = $dbh->{sql_meta_map}{$table};
+ }
+
+ $dbh->{sql_meta}{$table} = { %{$values} };
+ my $class;
+ defined $values->{sql_table_class} and $class = $values->{sql_table_class};
+ defined $class or ( $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
+ # XXX we should never hit DBD::File::Table::get_table_meta here ...
+ my ( undef, $meta ) = $class->get_table_meta( $dbh, $table, $respect_case );
+ 1;
+} # new_sql_engine_meta
+
sub set_single_table_meta
{
my ( $dbh, $table, $attr, $value ) = @_;
@@ -806,7 +833,7 @@
and return $dbh->STORE( $attr, $value );
( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
+ ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 ); # 1 means: respect case
$meta or croak "No such table '$table'";
$class->set_table_meta_attr( $meta, $attr, $value );
@@ -827,7 +854,7 @@
and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
ref $table || ref $attr
- or return &$sstm( $dbh, $table, $attr, $value );
+ or return $sstm->( $dbh, $table, $attr, $value );
ref $table or $table = [$table];
ref $attr or $attr = { $attr => $value };
@@ -839,10 +866,9 @@
foreach my $tname ( @{$table} )
{
- my %tattrs;
while ( my ( $aname, $aval ) = each %$attr )
{
- &$sstm( $dbh, $tname, $aname, $aval );
+ $sstm->( $dbh, $tname, $aname, $aval );
}
}
@@ -1432,6 +1458,11 @@
};
$self->{command} eq "DROP" and $flags->{dropMode} = 1;
+ my ( $tblnm, $table_meta ) = $class->get_table_meta( $data->{Database}, $table, 1 )
+ or croak "Cannot find appropriate meta for table '$table'";
+
+ defined $table_meta->{sql_table_class} and $class = $table_meta->{sql_table_class};
+
# because column name mapping is initialized in constructor ...
# and therefore specific opening operations might be done before
# reaching DBI::DBD::SqlEngine::Table->new(), we need to intercept
@@ -1439,8 +1470,6 @@
my $write_op = $createMode || $lockMode || $flags->{dropMode};
if ($write_op)
{
- my ( $tblnm, $table_meta ) = $class->get_table_meta( $data->{Database}, $table, 1 )
- or croak "Cannot find appropriate file for table '$table'";
$table_meta->{readonly}
and croak "Table '$table' is marked readonly - "
. $self->{command}
@@ -1625,6 +1654,14 @@
return $className->SUPER::new($tbl);
} # new
+sub DESTROY
+{
+ my $self = shift;
+ my $meta = $self->{meta};
+ $self->{row} and undef $self->{row};
+ ()
+}
+
1;
=pod
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBI/DBD.pm new/DBI-1.634/lib/DBI/DBD.pm
--- old/DBI-1.633/lib/DBI/DBD.pm 2014-11-08 13:48:20.000000000 +0100
+++ new/DBI-1.634/lib/DBI/DBD.pm 2015-07-22 17:04:44.000000000 +0200
@@ -1,6 +1,6 @@
package DBI::DBD;
# vim:ts=8:sw=4
-
+use strict;
use vars qw($VERSION); # set $VERSION early so we don't confuse PAUSE/CPAN etc
# don't use Revision here because that's not in svn:keywords so that the
@@ -27,12 +27,14 @@
This document is I<still> a minimal draft which is in need of further work.
-The changes will occur both because the B<DBI> specification is changing
-and hence the requirements on B<DBD> drivers change, and because feedback
-from people reading this document will suggest improvements to it.
-
-Please read the B<DBI> documentation first and fully, including the B<DBI> FAQ.
-Then reread the B<DBI> specification again as you're reading this. It'll help.
+Please read the B<DBI> documentation first and fully. Then look at the
+implementation of some high-profile and regularly maintained drivers like
+DBD::Oracle, DBD::ODBC, DBD::Pg etc. (Those are no no particular order.)
+
+Then reread the B<DBI> specification and the code of those drivers again as
+you're reading this. It'll help. Where this document and the driver code
+differ it's likely that the driver code is more correct, especially if multiple
+drivers do the same thing.
This document is a patchwork of contributions from various authors.
More contributions (preferably as patches) are very welcome.
@@ -1795,6 +1797,12 @@
This header file has two jobs:
First it defines data structures for your private part of the handles.
+Note that the DBI provides many common fields for you. For example
+the statement handle (imp_sth) already has a row_count field with an IV type
+that accessed via the DBIc_ROW_COUNT(imp_sth) macro. Using this is strongly
+recommended as it's built in to some DBI internals so the DBI can 'just work'
+in more cases and you'll have less driver-specific code to write.
+Study DBIXS.h to see what's included with each type of handle.
Second it defines macros that rename the generic names like
C to database specific names like C. This
@@ -1818,6 +1826,10 @@
login6 function to see if there are any Unicode characters in the
dbname.
+Similarly defining dbd_db_do4_iv is prefered over dbd_db_do4, dbd_st_rows_iv
+over dbd_st_rows, and dbd_st_execute_iv over dbd_st_execute. The *_iv forms are
+declared to return the IV type instead of an int.
+
People used to just pick Oracle's F and use the same names,
structures and types. I strongly recommend against that. At first glance
this saves time, but your implementation will be less readable. It was
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/DBI/FAQ.pm new/DBI-1.634/lib/DBI/FAQ.pm
--- old/DBI-1.633/lib/DBI/FAQ.pm 2013-06-24 23:03:21.000000000 +0200
+++ new/DBI-1.634/lib/DBI/FAQ.pm 2015-05-26 17:26:53.000000000 +0200
@@ -18,6 +18,7 @@
### commercial products, such as books, magazine articles or CD-ROMs should be
### made to Alligator Descartes.
###
+use strict;
package DBI::FAQ;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/lib/Win32/DBIODBC.pm new/DBI-1.634/lib/Win32/DBIODBC.pm
--- old/DBI-1.633/lib/Win32/DBIODBC.pm 2013-05-23 12:56:50.000000000 +0200
+++ new/DBI-1.634/lib/Win32/DBIODBC.pm 2015-05-26 17:26:53.000000000 +0200
@@ -1,7 +1,7 @@
package # hide this package from CPAN indexer
Win32::ODBC;
-#use strict;
+use strict;
use DBI;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/t/10examp.t new/DBI-1.634/t/10examp.t
--- old/DBI-1.633/t/10examp.t 2014-01-08 10:29:56.000000000 +0100
+++ new/DBI-1.634/t/10examp.t 2015-07-22 17:15:00.000000000 +0200
@@ -14,7 +14,7 @@
require File::Spec;
require VMS::Filespec if $^O eq 'VMS';
-use Test::More tests => 229;
+use Test::More tests => 234;
do {
# provide some protection against growth in size of '.' during the test
@@ -41,7 +41,7 @@
# connect_cached
# ------------------------------------------
# This test checks that connect_cached works
- # and how it then relates to the CachedKids
+ # and how it then relates to the CachedKids
# attribute for the driver.
ok my $dbh_cached_1 = DBI->connect_cached('dbi:ExampleP:', '', '', { TraceLevel=>0, Executed => 0 });
@@ -51,7 +51,7 @@
is($dbh_cached_1, $dbh_cached_2, '... these 2 handles are cached, so they are the same');
ok my $dbh_cached_3 = DBI->connect_cached('dbi:ExampleP:', '', '', { examplep_foo => 1 });
-
+
isnt($dbh_cached_3, $dbh_cached_2, '... this handle was created with different parameters, so it is not the same');
# check that cached_connect applies attributes to handles returned from the cache
@@ -64,12 +64,12 @@
my $drh = $dbh->{Driver};
isa_ok($drh, "DBI::dr");
-
- my @cached_kids = values %{$drh->{CachedKids}};
+
+ my @cached_kids = values %{$drh->{CachedKids}};
ok(eq_set(\@cached_kids, [ $dbh_cached_1, $dbh_cached_3 ]), '... these are our cached kids');
- $drh->{CachedKids} = {};
- cmp_ok(scalar(keys %{$drh->{CachedKids}}), '==', 0, '... we have emptied out cache');
+ $drh->{CachedKids} = {};
+ cmp_ok(scalar(keys %{$drh->{CachedKids}}), '==', 0, '... we have emptied out cache');
}
check_connect_cached();
@@ -480,15 +480,15 @@
{
# dump_results;
my $sth = $dbh->prepare($std_sql);
-
+
isa_ok($sth, "DBI::st");
-
+
if (length(File::Spec->updir)) {
ok($sth->execute(File::Spec->updir));
} else {
ok($sth->execute('../'));
}
-
+
my $dump_file = "dumpcsr.tst.$$";
SKIP: {
skip "# dump_results test skipped: unable to open $dump_file: $!\n", 4
@@ -572,6 +572,35 @@
is(keys(%tables), 0);
}
+{
+ # some tests on special cases for the older tables call
+ # uses DBD::NullP and relies on 2 facts about DBD::NullP:
+ # 1) it has a get_info for for 29 - the quote chr
+ # 2) it has a table_info which returns some types and catalogs
+ my $dbhnp = DBI->connect('dbi:NullP:test');
+
+ # this special case should just return a list of table types
+ my @types = $dbhnp->tables('','','','%');
+ ok(scalar(@types), 'we got some table types');
+ my $defined = grep {defined($_)} @types;
+ is($defined, scalar(@types), 'all table types are defined');
+ SKIP: {
+ skip "some table types were not defined", 1 if ($defined != scalar(@types));
+ my $found_sep = grep {$_ =~ '\.'} @types;
+ is($found_sep, 0, 'no name separators in table types') or diag(Dumper(\@types));
+ };
+
+ # this special case should just return a list of catalogs
+ my @catalogs = $dbhnp->tables('%', '', '');
+ ok(scalar(@catalogs), 'we got some catalogs');
+ SKIP: {
+ skip "no catalogs found", 1 if !scalar(@catalogs);
+ my $found_sep = grep {$_ =~ '\.'} @catalogs;
+ is($found_sep, 0, 'no name separators in catalogs') or diag(Dumper(\@catalogs));
+ };
+ $dbhnp->disconnect;
+}
+
$dbh->disconnect;
ok(!$dbh->{Active});
ok(!$dbh->ping, "ping should return false after disconnect");
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/DBI-1.633/t/49dbd_file.t new/DBI-1.634/t/49dbd_file.t
--- old/DBI-1.633/t/49dbd_file.t 2014-12-11 12:04:20.000000000 +0100
+++ new/DBI-1.634/t/49dbd_file.t 2015-05-26 17:20:06.000000000 +0200
@@ -130,11 +130,19 @@
is_deeply (\@tables, [ map { [ undef, undef, $_, 'TABLE', 'FILE' ] } sort "000_just_testing", $tbl ], "table_info gives test table");
SKIP: {
- $using_dbd_gofer and skip "modifying meta data doesn't work with Gofer-AutoProxy", 4;
+ $using_dbd_gofer and skip "modifying meta data doesn't work with Gofer-AutoProxy", 6;
ok ($dbh->f_set_meta ($tbl, "f_dir", $dir), "set single meta datum");
is ($tbl_file, $dbh->f_get_meta ($tbl, "f_fqfn"), "verify set single meta datum");
ok ($dbh->f_set_meta ($tbl, { f_dir => $dir }), "set multiple meta data");
is ($tbl_file, $dbh->f_get_meta ($tbl, "f_fqfn"), "verify set multiple meta attributes");
+
+ ok($dbh->f_new_meta("t_bsgdf_3544G2z", {
+ f_ext => undef,
+ f_dir => $dir,
+ }), "initialize new table (meta) with settings");
+
+ my $t_bsgdf_file = File::Spec->catfile (Cwd::abs_path ($dir), "t_bsgdf_3544G2z");
+ is($t_bsgdf_file, $dbh->f_get_meta ("t_bsgdf_3544G2z", "f_fqfn"), "verify create meta from scratch");
}
ok ($sth = $dbh->prepare ("select * from $tbl"), "Prepare select * from $tbl");