File Coverage

blib/lib/Labyrinth/Plugin/Menus.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Labyrinth::Plugin::Menus;
2              
3 2     2   6217 use warnings;
  2         3  
  2         59  
4 2     2   7 use strict;
  2         3  
  2         92  
5              
6             my $VERSION = '5.17';
7              
8             =head1 NAME
9              
10             Labyrinth::Plugin::Menus - Plugin Menus handler for Labyrinth
11              
12             =head1 DESCRIPTION
13              
14             Contains all the menu handling functionality for the Labyrinth
15             framework.
16              
17             =cut
18              
19             # menu array
20             # 0 = ?
21             # 1 = selected=1, unselected=0
22             # 2 = title
23             # 3 = href
24             # 4 = access
25             # 5 = text
26             # 6.. = images
27              
28             # -------------------------------------
29             # Library Modules
30              
31 2     2   8 use base qw(Labyrinth::Plugin::Base);
  2         2  
  2         739  
32              
33             use Labyrinth::Audit;
34             use Labyrinth::Globals;
35             use Labyrinth::DBUtils;
36             use Labyrinth::Media;
37             use Labyrinth::MLUtils;
38             use Labyrinth::Session;
39             use Labyrinth::Support;
40             use Labyrinth::Variables;
41              
42             # -------------------------------------
43             # Constants
44              
45             use constant MaxMenuWidth => 400;
46             use constant MaxMenuHeight => 400;
47              
48             # -------------------------------------
49             # Variables
50              
51             # type: 0 = optional, 1 = mandatory
52             # html: 0 = none, 1 = text, 2 = textarea
53              
54             my %fields = (
55             menuid => { type => 0, html => 0 },
56             name => { type => 1, html => 1 },
57             realmid => { type => 1, html => 0 },
58             typeid => { type => 1, html => 0 },
59             title => { type => 0, html => 1 },
60             parentid => { type => 0, html => 0 },
61             );
62              
63             my (@mandatory,@allfields);
64             for(keys %fields) {
65             push @mandatory, $_ if($fields{$_}->{type});
66             push @allfields, $_;
67             }
68              
69             my @savefields = qw(name title typeid realmid parentid);
70             my $INDEXKEY = 'menuid';
71             my $ALLSQL = 'AllMenus';
72             my $SAVESQL = 'SaveMenu';
73             my $ADDSQL = 'AddMenu';
74             my $GETSQL = 'GetMenuByID';
75             my $DELETESQL = 'DeleteMenu';
76             my $LEVEL = ADMIN;
77              
78             my %adddata = (
79             menuid => 0,
80             realmid => 0,
81             type => 0,
82             title => '',
83             name => '',
84             );
85              
86              
87             # -------------------------------------
88             # The Subs
89              
90             =head1 PUBLIC INTERFACE METHODS
91              
92             =head2 Default Methods
93              
94             =over 4
95              
96             =item LoadMenus
97              
98             Loads all the menus used within the system, and stores them within the 'menu'
99             template variable hash, using the menuid as the key to each.
100              
101             =back
102              
103             =cut
104              
105             sub LoadMenus {
106             # get menu list for current realm
107             my @rows = $dbi->GetQuery('hash','GetMenus',RealmID($tvars{realm}));
108              
109             $tvars{menus} = undef; # in case we're reloading
110             my $request = $ENV{REQUEST_URI};
111             my $script = $settings{script};
112             my (%match,%tree);
113             # LogDebug("script=[$script]");
114              
115             # for each menu get option list
116             for my $row (@rows) {
117             $tvars{menus}->{$row->{menuid}}->{name} = $row->{name};
118             $tvars{menus}->{$row->{menuid}}->{title} = $row->{title};
119             $tvars{menus}->{$row->{menuid}}->{typeid} = $row->{typeid};
120             $tvars{menus}->{$row->{menuid}}->{parentid} = $row->{parentid};
121             my @opts = $dbi->GetQuery('hash','GetOptions',$row->{menuid});
122             for my $opt (@opts) {
123             my @images;
124             if($row->{typeid} > 1) {
125             my @rs = $dbi->GetQuery('hash','GetOptImages',$opt->{optionid});
126             @images = map {$_->{'link'}} @rs;
127             }
128             #LogDebug("request=$request, opt=$opt->{href}");
129             #LogDebug("section=$tvars{section}, opt=$opt->{section}");
130             # try and find the selected option
131             my $inx = $tvars{menus}->{$row->{menuid}}->{data} ? scalar(@{$tvars{menus}->{$row->{menuid}}->{data}}) : 0;
132             $match{request} = [$row->{menuid},$inx,$opt->{optionid}] if($request && $request eq $opt->{href});
133             $match{section} = [$row->{menuid},$inx,$opt->{optionid}] if($opt->{section} && $tvars{section} eq $opt->{section});
134             $match{options} = [$row->{menuid},$inx,$opt->{optionid}] if($request && $request =~ /$opt->{href}/);
135             $match{hideout} = [$row->{menuid},$inx,$opt->{optionid}] if($opt->{section} && ($opt->{section} eq 'home' || $opt->{href} eq '/'));
136             $match{default} = [$row->{menuid},$inx,$opt->{optionid}] if(!$match{default});
137             $opt->{href} =~ s!^\?!$script\?!; # all query only links are local
138             # $opt->{href} =~ s!^/$script!$tvars{cgipath}/$script!; # all script links are local
139             push @{$tvars{menus}->{$row->{menuid}}->{data}},
140             [ 0,0,
141             $opt->{text},
142             $opt->{href},
143             ($opt->{accessid}||0),
144             $opt->{name},
145             @images
146             ];
147             $tree{$opt->{optionid}} = { menuid => $row->{menuid}, index => scalar(@{$tvars{menus}->{$row->{menuid}}->{data}}) - 1, parent => $row->{parentid} };
148             }
149             }
150              
151             #LogDebug("match{$_}=$match{$_}[0]/$match{$_}[2]") for(qw(request section options hideout default));
152              
153             my $match = 'default';
154             if($match{request}[0]) { $match = 'request'; }
155             elsif($match{section}[0]) { $match = 'section'; }
156             elsif($match{options}[0]) { $match = 'options'; }
157             elsif($match{hideout}[0]) { $match = 'hideout'; }
158             UpdateSession(optionid => $match{$match}->[2]);
159              
160             # previous/next trail
161             $tvars{trail2}{prev} = _trail2($match{$match},-1);
162             $tvars{trail2}{this} = _trail2($match{$match}, 0);
163             $tvars{trail2}{next} = _trail2($match{$match}, 1);
164             $tvars{trail1} = undef;
165              
166             # breadcrumbs trail
167             my $menu = 0;
168             my $opt = $match{$match}->[2];
169             $tvars{menus}->{$tree{$opt}{menuid}}->{data}->[$tree{$opt}{index}][1] = 1; # option has been selected
170              
171             # use Data::Dumper;
172             # LogDebug("opt=$opt");
173             # LogDebug("tree=".Dumper(\%tree));
174              
175             for(keys %tree) {
176             next unless(defined $opt && defined $tree{$_} && defined $tree{$_}->{parent});
177             $menu = $tree{$_}->{menuid} if($opt == $tree{$_}->{parent});
178             }
179              
180             while($opt) {
181             $tvars{menus}->{$tree{$opt}{menuid}}->{data}->[$tree{$opt}{index}][0] = $menu; # submenu has been selected
182             push @{$tvars{trail1}},
183             {
184             text => $tvars{menus}->{$tree{$opt}{menuid}}->{data}->[$tree{$opt}{index}][2],
185             href => $tvars{menus}->{$tree{$opt}{menuid}}->{data}->[$tree{$opt}{index}][3]
186             };
187             $menu = $tree{$opt}{menuid};
188             $opt = $tree{$opt}{parent};
189             }
190             }
191              
192             sub _trail2 {
193             my ($hash,$diff) = @_;
194             return unless(defined $hash && @$hash);
195              
196             my %hash;
197             my $opt = $hash->[1] + $diff;
198             if($opt >= 0 && $opt < scalar(@{$tvars{menus}->{$hash->[0]}->{data}})) {
199             $hash{text} = $tvars{menus}->{$hash->[0]}->{data}->[$opt][2];
200             $hash{href} = $tvars{menus}->{$hash->[0]}->{data}->[$opt][3];
201             }
202             return \%hash;
203             }
204              
205             sub _LoadMenus {
206             # get menu list for current realm
207             my @rows = $dbi->GetQuery('hash','GetMenus',RealmID($tvars{realm}));
208             $tvars{menus} = undef; # in case we're reloading
209             my $request = $ENV{REQUEST_URI};
210             my $script = $settings{script};
211             my (%tree,$last,$href);
212             # LogDebug("script=[$script]");
213              
214             # for each menu get option list
215             for my $row (@rows) {
216             $tvars{menus}->{$row->{menuid}}->{name} = $row->{name};
217             $tvars{menus}->{$row->{menuid}}->{title} = $row->{title};
218             $tvars{menus}->{$row->{menuid}}->{typeid} = $row->{typeid};
219             $tvars{menus}->{$row->{menuid}}->{parentid} = $row->{parentid};
220             $last = '';
221             $href = '';
222             my @opts = $dbi->GetQuery('hash','GetOptions',$row->{menuid});
223             for my $opt (@opts) {
224             my @images;
225             if($row->{typeid} > 1) {
226             my @rs = $dbi->GetQuery('hash','GetOptImages',$opt->{optionid});
227             @images = map {$_->{'link'}} @rs;
228             }
229             UpdateSession(optionid => $opt->{optionid}) if($request && $request =~ /$opt->{href}/);
230             $opt->{href} =~ s!^\?!$script\?!; # all query only links are local
231             # $opt->{href} =~ s!^/$script!$tvars{cgipath}/$script!; # all script links are local
232              
233             # establish the current level trail
234             if($tvars{trail2} && !$tvars{trail2}{'next'}) {
235             $tvars{trail2}{'next'} = {text => $opt->{text}, href => $opt->{href}};
236             }
237             if($opt->{optionid} == $tvars{user}{option}) {
238             $tvars{trail2} = { 'prev' => {text => $last, href => $href},
239             'this' => {text => $opt->{text}}};
240             } else {
241             $last = $opt->{text};
242             $href = $opt->{href};
243             }
244             push @{$tvars{menus}->{$row->{menuid}}->{data}}, [0,0,$opt->{text},$opt->{href},($opt->{accessid}||0),@images];
245              
246             $tree{$opt->{optionid}} = {
247             minx => $row->{menuid},
248             oinx => (scalar(@{$tvars{menus}->{$row->{menuid}}->{data}}) - 1),
249             opar => $row->{parentid}
250             };
251             }
252             }
253             # use Data::Dumper;
254             # LogDebug("LoadMenus: tree=".Dumper(\%tree));
255             # now establish the main trail
256             if($tvars{user}{option}) {
257             my $option = $tvars{user}{option};
258             for my $opt (keys %tree) {
259             if($tree{$opt}->{opar} == $option) {
260             $tvars{menus}{$tree{$option}->{minx}}{data}[$tree{$option}->{oinx}][0] = $tree{$opt}->{minx};
261             LogDebug("LoadMenus: option=$option, opt=$opt, minx=$tree{$option}->{minx}, oinx=$tree{$option}->{oinx}, minx=$tree{$opt}->{minx}");
262             # menu has a sub menu
263             last;
264             }
265             }
266              
267             while($option) {
268             my $minx = $tree{$option}->{minx};
269             my $oinx = $tree{$option}->{oinx};
270             if($minx && $oinx) {
271             $tvars{menus}{$minx}{data}[$oinx][1] = 1; # menu has been selected
272             unshift @{$tvars{trail1}}, # breadcrumbs trail
273             {text => $tvars{menus}{$minx}{data}[$oinx][2],
274             href => $tvars{menus}{$minx}{data}[$oinx][3]};
275             }
276             $option = $tree{$option}->{opar};
277             next unless($option);
278             my $pinx = $tree{$option}->{minx};
279             $oinx = $tree{$option}->{oinx};
280             $tvars{menus}{$pinx}{data}[$oinx][0] = $minx; # menu has this sub menu
281             }
282             }
283             }
284              
285             =head1 ADMIN INTERFACE METHODS
286              
287             =head2 Menu Methods
288              
289             =over
290              
291             =item Admin
292              
293             List current menus.
294              
295             =item Add
296              
297             Add a new menu.
298              
299             =item Edit
300              
301             Edit a given menu.
302              
303             =item Save
304              
305             Save the given menu.
306              
307             =item Delete
308              
309             Delete the given menu.
310              
311             =item DeleteOptions
312              
313             Delete the specified option(s) of a given menu.
314              
315             =item TypeSelect
316              
317             Provide a drop down list of menu option types.
318              
319             =item TypeName
320              
321             Provide the name of the given option type.
322              
323             =item ParentSelect
324              
325             Provides a drop down in order to enable multiple levels of menus and options.
326              
327             =item CheckImages
328              
329             Stores the image for a menu option state.
330              
331             =back
332              
333             =cut
334              
335             sub Admin {
336             return unless(AccessUser($LEVEL));
337              
338             if($cgiparams{doaction}) {
339             if($cgiparams{doaction} eq 'Delete' ) { Delete(); }
340             }
341              
342             my @rows = $dbi->GetQuery('hash',$ALLSQL);
343             for (@rows) {
344             $_->{type} = TypeName($_->{typeid});
345             $_->{realm} = RealmName($_->{realmid});
346             }
347             $tvars{data} = \@rows if(@rows);
348             }
349              
350             sub Add {
351             return unless AccessUser($LEVEL);
352             $tvars{data} = \%adddata;
353             $tvars{data}->{ddtypes} = TypeSelect();
354             $tvars{data}->{ddrealms} = RealmSelect();
355             $tvars{data}->{ddparent} = ParentSelect();
356             }
357              
358             sub Edit {
359             return unless AccessUser($LEVEL);
360             return unless AuthorCheck($GETSQL,$INDEXKEY,$LEVEL);
361              
362             my $script = $settings{script};
363              
364             my @opts = $dbi->GetQuery('hash','GetOptions',$tvars{data}->{menuid});
365             for my $opt (@opts) {
366             my @images;
367             if($tvars{data}->{typeid} > 1) {
368             my @rs = $dbi->GetQuery('hash','GetOptImages',$opt->{optionid});
369             for(@rs) {
370             $opt->{'image' . $_->{typeid}} = $_->{'link'};
371             $opt->{'imageid' . $_->{typeid}} = $_->{'imageid'};
372             }
373             @images = map {$_->{'link'}} @rs;
374             }
375             $opt->{ddaccess} = AccessSelect($opt->{accessid},'ACCESS'.$opt->{optionid});
376              
377             my $href = $opt->{href};
378             $href =~ s!^\?!$script\?!; # all query only links are local
379             push @{$tvars{preview}->{data}}, [0,0,$opt->{text},$href,($opt->{accessid}||0),$opt->{name},@images];
380             }
381             $tvars{data}->{options} = \@opts if(@opts);
382             $tvars{data}->{ddtypes} = TypeSelect($tvars{data}->{typeid});
383             $tvars{data}->{ddrealms} = RealmSelect($tvars{data}->{realmid});
384             $tvars{data}->{ddparent} = ParentSelect($tvars{data}->{parentid},$tvars{data}->{menuid});
385              
386             $tvars{preview}->{$_} = $tvars{data}->{$_} for(qw(title typeid parentid));
387             }
388              
389             sub Save {
390             return unless AccessUser($LEVEL);
391             return unless AuthorCheck($GETSQL,$INDEXKEY,$LEVEL);
392              
393             for(keys %fields) {
394             if($fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}) }
395             elsif($fields{$_}->{html} == 2) { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
396             elsif($fields{$_}->{html} == 3) { $cgiparams{$_} = CleanLink($cgiparams{$_}) }
397             }
398              
399             return if FieldCheck(\@allfields,\@mandatory);
400              
401             my @fields = map {$tvars{data}->{$_}} @savefields;
402             if($cgiparams{$INDEXKEY}) {
403             $dbi->DoQuery($SAVESQL,@fields,$cgiparams{$INDEXKEY});
404             } else {
405             $cgiparams{$INDEXKEY} = $dbi->IDQuery($ADDSQL,@fields);
406             }
407              
408             # delete option if requested
409             if($cgiparams{'doaction'}) {
410             DeleteOptions() if($cgiparams{'doaction'} eq 'DeleteOption');
411             }
412              
413             # save options
414             my $order = 1;
415             my @opts = $dbi->GetQuery('hash','GetOptions',$tvars{data}->{menuid});
416             for my $opt (@opts) {
417             my @fields = (
418             $cgiparams{"ORDER" . $opt->{optionid}}, # menu order
419             $cgiparams{"NAME" . $opt->{optionid}}, # CSS code name
420             $cgiparams{"SECT" . $opt->{optionid}}, # section name
421             $cgiparams{"TEXT" . $opt->{optionid}}, # menu text
422             $cgiparams{"HREF" . $opt->{optionid}}, # menu link
423             ($cgiparams{"ACCESS" . $opt->{optionid}} || 0), # access level
424             );
425             $dbi->DoQuery('SaveOption',@fields,$opt->{optionid});
426             $order = $opt->{orderno} + 1;
427              
428             my @rs = $dbi->GetQuery('hash','GetOptImages',$opt->{optionid});
429             my %images = map {$_->{typeid} => $_->{imageid}} @rs;
430             CheckImages($images{1},'IMAGEFILE',$opt->{optionid},1) if($tvars{data}->{typeid} > 1);
431             CheckImages($images{2},'ROLLOVER' ,$opt->{optionid},2) if($tvars{data}->{typeid} > 2);
432             CheckImages($images{3},'SELECTED' ,$opt->{optionid},3) if($tvars{data}->{typeid} > 3);
433             }
434              
435             # add option if requested
436             if($cgiparams{'doaction'}) {
437             $dbi->DoQuery('AddOption',$tvars{data}->{menuid},$order,0) if($cgiparams{'doaction'} eq 'AddOption');
438             }
439              
440             $tvars{thanks} = 1;
441             }
442              
443             sub Delete {
444             return unless AccessUser($LEVEL);
445             my @ids = CGIArray('LISTED');
446             return unless @ids;
447              
448             # remove menus
449             my $ids = join(",",@ids);
450             $dbi->DoQuery($DELETESQL,{ids=>$ids});
451             my @opts = $dbi->GetQuery('hash','FindOptions',{ids=>$ids});
452              
453             # remove options
454             $ids = join(",",map {$_->{optionid}} @opts);
455             $dbi->DoQuery('DeleteOptions',{ids=>$ids});
456             $dbi->DoQuery('DeleteOptImages',{ids=>$ids});
457             }
458              
459             sub DeleteOptions {
460             my @ids = CGIArray('LISTED');
461             return unless @ids;
462             my $ids = join(",",@ids);
463             $dbi->DoQuery('DeleteOptions',{ids=>$ids});
464             $dbi->DoQuery('DeleteOptImages',{ids=>$ids});
465             }
466              
467             my %types = (
468             1 => 'text',
469             2 => 'image',
470             3 => 'rollover',
471             4 => 'highlighted',
472             );
473             my @types = map {{'id'=>$_,'value'=> $types{$_}}} sort keys %types;
474              
475             sub TypeSelect {
476             my $opt = shift || 0;
477             DropDownRows($opt,"typeid",'id','value',@types);
478             }
479              
480             sub TypeName {
481             my $id = shift || 1;
482             return $types{$id};
483             }
484              
485             sub ParentSelect {
486             my $oinx = shift || 0;
487             my $minx = shift || 0;
488             my @opts = $dbi->GetQuery('hash','GetAllOptions',$minx);
489             my @rows = map {{optionid => $_->{optionid}, text => "$_->{name} - $_->{text}"}} @opts;
490             unshift @rows, {optionid => 0, text => 'Select Parent Option'};
491             DropDownRows($oinx,"parentid",'optionid','text',@rows);
492             }
493              
494             sub CheckImages {
495             my ($oldid,$key,$optionid,$typeid) = @_;
496             my $param = $key . $optionid;
497              
498             return unless($cgiparams{$param});
499              
500             my $maximagewidth = $settings{maxmenuwidth} || MaxMenuWidth;
501             my $maximageheight = $settings{maxmenuheight} || MaxMenuHeight;
502              
503             # my $file = CGIFile($key . $optionid);
504             my ($imageid) = SaveImageFile(
505             param => $key . $optionid,
506             stock => 'DRAFT'
507             );
508              
509             my $sqlkey = ($oldid ? 'SaveOptImage' : 'AddOptImage');
510             $dbi->DoQuery($sqlkey,$imageid,$optionid,$typeid);
511             }
512              
513             1;
514              
515             __END__