File Coverage

blib/lib/DBIx/HTML/ClientDB.pm
Criterion Covered Total %
statement 9 96 9.3
branch 0 16 0.0
condition 0 3 0.0
subroutine 3 14 21.4
pod 7 7 100.0
total 19 136 13.9


line stmt bran cond sub pod time code
1             package DBIx::HTML::ClientDB;
2              
3             # Name:
4             # DBIx::HTML::ClientDB.
5             #
6             # Purpose:
7             # Allow caller to specify a database handle, an sql statement,
8             # and a name for the menu, and from that build the HTML for the menu,
9             # and the JavaScript so the menu can search the client-side database.
10             #
11             # Documentation:
12             # POD-style documentation is at the end. Extract it with pod2html.*.
13             #
14             # Note:
15             # o tab = 4 spaces || die
16             #
17             # V 1.00 1-Oct-2002
18             # -----------------
19             # o Original version
20             #
21             # Author:
22             # Ron Savage
23             # Home page: http://www.deakin.edu.au/~rons
24              
25 1     1   21412 use strict;
  1         2  
  1         30  
26 1     1   10 use warnings;
  1         2  
  1         37  
27              
28             require 5.005_62;
29              
30             require Exporter;
31              
32 1     1   6 use Carp;
  1         1  
  1         1514  
33              
34             our @ISA = qw(Exporter);
35              
36             # Items to export into callers namespace by default. Note: do not export
37             # names by default without a very good reason. Use EXPORT_OK instead.
38             # Do not simply export all your public functions/methods/constants.
39              
40             # This allows declaration use Image::MagickWrapper ':all';
41             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
42             # will save memory.
43             our %EXPORT_TAGS = ( 'all' => [ qw(
44              
45             ) ] );
46              
47             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
48              
49             our @EXPORT = qw(
50              
51             );
52             our $VERSION = '1.08';
53              
54             # -----------------------------------------------
55              
56             # Preloaded methods go here.
57              
58             # -----------------------------------------------
59              
60             # Encapsulated class data.
61              
62             {
63             my(%_attr_data) =
64             ( # Alphabetical order.
65             _border => 0,
66             _dbh => '',
67             _default => '',
68             _form_name => 'dbix_client_form',
69             _max_width => 0,
70             _menu_name => 'dbix_client_menu',
71             _row_headings => '',
72             _sql => '',
73             );
74              
75             sub _default_for
76             {
77 0     0     my($self, $attr_name) = @_;
78              
79 0           $_attr_data{$attr_name};
80             }
81              
82             sub _read_data
83             {
84 0     0     my($self) = @_;
85 0           my(@row_headings) = split(/,/, $$self{'_row_headings'});
86 0           $$self{'_row_headings'} = [@row_headings];
87 0           my($sth) = $$self{'_dbh'} -> prepare($$self{'_sql'});
88 0           $$self{'_data'} = [];
89 0           my($first) = 1;
90 0           my($max_width) = 0;
91              
92 0           $sth -> execute();
93              
94 0           my($data);
95              
96 0           while ($data = $sth -> fetch() )
97             {
98 0           push(@{$$self{'_data'} }, [@$data]);
  0            
99              
100 0 0         if ($first)
101             {
102 0 0         croak(__PACKAGE__ . ". You must supply one row heading for each column in the SQL") if ($#{$data} != $#{$$self{'_row_headings'} });
  0            
  0            
103              
104 0           $first = 0;
105 0 0         $$self{'_default'} = $$data[1] if (! $$self{'_default'});
106             }
107              
108 0           for (1 .. $#{$data})
  0            
109             {
110 0 0         $max_width = length($$data[$_]) if (length($$data[$_]) > $max_width);
111             }
112             }
113              
114 0 0         $$self{'_max_width'} = $max_width if (! $$self{'_max_width'});
115 0           $$self{'_size'} = $#{$$self{'_data'} } + 1;
  0            
116              
117             } # End of _read_data.
118              
119             sub _standard_keys
120             {
121 0     0     sort keys %_attr_data;
122             }
123              
124             sub _validate_options
125             {
126 0     0     my($self) = @_;
127              
128 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'});
129              
130             # # Reset empty parameters to their defaults.
131             # # This could be optional, depending on another option.
132             #
133             # for my $attr_name ($self -> _standard_keys() )
134             # {
135             # $$self{$attr_name} = $self -> _default_for($attr_name) if (! $$self{$attr_name});
136             # }
137              
138             } # End of _validate_options.
139              
140             } # End of Encapsulated class data.
141              
142             # -----------------------------------------------
143              
144             sub javascript_for_client_db()
145             {
146 0     0 1   my($self) = @_;
147 0           my(@code) = <
148              
149            
216              
217             EOS
218              
219 0           join("\n", @code);
220              
221             } # End of javascript_for_client_db.
222              
223             # -----------------------------------------------
224              
225             sub javascript_for_client_init
226             {
227 0     0 1   my($self) = @_;
228 0           my(@code) = <
229              
230            
237              
238             EOS
239              
240 0           join("\n", @code);
241              
242             } # End of javascript_for_client_init.
243              
244             # -----------------------------------------------
245              
246             sub javascript_for_client_on_load
247             {
248 0     0 1   my($self) = @_;
249              
250 0           ('onLoad' => 'dbix_client_init()');
251              
252             } # End of javascript_for_client_on_load.
253              
254             # -----------------------------------------------
255              
256             sub new
257             {
258 0     0 1   my($class, %arg) = @_;
259 0           my($self) = bless({}, $class);
260              
261 0           for my $attr_name ($self -> _standard_keys() )
262             {
263 0           my($arg_name) = $attr_name =~ /^_(.*)/;
264              
265 0 0         if (exists($arg{$arg_name}) )
266             {
267 0           $$self{$attr_name} = $arg{$arg_name};
268             }
269             else
270             {
271 0           $$self{$attr_name} = $self -> _default_for($attr_name);
272             }
273             }
274              
275 0           $self -> _validate_options();
276 0           $self -> _read_data();
277              
278 0           return $self;
279              
280             } # End of new.
281              
282             # -----------------------------------------------
283              
284             sub param
285             {
286 0     0 1   my($self, $id) = @_;
287 0           my(@result) = ();
288              
289 0           for (@{$$self{'_data'} })
  0            
290             {
291 0 0         @result = @$_ if ($$_[0] eq $id);
292             }
293              
294 0           @result;
295              
296             } # End of param.
297              
298             # -----------------------------------------------
299              
300             sub size
301             {
302 0     0 1   my($self) = @_;
303              
304 0           $$self{'_size'};
305              
306             } # End of size.
307              
308             # -----------------------------------------------
309              
310             sub table
311             {
312 0     0 1   my($self) = @_;
313 0           my(@html) = <
314            
315            
316             $$self{'_row_headings'}[0]
317            
318             EOS
319              
320 0           for (2 ..$#{$$self{'_row_headings'} })
  0            
321             {
322 0           push(@html, <
323            
324             $$self{'_row_headings'}[$_]
325            
326             EOS
327             }
328              
329 0           push(@html, <
330            
331             EOS
332              
333 0           join("\n", @html);
334              
335             } # End of table.
336              
337             # -----------------------------------------------
338              
339             1;
340              
341             __END__