DBI 1.38: Undefined subroutine &DBD::_::db::croak called at DBI.pm line 1496

--------------043611293F9F9B63EB9B52C5
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Hi Tim,

the attached patch adds 'Carp::' to all unqualified
calls to carp() and croak().
You'll get the error message above with something like

  perl -MDBI -e 'DBI->connect()->primary_key($c,$s,$t)'


Steffen
--------------043611293F9F9B63EB9B52C5
Content-Type: text/plain; charset=us-ascii; name="DBI.diff"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="DBI.diff"

*** DBI.orig	Fri Aug 22 23:25:40 2003
--- DBI.pm	Mon Nov 03 16:14:28 2003
***************
*** 155,161 ****
  
  my $Revision = substr(q$Revision: 11.36 $, 10);
  
! use Carp;
  use DynaLoader ();
  use Exporter ();
  
--- 155,161 ----
  
  my $Revision = substr(q$Revision: 11.36 $, 10);
  
! use Carp();
  use DynaLoader ();
  use Exporter ();
  
***************
*** 726,732 ****
  	# catch people on case in-sensitive systems using the wrong case
  	$advice = "\nPerhaps the capitalisation of DBD '$driver' isn't right."
  		if $@ =~ /locate object method/;
! 	croak("$driver_class initialisation failed: $@$advice");
      }
  
      $DBI::installed_drh{$driver} = $drh;
--- 726,732 ----
  	# catch people on case in-sensitive systems using the wrong case
  	$advice = "\nPerhaps the capitalisation of DBD '$driver' isn't right."
  		if $@ =~ /locate object method/;
! 	Carp::croak("$driver_class initialisation failed: $@$advice");
      }
  
      $DBI::installed_drh{$driver} = $drh;
