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

View of /WebApplication/WebMenu.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.5 - (download) (as text) (annotate)
Wed Jun 27 21:04:32 2007 UTC (12 years, 8 months ago) by paczian
Branch: MAIN
Changes since 1.4: +29 -3 lines
added a space for a search component

package WebMenu;

# WebMenu - manage menu for the WeApplication framework

# $Id: WebMenu.pm,v 1.5 2007/06/27 21:04:32 paczian Exp $

use strict;
use warnings;

use Carp qw( confess );

use CGI;



=head1 NAME

WebMenu - manage menu for the WeApplication framework


use WebMenu;

my $menu = WebMenu->new();


$menu->add_entry("Edit", "Copy", "copy.cgi");

$menu->add_entry("Edit", "Paste", "paste.cgi", "_blank");



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 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.

=head1 METHODS

=over 4

=item * B<new> ()

Creates a new instance of the WebMenu object. 


sub new {
    my $class = shift;
    my $self = { home => undef,
		 entries => {},
		 categories => [],
		 categories_index => {},
		 search => 0,
    bless $self, $class;
    return $self;

=item * B<flush> ()

Flushes all categories and entries from the menu (leaving it empty).


sub flush {
    my $self = shift;
    $self->{home} = undef;
    $self->{entries} = {};
    $self->{categories} = [];
    $self->{categories_index} = {};
    $self->{search} = 0;
    return $self;

=item * B<home> (I<url>)

Returns the link of the home page. If the optional parameter I<url> is given, 
home will be set. I<url> may be undef.


sub home {
    my $self = shift;
    if (scalar(@_)) {
	$self->{home} = $_[0];
    return $self->{home};

=item * B<add_category> (I<category>, I<url>, I<target>, I<right>)

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. The optional I<right>
parameter specifies the right a user must have to be able to see this category.


sub add_category {
    my ($self, $category, $url, $target, $right, $order) = @_;
    unless ($category) {
	confess 'No category given.';

    unless ($order) {
      $order = scalar(@{$self->{categories}});

    if (exists($self->{categories_index}->{$category})) {
	confess "Trying to add category '$category' which already exists.";

    $url = '' unless ($url);
    $target = '' unless ($target);
    # update the category index
    $self->{categories_index}->{$category} = scalar(@{$self->{categories}});
    # add the category and link
    push @{$self->{categories}}, [ $category, $url, $target, $right, $order ];

    # init the entries array for that category
    $self->{entries}->{$category} = [];

    return $self;

=item * B<delete_category> (I<category>)

Deletes a category from the menu. I<category> is mandatory and expects the 
name of the menu category. If the category does not exist a warning is printed.


sub delete_category {
    my ($self, $category) = @_;
    unless ($category) {
	confess 'No category given.';

    my $i = $self->{categories_index}->{$category};
    if ($i) {
	splice @{$self->{categories}}, $i, 1;
	delete $self->{categories_index}->{$category};
	delete $self->{entries}->{$category}
    else {
	warn "Trying to delete non-existant category '$category'.";

    return $self;

=item * B<get_categories> ()

Returns the names of all categories (in a random order).


sub get_categories {
    return keys(%{$_[0]->{categories_index}});

=item * B<search> (I<search_component>)

Getter / Setter for the search component of the menu


sub search {
  my ($self, $search) = @_;

  if (defined($search)) {
    $self->{search} = $search;

  return $self->{search};


=item * B<add_entry> (I<category>, I<entry>, I<url>)

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. I<target> is optional and 
defines a href target for that link.


sub add_entry {
    my ($self, $category, $entry, $url, $target) = @_;
    unless ($category and $entry and $url) {
	confess "Missing parameter ('$category', '$entry', '$url').";

    unless (exists($self->{categories_index}->{$category})) {
	confess "Trying to add to non-existant category '$category'.";
    $target = '' unless ($target);

    push @{$self->{entries}->{$category}}, [ $entry, $url, $target ];

    return $self;


=item * B<output> (I<application>)

Returns the html output of the menu. I<application> must be a reference to the
application this menu is being printed in. This is only neccessary if rights
are required for any category to be displayed.


sub output {
  my ($self, $application) = @_;

  return '' unless scalar(@{$self->{categories}});

  my $html = "<div id='menu'>\n";
  $html .= "\t<ul id='nav'>\n";

  my @ordered_categories = sort { $a->[4] <=> $b->[4] } @{$self->{categories}};
  foreach (@ordered_categories) {
    my ($cat, $c_url, $c_target, $right, $order) = @$_;

    # check if a right is required to see this category
    if (defined($right)) {
      unless (defined($application) && ref($application) eq 'WebApplication') {
	confess "When using rights for a menu category, an application reference must be passed.";
      next unless ($application->session->user && $application->session->user->has_right($application, @$right));

    my $url = ($c_url) ? qq~href="$c_url"~ : '';
    my $target = ($c_target) ? qq~target="$c_target"~ : '';
    $html .= qq~\t\t<li><div><a $url $target>$cat</a></div>\n~;
    if (scalar(@{$self->{entries}->{$cat}})) {

      $html .= "\t\t<ul>\n";

      foreach (@{$self->{entries}->{$cat}}) {

	my ($entry, $e_url, $e_target) = @$_;
	my $target = ($e_target) ? qq~target="$e_target"~ : '';
	$html .= qq~\t\t\t<li><a href="$e_url" $target>$entry</a></li>\n~;
      $html .= "\t\t</ul>\n";

    $html .= "\t\t</li>\n";

  $html .= "\t</ul>\n";
  $html .= "<table style='position: absolute; right: 10px;'><tr>";
  # check for search module
  if ($self->search()) {
    $html .= "<td>".$self->search->output()."</td>";

  # display user string
  if ($application->session->user) {
    $html .= qq~<td><div id="user" style="padding-top: 2px;">
                <img height="15px" src="./Html/user.gif" title="Current User" />
                <strong>~ . $application->session->user->firstname . " " . $application->session->user->lastname . qq~</strong></div></td>~;
  $html .= "</tr></table>";

  $html .= "</div>\n";

  return $html;


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3