File Coverage

lib/DBIx/AnyDBD.pm

Criterion	Covered	Total	%
statement	21	127	16.5
branch	0	64	0.0
condition	0	14	0.0
subroutine	7	17	41.1
pod	4	7	57.1
total	32	229	13.9

# $Id: AnyDBD.pm,v 1.15 2002/09/04 12:05:03 matt Exp $

package DBIx::AnyDBD;
use DBI;
use warnings;
use strict;
use vars qw/$AUTOLOAD $VERSION/;

=head1 NAME

DBIx::AnyDBD - DBD independent class

=head1 VERSION

Version 2.03

=cut

our $VERSION = '2.03';

=head1 SYNOPSIS

This class provides application developers with an abstraction class
a level away from DBI, that allows them to write an application that
works on multiple database platforms. The idea isn't to take away the
responsibility for coding different SQL on different platforms, but
to simply provide a platform that uses the right class at the right
time for whatever DB is currently in use.


    use DBIx::AnyDBD;

    my $db = DBIx::AnyDBD->connect("dbi:Oracle:sid1",
        "user", "pass", {}, "MyClass");

    my $foo = $db->foo;
    my $blee = $db->blee;

That doesn't really tell you much... Because you have to implement a
bit more than that. Underneath you have to have a module
MyClass::Oracle that has methods foo() and blee in it. If those
methods don't exist in MyClass::Oracle, it will check in MyClass::Default,
allowing you to implement code that doesn't need to be driver
dependent in the same module. The foo() and blee() methods will receive
the DBIx::AnyDBD instance as thier first parameter, and any parameters
you pass just go as parameters.

See the example Default.pm and Sybase.pm classes in the AnyDBD directory
for an example.

Underneath it's all implemented using the ISA hierarchy, which is modified
when you connect to your database. The inheritance tree ensures that the
right functions get called at the right time. There is also an AUTOLOADer
that steps in if the function doesn't exist and tries to call the function
on the database handle (i.e. in the DBI class). The sub-classing uses
C{Driver}->{Name})> (along with some clever fiddling for
ODBC and ADO) to get the super-class, so if you don't know what to name
your class (see the list below first) then check that.

=head1 SUBROUTINES/METHODS

=head2 new

    dsn => $dsn,
    user => $user,
    pass => $pass,
    attr => $attr,
    package => $package

new() is a named parameter call that connects and creates a new db object
for your use. The named parameters are dsn, user, pass, attr and package.
The first 4 are just the parameters passed to DBI->connect, and package
contains the package prefix for your database dependent modules, for example,
if package was "MyPackage", the AUTOLOADer would look for
MyPackage::Oracle::func, and then MyPackage::Default::func. Beware that the
DBD driver will be ucfirst'ed, because lower case package names are reserved
as pragmas in perl. See the known DBD package mappings below.

If package parameter is undefined then the package name used to call
the constructor is used.  This will usually be DBIx::AnyDBD.  This, in
itself, is not very useful but is convenient if you subclass
DBIx::AnyDBD.

If attr is undefined then the default attributes are:

    AutoCommit => 1
    PrintError => 0
    RaiseError => 1

So be aware if you don't want your application dying to either eval{} all
db sections and catch the exception, or pass in a different attr parameter.

After re-blessing the object into the database specific object, DBIx::AnyDBD
will call the _init() method on the object, if it exists. This allows you
to perform some driver specific post-initialization.

=cut

sub new {
	my $proto = shift;
	my %args = @_;

	my $class = ref($proto) || $proto;

	return unless(defined($class));

    my $dbh = DBI->connect(
            $args{dsn},
            $args{user},
            $args{pass},
            ($args{attr} ||
                {
                    AutoCommit => 1,
                    PrintError => 0,
                    RaiseError => 1,
                })
            );
    die "Can't connect: " . DBI->errstr unless $dbh;
    my $package = $args{'package'} || $class;
    my $self = bless { 'package' => $package, dbh => $dbh }, $class;
    $self->rebless;
    $self->_init if $self->can('_init');
    return $self;
}

