File Coverage

blib/lib/DBIx/HTML/LinkedMenus.pm
Criterion Covered Total %
statement 9 90 10.0
branch 0 16 0.0
condition 0 15 0.0
subroutine 3 15 20.0
pod 8 8 100.0
total 20 144 13.8


line stmt bran cond sub pod time code
1             package DBIx::HTML::LinkedMenus;
2              
3             # Name:
4             # DBIx::HTML::LinkedMenus
5             #
6             # Purpose:
7             # Convert db data to 2 linked HTML popup menus.
8             #
9             # Documentation:
10             # POD-style documentation is at the end. Extract it with pod2html.*.
11             #
12             # Note:
13             # o tab = 4 spaces || die
14             #
15             # Author:
16             # Ron Savage
17             # Home page: http://savage.net.au/index.html
18              
19 1     1   23667 use strict;
  1         3  
  1         38  
20 1     1   5 use warnings;
  1         1  
  1         39  
21              
22             require 5.005_62;
23              
24             require Exporter;
25              
26 1     1   6 use Carp;
  1         2  
  1         1613  
27              
28             our @ISA = qw(Exporter);
29              
30             # Items to export into callers namespace by default. Note: do not export
31             # names by default without a very good reason. Use EXPORT_OK instead.
32             # Do not simply export all your public functions/methods/constants.
33              
34             # This allows declaration use Image::MagickWrapper ':all';
35             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
36             # will save memory.
37             our %EXPORT_TAGS = ( 'all' => [ qw(
38              
39             ) ] );
40              
41             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
42              
43             our @EXPORT = qw(
44              
45             );
46             our $VERSION = '1.10';
47              
48             # -----------------------------------------------
49              
50             # Preloaded methods go here.
51              
52             # -----------------------------------------------
53              
54             # Encapsulated class data.
55              
56             {
57             my(%_attr_data) =
58             ( # Alphabetical order.
59             _base_menu_name => 'dbix_base_menu',
60             _base_prompt => undef,
61             _base_value => undef,
62             _base_sql => '',
63             _dbh => '',
64             _form_name => 'dbix_form',
65             _linked_menu_name => 'dbix_linked_menu',
66             _linked_prompt => undef,
67             _linked_value => undef,
68             _linked_sql => '',
69             );
70              
71             sub _default_for
72             {
73 0     0     my($self, $attr_name) = @_;
74              
75 0           $_attr_data{$attr_name};
76             }
77              
78             sub _read_data
79             {
80 0     0     my($self) = @_;
81 0           my($base_sth) = $$self{'_dbh'} -> prepare($$self{'_base_sql'});
82 0           my($linked_sth) = $$self{'_dbh'} -> prepare($$self{'_linked_sql'});
83 0           $$self{'_data'} = {};
84 0           my($base_order) = 0;
85              
86 0           $base_sth -> execute();
87              
88 0           my($base_data, $linked_order, $linked_data);
89              
90 0           while ($base_data = $base_sth -> fetch() )
91             {
92 0           $base_order++;
93              
94 0           $linked_sth -> execute($$base_data[2]);
95              
96 0           $linked_order = 0;
97              
98 0           while ($linked_data = $linked_sth -> fetch() )
99             {
100 0           $linked_order++;
101              
102 0 0         if ($linked_order == 1)
103             {
104 0           $$self{'_data'}{$$base_data[0]} =
105             {
106             link => {},
107             order => $base_order,
108             value => $$base_data[1],
109             };
110             }
111              
112 0           $$self{'_data'}{$$base_data[0]}{'link'}{$$linked_data[0]} =
113             {
114             order => $linked_order,
115             value => $$linked_data[1],
116             };
117             }
118             }
119              
120 0           $$self{'_size'} = $base_order;
121              
122             } # End of _read_data.
123              
124             sub _standard_keys
125             {
126 0     0     sort keys %_attr_data;
127             }
128              
129             sub _validate_options
130             {
131 0     0     my($self) = @_;
132              
133 0 0 0       croak(__PACKAGE__ . ". You must supply values for these parameters: dbh, base_sql, linked_sql, base_menu_name and linked_menu_name") if (! $$self{'_dbh'} || ! $$self{'_base_sql'} || ! $$self{'_linked_sql'} || ! $$self{'_base_menu_name'} || ! $$self{'_linked_menu_name'});
134              
135             # # Reset empty parameters to their defaults.
136             # # This could be optional, depending on another option.
137             #
138             # for my $attr_name ($self -> _standard_keys() )
139             # {
140             # $$self{$attr_name} = $self -> _default_for($attr_name) if (! $$self{$attr_name});
141             # }
142              
143             } # End of _validate_options.
144              
145             } # End of Encapsulated class data.
146              
147             # -----------------------------------------------
148              
149             sub get
150             {
151 0     0 1   my($self, $base_id, $link_id) = @_;
152 0           my(@result) = ();
153              
154 0 0 0       if (exists($$self{'_data'}{$base_id}) && exists($$self{'_data'}{$base_id}{'link'}{$link_id}) )
155             {
156 0           @result = ($$self{'_data'}{$base_id}{'value'}, $$self{'_data'}{$base_id}{'link'}{$link_id}{'value'});
157             }
158              
159 0           @result;
160              
161             } # End of get.
162              
163             # -----------------------------------------------
164              
165             sub html_for_base_menu
166             {
167 0     0 1   my($self) = @_;
168              
169 0           "";
170              
171             } # End of html_for_base_menu.
172              
173             # -----------------------------------------------
174              
175             sub html_for_linked_menu
176             {
177 0     0 1   my($self) = @_;
178              
179 0           "";
180              
181             } # End of html_for_linked_menu.
182              
183             # -----------------------------------------------
184              
185             sub javascript_for_db()
186             {
187 0     0 1   my($self) = @_;
188 0           my(@code) = <
189              
190            
271              
272             EOS
273              
274 0           join("\n", @code);
275              
276             } # End of javascript_for_db.
277              
278             # -----------------------------------------------
279              
280             sub javascript_for_init_menu
281             {
282 0     0 1   my($self) = @_;
283 0           my(@code) = <
284              
285            
292              
293             EOS
294              
295 0           join("\n", @code);
296              
297             } # End of javascript_for_init_menu.
298              
299             # -----------------------------------------------
300              
301             sub javascript_for_on_load
302             {
303 0     0 1   my($self) = @_;
304              
305 0           ('onLoad' => 'dbix_init()');
306              
307             } # End of javascript_for_on_load.
308              
309             # -----------------------------------------------
310              
311             sub new
312             {
313 0     0 1   my($caller, %arg) = @_;
314 0           my($caller_is_obj) = ref($caller);
315 0   0       my($class) = $caller_is_obj || $caller;
316 0           my($self) = bless({}, $class);
317              
318 0           for my $attr_name ($self -> _standard_keys() )
319             {
320 0           my($arg_name) = $attr_name =~ /^_(.*)/;
321              
322 0 0         if (exists($arg{$arg_name}) )
323             {
324 0           $$self{$attr_name} = $arg{$arg_name};
325             }
326             else
327             {
328 0           $$self{$attr_name} = $self -> _default_for($attr_name);
329             }
330             }
331              
332 0           $self -> _validate_options();
333 0           $self -> _read_data();
334              
335 0 0         $self = undef if (! $$self{'_size'});
336              
337 0           return $self;
338              
339             } # End of new.
340              
341             # -----------------------------------------------
342              
343             sub size
344             {
345 0     0 1   my($self) = @_;
346              
347 0           $$self{'_size'};
348              
349             } # End of size.
350              
351             # -----------------------------------------------
352              
353             1;
354              
355             __END__