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: [EMAIL PROTECTED]");
> }
>
> $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: [EMAIL PROTECTED]");
> }
>
> $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;
> }