=head2 new_with_dbh

Instantiate an object around an existing DBI database handle.

=cut

# RT#5661
sub new_with_dbh {
	my ($class, $dbh, $package) = @_;
	my $self = bless { 'package' => $package, 'dbh' => $dbh }, $class;

	$self->rebless;
	$self->_init if $self->can('_init');

	return $self;
}

=head2 connect($dsn, $user, $pass, $attr, $package)

connect() is very similar to DBI->connect, taking exactly the same first
4 parameters. The 5th parameter is the package prefix, as above.

connect() doesn't try and default attributes for you if you don't pass them.

After re-blessing the object into the database specific object, DBIx::AnyDBD
will call the _init() method on the object, if it exists. This allows you
to perform some driver specific post-initialization.

=cut

sub connect {
    my $class = shift;
    my ($dsn, $user, $pass, $args, $package) = @_;
    my $dbh = DBI->connect($dsn, $user, $pass, $args);
    return undef unless $dbh;
    $package ||= $class;
    my $self = bless { 'package' => $package, 'dbh' => $dbh }, $class;
    $self->rebless;
    $self->_init if $self->can('_init');
    return $self;
}

sub rebless {
    my $self = shift;
    my $driver = ucfirst($self->{dbh}->{Driver}->{Name});
    if ( $driver eq 'Proxy' ) {
	# Looking into the internals of DBD::Proxy is maybe a little questionable
	($driver) = $self->{dbh}->{proxy_client}->{application} =~ /^DBI:(.+?):/;
    }
    my $class = $self->{'package'};
    my ($odbc, $ado) = ($driver eq 'ODBC', $driver eq 'ADO');
    if ($odbc || $ado) {
        my $name;

        if ($odbc) {
            no strict;
            $name = $self->{dbh}->func(17, GetInfo);
        }
        elsif ($ado) {
            $name = $self->{dbh}->{ado_conn}->Properties->Item('DBMS Name')->Value;
        }
        else {
            die "Can't determine driver name!\n";
        }

        if ($name eq 'Microsoft SQL Server') {
            $driver = 'MSSQL';
        }
        elsif ($name eq 'SQL Server') {
            $driver = 'Sybase';
        }
        elsif ($name =~ /Oracle/) {
            $driver = 'Oracle';
        }
#             elsif ($name eq 'ACCESS') {
#                   $driver = 'Access';
#             }
#             elsif ($name eq 'Informix') {
#                   $driver = 'Informix'; # caught by "else" condition below
#             }
        elsif ($name eq 'Adaptive Server Anywhere') {
            $driver = 'ASAny';
        } elsif ($name eq 'ADABAS D') {
            $driver = 'AdabasD';
        }
        else {  # this should catch Access and Informix
            $driver = lc($name);
            $driver =~ s/\b(\w)/uc($1)/eg;
            $driver =~ s/\s+/_/g;
        }
    }

    my $dir;
    ($dir = $self->{package}) =~ s/::/\//g;
    load_module("$dir/Default.pm") or die "Cannot find $dir/Default.pm module in \@INC for $self->{package}!";

    if (!load_module("$dir/$driver.pm")) {
        # no package for driver - use Default instead
        bless $self, "${class}::Default";
        # make Default -> DBIx::AnyDBD hierarchy
        add_isa("${class}::Default", 'DBIx::AnyDBD');
    }
    else {
        # package OK...

        bless $self, "${class}::${driver}";

        if ($ado) {
            if (load_module("$dir/ADO.pm")) {
                if (!load_module("$dir/ODBC.pm")) {
                    add_isa("${class}::${driver}", "${class}::ADO");
                    add_isa("${class}::ADO", "${class}::Default");
                }
                else {
                    add_isa("${class}::${driver}", "${class}::ADO");
                    add_isa("${class}::ADO", "${class}::ODBC");
                    add_isa("${class}::ODBC", "${class}::Default");
                }
                return;
            }
        }

        if ($odbc) {
            if (load_module("$dir/ODBC.pm")) {
                add_isa("${class}::${driver}", "${class}::ODBC");
                add_isa("${class}::ODBC", "${class}::Default");
                return;
            }
        }

        # make Default -> DBIx::AnyDBD hierarchy
        add_isa("${class}::Default", 'DBIx::AnyDBD');

        # make Driver -> Default hierarchy
        add_isa("${class}::${driver}", "${class}::Default");
    }

}

