File Coverage

blib/lib/ODS/Table.pm
Criterion Covered Total %
statement 85 90 94.4
branch 24 32 75.0
condition 1 2 50.0
subroutine 11 11 100.0
pod 0 5 0.0
total 121 140 86.4


line stmt bran cond sub pod time code
1             package ODS::Table;
2              
3 71     71   482 use strict;
  71         135  
  71         2826  
4 71     71   404 use warnings;
  71         198  
  71         3302  
5              
6 71     71   34185 use YAOO;
  71         2919403  
  71         503  
7              
8 71     71   69432 use ODS::Utils qw/clone/;
  71         580  
  71         367  
9              
10 71     71   6984 use ODS::Utils qw/load build_temp_class/;
  71         135  
  71         223  
11              
12 71     71   1740 use Carp qw/croak/;
  71         78  
  71         72313  
13              
14             auto_build;
15              
16             has storage_class => isa(string);
17              
18             has storage => isa(object);
19              
20             has table_class => isa(string);
21              
22             has resultset_class => isa(string);
23              
24             has resultset => isa(object);
25              
26             has name => isa(string);
27              
28             has columns => isa(ordered_hash()), default(1);
29              
30             has row_class => isa(string);
31              
32             has rows => isa(array);
33              
34             has options => isa(hash);
35              
36             has keyfield => isa(string);
37              
38             sub add_column {
39 1068     1068 0 1865 my ($self, @args) = @_;
40              
41 1068         1197 my $name = shift @args;
42              
43 1068 100       1745 if (!$self->keyfield) {
44 82         520 $self->keyfield($name);
45             }
46              
47 1068 50       6105 if ($self->columns->{$name}) {
48 0         0 croak sprintf "Column %s is already defined in the %s table",
49             $name, $self->name;
50             }
51              
52 1068 50       10046 if (scalar @args % 2) {
53 0         0 croak "The column definition for %s does not contain an even number of key/values in the %s table.",
54             $name, $self->name;
55             }
56              
57 1068         3206 my %column = @args;
58 1068         1537 $column{name} = $name;
59 1068 100       1658 if (! $column{type}) {
60 426         578 $column{type} = 'string';
61             }
62              
63 1068 100       1506 if ($column{keyfield}) {
64 78         188 $self->keyfield($name);
65             }
66              
67 1068         2587 my $module = 'ODS::Table::Column::' . ucfirst($column{type});
68              
69 1068         2271 load $module;
70              
71 1068         2337 for my $key ( keys %column ) {
72 5319 100       7732 delete $column{$key} if not defined $column{$key};
73             }
74              
75 1068         3342 my $column = $module->new(\%column);
76              
77 1068         177701 $self->columns->{$name} = $column;
78              
79 1068         23411 return $self;
80             }
81              
82             sub add_item {
83 1     1 0 4 my ($self, @args) = @_;
84              
85 1         3 my $name = 'array_items';
86              
87 1 50       4 if (!$self->keyfield) {
88 1         10 $self->keyfield($name);
89             }
90              
91 1 50       34 if ($self->columns->{$name}) {
92 0         0 croak sprintf "Column %s is already defined in the %s table",
93             $name, $self->name;
94             }
95              
96 1 50       25 if (scalar @args % 2) {
97 0         0 croak "The column definition for %s does not contain an even number of key/values in the %s table.",
98             $name, $self->name;
99             }
100              
101 1         4 my %column = @args;
102 1         3 $column{name} = $name;
103 1 50       3 if (! $column{type}) {
104 0         0 $column{type} = 'string';
105             }
106              
107 1         22 my $module = 'ODS::Table::Column::' . ucfirst($column{type});
108              
109 1         5 load $module;
110              
111 1         9 my $column = $module->new(\%column);
112              
113 1         243 $self->columns->{$name} = $column;
114              
115 1         32 return $self;
116             }
117              
118             sub connect {
119 137     137 0 919 my ($self, $package, $storage, $connect) = (shift, shift, shift, shift);
120              
121 137         974 $self->set_table_resultset_row_class($package);
122              
123 137         3640 my $serialize_class;
124 137 100       4526 if ( $connect->{serialize_class} ) {
125 133         351 $serialize_class = 'ODS::Serialize::' . $connect->{serialize_class};
126 133         647 load $serialize_class;
127 133         1693 $serialize_class = $serialize_class->new;
128             }
129              
130 137 50       12921 $self->storage_class($storage) if $storage;
131              
132 137         2902 $storage = $self->storage_class;
133              
134 137         1015 my $module = 'ODS::Storage::' . $storage;
135              
136 137         783 load $module;
137              
138             $self->storage(
139             $module->connect(
140 137 50       294 %{$connect || {}},
  137 100       2730  
141             table => $self,
142             ($serialize_class ? (serialize_class => $serialize_class) : ())
143             )
144             );
145              
146 137         11716 return $self->resultset($self->resultset_class->new(table => $self, @_));
147             }
148              
149             has parent_column => isa(object);
150              
151             sub instantiate {
152 23     23 0 64 my ($self, $package, $column, $inflated, $data) = @_;
153              
154 23         89 $self->parent_column($column);
155              
156 23         812 $self->set_table_resultset_row_class($package);
157              
158 23   50     526 my $row = $self->row_class->new(
159             table => $self,
160             data => $data,
161             inflated => $inflated || 0,
162             serialize_class => $column->serialize_class
163             );
164              
165 23         226 return $row;
166             }
167              
168             sub set_table_resultset_row_class {
169 160     160 0 744 my ($self, $package) = @_;
170              
171 160         899 $self->table_class($package);
172              
173 160         6670 (my $resultset = $package) =~ s/Table/ResultSet/g;
174              
175 160         542 eval {
176 160         953 load $resultset
177             };
178              
179 160 100       1005 if ($@) {
180 32         62 $resultset = 'ODS::Table::ResultSet';
181 32         106 load $resultset;
182             }
183              
184 160         723 $self->resultset_class($resultset);
185              
186 160         5052 (my $row = $package) =~ s/Table/Row/g;
187              
188 160         311 eval {
189 160         651 load $row
190             };
191              
192 160 100       1015 if ($@) {
193 159         3588 $row = build_temp_class('ODS::Table::Row');
194             }
195              
196 160         934 $self->row_class($row);
197             }
198              
199             1;
200              
201             __END__