File Coverage

blib/lib/DBIx/Hash2Table.pm
Criterion Covered Total %
statement 9 43 20.9
branch 0 8 0.0
condition 0 9 0.0
subroutine 3 8 37.5
pod 0 2 0.0
total 12 70 17.1


line stmt bran cond sub pod time code
1             package DBIx::Hash2Table;
2              
3 2     2   71500 use strict;
  2         12  
  2         58  
4 2     2   10 use warnings;
  2         3  
  2         48  
5              
6 2     2   9 use Carp;
  2         4  
  2         1425  
7              
8             our $VERSION = '2.05';
9              
10             # -----------------------------------------------
11              
12             # Preloaded methods go here.
13              
14             # -----------------------------------------------
15              
16             # Encapsulated class data.
17              
18             {
19             my(%_attr_data) =
20             (
21             _columns => '',
22             _dbh => '',
23             _extras => [],
24             _hash_ref => '',
25             _table_name => '',
26             );
27              
28             sub _default_for
29             {
30 0     0     my($self, $attr_name) = @_;
31              
32 0           $_attr_data{$attr_name};
33             }
34              
35             sub _save
36             {
37 0     0     my($self, $sth, $hash_ref, $parent) = @_;
38              
39 0           my(@bind);
40              
41 0           for my $key (keys %$hash_ref)
42             {
43             # If we have a hash ref, which we almost always do have...
44              
45 0 0         if (ref($$hash_ref{$key}) eq 'HASH')
46             {
47 0           $$self{'_id'}++;
48              
49 0           @bind = ($$self{'_id'}, $parent, $key);
50              
51 0           for (@{$$self{'_extras'} })
  0            
52             {
53 0 0         push(@bind, exists($$hash_ref{$key}{$_}) ? $$hash_ref{$key}{$_} : undef);
54             }
55              
56 0           $sth -> execute(@bind);
57              
58             # Curse again. (Aka 'recurse', for non-native speakers of English.)
59              
60 0           $self -> _save($sth, $$hash_ref{$key}, $$self{'_id'});
61             }
62             }
63              
64             } # End of _save.
65              
66             sub _standard_keys
67             {
68 0     0     keys %_attr_data;
69             }
70             }
71              
72             # -----------------------------------------------
73              
74             sub insert
75             {
76 0     0 0   my($self) = @_;
77 0           $$self{'_extras'} = [sort @{$$self{'_extras'} }];
  0            
78 0           my($sql) = "insert into $$self{'_table_name'} (" . join(', ', @{$$self{'_columns'} }, @{$$self{'_extras'} }) . ') values (' . join(', ', ('?') x ($#{$$self{'_columns'} } + $#{$$self{'_extras'} } + 2) ) . ')';
  0            
  0            
  0            
  0            
79 0           my($sth) = $$self{'_dbh'} -> prepare($sql);
80 0           $$self{'_id'} = 0;
81              
82 0           $self -> _save($sth, $$self{'_hash_ref'}, 0);
83              
84             } # End of insert.
85              
86             # -----------------------------------------------
87              
88             sub new
89             {
90 0     0 0   my($class, %arg) = @_;
91 0           my($self) = bless({}, $class);
92              
93 0           for my $attr_name ($self -> _standard_keys() )
94             {
95 0           my($arg_name) = $attr_name =~ /^_(.*)/;
96              
97 0 0         if (exists($arg{$arg_name}) )
98             {
99 0           $$self{$attr_name} = $arg{$arg_name};
100             }
101             else
102             {
103 0           $$self{$attr_name} = $self -> _default_for($attr_name);
104             }
105             }
106              
107             croak(__PACKAGE__ . ". You must supply a value for each parameter except 'extras'")
108 0 0 0       if (! ($$self{'_columns'} && $$self{'_dbh'} && $$self{'_hash_ref'} && $$self{'_table_name'}) );
      0        
      0        
109              
110 0           return $self;
111              
112             } # End of new.
113              
114             # -----------------------------------------------
115              
116             1;
117              
118             __END__