sub add_isa {
    my ($class, $newval) = @_;
    no strict 'refs';
    unshift @{"${class}::ISA"}, $newval unless $class->isa($newval);
}

sub load_module {
    my $module = shift;

    eval {
        require $module;
    };
    if ($@) {
        if ($@ =~ /^Can't locate $module in \@INC/) {
            undef $@;
            return 0;
        }
        else {
            die $@;
        }
    }

    return 1;
}

=head2 $db->get_dbh()

This method is mainly for the DB dependent modules to use, it returns the
underlying DBI database handle. There will probably have code added here
to check the db is still connected, so it may be wise to always use this
method rather than trying to retrieve $self->{dbh} directly.

=cut

sub get_dbh {
    # maybe add code here to check connection status.
    # or maybe add check once every 10 get_dbh's...
    return shift->{dbh};
}

sub DESTROY {
    my $self = shift;
    my $dbh;
    if ($dbh = $self->get_dbh) {
        $dbh->disconnect;
    }
}

=head2 Controlling error propagation from AUTOLOADed DBI methods

Typicially the implementation packages will make calls to DBI methods
as though they were methods of the DBIx::AnyDBD object.  If one of
these methods reports an error in DBI::AnyDBD then the error is caught
and rethrown by DBIx::AnyDBD so that the error is reported as occuring
in the implementation module.  It does this by calling Carp::croak()
with the current package set to DBIx::AnyDBD::Carp.

Usually this the the right thing to do but sometimes you may want to
report the error in the line containing the original method call on
the DBIx::AnyDBD object.  In this case you should temporarily set
@DBIx::AnyDBD::Carp::ISA.

    my $db = DBIx::AnyDBD->connect("dbi:Oracle:sid1",
        "user", "pass", {}, "MyClass");

    my $foo = $db->foo;
    my $blee = $db->blee("too few arguments"); # Error reported here

    package MyClass::Oracle;

    sub foo {
	shift->prepare("Invalid SQL"); # Error reported here
    }

    sub blee {
	local @DBIx::AnyDBD::Carp::ISA = __PACKAGE__;
	shift->selectall_arrayref(BLEE_STATEMENT,{},@_); # Error not reported here
    }

=cut

sub AUTOLOAD {
    (my $func = $AUTOLOAD) =~ s/.*:://;
    no strict 'refs';
    # The following is much more elegant but doesn't work!
    # *$func = sub {
    #	  unshift @_ => shift->get_dbh;
    #	  goto &{$_[0]->can($func)};
    # };
    *$func = sub {
      my $dbh = shift->get_dbh;
      if (wantarray) {
	  my @r = eval { $dbh->$func(@_) };
	  return @r unless $@;
      } elsif (defined wantarray) {
	  my $r = eval { $dbh->$func(@_) };
	  return $r unless $@;
      } else {
	  eval { $dbh->$func(@_) };
	  return unless $@;
      };
      if ( $@ =~ /(.*) at ${\__FILE__} .*$/ ) {
	  # We want croak() to report errors as occouring
	  # in the implementation class even though we are related
	  package DBIx::AnyDBD::Carp;
	  require Carp;
	  Carp::croak "$1";
      }
      die; # Unreachable ?
    };
    goto &$func;
}

1;

__END__