File Coverage

lib/Class/DBI/Lite/RootMeta.pm
Criterion Covered Total %
statement 19 36 52.7
branch 4 8 50.0
condition n/a
subroutine 7 12 58.3
pod 0 8 0.0
total 30 64 46.8


line stmt bran cond sub pod time code
1              
2             package
3             Class::DBI::Lite::RootMeta;
4              
5 17     17   106 use strict;
  17         33  
  17         457  
6 17     17   81 use warnings 'all';
  17         31  
  17         503  
7 17     17   93 use List::Util 'shuffle';
  17         30  
  17         6185  
8              
9             our %instances = ( );
10              
11              
12             #==============================================================================
13             sub new
14             {
15 17     17 0 51 my ($s, $dsn) = @_;
16             #warn "$s.new(@$dsn) => host=" . ( $ENV{HTTP_HOST} || 'N/A' );
17            
18 17         64 my $key = join ':', @$dsn;
19 17 100       71 if( my $inst = $instances{$key} )
20             {
21 1         5 return $inst;
22             }
23             else
24             {
25 16         133 return $instances{$key} = bless {
26             dsn => $dsn, # Global
27             schema => $dsn->[0], # Global
28             master => $dsn,
29             slaves => [ ],
30             has_slaves => 0,
31             }, $s;
32             }# end if()
33             }# end new()
34              
35 3 50   3 0 7 sub dsn { my $s = shift; @_ ? $s->{dsn} = shift : $s->{dsn} }
  3         27  
36 112690 50   112690 0 146388 sub schema { my $s = shift; @_ ? $s->{schema} = shift : $s->{schema} }
  112690         277634  
37 0 0   0 0 0 sub master { my $s = shift; @_ ? $s->{master} = shift : $s->{master} }
  0         0  
38 0     0 0 0 sub slaves { shift->{slaves} }
39 10276     10276 0 36216 sub has_slaves { shift->{has_slaves} }
40 0     0 0   sub add_slave { my $s = shift; $s->{has_slaves} = 1; push @{$s->{slaves}}, @_; $s->_randomize_slaves(); }
  0            
  0            
  0            
  0            
41              
42             sub random_slave
43             {
44 0     0 0   my $s = shift;
45 0           push @{ $s->{slaves} }, shift( @{ $s->{slaves} } );
  0            
  0            
46 0           $s->{slaves}->[0];
47             }# end random_slave()
48              
49              
50             sub _randomize_slaves
51             {
52 0     0     my $s = shift;
53            
54 0           @{ $s->{slaves} } = shuffle( @{ $s->{slaves} } );
  0            
  0            
55             }# end _randomize_slaves()
56              
57             1;# return true:
58