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

Annotation of /WebApplication/WebMenu.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : paarmann 1.1 package WebMenu;
2 :    
3 : paarmann 1.2 # WebMenu - manage menu for the WeApplication framework
4 :    
5 : paarmann 1.10 # $Id: WebMenu.pm,v 1.9 2008/01/16 22:17:51 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 : paarmann 1.1 };
62 :     bless $self, $class;
63 :    
64 :     return $self;
65 :     }
66 :    
67 :    
68 :     =pod
69 :    
70 :     =item * B<flush> ()
71 :    
72 :     Flushes all categories and entries from the menu (leaving it empty).
73 :    
74 :     =cut
75 :    
76 :     sub flush {
77 :     my $self = shift;
78 :     $self->{home} = undef;
79 :     $self->{entries} = {};
80 :     $self->{categories} = [];
81 :     $self->{categories_index} = {};
82 : paczian 1.5 $self->{search} = 0;
83 : paarmann 1.1 return $self;
84 :     }
85 :    
86 :    
87 :     =pod
88 :    
89 :     =item * B<home> (I<url>)
90 :    
91 : paarmann 1.2 Returns the link of the home page. If the optional parameter I<url> is given,
92 :     home will be set. I<url> may be undef.
93 : paarmann 1.1
94 :     =cut
95 :    
96 :     sub home {
97 :     my $self = shift;
98 :     if (scalar(@_)) {
99 :     $self->{home} = $_[0];
100 :     }
101 :     return $self->{home};
102 :     }
103 :    
104 :    
105 :     =pod
106 :    
107 : paczian 1.3 =item * B<add_category> (I<category>, I<url>, I<target>, I<right>)
108 : paarmann 1.1
109 : paarmann 1.2 Adds a category to the menu. I<category> is mandatory and expects the name of the
110 :     menu category. I<url> is optional and will add a link to the category name in the menu.
111 : paczian 1.3 I<target> is optional and defines a href target for that link. The optional I<right>
112 :     parameter specifies the right a user must have to be able to see this category.
113 : paarmann 1.1
114 :     =cut
115 :    
116 :     sub add_category {
117 : paczian 1.4 my ($self, $category, $url, $target, $right, $order) = @_;
118 : paarmann 1.1
119 :     unless ($category) {
120 : paarmann 1.6 die 'No category given.';
121 : paarmann 1.1 }
122 :    
123 : paczian 1.4 unless ($order) {
124 :     $order = scalar(@{$self->{categories}});
125 :     }
126 :    
127 : paarmann 1.1 if (exists($self->{categories_index}->{$category})) {
128 : paarmann 1.6 die "Trying to add category '$category' which already exists.";
129 : paarmann 1.1 }
130 :    
131 :     $url = '' unless ($url);
132 :     $target = '' unless ($target);
133 :    
134 :     # update the category index
135 :     $self->{categories_index}->{$category} = scalar(@{$self->{categories}});
136 :    
137 :     # add the category and link
138 : paczian 1.4 push @{$self->{categories}}, [ $category, $url, $target, $right, $order ];
139 : paarmann 1.1
140 :     # init the entries array for that category
141 :     $self->{entries}->{$category} = [];
142 :    
143 :     return $self;
144 :     }
145 :    
146 :    
147 :     =pod
148 :    
149 :     =item * B<delete_category> (I<category>)
150 :    
151 : paarmann 1.2 Deletes a category from the menu. I<category> is mandatory and expects the
152 :     name of the menu category. If the category does not exist a warning is printed.
153 : paarmann 1.1
154 :     =cut
155 :    
156 :     sub delete_category {
157 :     my ($self, $category) = @_;
158 :    
159 :     unless ($category) {
160 : paarmann 1.6 die 'No category given.';
161 : paarmann 1.1 }
162 :    
163 :     my $i = $self->{categories_index}->{$category};
164 :     if ($i) {
165 :     splice @{$self->{categories}}, $i, 1;
166 :     delete $self->{categories_index}->{$category};
167 :     delete $self->{entries}->{$category}
168 :     }
169 :     else {
170 :     warn "Trying to delete non-existant category '$category'.";
171 :     }
172 :    
173 :     return $self;
174 :     }
175 :    
176 :    
177 :     =pod
178 :    
179 :     =item * B<get_categories> ()
180 :    
181 :     Returns the names of all categories (in a random order).
182 :    
183 :     =cut
184 :    
185 :     sub get_categories {
186 :     return keys(%{$_[0]->{categories_index}});
187 :     }
188 :    
189 : paczian 1.5 =pod
190 :    
191 :     =item * B<search> (I<search_component>)
192 :    
193 :     Getter / Setter for the search component of the menu
194 :    
195 :     =cut
196 :    
197 :     sub search {
198 :     my ($self, $search) = @_;
199 :    
200 :     if (defined($search)) {
201 :     $self->{search} = $search;
202 :     }
203 :    
204 :     return $self->{search};
205 :     }
206 : paarmann 1.1
207 :     =pod
208 :    
209 : paarmann 1.10 =item * B<add_entry> (I<category>, I<entry>, I<url>, I<right>)
210 : paarmann 1.1
211 : paarmann 1.2 Adds an entry and link to a existing category of the menu. I<category>, I<entry>
212 :     and I<url> are mandatory. I<category> expects the name of the menu category.
213 :     I<entry> can be any string, I<url> expects a url. I<target> is optional and
214 :     defines a href target for that link.
215 : paarmann 1.10 The optional I<right> parameter specifies the right a user must have to
216 :     be able to see this category.
217 : paarmann 1.1
218 :     =cut
219 :    
220 :     sub add_entry {
221 : paarmann 1.10 my ($self, $category, $entry, $url, $target, $right) = @_;
222 : paarmann 1.1
223 : paczian 1.7 unless ($category and $entry){# and $url) {
224 : paarmann 1.6 die "Missing parameter ('$category', '$entry', '$url').";
225 : paarmann 1.1 }
226 :    
227 :     unless (exists($self->{categories_index}->{$category})) {
228 : paarmann 1.6 die "Trying to add to non-existant category '$category'.";
229 : paarmann 1.1 }
230 :    
231 :     $target = '' unless ($target);
232 :    
233 : paarmann 1.10 push @{$self->{entries}->{$category}}, [ $entry, $url, $target, $right ];
234 : paarmann 1.1
235 :     return $self;
236 :     }
237 :    
238 :     =pod
239 :    
240 : paczian 1.3 =item * B<output> (I<application>)
241 : paarmann 1.1
242 : paczian 1.3 Returns the html output of the menu. I<application> must be a reference to the
243 :     application this menu is being printed in. This is only neccessary if rights
244 :     are required for any category to be displayed.
245 : paarmann 1.1
246 :     =cut
247 :    
248 :     sub output {
249 : paczian 1.3 my ($self, $application) = @_;
250 :    
251 :     return '' unless scalar(@{$self->{categories}});
252 : paarmann 1.1
253 :     my $html = "<div id='menu'>\n";
254 :     $html .= "\t<ul id='nav'>\n";
255 :    
256 : paczian 1.4 my @ordered_categories = sort { $a->[4] <=> $b->[4] } @{$self->{categories}};
257 :     foreach (@ordered_categories) {
258 : paarmann 1.1
259 : paczian 1.4 my ($cat, $c_url, $c_target, $right, $order) = @$_;
260 : paczian 1.3
261 :     # check if a right is required to see this category
262 :     if (defined($right)) {
263 :     unless (defined($application) && ref($application) eq 'WebApplication') {
264 : paarmann 1.6 die "When using rights for a menu category, an application reference must be passed.";
265 : paczian 1.3 }
266 : paarmann 1.6 next unless ($application->session->user &&
267 :     $application->session->user->has_right($application, @$right));
268 : paczian 1.3 }
269 :    
270 : paarmann 1.1 my $url = ($c_url) ? qq~href="$c_url"~ : '';
271 :     my $target = ($c_target) ? qq~target="$c_target"~ : '';
272 :    
273 :     $html .= qq~\t\t<li><div><a $url $target>$cat</a></div>\n~;
274 :    
275 :     if (scalar(@{$self->{entries}->{$cat}})) {
276 :    
277 :     $html .= "\t\t<ul>\n";
278 :    
279 :     foreach (@{$self->{entries}->{$cat}}) {
280 :    
281 : paarmann 1.10 my ($entry, $e_url, $e_target, $e_right) = @$_;
282 :    
283 :     # check if a right is required to see this category
284 :     if (defined($e_right)) {
285 :     unless (defined($application) && ref($application) eq 'WebApplication') {
286 :     die "When using rights for a menu category, an application reference must be passed.";
287 :     }
288 :     next unless ($application->session->user &&
289 :     $application->session->user->has_right($application, @$e_right));
290 :     }
291 :    
292 : paczian 1.7 if ($e_url) {
293 :     my $target = ($e_target) ? qq~target="$e_target"~ : '';
294 :     $html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;
295 :     } else {
296 :     $html .= qq~\t\t\t<li>$entry</li>\n~;
297 :     }
298 : paarmann 1.1 }
299 :    
300 :     $html .= "\t\t</ul>\n";
301 :    
302 :     }
303 :    
304 :     $html .= "\t\t</li>\n";
305 :    
306 :     }
307 :    
308 :     $html .= "\t</ul>\n";
309 : paczian 1.3
310 : paarmann 1.1 $html .= "</div>\n";
311 :    
312 :     return $html;
313 :    
314 :     }
315 : paarmann 1.6
316 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3