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

Annotation of /WebApplication/WebMenu.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : paarmann 1.1 package WebMenu;
2 :    
3 : paarmann 1.2 # WebMenu - manage menu for the WeApplication framework
4 :    
5 :     # $Id$
6 :    
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 :     };
66 :     bless $self, $class;
67 :    
68 :     return $self;
69 :     }
70 :    
71 :    
72 :     =pod
73 :    
74 :     =item * B<flush> ()
75 :    
76 :     Flushes all categories and entries from the menu (leaving it empty).
77 :    
78 :     =cut
79 :    
80 :     sub flush {
81 :     my $self = shift;
82 :     $self->{home} = undef;
83 :     $self->{entries} = {};
84 :     $self->{categories} = [];
85 :     $self->{categories_index} = {};
86 :     return $self;
87 :     }
88 :    
89 :    
90 :     =pod
91 :    
92 :     =item * B<home> (I<url>)
93 :    
94 : paarmann 1.2 Returns the link of the home page. If the optional parameter I<url> is given,
95 :     home will be set. I<url> may be undef.
96 : paarmann 1.1
97 :     =cut
98 :    
99 :     sub home {
100 :     my $self = shift;
101 :     if (scalar(@_)) {
102 :     $self->{home} = $_[0];
103 :     }
104 :     return $self->{home};
105 :     }
106 :    
107 :    
108 :     =pod
109 :    
110 :     =item * B<add_category> (I<category>, I<url>, I<target>)
111 :    
112 : paarmann 1.2 Adds a category to the menu. I<category> is mandatory and expects the name of the
113 :     menu category. I<url> is optional and will add a link to the category name in the menu.
114 :     I<target> is optional and defines a href target for that link.
115 : paarmann 1.1
116 :     =cut
117 :    
118 :     sub add_category {
119 :     my ($self, $category, $url, $target) = @_;
120 :    
121 :     unless ($category) {
122 :     confess 'No category given.';
123 :     }
124 :    
125 :     if (exists($self->{categories_index}->{$category})) {
126 :     confess "Trying to add category '$category' which already exists.";
127 :     }
128 :    
129 :     $url = '' unless ($url);
130 :     $target = '' unless ($target);
131 :    
132 :     # update the category index
133 :     $self->{categories_index}->{$category} = scalar(@{$self->{categories}});
134 :    
135 :     # add the category and link
136 :     push @{$self->{categories}}, [ $category, $url, $target ];
137 :    
138 :     # init the entries array for that category
139 :     $self->{entries}->{$category} = [];
140 :    
141 :     return $self;
142 :     }
143 :    
144 :    
145 :     =pod
146 :    
147 :     =item * B<delete_category> (I<category>)
148 :    
149 : paarmann 1.2 Deletes a category from the menu. I<category> is mandatory and expects the
150 :     name of the menu category. If the category does not exist a warning is printed.
151 : paarmann 1.1
152 :     =cut
153 :    
154 :     sub delete_category {
155 :     my ($self, $category) = @_;
156 :    
157 :     unless ($category) {
158 :     confess 'No category given.';
159 :     }
160 :    
161 :     my $i = $self->{categories_index}->{$category};
162 :     if ($i) {
163 :     splice @{$self->{categories}}, $i, 1;
164 :     delete $self->{categories_index}->{$category};
165 :     delete $self->{entries}->{$category}
166 :     }
167 :     else {
168 :     warn "Trying to delete non-existant category '$category'.";
169 :     }
170 :    
171 :     return $self;
172 :     }
173 :    
174 :    
175 :     =pod
176 :    
177 :     =item * B<get_categories> ()
178 :    
179 :     Returns the names of all categories (in a random order).
180 :    
181 :     =cut
182 :    
183 :     sub get_categories {
184 :     return keys(%{$_[0]->{categories_index}});
185 :     }
186 :    
187 :    
188 :     =pod
189 :    
190 :     =item * B<add_entry> (I<category>, I<entry>, I<url>)
191 :    
192 : paarmann 1.2 Adds an entry and link to a existing category of the menu. I<category>, I<entry>
193 :     and I<url> are mandatory. I<category> expects the name of the menu category.
194 :     I<entry> can be any string, I<url> expects a url. I<target> is optional and
195 :     defines a href target for that link.
196 : paarmann 1.1
197 :     =cut
198 :    
199 :     sub add_entry {
200 :     my ($self, $category, $entry, $url, $target) = @_;
201 :    
202 :     unless ($category and $entry and $url) {
203 :     confess "Missing parameter ('$category', '$entry', '$url').";
204 :     }
205 :    
206 :     unless (exists($self->{categories_index}->{$category})) {
207 :     confess "Trying to add to non-existant category '$category'.";
208 :     }
209 :    
210 :     $target = '' unless ($target);
211 :    
212 :     push @{$self->{entries}->{$category}}, [ $entry, $url, $target ];
213 :    
214 :     return $self;
215 :     }
216 :    
217 :     =pod
218 :    
219 :     =item * B<output> ()
220 :    
221 :     Returns the html output of the menu.
222 :    
223 :     =cut
224 :    
225 :     sub output {
226 :     my $self = shift;
227 :    
228 :     my $html = "<div id='menu'>\n";
229 :     $html .= "\t<ul id='nav'>\n";
230 :    
231 :     foreach (@{$self->{categories}}) {
232 :    
233 :     my ($cat, $c_url, $c_target) = @$_;
234 :     my $url = ($c_url) ? qq~href="$c_url"~ : '';
235 :     my $target = ($c_target) ? qq~target="$c_target"~ : '';
236 :    
237 :     $html .= qq~\t\t<li><div><a $url $target>$cat</a></div>\n~;
238 :    
239 :     if (scalar(@{$self->{entries}->{$cat}})) {
240 :    
241 :     $html .= "\t\t<ul>\n";
242 :    
243 :     foreach (@{$self->{entries}->{$cat}}) {
244 :    
245 :     my ($entry, $e_url, $e_target) = @$_;
246 :     my $target = ($e_target) ? qq~target="$e_target"~ : '';
247 :     $html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;
248 :     }
249 :    
250 :     $html .= "\t\t</ul>\n";
251 :    
252 :     }
253 :    
254 :     $html .= "\t\t</li>\n";
255 :    
256 :     }
257 :    
258 :     $html .= "\t</ul>\n";
259 :     $html .= "</div>\n";
260 :    
261 :     return $html;
262 :    
263 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3