File Coverage

blib/lib/DBIx/HTML/ClientDB.pm
Criterion Covered Total %
statement 6 93 6.4
branch 0 16 0.0
condition 0 3 0.0
subroutine 2 13 15.3
pod 7 7 100.0
total 15 132 11.3


line stmt bran cond sub pod time code
1             package DBIx::HTML::ClientDB;
2              
3 2     2   69942 use strict;
  2         13  
  2         58  
4 2     2   9 use warnings;
  2         4  
  2         2833  
5              
6             our $VERSION = '1.09';
7              
8             # -----------------------------------------------
9              
10             # Encapsulated class data.
11              
12             {
13             my(%_attr_data) =
14             ( # Alphabetical order.
15             _border => 0,
16             _dbh => '',
17             _default => '',
18             _form_name => 'dbix_client_form',
19             _max_width => 0,
20             _menu_name => 'dbix_client_menu',
21             _row_headings => '',
22             _sql => '',
23             );
24              
25             sub _default_for
26             {
27 0     0     my($self, $attr_name) = @_;
28              
29 0           $_attr_data{$attr_name};
30             }
31              
32             sub _read_data
33             {
34 0     0     my($self) = @_;
35 0           my(@row_headings) = split(/,/, $$self{'_row_headings'});
36 0           $$self{'_row_headings'} = [@row_headings];
37 0           my($sth) = $$self{'_dbh'} -> prepare($$self{'_sql'});
38 0           $$self{'_data'} = [];
39 0           my($first) = 1;
40 0           my($max_width) = 0;
41              
42 0           $sth -> execute();
43              
44 0           my($data);
45              
46 0           while ($data = $sth -> fetch() )
47             {
48 0           push(@{$$self{'_data'} }, [@$data]);
  0            
49              
50 0 0         if ($first)
51             {
52 0 0         croak(__PACKAGE__ . ". You must supply one row heading for each column in the SQL") if ($#{$data} != $#{$$self{'_row_headings'} });
  0            
  0            
53              
54 0           $first = 0;
55 0 0         $$self{'_default'} = $$data[1] if (! $$self{'_default'});
56             }
57              
58 0           for (1 .. $#{$data})
  0            
59             {
60 0 0         $max_width = length($$data[$_]) if (length($$data[$_]) > $max_width);
61             }
62             }
63              
64 0 0         $$self{'_max_width'} = $max_width if (! $$self{'_max_width'});
65 0           $$self{'_size'} = $#{$$self{'_data'} } + 1;
  0            
66              
67             } # End of _read_data.
68              
69             sub _standard_keys
70             {
71 0     0     sort keys %_attr_data;
72             }
73              
74             sub _validate_options
75             {
76 0     0     my($self) = @_;
77              
78 0 0 0       croak(__PACKAGE__ . ". You must supply values for these parameters: dbh, form_name, menu_name, row_headings and sql") if (! $$self{'_dbh'} || ! $$self{'_form_name'} || ! $$self{'_menu_name'} || ! $$self{'_row_headings'} || ! $$self{'_sql'});
79              
80             # # Reset empty parameters to their defaults.
81             # # This could be optional, depending on another option.
82             #
83             # for my $attr_name ($self -> _standard_keys() )
84             # {
85             # $$self{$attr_name} = $self -> _default_for($attr_name) if (! $$self{$attr_name});
86             # }
87              
88             } # End of _validate_options.
89              
90             } # End of Encapsulated class data.
91              
92             # -----------------------------------------------
93              
94             sub javascript_for_client_db()
95             {
96 0     0 1   my($self) = @_;
97 0           my(@code) = <
98              
99            
166              
167             EOS
168              
169 0           join("\n", @code);
170              
171             } # End of javascript_for_client_db.
172              
173             # -----------------------------------------------
174              
175             sub javascript_for_client_init
176             {
177 0     0 1   my($self) = @_;
178 0           my(@code) = <
179              
180            
187              
188             EOS
189              
190 0           join("\n", @code);
191              
192             } # End of javascript_for_client_init.
193              
194             # -----------------------------------------------
195              
196             sub javascript_for_client_on_load
197             {
198 0     0 1   my($self) = @_;
199              
200 0           ('onLoad' => 'dbix_client_init()');
201              
202             } # End of javascript_for_client_on_load.
203              
204             # -----------------------------------------------
205              
206             sub new
207             {
208 0     0 1   my($class, %arg) = @_;
209 0           my($self) = bless({}, $class);
210              
211 0           for my $attr_name ($self -> _standard_keys() )
212             {
213 0           my($arg_name) = $attr_name =~ /^_(.*)/;
214              
215 0 0         if (exists($arg{$arg_name}) )
216             {
217 0           $$self{$attr_name} = $arg{$arg_name};
218             }
219             else
220             {
221 0           $$self{$attr_name} = $self -> _default_for($attr_name);
222             }
223             }
224              
225 0           $self -> _validate_options();
226 0           $self -> _read_data();
227              
228 0           return $self;
229              
230             } # End of new.
231              
232             # -----------------------------------------------
233              
234             sub param
235             {
236 0     0 1   my($self, $id) = @_;
237 0           my(@result) = ();
238              
239 0           for (@{$$self{'_data'} })
  0            
240             {
241 0 0         @result = @$_ if ($$_[0] eq $id);
242             }
243              
244 0           @result;
245              
246             } # End of param.
247              
248             # -----------------------------------------------
249              
250             sub size
251             {
252 0     0 1   my($self) = @_;
253              
254 0           $$self{'_size'};
255              
256             } # End of size.
257              
258             # -----------------------------------------------
259              
260             sub table
261             {
262 0     0 1   my($self) = @_;
263 0           my(@html) = <
264            
265            
266             $$self{'_row_headings'}[0]
267            
268             EOS
269              
270 0           for (2 ..$#{$$self{'_row_headings'} })
  0            
271             {
272 0           push(@html, <
273            
274             $$self{'_row_headings'}[$_]
275            
276             EOS
277             }
278              
279 0           push(@html, <
280            
281             EOS
282              
283 0           join("\n", @html);
284              
285             } # End of table.
286              
287             # -----------------------------------------------
288              
289             1;
290              
291             __END__