File Coverage

blib/lib/Tao/DBI/db.pm
Criterion Covered Total %
statement 20 51 39.2
branch 0 16 0.0
condition 0 10 0.0
subroutine 7 12 58.3
pod 1 3 33.3
total 28 92 30.4


line stmt bran cond sub pod time code
1              
2             package Tao::DBI::db;
3              
4 1     1   14 use 5.006;
  1         3  
5 1     1   5 use strict;
  1         2  
  1         19  
6 1     1   4 use warnings;
  1         1  
  1         72  
7              
8             require Exporter;
9              
10             our @ISA = qw(Exporter);
11             our @EXPORT = qw();
12              
13             our $VERSION = '0.012';
14              
15 1     1   44662 use DBI;
  1         41138  
  1         76  
16 1     1   755 use Tao::DBI::st;
  1         2  
  1         40  
17 1     1   533 use Tao::DBI::st_deep;
  1         21  
  1         409  
18              
19             # the instance variables:
20             # DBH
21             # NAME
22              
23             # usage:
24             # $dbh = new Tao::DBI::db($args);
25             sub new {
26 0     0 1   my ( $proto, $args ) = @_;
27 0   0       my $class = ref($proto) || $proto;
28 0           my $obj = bless {}, $class;
29 0           $obj->initialize($args);
30 0           return $obj;
31             }
32              
33             # usage:
34             # $dbh->initialize($args);
35             # where $args is
36             # { name => , dsn|url => , user => , password =>, options passed to DBI->connect }
37             #
38             #
39             # protected
40             sub initialize {
41 0     0 0   my ( $self, $args ) = @_;
42              
43 0           $self->{NAME} = $args->{name};
44 0   0       $self->{URL} = $args->{dsn} || $args->{url};
45 0           $self->{USER} = $args->{user};
46 0           $self->{PASS} = $args->{password};
47 0 0         unless ( exists $args->{FetchHashKeyName} ) {
48 0           $args->{FetchHashKeyName} = 'NAME_lc';
49             }
50 0 0         unless ( exists $args->{AutoCommit} ) {
51 0           $args->{AutoCommit} = 0;
52             }
53              
54 0           my $dbh = DBI->connect( $self->{URL}, $self->{USER}, $self->{PASS}, $args )
55             ; # remaining arguments can be passed to DBI->connect (needs improving!)
56 0 0         if ($dbh) {
57 0           $self->{DBH} = $dbh;
58             }
59             else {
60 0           die "Can't establish connection '$self->{NAME}': $DBI::errstr\n";
61             }
62             }
63              
64             # $stmt = $dbh->prepare($sql, $args);
65             # $stmt = $dbh->prepare($args); # $args is hashref
66             sub prepare {
67 0     0 0   my $self = shift;
68 0           my $sql;
69 0 0         $sql = shift unless ref $_[0]; # first non-ref arg
70 0   0       my $args = shift || {};
71 0   0       my $st_type = $args->{type} || 'plain';
72 0 0         if ( $st_type eq 'plain' ) {
    0          
73             return new Tao::DBI::st(
74             {
75             ( $sql ? ( sql => $sql ) : () ),
76             dbh => $self->{DBH},
77 0 0         %$args
78             }
79             );
80             }
81             elsif ( $st_type eq 'deep' ) {
82             return new Tao::DBI::st_deep(
83             {
84             ( $sql ? ( sql => $sql ) : () ),
85             dbh => $self->{DBH},
86 0 0         %$args
87             }
88             );
89             }
90             else {
91 0           die "unknown statement type: $st_type\n";
92             }
93             }
94              
95 1     1   5 use vars qw ($AUTOLOAD);
  1         2  
  1         127  
96              
97             # If method wasn't found, delegates to DBH instance variable.
98             # This way, instances of this class behaves like DBI connections.
99             #
100             # this needs improvement: non existent methods will provoke weird
101             # messages from DBI objects, instead of Tao::DBI::db
102             sub AUTOLOAD {
103 0     0     my $self = shift;
104 0           my $meth = $AUTOLOAD;
105 0           $meth =~ s/.*:://;
106 0           return $self->{DBH}->$meth(@_);
107             }
108              
109       0     sub DESTROY { }
110              
111             1;
112              
113             # May 29, 2003
114              
115             __END__