File Coverage

blib/lib/DBIx/AnyDBD.pm

Criterion	Covered	Total	%
statement	18	117	15.3
branch	0	60	0.0
condition	0	11	0.0
subroutine	6	15	40.0
pod	3	6	50.0
total	27	209	12.9

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

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

$VERSION = '2.01';

sub new {
    my $class = shift;
    my %args = @_;
    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;
}

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;
}

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;
    }
}

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__