[Bio] / WebApplication / WebMenu.pm Repository:
ViewVC logotype

Annotation of /WebApplication/WebMenu.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (view) (download) (as text)

1 : paarmann 1.1 package WebMenu;
2 :    
3 : paarmann 1.2 # WebMenu - manage menu for the WeApplication framework
4 :    
5 : paczian 1.12 # $Id: WebMenu.pm,v 1.11 2008/03/27 17:05:12 paarmann Exp $
6 : paarmann 1.2
7 : paarmann 1.1 use strict;
8 :     use warnings;
9 :    
10 :    
11 :     =pod
12 :    
13 :     =head1 NAME
14 :    
15 :     WebMenu - manage menu for the WeApplication framework
16 :    
17 :     =head1 SYNOPSIS
18 :    
19 :     use WebMenu;
20 :    
21 :     my $menu = WebMenu->new();
22 :    
23 :     $menu->add_category("Edit");
24 :    
25 :     $menu->add_entry("Edit", "Copy", "copy.cgi");
26 :    
27 :     $menu->add_entry("Edit", "Paste", "paste.cgi", "_blank");
28 :    
29 :     $menu->output();
30 :    
31 :    
32 :     =head1 DESCRIPTION
33 :    
34 : paarmann 1.2 The WebMenu module defines a mechanism to build a menu structure by defining
35 :     categories (top level menu entries) and optional links, as well as sub entries
36 :     for each of the categories (consisting of a entry name, an url and an optional
37 :     browser target.
38 :    
39 :     The html output of the menu consists of an unordered list of lists, ie. a two
40 :     level hierarchy of html links (<a href> tags) embedded in <ul> tags representing
41 :     categories and their entries.
42 : paarmann 1.1
43 :     =head1 METHODS
44 :    
45 :     =over 4
46 :    
47 :     =item * B<new> ()
48 :    
49 :     Creates a new instance of the WebMenu object.
50 :    
51 :     =cut
52 :    
53 :     sub new {
54 :     my $class = shift;
55 :    
56 :     my $self = { home => undef,
57 :     entries => {},
58 :     categories => [],
59 :     categories_index => {},
60 : paczian 1.5 search => 0,
61 : paczian 1.12 style => 'vertical',
62 : paarmann 1.1 };
63 :     bless $self, $class;
64 :    
65 :     return $self;
66 :     }
67 :    
68 :    
69 :     =pod
70 :    
71 :     =item * B<flush> ()
72 :    
73 :     Flushes all categories and entries from the menu (leaving it empty).
74 :    
75 :     =cut
76 :    
77 :     sub flush {
78 :     my $self = shift;
79 :     $self->{home} = undef;
80 :     $self->{entries} = {};
81 :     $self->{categories} = [];
82 :     $self->{categories_index} = {};
83 : paczian 1.5 $self->{search} = 0;
84 : paarmann 1.1 return $self;
85 :     }
86 :    
87 :    
88 :     =pod
89 :    
90 :     =item * B<home> (I<url>)
91 :    
92 : paarmann 1.2 Returns the link of the home page. If the optional parameter I<url> is given,
93 :     home will be set. I<url> may be undef.
94 : paarmann 1.1
95 :     =cut
96 :    
97 :     sub home {
98 :     my $self = shift;
99 :     if (scalar(@_)) {
100 :     $self->{home} = $_[0];
101 :     }
102 :     return $self->{home};
103 :     }
104 :    
105 :    
106 :     =pod
107 :    
108 : paczian 1.3 =item * B<add_category> (I<category>, I<url>, I<target>, I<right>)
109 : paarmann 1.1
110 : paarmann 1.2 Adds a category to the menu. I<category> is mandatory and expects the name of the
111 :     menu category. I<url> is optional and will add a link to the category name in the menu.
112 : paczian 1.3 I<target> is optional and defines a href target for that link. The optional I<right>
113 :     parameter specifies the right a user must have to be able to see this category.
114 : paarmann 1.1
115 :     =cut
116 :    
117 :     sub add_category {
118 : paczian 1.4 my ($self, $category, $url, $target, $right, $order) = @_;
119 : paarmann 1.1
120 :     unless ($category) {
121 : paarmann 1.6 die 'No category given.';
122 : paarmann 1.1 }
123 :    
124 : paczian 1.4 unless ($order) {
125 :     $order = scalar(@{$self->{categories}});
126 :     }
127 :    
128 : paarmann 1.1 if (exists($self->{categories_index}->{$category})) {
129 : paarmann 1.6 die "Trying to add category '$category' which already exists.";
130 : paarmann 1.1 }
131 :    
132 :     $url = '' unless ($url);
133 :     $target = '' unless ($target);
134 :    
135 :     # update the category index
136 :     $self->{categories_index}->{$category} = scalar(@{$self->{categories}});
137 :    
138 :     # add the category and link
139 : paczian 1.4 push @{$self->{categories}}, [ $category, $url, $target, $right, $order ];
140 : paarmann 1.1
141 :     # init the entries array for that category
142 :     $self->{entries}->{$category} = [];
143 :    
144 :     return $self;
145 :     }
146 :    
147 :    
148 :     =pod
149 :    
150 :     =item * B<delete_category> (I<category>)
151 :    
152 : paarmann 1.2 Deletes a category from the menu. I<category> is mandatory and expects the
153 :     name of the menu category. If the category does not exist a warning is printed.
154 : paarmann 1.1
155 :     =cut
156 :    
157 :     sub delete_category {
158 :     my ($self, $category) = @_;
159 :    
160 :     unless ($category) {
161 : paarmann 1.6 die 'No category given.';
162 : paarmann 1.1 }
163 :    
164 :     my $i = $self->{categories_index}->{$category};
165 :     if ($i) {
166 :     splice @{$self->{categories}}, $i, 1;
167 :     delete $self->{categories_index}->{$category};
168 :     delete $self->{entries}->{$category}
169 :     }
170 :     else {
171 :     warn "Trying to delete non-existant category '$category'.";
172 :     }
173 :    
174 :     return $self;
175 :     }
176 :    
177 :    
178 :     =pod
179 :    
180 :     =item * B<get_categories> ()
181 :    
182 :     Returns the names of all categories (in a random order).
183 :    
184 :     =cut
185 :    
186 :     sub get_categories {
187 :     return keys(%{$_[0]->{categories_index}});
188 :     }
189 :    
190 : paczian 1.5 =pod
191 :    
192 :     =item * B<search> (I<search_component>)
193 :    
194 :     Getter / Setter for the search component of the menu
195 :    
196 :     =cut
197 :    
198 :     sub search {
199 :     my ($self, $search) = @_;
200 :    
201 :     if (defined($search)) {
202 :     $self->{search} = $search;
203 :     }
204 :    
205 :     return $self->{search};
206 :     }
207 : paarmann 1.1
208 :     =pod
209 :    
210 : paarmann 1.10 =item * B<add_entry> (I<category>, I<entry>, I<url>, I<right>)
211 : paarmann 1.1
212 : paarmann 1.2 Adds an entry and link to a existing category of the menu. I<category>, I<entry>
213 :     and I<url> are mandatory. I<category> expects the name of the menu category.
214 :     I<entry> can be any string, I<url> expects a url. I<target> is optional and
215 :     defines a href target for that link.
216 : paarmann 1.10 The optional I<right> parameter specifies the right a user must have to
217 :     be able to see this category.
218 : paarmann 1.1
219 :     =cut
220 :    
221 :     sub add_entry {
222 : paarmann 1.10 my ($self, $category, $entry, $url, $target, $right) = @_;
223 : paarmann 1.1
224 : paczian 1.7 unless ($category and $entry){# and $url) {
225 : paarmann 1.6 die "Missing parameter ('$category', '$entry', '$url').";
226 : paarmann 1.1 }
227 :    
228 :     unless (exists($self->{categories_index}->{$category})) {
229 : paarmann 1.6 die "Trying to add to non-existant category '$category'.";
230 : paarmann 1.1 }
231 :    
232 :     $target = '' unless ($target);
233 :    
234 : paarmann 1.10 push @{$self->{entries}->{$category}}, [ $entry, $url, $target, $right ];
235 : paarmann 1.1
236 :     return $self;
237 :     }
238 :    
239 :     =pod
240 :    
241 : paczian 1.3 =item * B<output> (I<application>)
242 : paarmann 1.1
243 : paczian 1.3 Returns the html output of the menu. I<application> must be a reference to the
244 :     application this menu is being printed in. This is only neccessary if rights
245 :     are required for any category to be displayed.
246 : paarmann 1.1
247 :     =cut
248 :    
249 :     sub output {
250 : paczian 1.3 my ($self, $application) = @_;
251 :    
252 :     return '' unless scalar(@{$self->{categories}});
253 : paarmann 1.1
254 : paczian 1.12 my $html = "";
255 :    
256 :     if ($self->style eq 'vertical') {
257 :     $html = $self->output_vertical($application);
258 :     } elsif ($self->style eq 'horizontal') {
259 :     $html = $self->output_horizontal($application);
260 :     }
261 :    
262 :     return $html;
263 :     }
264 :    
265 :     sub output_vertical {
266 :     my ($self, $application) = @_;
267 :    
268 : paarmann 1.1 my $html = "<div id='menu'>\n";
269 :     $html .= "\t<ul id='nav'>\n";
270 :    
271 : paczian 1.4 my @ordered_categories = sort { $a->[4] <=> $b->[4] } @{$self->{categories}};
272 :     foreach (@ordered_categories) {
273 : paarmann 1.1
274 : paczian 1.4 my ($cat, $c_url, $c_target, $right, $order) = @$_;
275 : paczian 1.3
276 :     # check if a right is required to see this category
277 :     if (defined($right)) {
278 :     unless (defined($application) && ref($application) eq 'WebApplication') {
279 : paarmann 1.6 die "When using rights for a menu category, an application reference must be passed.";
280 : paczian 1.3 }
281 : paarmann 1.6 next unless ($application->session->user &&
282 :     $application->session->user->has_right($application, @$right));
283 : paczian 1.3 }
284 :    
285 : paarmann 1.1 my $url = ($c_url) ? qq~href="$c_url"~ : '';
286 :     my $target = ($c_target) ? qq~target="$c_target"~ : '';
287 :    
288 :     $html .= qq~\t\t<li><div><a $url $target>$cat</a></div>\n~;
289 :    
290 :     if (scalar(@{$self->{entries}->{$cat}})) {
291 :    
292 :     $html .= "\t\t<ul>\n";
293 :    
294 :     foreach (@{$self->{entries}->{$cat}}) {
295 :    
296 : paarmann 1.10 my ($entry, $e_url, $e_target, $e_right) = @$_;
297 :    
298 :     # check if a right is required to see this category
299 :     if (defined($e_right)) {
300 :     unless (defined($application) && ref($application) eq 'WebApplication') {
301 :     die "When using rights for a menu category, an application reference must be passed.";
302 :     }
303 :     next unless ($application->session->user &&
304 :     $application->session->user->has_right($application, @$e_right));
305 :     }
306 :    
307 : paczian 1.7 if ($e_url) {
308 :     my $target = ($e_target) ? qq~target="$e_target"~ : '';
309 :     $html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;
310 :     } else {
311 : paarmann 1.11 $html .= qq~\t\t\t<li><span>$entry</span></li>\n~;
312 : paczian 1.7 }
313 : paarmann 1.1 }
314 :    
315 :     $html .= "\t\t</ul>\n";
316 :    
317 :     }
318 :    
319 :     $html .= "\t\t</li>\n";
320 :    
321 :     }
322 :    
323 :     $html .= "\t</ul>\n";
324 : paczian 1.3
325 : paarmann 1.1 $html .= "</div>\n";
326 :    
327 :     return $html;
328 : paczian 1.12 }
329 :    
330 :     sub output_horizontal {
331 :     my ($self, $application) = @_;
332 :    
333 :     my $html = "<table class='menu_table'><tr class='menu_cats'>";
334 :    
335 :     my @ordered_categories = sort { $a->[4] <=> $b->[4] } @{$self->{categories}};
336 :     my $i = 0;
337 :     foreach (@ordered_categories) {
338 :    
339 :     my ($cat, $c_url, $c_target, $right, $order) = @$_;
340 :    
341 :     # check if a right is required to see this category
342 :     if (defined($right)) {
343 :     unless (defined($application) && ref($application) eq 'WebApplication') {
344 :     die "When using rights for a menu category, an application reference must be passed.";
345 :     }
346 :     next unless ($application->session->user &&
347 :     $application->session->user->has_right($application, @$right));
348 :     }
349 :    
350 :     $html .= qq~<td class='menu_cat_inactive' onclick='activate_menu_cat("$i");' id='menu_cat_$i'>$cat</td>~;
351 :     $i++;
352 :     }
353 :     $html .= "<td class='menu_filler'>&nbsp</td></tr></table>";
354 :    
355 :     $i = 0;
356 :     foreach (@ordered_categories) {
357 :    
358 :     my ($cat, $c_url, $c_target, $right, $order) = @$_;
359 :    
360 :     # check if a right is required to see this category
361 :     if (defined($right)) {
362 :     unless (defined($application) && ref($application) eq 'WebApplication') {
363 :     die "When using rights for a menu category, an application reference must be passed.";
364 :     }
365 :     next unless ($application->session->user &&
366 :     $application->session->user->has_right($application, @$right));
367 :     }
368 :     if (scalar(@{$self->{entries}->{$cat}})) {
369 :    
370 :     $html .= "<table id='menu_cat_bar_$i' class='menu_cat_bar_inactive'><tr>";
371 :    
372 :     foreach (@{$self->{entries}->{$cat}}) {
373 :    
374 :     my ($entry, $e_url, $e_target, $e_right) = @$_;
375 :    
376 :     # check if a right is required to see this category
377 :     if (defined($e_right)) {
378 :     unless (defined($application) && ref($application) eq 'WebApplication') {
379 :     die "When using rights for a menu category, an application reference must be passed.";
380 :     }
381 :     next unless ($application->session->user &&
382 :     $application->session->user->has_right($application, @$e_right));
383 :     }
384 :    
385 :     if ($e_url) {
386 :     my $target = ($e_target) ? qq~target="$e_target"~ : '';
387 :     $html .= qq~<td class='menu_item'><a href="$e_url" $target>$entry</a></td>~;
388 :     } else {
389 :     $html .= qq~<td class='menu_item'><span>$entry</span></td>~;
390 :     }
391 :     }
392 :    
393 :     $html .= "</tr></table>";
394 :    
395 :     }
396 :     $i++;
397 :     }
398 :    
399 :     $html .= qq~
400 :     <script>
401 :     function activate_menu_cat (which) {
402 :     for (i=0; i<1000; i++) {
403 :     var cat_bar = document.getElementById('menu_cat_bar_'+i);
404 :     var cat = document.getElementById('menu_cat_'+i);
405 :     if (cat_bar) {
406 :     if (i == which) {
407 :     cat_bar.className = 'menu_cat_bar_active';
408 :     cat.className = 'menu_cat_active';
409 :     } else {
410 :     cat_bar.className = 'menu_cat_bar_inactive';
411 :     cat.className = 'menu_cat_inactive';
412 :     }
413 :     } else {
414 :     break;
415 :     }
416 :     }
417 :     }
418 :     </script>
419 :     ~;
420 :    
421 :     return $html;
422 :     }
423 :    
424 :     sub style {
425 :     my ($self, $style) = @_;
426 :    
427 :     if (defined($style)) {
428 :     $self->{style} = $style;
429 :     }
430 : paarmann 1.1
431 : paczian 1.12 return $self->{style};
432 : paarmann 1.1 }
433 : paarmann 1.6
434 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3