File Coverage

blib/lib/HTML/DBTable.pm
Criterion Covered Total %
statement 119 166 71.6
branch 54 110 49.0
condition 7 17 41.1
subroutine 23 28 82.1
pod 1 18 5.5
total 204 339 60.1


line stmt bran cond sub pod time code
1             package HTML::DBTable;
2              
3 3     3   149713 use 5.006;
  3         10  
  3         111  
4 3     3   15 use strict;
  3         6  
  3         87  
5 3     3   16 use warnings;
  3         10  
  3         107  
6              
7 3     3   2886 use Params::Validate qw(:all);
  3         45152  
  3         790  
8 3     3   2955 use DBIx::DBSchema;
  3         72021  
  3         96  
9 3     3   5022 use HTML::Template;
  3         57905  
  3         8292  
10              
11             our $VERSION = '0.05';
12              
13             my $init_params =
14             {
15             strip_tablename => { type => BOOLEAN,default => 1},
16             begin_form => { type => BOOLEAN,default => 1},
17             end_form => { type => BOOLEAN,default => 1},
18             };
19              
20             sub new {
21 1     1 1 438 my $proto = shift;
22 1   33     7 my $class = ref($proto) || $proto;
23 1         35 my %opts = validate(@_ , $init_params);
24 1         6 my $self = {%opts};
25 1         3 bless $self,$class;
26 1         3 return $self;
27             }
28              
29             sub html {
30 8     8 0 7047 my $self = shift;
31 8         219 my %opt = validate(@_, { dbh => {isa => 'DBI::db',optional=>1 },
32             tablename => {type => SCALAR,
33             optional=>1 },
34             values => {type => HASHREF,
35             optional => 1 },
36             tmpl_path => {type => SCALAR ,
37             optional => 1 },
38             } );
39 8 50       75 $self->tmpl_path($opt{tmpl_path}) if (exists $opt{tmpl_path});
40 8 50       26 $self->dbh($opt{dbh}) if (exists $opt{dbh});
41 8 50       25 $self->tablename($opt{tablename}) if (exists $opt{tablename});
42 8 100       24 $self->values($opt{values}) if (exists $opt{values});
43             #my $tbl_schema = new_native DBIx::DBSchema::Table
44             # $self->dbh,$self->tablename;
45 8         26 my $tbl_schema = $self-> _new_table_schema;
46 8         59 my @columns = $tbl_schema->columns;
47 8         69 my @fields = ();
48 8         12 my @hidden_fields = ();
49 8         16 my $column_pos = 0;
50 8         20 my $values = $self->values;
51 8         20 foreach (@columns) {
52 24         81 my $col_schema = $tbl_schema->column($_);
53 24 100       157 my $name = ($self->strip_tablename) ? '' : $self->tablename . '.';
54 24         93 $name .= $col_schema->name;
55 24         197 my $length = $col_schema->length;
56 24 50       161 $length = $length == 0 ? 10
    50          
    100          
57             : ($length > 50 ? 50 : $length) if ($length);
58 24 100 66     63 my $field = { name => $name,
    50          
    50          
59             label => $col_schema->name,
60             pos => $column_pos,
61             value => $values->{$col_schema->name}
62             || $col_schema->default,
63             length => $length,
64             can_be_null => ($col_schema->null eq 'NULL'),
65             is_null => defined
66             $values->{$col_schema->name}
67             ? 0 : 1,
68             'row.pre' => defined $self->{cb_row_pre}
69             ? $self->{cb_row_pre}->call($col_schema->name) : '',
70             'row.post' => defined $self->{cb_row_post}
71             ? $self->{cb_row_post}->call($col_schema->name) : '',
72             };
73             # reimposto la label
74 24 100       717 if ($self->labels) {
75 15 100       32 if (ref($self->labels) eq 'HASH') {
76 12 100       25 $field->{label} = $self->labels->{$field->{name}}
77             if (exists $self->labels->{$field->{name}});
78             } else {
79 3         20 $field->{label} = $self->labels->[$column_pos]
80 3 50       5 if ($column_pos < scalar(@{$self->labels}) );
81             }
82             }
83 24         68 $self->_set_field_appearance(field => $field,schema => $col_schema);
84 24         65 $self->_set_field_enums(field => $field,schema => $col_schema);
85 24 100       39 if ($field->{use_hidden}) {
86 3         7 push @hidden_fields,$field;
87             } else {
88 21         31 push @fields,$field;
89             }
90 24         62 $column_pos++;
91             }
92 8         26 my $htmpl = $self->_new_html_template();
93 8         37 $htmpl->param(fields => \@fields);
94 8         274 $htmpl->param('fields.hidden' => \@hidden_fields);
95 8         209 $htmpl->param('form.begin' => $self->begin_form);
96 8         201 $htmpl->param('form.end' => $self->end_form);
97 8 50       208 $htmpl->param('rows.pre' => defined $self->{cb_rows_pre}
98             ? $self->{cb_rows_pre}->call() : '');
99 8 50       187 $htmpl->param('rows.post' => defined $self->{cb_rows_post}
100             ? $self->{cb_rows_pre}->call() : '');
101 8         184 return $htmpl->output;
102             }
103              
104             sub _new_html_template() {
105 8     8   13 my $self = shift;
106 8         10 my $htmpl;
107 8 50       18 if ($self->tmpl_path) {
108 0         0 $htmpl = new HTML::Template( filename => $self->tmpl_path,
109             vanguard_compatibility_mode=>1,
110             global_vars => 1);
111             } else {
112 8         30 $htmpl = new HTML::Template( scalarref => \$self->template,
113             vanguard_compatibility_mode=>1,
114             global_vars=>1);
115             }
116 8         27871 return $htmpl;
117            
118             }
119              
120             sub _new_table_schema() {
121 8     8   15 my $self = shift;
122 8 50       23 if ($self->tblschema) {
123 8         22 return $self->tblschema;
124             } else {
125 0 0       0 die "You must set a DB handle connection setting dbh parameter"
126             unless ($self->dbh);
127 0         0 return new_native DBIx::DBSchema::Table
128             $self->dbh,$self->tablename;
129             }
130             }
131              
132             sub _set_field_appearance {
133 24     24   29 my $self = shift;
134 24         461 my %opt = validate(@_ ,{
135             field => HASHREF,
136             schema => {isa => 'DBIx::DBSchema::Column'}
137             } );
138 24         110 my $appearance = 'text';
139 24 100       55 if ($self->appearances) {
140 9 100       19 if (ref $self->appearances eq 'HASH') {
141 3 100       6 $appearance = $self->appearances->{$opt{field}->{name}}
142             if (exists $self->appearances->{$opt{field}->{name}});
143             } else {
144 6         14 $appearance = $self->appearances->[$opt{field}->{pos}]
145 6 100       10 if ($opt{field}->{pos} < scalar(@{$self->appearances}) );
146             }
147             }
148 24 50 33     76 if ($opt{schema}->type eq 'enum' || $appearance eq 'enum') {
149 0         0 my @items_value = @{$opt{schema}->enum};
  0         0  
150 0 0       0 $appearance = (scalar(@items_value) < 5) ? 'radio' : 'combo';
151             }
152 24         289 $opt{field}->{'use_' . $appearance} = 1;
153             }
154              
155             sub _set_field_enums() {
156 24     24   29 my $self = shift;
157 24         448 my %opt = validate(@_ ,{
158             field => HASHREF,
159             schema => {isa => 'DBIx::DBSchema::Column'}
160             } );
161 24         123 my $field = $opt{field};
162 24         30 my $col_schema = $opt{schema};
163 24 50 33     153 if ($field->{use_combo} || $field->{use_radio} ) {
164 0         0 my %enums = ();
165 0 0       0 if ($self->enums) {
166 0         0 my $enums;
167 0 0       0 if (ref $self->enums eq 'HASH') {
168 0 0       0 $enums = $self->enums->{$field->{name}}
169             if (exists $self->enums->{$field->{name}});
170             } else {
171 0         0 $enums = $self->enums->[$field->{pos}]
172 0 0       0 if ($field->{pos}<=scalar(@{$self->enums}));
173             }
174 0 0       0 if ($enums) {
175 0 0       0 if (ref $enums eq 'HASH') {
176 0         0 %enums = %{$enums}
  0         0  
177             } else {
178 0         0 %enums = map {$_ => $_ }
  0         0  
179 0         0 @{$enums};
180             }
181             }
182             } else {
183 0 0       0 %enums = map {$_ => $_} @{$col_schema->enum} if ($col_schema->enum);
  0         0  
  0         0  
184             }
185 0         0 $field->{enums} = [];
186 0         0 foreach (keys %enums) {
187 0         0 my $item = {enum_key => $_,enum_value =>$enums{$_}};
188 0 0       0 if ( $field->{value} ) {
189 0 0       0 $item->{selected} = $_ eq $field->{value}
    0          
190             ? ($field->{use_combo}
191             ? 'selected'
192             : 'checked'
193             )
194             : '';
195             }
196 0         0 push @{$field->{enums}}, $item;
  0         0  
197             }
198             }
199             }
200              
201             sub tmpl_path {
202 8     8 0 11 my $self = shift;
203 8         62 my @opt = validate_pos(@_, {type => SCALAR | UNDEF, default => undef} );
204 8 50       43 return defined $opt[0] ? $self->{tmpl_path} = $opt[0] : $self->{tmpl_path};
205             }
206              
207              
208             sub dbh {
209 3     3 0 6 my $self = shift;
210 3         21 my @opt = validate_pos(@_, {isa => 'DBI::db' , default => undef} );
211 3 50       22 return defined $opt[0] ? $self->{dbh} = $opt[0] : $self->{dbh};
212             }
213              
214             sub tablename {
215 3     3 0 3 my $self = shift;
216 3 50 33     7 if (defined $self->tblschema && !defined $self->dbh) {
217             # prendo il nome direttamente dal tblschema
218 3         7 return $self->tblschema->name;
219             }
220 0         0 my @opt = validate_pos(@_, {type => SCALAR, default => undef} );
221 0 0       0 return defined $opt[0] ? $self->{tablename} = $opt[0] : $self->{tablename};
222             }
223              
224             sub strip_tablename {
225 25     25 0 3441 my $self = shift;
226 25         213 my @opt = validate_pos(@_, {type => BOOLEAN, default => undef} );
227 25 100       149 return defined $opt[0] ? $self->{strip_tablename} = $opt[0] : $self->{strip_tablename};
228             }
229              
230             sub values {
231 9     9 0 12 my $self = shift;
232 9         86 my @opt = validate_pos(@_, {type => HASHREF, default => undef} );
233 9 100       49 return defined $opt[0] ? $self->{values} = $opt[0] : $self->{values};
234             }
235              
236             sub tblschema {
237 23     23 0 355 my $self = shift;
238 23         217 my @opt = validate_pos(@_, {isa => 'DBIx::DBSchema::Table',
239             default => undef} );
240 23 100       153 return defined $opt[0] ? $self->{tblschema} = $opt[0] : $self->{tblschema};
241             }
242              
243             sub labels {
244 62     62 0 7108 my $self = shift;
245 62         471 my @opt = validate_pos(@_, {type => ARRAYREF | HASHREF,
246             default => undef} );
247 62 100       360 return defined $opt[0] ? $self->{labels} = $opt[0] : $self->{labels};
248            
249             }
250              
251             sub appearances {
252 47     47 0 6698 my $self = shift;
253 47         333 my @opt = validate_pos(@_, {type => ARRAYREF | HASHREF,
254             default => undef} );
255 47 100       260 return defined $opt[0] ? $self->{appearances} = $opt[0] : $self->{appearances};
256            
257             }
258              
259             sub enums {
260 0     0 0 0 my $self = shift;
261 0         0 my @opt = validate_pos(@_, {type => ARRAYREF | HASHREF,
262             default => undef} );
263 0 0       0 return defined $opt[0] ? $self->{enums} = $opt[0] : $self->{enums};
264            
265             }
266              
267             sub begin_form {
268 8     8 0 15 my $self = shift;
269 8         96 my @opt = validate_pos(@_, {type => BOOLEAN, default => undef} );
270 8 50       58 return defined $opt[0] ? $self->{begin_form} = $opt[0] : $self->{begin_form};
271             }
272              
273             sub end_form {
274 8     8 0 21 my $self = shift;
275 8         68 my @opt = validate_pos(@_, {type => BOOLEAN, default => undef} );
276 8 50       54 return defined $opt[0] ? $self->{end_form} = $opt[0] : $self->{end_form};
277             }
278             sub cb_row_pre {
279 0     0 0 0 my $self = shift;
280 0         0 my @opt = validate_pos(@_, {isa => 'Callback',
281             default => undef} );
282 0 0       0 return defined $opt[0] ? $self->{cb_row_pre} = $opt[0] : $self->{cb_row_pre};
283            
284             }
285             sub cb_row_post {
286 0     0 0 0 my $self = shift;
287 0         0 my @opt = validate_pos(@_, {isa => 'Callback',
288             default => undef} );
289 0 0       0 return defined $opt[0] ? $self->{cb_row_post} = $opt[0] : $self->{cb_row_post};
290            
291             }
292             sub cb_rows_pre {
293 0     0 0 0 my $self = shift;
294 0         0 my @opt = validate_pos(@_, {isa => 'Callback',
295             default => undef} );
296 0 0       0 return defined $opt[0] ? $self->{cb_rows_pre} = $opt[0] : $self->{cb_rows_pre};
297            
298             }
299             sub cb_rows_post {
300 0     0 0 0 my $self = shift;
301 0         0 my @opt = validate_pos(@_, {isa => 'Callback',
302             default => undef} );
303 0 0       0 return defined $opt[0] ? $self->{cb_rows_post} = $opt[0] : $self->{cb_rows_post};
304            
305             }
306              
307             sub template() {
308 8     8 0 11 my $self = shift;
309 8         59 my @opt = validate_pos(@_, {type => SCALAR,
310             default => undef} );
311 8 50       36 $self->{template} = $opt[0] if ($opt[0]);
312 8   50     58 return $self->{template} || <
313            
314            
315            
316             %rows.pre%
317            
318            
319            
320            
321            
322            
323             %row.pre%%label%:
324            
325            
326            
327            
328             onclick="if (this.checked) {nullify(this.form,'%name%');
329             this.checked = true}; return true"
330             checked>
331            
332            
333            
334            
335            
336            
337            
338            
339            
340            
341            
342            
343            
344             %enum_value%
345            
346            
347            
348            
349             onchange="return unnullify(this.form,this)" >
350            
351            
352             %value%
353            
354             %row.post%
355            
356            
357            
358            
359            
360            
361            
362            
363            
364              
365            
385              
386             EOF
387             }
388              
389              
390             1;