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

Annotation of /WebApplication/WebMenu.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : paarmann 1.1 package WebMenu;
2 :    
3 :     use strict;
4 :     use warnings;
5 :    
6 :     use Carp qw( confess );
7 :    
8 :     use CGI;
9 :    
10 :     1;
11 :    
12 :     =pod
13 :    
14 :     =head1 NAME
15 :    
16 :     WebMenu - manage menu for the WeApplication framework
17 :    
18 :     =head1 SYNOPSIS
19 :    
20 :     use WebMenu;
21 :    
22 :     my $menu = WebMenu->new();
23 :    
24 :     $menu->add_category("Edit");
25 :    
26 :     $menu->add_entry("Edit", "Copy", "copy.cgi");
27 :    
28 :     $menu->add_entry("Edit", "Paste", "paste.cgi", "_blank");
29 :    
30 :     $menu->output();
31 :    
32 :    
33 :     =head1 DESCRIPTION
34 :    
35 :     The WebMenu module defines a mechanism to build a menu structure by defining categories (top level menu entries) and optional links, as well as sub entries for each of the categories (consisting of a entry name, an url and an optional browser target.
36 :    
37 :     The html output of the menu consists of an unordered list of lists, ie. a two level hierarchy of html links (<a href> tags) embedded in <ul> tags representing categories and their entries.
38 :    
39 :     =head1 METHODS
40 :    
41 :     =over 4
42 :    
43 :     =item * B<new> ()
44 :    
45 :     Creates a new instance of the WebMenu object.
46 :    
47 :     =cut
48 :    
49 :     sub new {
50 :     my $class = shift;
51 :    
52 :     my $self = { home => undef,
53 :     entries => {},
54 :     categories => [],
55 :     categories_index => {},
56 :     };
57 :     bless $self, $class;
58 :    
59 :     return $self;
60 :     }
61 :    
62 :    
63 :     =pod
64 :    
65 :     =item * B<flush> ()
66 :    
67 :     Flushes all categories and entries from the menu (leaving it empty).
68 :    
69 :     =cut
70 :    
71 :     sub flush {
72 :     my $self = shift;
73 :     $self->{home} = undef;
74 :     $self->{entries} = {};
75 :     $self->{categories} = [];
76 :     $self->{categories_index} = {};
77 :     return $self;
78 :     }
79 :    
80 :    
81 :     =pod
82 :    
83 :     =item * B<home> (I<url>)
84 :    
85 :     Returns the link of the home page. If the optional parameter I<url> is given, home will be set.
86 :     I<url> may be undef.
87 :    
88 :     =cut
89 :    
90 :     sub home {
91 :     my $self = shift;
92 :     if (scalar(@_)) {
93 :     $self->{home} = $_[0];
94 :     }
95 :     return $self->{home};
96 :     }
97 :    
98 :    
99 :     =pod
100 :    
101 :     =item * B<add_category> (I<category>, I<url>, I<target>)
102 :    
103 :     Adds a category to the menu. I<category> is mandatory and expects the name of the menu category. I<url> is optional and will add a link to the category name in the menu. I<target> is optional and defines a href target for that link.
104 :    
105 :     =cut
106 :    
107 :     sub add_category {
108 :     my ($self, $category, $url, $target) = @_;
109 :    
110 :     unless ($category) {
111 :     confess 'No category given.';
112 :     }
113 :    
114 :     if (exists($self->{categories_index}->{$category})) {
115 :     confess "Trying to add category '$category' which already exists.";
116 :     }
117 :    
118 :     $url = '' unless ($url);
119 :     $target = '' unless ($target);
120 :    
121 :     # update the category index
122 :     $self->{categories_index}->{$category} = scalar(@{$self->{categories}});
123 :    
124 :     # add the category and link
125 :     push @{$self->{categories}}, [ $category, $url, $target ];
126 :    
127 :     # init the entries array for that category
128 :     $self->{entries}->{$category} = [];
129 :    
130 :     return $self;
131 :     }
132 :    
133 :    
134 :     =pod
135 :    
136 :     =item * B<delete_category> (I<category>)
137 :    
138 :     Deletes a category from the menu. I<category> is mandatory and expects the name of the menu category.
139 :     If the category does not exist a warning is printed.
140 :    
141 :     =cut
142 :    
143 :     sub delete_category {
144 :     my ($self, $category) = @_;
145 :    
146 :     unless ($category) {
147 :     confess 'No category given.';
148 :     }
149 :    
150 :     my $i = $self->{categories_index}->{$category};
151 :     if ($i) {
152 :     splice @{$self->{categories}}, $i, 1;
153 :     delete $self->{categories_index}->{$category};
154 :     delete $self->{entries}->{$category}
155 :     }
156 :     else {
157 :     warn "Trying to delete non-existant category '$category'.";
158 :     }
159 :    
160 :     return $self;
161 :     }
162 :    
163 :    
164 :     =pod
165 :    
166 :     =item * B<get_categories> ()
167 :    
168 :     Returns the names of all categories (in a random order).
169 :    
170 :     =cut
171 :    
172 :     sub get_categories {
173 :     return keys(%{$_[0]->{categories_index}});
174 :     }
175 :    
176 :    
177 :     =pod
178 :    
179 :     =item * B<add_entry> (I<category>, I<entry>, I<url>)
180 :    
181 :     Adds an entry and link to a existing category of the menu. I<category>, I<entry> and I<url> are mandatory. I<category> expects the name of the menu category. I<entry> can be any string, I<url> expects a url.
182 :     I<target> is optional and defines a href target for that link.
183 :    
184 :     =cut
185 :    
186 :     sub add_entry {
187 :     my ($self, $category, $entry, $url, $target) = @_;
188 :    
189 :     unless ($category and $entry and $url) {
190 :     confess "Missing parameter ('$category', '$entry', '$url').";
191 :     }
192 :    
193 :     unless (exists($self->{categories_index}->{$category})) {
194 :     confess "Trying to add to non-existant category '$category'.";
195 :     }
196 :    
197 :     $target = '' unless ($target);
198 :    
199 :     push @{$self->{entries}->{$category}}, [ $entry, $url, $target ];
200 :    
201 :     return $self;
202 :     }
203 :    
204 :     =pod
205 :    
206 :     =item * B<output> ()
207 :    
208 :     Returns the html output of the menu.
209 :    
210 :     =cut
211 :    
212 :     sub output {
213 :     my $self = shift;
214 :    
215 :     my $html = "<div id='menu'>\n";
216 :     $html .= "\t<ul id='nav'>\n";
217 :    
218 :     foreach (@{$self->{categories}}) {
219 :    
220 :     my ($cat, $c_url, $c_target) = @$_;
221 :     my $url = ($c_url) ? qq~href="$c_url"~ : '';
222 :     my $target = ($c_target) ? qq~target="$c_target"~ : '';
223 :    
224 :     $html .= qq~\t\t<li><div><a $url $target>$cat</a></div>\n~;
225 :    
226 :     if (scalar(@{$self->{entries}->{$cat}})) {
227 :    
228 :     $html .= "\t\t<ul>\n";
229 :    
230 :     foreach (@{$self->{entries}->{$cat}}) {
231 :    
232 :     my ($entry, $e_url, $e_target) = @$_;
233 :     my $target = ($e_target) ? qq~target="$e_target"~ : '';
234 :     $html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;
235 :     }
236 :    
237 :     $html .= "\t\t</ul>\n";
238 :    
239 :     }
240 :    
241 :     $html .= "\t\t</li>\n";
242 :    
243 :     }
244 :    
245 :     $html .= "\t</ul>\n";
246 :     $html .= "</div>\n";
247 :    
248 :     return $html;
249 :    
250 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3