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

Annotation of /WebApplication/WebMenu.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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.5 # $Id: WebMenu.pm,v 1.4 2007/06/14 16:34:57 paczian Exp $
6 : paarmann 1.2
7 : paarmann 1.1 use strict;
8 :     use warnings;
9 :    
10 :     use Carp qw( confess );
11 :    
12 :     use CGI;
13 :    
14 :     1;
15 :    
16 :     =pod
17 :    
18 :     =head1 NAME
19 :    
20 :     WebMenu - manage menu for the WeApplication framework
21 :    
22 :     =head1 SYNOPSIS
23 :    
24 :     use WebMenu;
25 :    
26 :     my $menu = WebMenu->new();
27 :    
28 :     $menu->add_category("Edit");
29 :    
30 :     $menu->add_entry("Edit", "Copy", "copy.cgi");
31 :    
32 :     $menu->add_entry("Edit", "Paste", "paste.cgi", "_blank");
33 :    
34 :     $menu->output();
35 :    
36 :    
37 :     =head1 DESCRIPTION
38 :    
39 : paarmann 1.2 The WebMenu module defines a mechanism to build a menu structure by defining
40 :     categories (top level menu entries) and optional links, as well as sub entries
41 :     for each of the categories (consisting of a entry name, an url and an optional
42 :     browser target.
43 :    
44 :     The html output of the menu consists of an unordered list of lists, ie. a two
45 :     level hierarchy of html links (<a href> tags) embedded in <ul> tags representing
46 :     categories and their entries.
47 : paarmann 1.1
48 :     =head1 METHODS
49 :    
50 :     =over 4
51 :    
52 :     =item * B<new> ()
53 :    
54 :     Creates a new instance of the WebMenu object.
55 :    
56 :     =cut
57 :    
58 :     sub new {
59 :     my $class = shift;
60 :    
61 :     my $self = { home => undef,
62 :     entries => {},
63 :     categories => [],
64 :     categories_index => {},
65 : paczian 1.5 search => 0,
66 : paarmann 1.1 };
67 :     bless $self, $class;
68 :    
69 :     return $self;
70 :     }
71 :    
72 :    
73 :     =pod
74 :    
75 :     =item * B<flush> ()
76 :    
77 :     Flushes all categories and entries from the menu (leaving it empty).
78 :    
79 :     =cut
80 :    
81 :     sub flush {
82 :     my $self = shift;
83 :     $self->{home} = undef;
84 :     $self->{entries} = {};
85 :     $self->{categories} = [];
86 :     $self->{categories_index} = {};
87 : paczian 1.5 $self->{search} = 0;
88 : paarmann 1.1 return $self;
89 :     }
90 :    
91 :    
92 :     =pod
93 :    
94 :     =item * B<home> (I<url>)
95 :    
96 : paarmann 1.2 Returns the link of the home page. If the optional parameter I<url> is given,
97 :     home will be set. I<url> may be undef.
98 : paarmann 1.1
99 :     =cut
100 :    
101 :     sub home {
102 :     my $self = shift;
103 :     if (scalar(@_)) {
104 :     $self->{home} = $_[0];
105 :     }
106 :     return $self->{home};
107 :     }
108 :    
109 :    
110 :     =pod
111 :    
112 : paczian 1.3 =item * B<add_category> (I<category>, I<url>, I<target>, I<right>)
113 : paarmann 1.1
114 : paarmann 1.2 Adds a category to the menu. I<category> is mandatory and expects the name of the
115 :     menu category. I<url> is optional and will add a link to the category name in the menu.
116 : paczian 1.3 I<target> is optional and defines a href target for that link. The optional I<right>
117 :     parameter specifies the right a user must have to be able to see this category.
118 : paarmann 1.1
119 :     =cut
120 :    
121 :     sub add_category {
122 : paczian 1.4 my ($self, $category, $url, $target, $right, $order) = @_;
123 : paarmann 1.1
124 :     unless ($category) {
125 :     confess 'No category given.';
126 :     }
127 :    
128 : paczian 1.4 unless ($order) {
129 :     $order = scalar(@{$self->{categories}});
130 :     }
131 :    
132 : paarmann 1.1 if (exists($self->{categories_index}->{$category})) {
133 :     confess "Trying to add category '$category' which already exists.";
134 :     }
135 :    
136 :     $url = '' unless ($url);
137 :     $target = '' unless ($target);
138 :    
139 :     # update the category index
140 :     $self->{categories_index}->{$category} = scalar(@{$self->{categories}});
141 :    
142 :     # add the category and link
143 : paczian 1.4 push @{$self->{categories}}, [ $category, $url, $target, $right, $order ];
144 : paarmann 1.1
145 :     # init the entries array for that category
146 :     $self->{entries}->{$category} = [];
147 :    
148 :     return $self;
149 :     }
150 :    
151 :    
152 :     =pod
153 :    
154 :     =item * B<delete_category> (I<category>)
155 :    
156 : paarmann 1.2 Deletes a category from the menu. I<category> is mandatory and expects the
157 :     name of the menu category. If the category does not exist a warning is printed.
158 : paarmann 1.1
159 :     =cut
160 :    
161 :     sub delete_category {
162 :     my ($self, $category) = @_;
163 :    
164 :     unless ($category) {
165 :     confess 'No category given.';
166 :     }
167 :    
168 :     my $i = $self->{categories_index}->{$category};
169 :     if ($i) {
170 :     splice @{$self->{categories}}, $i, 1;
171 :     delete $self->{categories_index}->{$category};
172 :     delete $self->{entries}->{$category}
173 :     }
174 :     else {
175 :     warn "Trying to delete non-existant category '$category'.";
176 :     }
177 :    
178 :     return $self;
179 :     }
180 :    
181 :    
182 :     =pod
183 :    
184 :     =item * B<get_categories> ()
185 :    
186 :     Returns the names of all categories (in a random order).
187 :    
188 :     =cut
189 :    
190 :     sub get_categories {
191 :     return keys(%{$_[0]->{categories_index}});
192 :     }
193 :    
194 : paczian 1.5 =pod
195 :    
196 :     =item * B<search> (I<search_component>)
197 :    
198 :     Getter / Setter for the search component of the menu
199 :    
200 :     =cut
201 :    
202 :     sub search {
203 :     my ($self, $search) = @_;
204 :    
205 :     if (defined($search)) {
206 :     $self->{search} = $search;
207 :     }
208 :    
209 :     return $self->{search};
210 :     }
211 : paarmann 1.1
212 :     =pod
213 :    
214 :     =item * B<add_entry> (I<category>, I<entry>, I<url>)
215 :    
216 : paarmann 1.2 Adds an entry and link to a existing category of the menu. I<category>, I<entry>
217 :     and I<url> are mandatory. I<category> expects the name of the menu category.
218 :     I<entry> can be any string, I<url> expects a url. I<target> is optional and
219 :     defines a href target for that link.
220 : paarmann 1.1
221 :     =cut
222 :    
223 :     sub add_entry {
224 :     my ($self, $category, $entry, $url, $target) = @_;
225 :    
226 :     unless ($category and $entry and $url) {
227 :     confess "Missing parameter ('$category', '$entry', '$url').";
228 :     }
229 :    
230 :     unless (exists($self->{categories_index}->{$category})) {
231 :     confess "Trying to add to non-existant category '$category'.";
232 :     }
233 :    
234 :     $target = '' unless ($target);
235 :    
236 :     push @{$self->{entries}->{$category}}, [ $entry, $url, $target ];
237 :    
238 :     return $self;
239 :     }
240 :    
241 :     =pod
242 :    
243 : paczian 1.3 =item * B<output> (I<application>)
244 : paarmann 1.1
245 : paczian 1.3 Returns the html output of the menu. I<application> must be a reference to the
246 :     application this menu is being printed in. This is only neccessary if rights
247 :     are required for any category to be displayed.
248 : paarmann 1.1
249 :     =cut
250 :    
251 :     sub output {
252 : paczian 1.3 my ($self, $application) = @_;
253 :    
254 :     return '' unless scalar(@{$self->{categories}});
255 : paarmann 1.1
256 :     my $html = "<div id='menu'>\n";
257 :     $html .= "\t<ul id='nav'>\n";
258 :    
259 : paczian 1.4 my @ordered_categories = sort { $a->[4] <=> $b->[4] } @{$self->{categories}};
260 :     foreach (@ordered_categories) {
261 : paarmann 1.1
262 : paczian 1.4 my ($cat, $c_url, $c_target, $right, $order) = @$_;
263 : paczian 1.3
264 :     # check if a right is required to see this category
265 :     if (defined($right)) {
266 :     unless (defined($application) && ref($application) eq 'WebApplication') {
267 :     confess "When using rights for a menu category, an application reference must be passed.";
268 :     }
269 :     next unless ($application->session->user && $application->session->user->has_right($application, @$right));
270 :     }
271 :    
272 : paarmann 1.1 my $url = ($c_url) ? qq~href="$c_url"~ : '';
273 :     my $target = ($c_target) ? qq~target="$c_target"~ : '';
274 :    
275 :     $html .= qq~\t\t<li><div><a $url $target>$cat</a></div>\n~;
276 :    
277 :     if (scalar(@{$self->{entries}->{$cat}})) {
278 :    
279 :     $html .= "\t\t<ul>\n";
280 :    
281 :     foreach (@{$self->{entries}->{$cat}}) {
282 :    
283 :     my ($entry, $e_url, $e_target) = @$_;
284 :     my $target = ($e_target) ? qq~target="$e_target"~ : '';
285 :     $html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;
286 :     }
287 :    
288 :     $html .= "\t\t</ul>\n";
289 :    
290 :     }
291 :    
292 :     $html .= "\t\t</li>\n";
293 :    
294 :     }
295 :    
296 :     $html .= "\t</ul>\n";
297 : paczian 1.5
298 :     $html .= "<table style='position: absolute; right: 10px;'><tr>";
299 :     # check for search module
300 :     if ($self->search()) {
301 :     $html .= "<td>".$self->search->output()."</td>";
302 :     }
303 : paczian 1.3
304 :     # display user string
305 :     if ($application->session->user) {
306 : paczian 1.5 $html .= qq~<td><div id="user" style="padding-top: 2px;">
307 : paczian 1.3 <img height="15px" src="./Html/user.gif" title="Current User" />
308 : paczian 1.5 <strong>~ . $application->session->user->firstname . " " . $application->session->user->lastname . qq~</strong></div></td>~;
309 : paczian 1.3 }
310 : paczian 1.5 $html .= "</tr></table>";
311 : paczian 1.3
312 : paarmann 1.1 $html .= "</div>\n";
313 :    
314 :     return $html;
315 :    
316 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3