File Coverage

blib/lib/LittleORM/Model/Dbh.pm
Criterion Covered Total %
statement 9 60 15.0
branch 0 30 0.0
condition 0 6 0.0
subroutine 3 12 25.0
pod 0 5 0.0
total 12 113 10.6


line stmt bran cond sub pod time code
1 1     1   4 use strict;
  1         1  
  1         31  
2              
3             # DBH-related routines which were inside ORM/Model.pm earlier
4              
5 1     1   326 use LittleORM::Db::Connector ();
  1         3  
  1         45  
6              
7             package LittleORM::Model;
8              
9 1     1   52 use Carp::Assert 'assert';
  1         2  
  1         5  
10              
11             sub set_read_dbh
12             {
13 0     0 0   my ( $self, $dbh ) = @_;
14              
15             # arrayref expected
16 0           $self -> meta() -> _littleorm_rdbh( $dbh );
17             }
18              
19             sub set_write_dbh
20             {
21 0     0 0   my ( $self, $dbh ) = @_;
22              
23             # arrayref expected
24 0           $self -> meta() -> _littleorm_wdbh( $dbh );
25             }
26              
27             sub set_dbh
28             {
29 0     0 0   my ( $self, $dbh ) = @_;
30              
31 0 0         if( ref( $dbh ) eq 'HASH' )
32             {
33 0           my ( $rdbh, $wdbh ) = @{ $dbh }{ 'read', 'write' };
  0            
34 0   0       assert( $rdbh and $wdbh );
35              
36 0 0         $self -> set_read_dbh( ref( $rdbh ) eq 'ARRAY' ? $rdbh : [ $rdbh ] );
37 0 0         $self -> set_write_dbh( ref( $wdbh ) eq 'ARRAY' ? $wdbh : [ $wdbh ] );
38              
39             } else
40             {
41 0           $self -> set_read_dbh( [ $dbh ] );
42 0           $self -> set_write_dbh( [ $dbh ] );
43             }
44             }
45              
46             # old methods
47              
48             sub __get_dbh
49             {
50 0     0     my $self = shift;
51 0           my %args = @_;
52              
53 0 0         unless( exists $args{ '_for_what' } )
54             {
55             # warn( "'_for_what' not specified, failing back to write DBH" );
56 0           $args{ '_for_what' } = 'write';
57             }
58              
59 0           assert( my $for_what = $args{ '_for_what' } ); # i must know what this DBH you need for
60              
61 0           my $class_dbh = $self -> __get_class_dbh( $for_what );
62              
63 0 0         unless( $class_dbh )
64             {
65 0           $self -> __set_db_connector_object_if_required();
66 0 0         if( my $c = $self -> meta() -> _littleorm_db_connector() )
67             {
68 0           $class_dbh = $c -> get_dbh( $for_what );
69 0           $self -> __set_class_dbh( $class_dbh, $for_what );
70             }
71             }
72              
73 0   0       my $dbh = ( $args{ '_dbh' }
74             or
75             $class_dbh
76             or
77             &LittleORM::Db::get_dbh( $for_what ) );
78              
79             # assert( &LittleORM::Db::dbh_is_ok( $dbh ), 'this method is supposed to return valid dbh' );
80              
81 0           return $dbh;
82             }
83              
84              
85              
86             # full old version saved for reference
87             # sub __get_dbh
88             # {
89             # my $self = shift;
90             # my %args = @_;
91              
92             # assert( my $for_what = $args{ '_for_what' } ); # i must know what this DBH you need for
93              
94             # my $dbh = &LittleORM::Db::dbh_is_ok( $self -> __get_class_dbh( $for_what ) );
95              
96             # unless( $dbh )
97             # {
98             # if( my $t = $args{ '_dbh' } )
99             # {
100             # $dbh = $t;
101             # $self -> __set_class_dbh( $dbh, $for_what );
102             # }
103             # }
104              
105             # unless( $dbh )
106             # {
107             # if( my $t = &LittleORM::Db::get_dbh( $for_what ) )
108             # {
109             # $dbh = $t;
110             # $self -> __set_class_dbh( $dbh, $for_what );
111             # }
112             # }
113              
114             # assert( &LittleORM::Db::dbh_is_ok( $dbh ), 'this method is supposed to return valid dbh' );
115              
116             # return $dbh;
117             # }
118              
119             sub get_class_dbh
120             {
121 0     0 0   return &__get_class_dbh( @_ );
122             }
123              
124             sub set_class_dbh
125             {
126 0     0 0   return &__set_class_dbh( @_ );
127             }
128              
129             sub __get_class_dbh
130             {
131              
132 0     0     my ( $self, $for_what ) = @_;
133              
134 0           my $rv = undef;
135              
136 0 0         if( $for_what eq 'write' )
137             {
138 0 0         if( my $t = $self -> meta() -> _littleorm_wdbh() )
139             {
140 0           $rv = &LittleORM::Db::__get_rand_array_el( $t );
141             }
142             } else
143             {
144 0 0         if( my $t = $self -> meta() -> _littleorm_rdbh() )
145             {
146 0           $rv = &LittleORM::Db::__get_rand_array_el( $t );
147             }
148             }
149              
150              
151             # this is to prevent stale disconnected $dbh from being used,
152             # as it remains true value in conditions
153              
154 0           return &LittleORM::Db::dbh_is_ok( $rv );
155             }
156              
157             sub __set_class_dbh
158             {
159 0     0     my ( $self, $dbh, $for_what ) = @_;
160              
161 0 0         if( $for_what )
162             {
163 0 0         if( $for_what eq 'read' )
    0          
164             {
165 0           $self -> set_read_dbh( [ $dbh ] );
166             } elsif( $for_what eq 'write' )
167             {
168 0           $self -> set_write_dbh( [ $dbh ] );
169             } else
170             {
171 0           assert( 0, 'for what? ' . $for_what );
172             }
173             } else
174             {
175 0           $self -> set_read_dbh( [ $dbh ] );
176 0           $self -> set_write_dbh( [ $dbh ] );
177             }
178              
179             # ancient DBH storing technique:
180              
181             # my $calling_package = ( ref( $self ) or $self );
182             # {
183             # no strict "refs";
184             # ${ $calling_package . "::_dbh" } = $dbh;
185             # }
186              
187             }
188              
189             sub __set_db_connector_object_if_required
190             {
191 0     0     my $self = shift;
192              
193 0           my $m = 'littleorm_db_connector_config';
194              
195 0 0         if( $self -> can( $m ) )
196             {
197 0 0         unless( $self -> meta() -> _littleorm_db_connector() )
198             {
199 0 0         if( my @args = $self -> $m() )
200             {
201 0           my $c = LittleORM::Db::Connector -> new( @args );
202 0           $self -> meta() -> _littleorm_db_connector( $c );
203             }
204             }
205             }
206             }
207              
208             42;