***************
*** 990,996 ****
  
  sub connect_test_perf {
      my($class, $dsn,$dbuser,$dbpass, $attr) = @_;
! 	croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
      # these are non standard attributes just for this special method
      my $loops ||= $attr->{dbi_loops} || 5;
      my $par   ||= $attr->{dbi_par}   || 1;	# parallelism
--- 990,996 ----
  
  sub connect_test_perf {
      my($class, $dsn,$dbuser,$dbpass, $attr) = @_;
! 	Carp::croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
      # these are non standard attributes just for this special method
      my $loops ||= $attr->{dbi_loops} || 5;
      my $par   ||= $attr->{dbi_par}   || 1;	# parallelism
***************
*** 1139,1145 ****
  {   package	# hide from PAUSE
  	DBD::Switch::dr;
      DBI->setup_driver('DBD::Switch');	# sets up @ISA
-     require Carp;
  
      $DBD::Switch::dr::imp_data_size = 0;
      $DBD::Switch::dr::imp_data_size = 0;	# avoid typo warning
--- 1139,1144 ----
***************
*** 1212,1225 ****
  	# to install new methods into the DBI dispatcher
  	# DBD::Foo::db->install_method("foo_mumble", { usage => [...], options => '...' });
  	my ($class, $method, $attr) = @_;
! 	croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
  	    unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
  	my ($driver, $subtype) = ($1, $2);
! 	croak("invalid method name '$method'")
  	    unless $method =~ m/^([a-z]+_)\w+$/;
  	my $prefix = $1;
  	my $reg_info = $dbd_prefix_registry->{$prefix};
! 	croak("method name prefix '$prefix' is not registered") unless $reg_info;
  	my %attr = %{$attr||{}}; # copy so we can edit
  	# XXX reformat $attr as needed for _install_method
  	my ($caller_pkg, $filename, $line) = caller;
--- 1211,1224 ----
  	# to install new methods into the DBI dispatcher
  	# DBD::Foo::db->install_method("foo_mumble", { usage => [...], options => '...' });
  	my ($class, $method, $attr) = @_;
! 	Carp::croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
  	    unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
  	my ($driver, $subtype) = ($1, $2);
! 	Carp::croak("invalid method name '$method'")
  	    unless $method =~ m/^([a-z]+_)\w+$/;
  	my $prefix = $1;
  	my $reg_info = $dbd_prefix_registry->{$prefix};
! 	Carp::croak("method name prefix '$prefix' is not registered") unless $reg_info;
  	my %attr = %{$attr||{}}; # copy so we can edit
  	# XXX reformat $attr as needed for _install_method
  	my ($caller_pkg, $filename, $line) = caller;
***************
*** 1238,1249 ****
  	my ($drh, $user, $pass, $attr) = @_;
  	unless (defined $user) {
  	    $user = $ENV{DBI_USER};
! 	    carp("DBI connect: user not defined and DBI_USER env var not set")
  		if 0 && !defined $user && $drh->{Warn};	# XXX enable later
  	}
  	unless (defined $pass) {
  	    $pass = $ENV{DBI_PASS};
! 	    carp("DBI connect: password not defined and DBI_PASS env var not set")
  		if 0 && !defined $pass && $drh->{Warn};	# XXX enable later
  	}
  	return ($user, $pass);
--- 1237,1248 ----
  	my ($drh, $user, $pass, $attr) = @_;
  	unless (defined $user) {
  	    $user = $ENV{DBI_USER};
! 	    Carp::carp("DBI connect: user not defined and DBI_USER env var not set")
  		if 0 && !defined $user && $drh->{Warn};	# XXX enable later
  	}
  	unless (defined $pass) {
  	    $pass = $ENV{DBI_PASS};
! 	    Carp::carp("DBI connect: password not defined and DBI_PASS env var not set")
  		if 0 && !defined $pass && $drh->{Warn};	# XXX enable later
  	}
  	return ($user, $pass);
***************
*** 1493,1499 ****
  	my $sth = $dbh->primary_key_info(@args) or return;
  	my ($row, @col);
  	push @col, $row->[3] while ($row = $sth->fetch);
! 	croak("primary_key method not called in list context")
  		unless wantarray; # leave us some elbow room
  	return @col;
      }
--- 1492,1498 ----
  	my $sth = $dbh->primary_key_info(@args) or return;
  	my ($row, @col);
  	push @col, $row->[3] while ($row = $sth->fetch);
! 	Carp::croak("primary_key method not called in list context")
  		unless wantarray; # leave us some elbow room
  	return @col;
      }

--------------043611293F9F9B63EB9B52C5--

0
s
11/4/2003 10:27:27 AM
perl.dbi.dev 1927 articles. 0 followers. Follow

1 Replies
673 Views

Similar Articles

[PageSpeed] 29

Thanks Steffen!

Tim.

On Tue, Nov 04, 2003 at 11:27:27AM +0100, Steffen Goeldner wrote:
> Hi Tim,
> 
> the attached patch adds 'Carp::' to all unqualified
> calls to carp() and croak().
> You'll get the error message above with something like
> 
>   perl -MDBI -e 'DBI->connect()->primary_key($c,$s,$t)'
> 
> 
> Steffen
> *** DBI.orig	Fri Aug 22 23:25:40 2003
> --- DBI.pm	Mon Nov 03 16:14:28 2003
> ***************
> *** 155,161 ****
>   
>   my $Revision = substr(q$Revision: 11.36 $, 10);
>   
> ! use Carp;
>   use DynaLoader ();
>   use Exporter ();
>   
> --- 155,161 ----
>   
>   my $Revision = substr(q$Revision: 11.36 $, 10);
>   
> ! use Carp();
>   use DynaLoader ();
>   use Exporter ();
>   
> ***************
> *** 726,732 ****
>   	# catch people on case in-sensitive systems using the wrong case
>   	$advice = "\nPerhaps the capitalisation of DBD '$driver' isn't right."
>   		if $@ =~ /locate object method/;
> ! 	croak("$driver_class initialisation failed: $@$advice");
>       }
>   
>       $DBI::installed_drh{$driver} = $drh;
> --- 726,732 ----
>   	# catch people on case in-sensitive systems using the wrong case
>   	$advice = "\nPerhaps the capitalisation of DBD '$driver' isn't right."
>   		if $@ =~ /locate object method/;
> ! 	Carp::croak("$driver_class initialisation failed: $@$advice");
>       }
>   
>       $DBI::installed_drh{$driver} = $drh;
> ***************
> *** 990,996 ****
>   
>   sub connect_test_perf {
>       my($class, $dsn,$dbuser,$dbpass, $attr) = @_;
> ! 	croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
>       # these are non standard attributes just for this special method
>       my $loops ||= $attr->{dbi_loops} || 5;
>       my $par   ||= $attr->{dbi_par}   || 1;	# parallelism
> --- 990,996 ----
>   
>   sub connect_test_perf {
>       my($class, $dsn,$dbuser,$dbpass, $attr) = @_;
> ! 	Carp::croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
>       # these are non standard attributes just for this special method
>       my $loops ||= $attr->{dbi_loops} || 5;
>       my $par   ||= $attr->{dbi_par}   || 1;	# parallelism
> ***************
> *** 1139,1145 ****
>   {   package	# hide from PAUSE
>   	DBD::Switch::dr;
>       DBI->setup_driver('DBD::Switch');	# sets up @ISA
> -     require Carp;
>   
>       $DBD::Switch::dr::imp_data_size = 0;
>       $DBD::Switch::dr::imp_data_size = 0;	# avoid typo warning
> --- 1139,1144 ----
> ***************
> *** 1212,1225 ****
>   	# to install new methods into the DBI dispatcher
>   	# DBD::Foo::db->install_method("foo_mumble", { usage => [...], options => '...' });
>   	my ($class, $method, $attr) = @_;
> ! 	croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
>   	    unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
>   	my ($driver, $subtype) = ($1, $2);
> ! 	croak("invalid method name '$method'")
>   	    unless $method =~ m/^([a-z]+_)\w+$/;
>   	my $prefix = $1;
>   	my $reg_info = $dbd_prefix_registry->{$prefix};
> ! 	croak("method name prefix '$prefix' is not registered") unless $reg_info;
>   	my %attr = %{$attr||{}}; # copy so we can edit
>   	# XXX reformat $attr as needed for _install_method
>   	my ($caller_pkg, $filename, $line) = caller;
> --- 1211,1224 ----
>   	# to install new methods into the DBI dispatcher
>   	# DBD::Foo::db->install_method("foo_mumble", { usage => [...], options => '...' });
>   	my ($class, $method, $attr) = @_;
> ! 	Carp::croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
>   	    unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
>   	my ($driver, $subtype) = ($1, $2);
> ! 	Carp::croak("invalid method name '$method'")
>   	    unless $method =~ m/^([a-z]+_)\w+$/;
>   	my $prefix = $1;
>   	my $reg_info = $dbd_prefix_registry->{$prefix};
> ! 	Carp::croak("method name prefix '$prefix' is not registered") unless $reg_info;
>   	my %attr = %{$attr||{}}; # copy so we can edit
>   	# XXX reformat $attr as needed for _install_method
>   	my ($caller_pkg, $filename, $line) = caller;
> ***************
> *** 1238,1249 ****
>   	my ($drh, $user, $pass, $attr) = @_;
>   	unless (defined $user) {
>   	    $user = $ENV{DBI_USER};
> ! 	    carp("DBI connect: user not defined and DBI_USER env var not set")
>   		if 0 && !defined $user && $drh->{Warn};	# XXX enable later
>   	}
>   	unless (defined $pass) {
>   	    $pass = $ENV{DBI_PASS};
> ! 	    carp("DBI connect: password not defined and DBI_PASS env var not set")
>   		if 0 && !defined $pass && $drh->{Warn};	# XXX enable later
>   	}
>   	return ($user, $pass);
> --- 1237,1248 ----
>   	my ($drh, $user, $pass, $attr) = @_;
>   	unless (defined $user) {
>   	    $user = $ENV{DBI_USER};
> ! 	    Carp::carp("DBI connect: user not defined and DBI_USER env var not set")
>   		if 0 && !defined $user && $drh->{Warn};	# XXX enable later
>   	}
>   	unless (defined $pass) {
>   	    $pass = $ENV{DBI_PASS};
> ! 	    Carp::carp("DBI connect: password not defined and DBI_PASS env var not set")
>   		if 0 && !defined $pass && $drh->{Warn};	# XXX enable later
>   	}
>   	return ($user, $pass);
> ***************
> *** 1493,1499 ****
>   	my $sth = $dbh->primary_key_info(@args) or return;
>   	my ($row, @col);
>   	push @col, $row->[3] while ($row = $sth->fetch);
> ! 	croak("primary_key method not called in list context")
>   		unless wantarray; # leave us some elbow room
>   	return @col;
>       }
> --- 1492,1498 ----
>   	my $sth = $dbh->primary_key_info(@args) or return;
>   	my ($row, @col);
>   	push @col, $row->[3] while ($row = $sth->fetch);
> ! 	Carp::croak("primary_key method not called in list context")
>   		unless wantarray; # leave us some elbow room
>   	return @col;
>       }

0
Tim
11/4/2003 3:28:47 PM
Reply: