Author: timbo
Date: Sat Jul 22 07:42:38 2006
New Revision: 6690
Added:
dbi/trunk/dumpmethods.pl
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/lib/DBI/PurePerl.pm
Log:
Fix (hopefully) an assertion failure in bleedperl.
Tweak install_drivers docs.
Add dumpmethods.pl script to list methods with named ima attributes.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Sat Jul 22 07:42:38 2006
@@ -13,7 +13,7 @@
Fixed small memory leak (per interpreter/thread) thanks to Ephraim Dan.
Fixed execute_for_fetch/execute_array to RaiseError thanks to Martin J.
Evans.
- Added ability for DBI::Profile Path to contain code refs - cool.
+ Added ability for DBI::Profile Path to contain code refs - cool!
Added $dbh->statistics_info specification thanks to Brandon Black.
=head2 Changes in DBI 1.51 (svn rev 6475), 6th June 2006
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Sat Jul 22 07:42:38 2006
@@ -2753,9 +2753,14 @@
%drivers = DBI->installed_drivers();
-Returns a list of driver name and driver handle pairs for all
-installed drivers. The driver name does not include the 'DBD::'
-prefix. Added in DBI 1.49.
+Returns a list of driver name and driver handle pairs for all drivers
+'installed' (loaded) into the current process. The driver name does not
+include the 'DBD::' prefix.
+
+To get a list of all drivers available in your perl instalation you can use
+L</available_drivers>.
+
+Added in DBI 1.49.
=item C<installed_versions>
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Sat Jul 22 07:42:38 2006
@@ -2599,7 +2599,7 @@
*/
if (SvROK(h) && SvRMAGICAL(SvRV(h)) && (mg=mg_find(SvRV(h),'P'))!=NULL) {
- if (SvPVX(mg->mg_obj)==NULL) { /* maybe global destruction */
+ if (mg->mg_obj==NULL || !SvOK(mg->mg_obj) || SvPVX(mg->mg_obj)==NULL)
{ /* maybe global destruction */
if (trace_level >= 3)
PerlIO_printf(DBILOGFP,
"%c <> %s for %s ignored (inner handle gone)\n",
@@ -3958,7 +3958,6 @@
double t2
CODE:
D_imp_xxh(h);
- STRLEN lna = 0;
(void)cv;
dbi_profile(h, imp_xxh, statement,
SvROK(method) ? SvRV(method) : method,
Added: dbi/trunk/dumpmethods.pl
==============================================================================
--- (empty file)
+++ dbi/trunk/dumpmethods.pl Sat Jul 22 07:42:38 2006
@@ -0,0 +1,39 @@
+package DBI;
+
+BEGIN { $ENV{DBI_PUREPERL} = 2 }
+use DBI;
+
+no strict qw(subs refs); # build name and code to value mappings
introspectively
+my @ima_n = grep { /^IMA_.*/ } keys %{"DBI::"};
+warn "@ima_n";
+my %ima_n2v = map { /^(IMA_.*)/ ? ($1=>&$_) : () } @ima_n;
+my %ima_v2n = reverse %ima_n2v;
+my @ima_a = map { $ima_v2a{1<<$_} || "b".($_+1) } 0..31;
+
+my @bit2hex_bitkeys = map { 1<<$_ } 0..31;
+my @bit2hex_bitvals = map { sprintf("%s", $ima_v2n{$_}||'') } @bit2hex_bitkeys;
+my %bit2hex; @bit2hex{ @bit2hex_bitkeys } = @bit2hex_bitvals;
+my @bit2hex_values = ("0x00000000", @bit2hex_bitvals);
+
+use Data::Dumper;
+warn Dumper \%DBI::DBI_methods;
+
+while ( my ($class, $meths) = each %DBI::DBI_methods ) {
+
+ for my $method (sort keys %$meths) {
+ my $info = $meths->{$method};
+ my $fullmeth = "DBI::${class}::$method";
+
+ my $proto = $info->{U}[2];
+ unless (defined $proto) {
+ $proto = '$' x ($info->{U}[0]||0);
+ $proto .= ";" . ('$' x $info->{U}[1]) if $info->{U}[1];
+ }
+
+ my $O = $info->{O}||0;
+ my @ima_flags = map { ($O & $_) ? $bit2hex{$_} : () } @bit2hex_bitkeys;
+
+ print "\$h->$fullmeth($proto) @ima_flags\n";
+ }
+}
+
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Sat Jul 22 07:42:38 2006
@@ -122,10 +122,12 @@
use constant IMA_COPY_STMT => 0x0040; #/* copy sth Statement to dbh */
use constant IMA_END_WORK => 0x0080; #/* set on commit & rollback */
use constant IMA_STUB => 0x0100; #/* donothing eg $dbh->connected */
-#define IMA_CLEAR_STMT 0x0200 /* clear Statement before call */
-#define IMA_PROF_EMPTY_STMT 0x0400 /* profile as empty Statement */
+use constant IMA_CLEAR_STMT => 0x0200; #/* clear Statement before call */
+use constant IMA_PROF_EMPTY_STMT=> 0x0400; #/* profile as empty Statement */
use constant IMA_NOT_FOUND_OKAY => 0x0800; #/* not error if not found */
use constant IMA_EXECUTE => 0x1000; #/* do/execute: DBIcf_Executed */
+use constant IMA_SHOW_ERR_STMT => 0x2000; #/* dbh meth relates to Statement*/
+use constant IMA_HIDE_ERR_PARAMVALUES => 0x4000; #/* ParamValues are not
relevant */
my %is_flag_attribute = map {$_ =>1 } qw(
Active
