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 - co...@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: L<http://www.chiark.greenend.org.uk/~sgtatham/bugs.html>. +If you think you've found a memory leak then read L</Memory Leaks>. + 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 L<http://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 L<DBI::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 L<Scalar::Util|Scalar::Util> module). The referenced @@ -4635,7 +4644,7 @@ passing to C</fetchall_arrayref>. 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<Placeholders|/Placeholders and Bind Values>). +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</Placeholders and Bind Values> 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</Placeholders and Bind Values> for more information. =head3 C<bind_param_inout> @@ -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</Placeholders and Bind Values> for more information. =head3 C<bind_param_array> @@ -7663,6 +7673,23 @@ via C<$h-E<gt>{private_..._*}>. See the entry under L</ATTRIBUTES COMMON TO ALL HANDLES> for info and important caveats. +=head2 Memory Leaks + +When tracking down memory leaks using tools like L<Devel::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</prepare_cached> and L</connect_cached>. + +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-us...@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-...@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<get_sql_engine_meta>, C<get_single_table_meta>, C<set_single_table_meta>, -C<set_sql_engine_meta> and C<clear_sql_engine_meta>. 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<new_sql_engine_meta>, C<get_sql_engine_meta>, C<get_single_table_meta>, +C<set_single_table_meta>, C<set_sql_engine_meta> and C<clear_sql_engine_meta>. +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<dbd_db_login()> to database specific names like C<ora_db_login()>. 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<dbdimp.c> 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");