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

Diff of /WebApplication/WebMenu.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Thu Jan 11 16:45:32 2007 UTC revision 1.7, Thu Nov 15 21:53:40 2007 UTC
# Line 1  Line 1 
1  package WebMenu;  package WebMenu;
2    
3    # WebMenu - manage menu for the WeApplication framework
4    
5    # $Id$
6    
7  use strict;  use strict;
8  use warnings;  use warnings;
9    
 use Carp qw( confess );  
   
 use CGI;  
   
 1;  
10    
11  =pod  =pod
12    
# Line 32  Line 31 
31    
32  =head1 DESCRIPTION  =head1 DESCRIPTION
33    
34  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.  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  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.  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    
43  =head1 METHODS  =head1 METHODS
44    
# Line 53  Line 57 
57                   entries => {},                   entries => {},
58                   categories => [],                   categories => [],
59                   categories_index => {},                   categories_index => {},
60                     search => 0,
61      };      };
62      bless $self, $class;      bless $self, $class;
63    
# Line 74  Line 79 
79      $self->{entries} = {};      $self->{entries} = {};
80      $self->{categories} = [];      $self->{categories} = [];
81      $self->{categories_index} = {};      $self->{categories_index} = {};
82        $self->{search} = 0;
83      return $self;      return $self;
84  }  }
85    
# Line 82  Line 88 
88    
89  =item * B<home> (I<url>)  =item * B<home> (I<url>)
90    
91  Returns the link of the home page. If the optional parameter I<url> is given, home will be set.  Returns the link of the home page. If the optional parameter I<url> is given,
92  I<url> may be undef.  home will be set. I<url> may be undef.
93    
94  =cut  =cut
95    
# Line 98  Line 104 
104    
105  =pod  =pod
106    
107  =item * B<add_category> (I<category>, I<url>, I<target>)  =item * B<add_category> (I<category>, I<url>, I<target>, I<right>)
108    
109  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.  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    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    
114  =cut  =cut
115    
116  sub add_category {  sub add_category {
117      my ($self, $category, $url, $target) = @_;      my ($self, $category, $url, $target, $right, $order) = @_;
118    
119      unless ($category) {      unless ($category) {
120          confess 'No category given.';          die 'No category given.';
121        }
122    
123        unless ($order) {
124          $order = scalar(@{$self->{categories}});
125      }      }
126    
127      if (exists($self->{categories_index}->{$category})) {      if (exists($self->{categories_index}->{$category})) {
128          confess "Trying to add category '$category' which already exists.";          die "Trying to add category '$category' which already exists.";
129      }      }
130    
131      $url = '' unless ($url);      $url = '' unless ($url);
# Line 122  Line 135 
135      $self->{categories_index}->{$category} = scalar(@{$self->{categories}});      $self->{categories_index}->{$category} = scalar(@{$self->{categories}});
136    
137      # add the category and link      # add the category and link
138      push @{$self->{categories}}, [ $category, $url, $target ];      push @{$self->{categories}}, [ $category, $url, $target, $right, $order ];
139    
140      # init the entries array for that category      # init the entries array for that category
141      $self->{entries}->{$category} = [];      $self->{entries}->{$category} = [];
# Line 135  Line 148 
148    
149  =item * B<delete_category> (I<category>)  =item * B<delete_category> (I<category>)
150    
151  Deletes a category from the menu. I<category> is mandatory and expects the name of the menu category.  Deletes a category from the menu. I<category> is mandatory and expects the
152  If the category does not exist a warning is printed.  name of the menu category. If the category does not exist a warning is printed.
153    
154  =cut  =cut
155    
# Line 144  Line 157 
157      my ($self, $category) = @_;      my ($self, $category) = @_;
158    
159      unless ($category) {      unless ($category) {
160          confess 'No category given.';          die 'No category given.';
161      }      }
162    
163      my $i = $self->{categories_index}->{$category};      my $i = $self->{categories_index}->{$category};
# Line 173  Line 186 
186      return keys(%{$_[0]->{categories_index}});      return keys(%{$_[0]->{categories_index}});
187  }  }
188    
189    =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    
207  =pod  =pod
208    
209  =item * B<add_entry> (I<category>, I<entry>, I<url>)  =item * B<add_entry> (I<category>, I<entry>, I<url>)
210    
211  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.  Adds an entry and link to a existing category of the menu. I<category>, I<entry>
212  I<target> is optional and defines a href target for that link.  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    
216  =cut  =cut
217    
218  sub add_entry {  sub add_entry {
219      my ($self, $category, $entry, $url, $target) = @_;      my ($self, $category, $entry, $url, $target) = @_;
220    
221      unless ($category and $entry and $url) {      unless ($category and $entry){# and $url) {
222          confess "Missing parameter ('$category', '$entry', '$url').";          die "Missing parameter ('$category', '$entry', '$url').";
223      }      }
224    
225      unless (exists($self->{categories_index}->{$category})) {      unless (exists($self->{categories_index}->{$category})) {
226          confess "Trying to add to non-existant category '$category'.";          die "Trying to add to non-existant category '$category'.";
227      }      }
228    
229      $target = '' unless ($target);      $target = '' unless ($target);
# Line 203  Line 235 
235    
236  =pod  =pod
237    
238  =item * B<output> ()  =item * B<output> (I<application>)
239    
240  Returns the html output of the menu.  Returns the html output of the menu. I<application> must be a reference to the
241    application this menu is being printed in. This is only neccessary if rights
242    are required for any category to be displayed.
243    
244  =cut  =cut
245    
246  sub output {  sub output {
247    my $self = shift;    my ($self, $application) = @_;
248    
249      return '' unless scalar(@{$self->{categories}});
250    
251    my $html = "<div id='menu'>\n";    my $html = "<div id='menu'>\n";
252    $html .= "\t<ul id='nav'>\n";    $html .= "\t<ul id='nav'>\n";
253    
254    foreach (@{$self->{categories}}) {    my @ordered_categories = sort { $a->[4] <=> $b->[4] } @{$self->{categories}};
255      foreach (@ordered_categories) {
256    
257        my ($cat, $c_url, $c_target, $right, $order) = @$_;
258    
259        # check if a right is required to see this category
260        if (defined($right)) {
261          unless (defined($application) && ref($application) eq 'WebApplication') {
262            die "When using rights for a menu category, an application reference must be passed.";
263          }
264          next unless ($application->session->user &&
265                       $application->session->user->has_right($application, @$right));
266        }
267    
     my ($cat, $c_url, $c_target) = @$_;  
268      my $url = ($c_url) ? qq~href="$c_url"~ : '';      my $url = ($c_url) ? qq~href="$c_url"~ : '';
269      my $target = ($c_target) ? qq~target="$c_target"~ : '';      my $target = ($c_target) ? qq~target="$c_target"~ : '';
270    
# Line 230  Line 277 
277        foreach (@{$self->{entries}->{$cat}}) {        foreach (@{$self->{entries}->{$cat}}) {
278    
279          my ($entry, $e_url, $e_target) = @$_;          my ($entry, $e_url, $e_target) = @$_;
280            if ($e_url) {
281          my $target = ($e_target) ? qq~target="$e_target"~ : '';          my $target = ($e_target) ? qq~target="$e_target"~ : '';
282          $html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;          $html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;
283            } else {
284              $html .= qq~\t\t\t<li>$entry</li>\n~;
285            }
286        }        }
287    
288        $html .= "\t\t</ul>\n";        $html .= "\t\t</ul>\n";
# Line 243  Line 294 
294    }    }
295    
296    $html .= "\t</ul>\n";    $html .= "\t</ul>\n";
297    
298    $html .= "</div>\n";    $html .= "</div>\n";
299    
300    return $html;    return $html;
301    
302  }  }
303    
304    1;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3