Commits

Shlomi Fish committed 574da43

Remove some old and stray files.

  • Participants
  • Parent commits 21b1591

Comments (0)

Files changed (28)

Changes

-Revision history for Perl extension Shlomif::NavMenu.
-
-0.01  Sat Sep 11 12:58:17 2004
-	- original version; created by h2xs 1.23 with options
-		-b 5.6.0 -X -cfn Shlomif::NavMenu
-

HTML/Widgets/NavMenu/Test/Data.pm

-package HTML::Widgets::NavMenu::Test::Data;
-
-use strict;
-
-use Exporter;
-use vars qw(@ISA);
-@ISA=qw(Exporter);
-
-use vars qw(@EXPORT);
-
-@EXPORT = qw(get_test_data);
-
-my @minimal_nav_menu =
-(
-    'current_host' => "default",
-    'hosts' => { 'default' => { 'base_url' => "http://www.hello.com/" }, },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-            },
-        ],
-    },
-);
-
-my @two_sites_data =
-(
-    'current_host' => "default",
-    'hosts' =>
-    {
-        'default' =>
-        {
-            'base_url' => "http://www.hello.com/",
-        },
-        'other' => 
-        { 
-            'base_url' => "http://www.other-url.co.il/~shlomif/", 
-        },
-    },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-                'subs' =>
-                [
-                    {
-                        'url' => "round/hello/personal.html",
-                        'value' => "Bio",
-                        'title' => "Biography of Myself",
-                    },
-                    {
-                        'url' => "round/toto/",
-                        'value' => "Gloria",
-                        'title' => "A Useful Conspiracy",
-                    },
-                ],
-            },
-            {
-                'value' => "Tam Tam Drums",
-                'title' => "Drumming is good for your health",
-                'url' => "hoola/",
-                'host' => "other",
-                'subs' =>
-                [
-                    {
-                        'url' => "hello/hoop.html",
-                        'title' => "Hoola Hoops Rulez and Ownz!",
-                        'value' => "Hoola Hoops",
-                        'host' => "default",
-                    },
-                    {
-                        'url' => "tetra/",
-                        'value' => "Tetrahedron",
-                        'subs' =>
-                        [
-                            {
-                                'url' => "tetra/one/",
-                                'value' => "Tetra One",
-                                'title' => "Tetra One Title",
-                            },
-                        ],
-                    },
-                ],
-            },
-        ],
-    },
-);
-
-my @expand_re_nav_menu =
-(
-    'current_host' => "default",
-    'hosts' => { 'default' => { 'base_url' => "http://www.hello.com/" }, },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-            },
-            {
-                'value' => "Foo",
-                'title' => "Fooish",
-                'url' => "foo/",
-                'subs' =>
-                [
-                    {
-                        'value' => "Expanded",
-                        'title' => "Expanded",
-                        'url' => "foo/expanded/",
-                        'expand_re' => "",
-                    },
-                ],
-            }
-        ],
-    },
-);
-
-my @show_always_nav_menu =
-(
-    'current_host' => "default",
-    'hosts' => { 'default' => { 'base_url' => "http://www.hello.com/" }, },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-            },
-            {
-                'value' => "Show Always",
-                'url' => "show-always/",
-                'show_always' => 1,
-                'subs' =>
-                [
-                    {
-                        'value' => "Gandalf",
-                        'url' => "show-always/gandalf/",
-                    },
-                    {
-                        'value' => "Robin",
-                        'url' => "robin/",
-                        'subs' =>
-                        [
-                            {
-                                'value' => "Hood",
-                                'url' => "robin/hood/",
-                            },
-                        ],
-                    },
-                    {
-                        'value' => "Queen Esther",
-                        'url' => "esther/",
-                        'subs' =>
-                        [
-                            {
-                                'value' => "Haman",
-                                'url' => "haman/",
-                            },
-                        ],
-                    },
-                ],
-            },
-        ],
-    },
-);
-
-my @items_in_sub_nav_menu =
-(
-    'current_host' => "default",
-    'hosts' =>
-    {
-        'default' =>
-        {
-            'base_url' => "http://www.hello.com/",
-        },
-    },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-                'subs' =>
-                [
-                    {
-                        'url' => "me/bio.html",
-                        'value' => "Bio",
-                        'title' => "Biography of Myself",
-                    },
-                    {
-                        'url' => "me/gloria/",
-                        'value' => "Gloria",
-                        'title' => "A Useful Conspiracy",
-                    },
-                ],
-            },
-            {
-                'value' => "Tam Tam Drums",
-                'title' => "Drumming is good for your health",
-                'url' => "hoola/",
-            },
-        ],
-    },
-);
-
-my @separator_nav_menu =
-(
-    'current_host' => "default",
-    'hosts' => { 'default' => { 'base_url' => "http://www.hello.com/" }, },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-                'subs' =>
-                [
-                    {
-                        'value' => "Group Hug",
-                        'url' => "me/group-hug/",
-                    },
-                    {
-                        'value' => "Cool I/O",
-                        'url' => "me/cool-io/",
-                    },
-                    {
-                        'separator' => 1,
-                        'skip' => 1,
-                    },
-                    {
-                        'value' => "Resume",
-                        'url' => "resume.html",
-                    },
-                ],
-            },
-            {
-                'separator' => 1,
-                'skip' => 1,
-            },
-            {
-                'value' => "Halifax",
-                'url' => "halifax/",
-            },
-        ],
-    },
-);
-
-my @hidden_item_nav_menu =
-(
-    'current_host' => "default",
-    'hosts' => { 'default' => { 'base_url' => "http://www.hello.com/" }, },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-                'subs' =>
-                [
-                    {
-                        'value' => "Visible",
-                        'url' => "me/visible/",
-                    },
-                    {
-                        'value' => "Hidden",
-                        'url' => "me/hidden/",
-                        'hide' => 1,
-                    },
-                    {
-                        'value' => "Visible Too",
-                        'url' => "me/visible-too/",
-                    },
-                ],
-            },
-        ],
-    },
-);
-
-my @header_role_nav_menu =
-(
-    'current_host' => "default",
-    'hosts' => { 'default' => { 'base_url' => "http://www.hello.com/" }, },
-    'tree_contents' =>
-    {
-        'host' => "default",
-        'value' => "Top 1",
-        'title' => "T1 Title",
-        'expand_re' => "",
-        'subs' =>
-        [
-            {
-                'value' => "Home",
-                'url' => "",
-            },
-            {
-                'value' => "About Me",
-                'title' => "About Myself",
-                'url' => "me/",
-                'role' => "header",
-                'show_always' => 1,
-                'subs' =>
-                [
-                    {
-                        'value' => "Sub Me",
-                        'url' => "me/sub-me1/",
-                    },
-                    {
-                        'value' => "Sub Me 2",
-                        'url' => "me/sub-me-two/",
-                    },
-                ],
-            },
-        ],
-    },
-);
-
-
-sub get_test_data
-{
-    return
-        {
-            'two_sites' => \@two_sites_data,
-            'minimal' => \@minimal_nav_menu,
-            'expand_re' => \@expand_re_nav_menu,
-            'show_always' => \@show_always_nav_menu,
-            'items_in_sub' => \@items_in_sub_nav_menu,
-            'separator' => \@separator_nav_menu,
-            'hidden_item' => \@hidden_item_nav_menu,
-            'header_role' => \@header_role_nav_menu,
-        };
-}
-
-1;

HTML/Widgets/NavMenu/Test/Util.pm

-package HTML::Widgets::NavMenu::Test::Util;
-
-use strict;
-
-use Exporter;
-use vars qw(@ISA);
-@ISA=qw(Exporter);
-
-use vars qw(@EXPORT);
-
-@EXPORT = qw(compare_string_arrays);
-
-sub compare_string_arrays
-{
-    my $arr1 = shift;
-    my $arr2 = shift;
-    my $len_cmp = (@$arr1 <=> @$arr2);
-    if ($len_cmp)
-    {
-        print STDERR "Len is not the same: Expected " . scalar(@$arr1) . " vs. Result " . scalar(@$arr2) . "\n";
-        return $len_cmp;
-    }
-    my $i;
-    for($i=0;$i<@$arr1;$i++)
-    {
-        my $item_cmp = $arr1->[$i] cmp $arr2->[$i];
-        if ($item_cmp)
-        {
-            print STDERR "Item[$i] is not the same:\nExpected: $arr1->[$i]\nResult: $arr2->[$i]\n";
-            return $item_cmp;
-        }
-    }
-    return 0;
-}
-
-1;

MANIFEST

-Changes
-Makefile.PL
-MANIFEST
-README
-TODO
-t/00use.t
-t/01unit.t
-t/02site-map.t
-t/03nav-links.t
-t/04nav-menu.t
-t/05stack.t
-t/06tree-iter-item.t
-t/07tree-iter.t
-t/08tree-node.t
-lib/Shlomif/NavMenu/Iterator/Base.pm
-lib/Shlomif/NavMenu/Iterator/Html.pm
-lib/Shlomif/NavMenu/Iterator/NavMenu.pm
-lib/Shlomif/NavMenu/Iterator/SiteMap.pm
-lib/Shlomif/NavMenu/Object.pm
-lib/Shlomif/NavMenu.pm
-lib/Shlomif/NavMenu/Tree/Iterator/Item.pm
-lib/Shlomif/NavMenu/Tree/Iterator.pm
-lib/Shlomif/NavMenu/Tree/Iterator/Stack.pm
-lib/Shlomif/NavMenu/Tree/Node.pm
-lib/Shlomif/NavMenu/Url.pm
-META.yml                                 Module meta-data (added by MakeMaker)
-HTML/Widgets/NavMenu/Test/Data.pm
-HTML/Widgets/NavMenu/Test/Util.pm

META.yml

-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Shlomif-NavMenu
-version:      0.1.9
-version_from: lib/Shlomif/NavMenu.pm
-installdirs:  site
-requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17

Makefile.PL

-use 5.006;
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
-    NAME              => 'Shlomif::NavMenu',
-    VERSION_FROM      => 'lib/Shlomif/NavMenu.pm', # finds $VERSION
-    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
-    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
-      (AUTHOR         => 'Shlomi Fish <shlomif@iglu.org.il>') : ()),
-);

README

-Shlomif-NavMenu version 0.01
-============================
-
-The README is used to introduce the module and provide instructions on
-how to install the module, any machine dependencies it may have (for
-example C compilers and installed libraries) and any other information
-that should be provided before the module is installed.
-
-A README file is required for CPAN modules since CPAN extracts the
-README file from a module distribution so that people browsing the
-archive can use it get an idea of the modules uses. It is usually a
-good idea to provide version information here so that people can
-decide whether fixes for the module are worth downloading.
-
-INSTALLATION
-
-To install this module type the following:
-
-   perl Makefile.PL
-   make
-   make test
-   make install
-
-DEPENDENCIES
-
-This module requires these other modules and libraries:
-
-  blah blah blah
-
-COPYRIGHT AND LICENCE
-
-Put the correct copyright and licence information here.
-
-Copyright (C) 2004 by Shlomi Fish
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself, either Perl version 5.8.3 or,
-at your option, any later version of Perl 5 you may have available.
-
-

TODO

-* Use Build.PL instead of Makefile.PL. (?)
-
-* Make 'expand_always', 'expand_cb' directives.
-
-* Move to the HTML::Widgets::NavMenu namespace.
-
-* Build a non-unit test of the homepage and perl-begin.
-
-* Move the trunk to trunk/module.
-

lib/Shlomif/NavMenu.pm

-#!/usr/bin/perl -w
-
-use utf8;
-
-package Shlomif::NavMenu;
-
-our $VERSION = '0.1.9';
-
-package Shlomif::NavMenu::Error;
-
-use strict;
-
-use Error qw(:try);
-
-use base "Error";
-
-package Shlomif::NavMenu::Error::Redirect;
-
-use strict;
-use vars qw(@ISA);
-@ISA=("Shlomif::NavMenu::Error");
-
-sub CGIpm_perform_redirect
-{
-    my $self = shift;
-
-    my $q = shift;
-
-    print $q->redirect($q->script_name() . $self->{-redirect_path});
-    exit;
-}
-
-package Shlomif::NavMenu::LeadingPath::Component;
-
-use strict;
-
-use base qw(Shlomif::NavMenu::Object);
-use base qw(Class::Accessor);
-
-__PACKAGE__->mk_accessors(
-    qw(host host_url title label direct_url)
-    );
-
-sub initialize
-{
-    my $self = shift;
-
-    my %args = (@_);
-
-    while (my ($k, $v) = each(%args))
-    {
-        $self->set($k,$v);
-    }
-    
-    return 0;
-}
-
-1;
-
-package Shlomif::NavMenu;
-
-use strict;
-
-use lib ".";
-use Shlomif::NavMenu::Url;
-use Error qw(:try);
-
-require Shlomif::NavMenu::Iterator::NavMenu;
-require Shlomif::NavMenu::Iterator::SiteMap;
-require Shlomif::NavMenu::Tree::Node;
-
-sub new
-{
-    my $class = shift;
-    my $self = {};
-    bless $self, $class;
-    $self->initialize(@_);
-    return $self;
-}
-
-sub initialize
-{
-    my $self = shift;
-
-    my %args = (@_);
-
-    $self->_register_path_info(\%args);
-
-    $self->{hosts} = $args{hosts};
-    $self->{tree_contents} = $args{tree_contents};
-
-    my $current_host = $args{current_host} || "";
-
-    $self->{current_host} = $current_host;
-
-    return 0;
-}
-
-sub get_nav_menu_traverser
-{
-    my $self = shift;
-
-    return
-        Shlomif::NavMenu::Iterator::NavMenu->new(
-            'nav_menu' => $self,
-        );
-}
-
-sub get_current_coords
-{
-    my $self = shift;
-
-    # This is to make sure $self->{current_coords} is generated.
-    $self->get_traversed_tree();
-
-    return [ @{$self->{current_coords}} ];
-}
-
-sub _register_path_info
-{
-    my $self = shift;
-    my $args = shift;
-
-    my $path_info = $args->{path_info};
-
-    my $redir_path = undef;
-
-    if ($path_info eq "")
-    {
-        $redir_path = "";
-    }
-    elsif ($path_info =~ m/\/\/$/)
-    {
-        my $path = $path_info;
-        $path =~ s{\/+$}{};
-        $redir_path = $path;
-    }
-
-    if (defined($redir_path))
-    {
-        throw Shlomif::NavMenu::Error::Redirect
-            -redirect_path => ($redir_path."/");
-    }
-
-    $path_info =~ s!^\/!!;
-
-    $self->{path_info} = $path_info;
-
-    return 0;
-}
-
-sub is_slash_terminated
-{
-    my $string = shift;
-    return (($string =~ /\/$/) ? 1 : 0);
-}
-
-sub text_to_url_obj
-{
-    my $text = shift;
-    my $url = 
-        Shlomif::NavMenu::Url->new(
-            $text,
-            (is_slash_terminated($text) || ($text eq "")),
-            "server",
-        );
-    return $url;
-}
-
-sub get_relative_url
-{
-    my $from_text = shift;
-    my $to_text = shift(@_);
-
-    my $from_url = text_to_url_obj($from_text);
-    my $to_url = text_to_url_obj($to_text);
-    my $ret = 
-        $from_url->get_relative_url(
-            $to_url, 
-            is_slash_terminated($from_text)
-        );
-   return $ret;
-}
-
-sub path_info
-{
-    my $self = shift;
-    return $self->{path_info};
-}
-
-sub get_cross_host_rel_url
-{
-    my $self = shift;
-    my %args = (@_);
-    my $host = $args{host};
-    my $host_url = $args{host_url};
-    my $abs_url = $args{abs_url};
-
-    if ($abs_url)
-    {
-        return $host_url;
-    }
-
-    return
-        ($host eq $self->{current_host}) ?
-            get_relative_url(
-                $self->path_info(),
-                $host_url
-            ) :
-            ($self->{hosts}->{$host}->{base_url} . $host_url);
-}
-
-sub gen_blank_nav_menu_tree_node
-{
-    my $self = shift;
-
-    return Shlomif::NavMenu::Tree::Node->new();
-}
-
-sub create_new_nav_menu_item
-{
-    my $self = shift;
-    my %args = (@_);
-
-    my $sub_contents = $args{sub_contents};
-    my $coords = $args{coords};
-    my $host = $sub_contents->{host} || $args{host} or
-        die "Host not specified!";
-
-    my $new_item = $self->gen_blank_nav_menu_tree_node();
-
-    foreach my $key (qw(host role show_always title url value))
-    {
-        if (exists($sub_contents->{$key}))
-        {
-            $new_item->set($key, $sub_contents->{$key});
-        }
-    }
-
-    foreach my $key (qw(hide separator))
-    {
-        if ($sub_contents->{$key})
-        {
-            $new_item->set($key, 1);
-        }
-    }
-
-    if (exists($sub_contents->{expand_re}))
-    {
-        my $regexp = $sub_contents->{expand_re};
-        # If $regexp is empty - then always succeeed.
-        # This is because a pattern match in which the pattern
-        # evaluates to an empty regexp uses the last successful pattern
-        # match.
-        if (($regexp eq "") || ($self->path_info() =~ /$regexp/))
-        {
-            $new_item->expand();
-        }
-    }
-
-    return $new_item;
-}
-
-sub render_tree_contents
-{
-    my $self = shift;
-
-    my %args = (@_);
-
-    my $path_info = $self->path_info();    
-
-    my $sub_contents = $args{sub_contents};
-    my $coords = $args{coords};
-    my $host = $sub_contents->{host} || $args{host} or
-        die "Host not specified!";
-    my $current_coords_ptr = $args{current_coords_ptr};
-
-    my $new_item =
-        $self->create_new_nav_menu_item(
-            %args,
-        );
-
-    if (exists($sub_contents->{url}))
-    {
-        if (($sub_contents->{url} eq $path_info) && ($host eq $self->{current_host}))
-        {
-            $$current_coords_ptr = [ @$coords ];
-            $new_item->mark_as_current();
-        }
-    }
-
-    if (exists($sub_contents->{subs}))
-    {
-        my $index = 0;
-        my $subs = [];
-        foreach my $sub_contents_sub (@{$sub_contents->{subs}})
-        {
-            $new_item->add_sub(
-                $self->render_tree_contents(
-                    'sub_contents' => $sub_contents_sub,
-                    'coords' => [@$coords, $index],
-                    'host' => $host,
-                    'current_coords_ptr' => $current_coords_ptr,
-                )
-            );
-        }
-        continue
-        {
-            $index++;
-        }
-    }
-    return $new_item;
-}
-
-
-
-sub gen_site_map
-{
-    my $self = shift;
-
-    my $iterator = 
-        Shlomif::NavMenu::Iterator::SiteMap->new(
-            'nav_menu' => $self,
-        );
-
-    $iterator->traverse();
-
-    return $iterator->get_results();
-}
-
-sub get_next_coords
-{
-    my $self = shift;
-
-    my @coords = @{shift || $self->get_current_coords};
-
-    my @branches = ($self->{tree_contents});
-
-    my @dest_coords;
-
-    my $i;
-
-    for($i=0;$i<scalar(@coords);$i++)
-    {
-        $branches[$i+1] = $branches[$i]->{'subs'}->[$coords[$i]];
-    }
-
-    if (exists($branches[$i]->{'subs'}))
-    {
-        @dest_coords = (@coords,0);
-    }
-    else
-    {
-        for($i--;$i>=0;$i--)
-        {
-            if (scalar(@{$branches[$i]->{'subs'}}) > ($coords[$i]+1))
-            {
-                @dest_coords = (@coords[0 .. ($i-1)], $coords[$i]+1);
-                last;
-            }
-        }
-        if ($i == -1)
-        {
-            return undef;
-        }
-    }
-
-    return \@dest_coords;
-}
-
-sub get_prev_coords
-{
-    my $self = shift;
-
-    my @coords = @{shift || $self->get_current_coords()};
-
-    if (scalar(@coords) == 0)
-    {
-        return undef;
-    }    
-    elsif ($coords[$#coords] > 0)
-    {
-        # Get the previous leaf
-	    my @previous_leaf = 
-	        ( 
-                @coords[0 .. ($#coords - 1) ] ,
-                $coords[$#coords]-1
-            );
-        # Continue in this leaf to the end.
-        my $new_coords = $self->get_most_advanced_leaf(\@previous_leaf);
-
-        return $new_coords;
-    }
-    elsif (scalar(@coords) > 0)
-    {
-        return [ @coords[0 .. ($#coords-1)] ];
-    }
-    else
-    {
-        return undef;
-    }
-}
-
-sub get_up_coords
-{
-    my $self = shift;
-
-    my @coords = @{shift || $self->get_current_coords};
-
-    if (scalar(@coords) == 0)
-    {
-        return undef;
-    }
-    else
-    {
-        if ((@coords == 1) && ($coords[0] > 0))
-        {
-            return [0];
-        }
-        pop(@coords);
-        return \@coords;
-    }
-}
-
-sub get_top_coords
-{
-    my $self = shift;
-
-    my @coords = @{shift || $self->get_current_coords()};
-
-    if ((! @coords) || ((@coords == 1) && ($coords[0] == 0)))
-    {
-        return undef;
-    }
-    else
-    {
-        return [0];
-    }
-}
-
-sub find_node_by_coords
-{
-    my $self = shift;
-    my $coords = shift;
-    my $callback = shift || (sub { });
-    my $ptr = $self->{tree_contents};
-    my $host = $ptr->{host};
-    my $idx = 0;
-    my $internal_callback = sub {
-        $callback->('idx' => $idx, 'ptr' => $ptr, 'host' => $host);
-    };
-    $internal_callback->();
-    foreach my $c (@$coords)
-    {
-        $ptr = $ptr->{subs}->[$c];
-        $idx++;
-        if ($ptr->{host})
-        {
-            $host = $ptr->{host};
-        }
-        $internal_callback->();
-    }
-    return { 'ptr' => $ptr, 'host' => $host };
-}
-
-sub is_skip
-{
-    my $self = shift;
-    my $coords = shift;
-
-    my $ret = $self->find_node_by_coords($coords);
-
-    my $ptr = $ret->{ptr};
-
-    return $ptr->{skip};
-}
-
-sub get_coords_while_skipping_skips
-{
-    my $self = shift;
-
-    my $callback = shift;
-    my $coords = shift || $self->get_current_coords();
-    
-    my $do_once = 1;
-
-    while ($do_once || $self->is_skip($coords))
-    {
-        $coords = $callback->($self, $coords);
-    }
-    continue
-    {
-        $do_once = 0;
-    }
-
-    return $coords;
-}
-
-sub get_most_advanced_leaf
-{
-    my $self = shift;
-
-    # We accept as a parameter the vector of coordinates
-    my $coords_ref = shift;
-
-    my @coords = @{$coords_ref};
-
-    # Get a reference to the contents HDS (= hierarchial data structure)
-    my $branch = $self->{tree_contents};
-
-    # Get to the current branch by advancing to the offset 
-    foreach my $c (@coords)
-    {
-        # Advance to the next level which is at index $c
-        $branch = $branch->{'subs'}->[$c];
-    }
-
-    # As long as there is something deeper
-    while (exists($branch->{'subs'}))
-    {
-        # Get the index of the most advanced sub-branch
-        my $index = scalar(@{$branch->{'subs'}})-1;
-        # We are going to return it, so store it
-        push @coords, $index;
-        # Recurse into the sub-branch
-        $branch = $branch->{'subs'}->[$index];
-    }
-    
-    return \@coords;
-}
-
-sub get_rel_url_from_coords
-{
-    my $self = shift;
-    my $coords = shift;
-
-    my ($ptr,$host);
-    my $node_ret = $self->find_node_by_coords($coords);
-    $ptr = $node_ret->{ptr};
-    $host = $node_ret->{host};
-
-    return $self->get_cross_host_rel_url(
-        'host' => $host,
-        'host_url' => ($ptr->{url} || ""),
-        'abs_url' => $ptr->{abs_url},
-    );
-}
-
-sub fill_leading_path
-{
-    my $self = shift;
-
-    my %args = (@_);
-
-    my $coords = $self->get_current_coords();
-
-    $self->find_node_by_coords($coords, $args{'callback'});
-}
-
-# The traversed_tree is the tree that is calculated from the tree given
-# by the user and some other parameters such as the host and path_info.
-# It is passed to the NavMenu::Iterator::* classes as argument.
-sub get_traversed_tree
-{
-    my $self = shift;
-
-    if (! $self->{'traversed_tree'})
-    {
-        my $gen_retval = $self->gen_traversed_tree();
-        $self->{'traversed_tree'} = $gen_retval->{'tree'};
-        $self->{'current_coords'} = $gen_retval->{'current_coords'};
-    }
-    return $self->{'traversed_tree'};
-}
-
-sub gen_traversed_tree
-{
-    my $self = shift;
-
-    my $current_coords = [];
-
-    my $tree = 
-        $self->render_tree_contents(
-            'sub_tree' => undef,
-            'sub_contents' => $self->{tree_contents},
-            'coords' => [],
-            'current_coords_ptr' => \$current_coords,
-            );
-
-    # The root should always be expanded because:
-    # 1. If one of the leafs was marked as expanded so will its ancestors
-    #    and eventually the root.
-    # 2. If nothing was marked as expanded, it should still be marked as 
-    #    expanded so it will expand.
-    $tree->expand();
-   
-    return {'tree' => $tree, 'current_coords' => $current_coords };
-}
-
-sub render
-{
-    my $self = shift;
-
-    my %args = (@_);
-
-    my $iterator = $self->get_nav_menu_traverser();
-    $iterator->traverse();
-    my $html = [ @{$iterator->{'html'}} ];
-    
-    my $hosts = $self->{hosts};
-
-    my @leading_path;
-
-    {
-        my $fill_leading_path_callback =
-            sub {
-                my %args = (@_);
-                my $ptr = $args{ptr};
-                my $host = $args{host};
-                $host = $ptr->{host} if ($ptr->{host});
-                # This is a workaround for the root link.
-                my $host_url = $ptr->{url} || "";
-
-                push @leading_path,
-                    Shlomif::NavMenu::LeadingPath::Component->new(
-                        'host' => $host,
-                        'host_url' => $host_url,
-                        'title' => $ptr->{title},
-                        'label' => $ptr->{value},
-                        'direct_url' =>
-                            $self->get_cross_host_rel_url(
-                                'host' => $host,
-                                'host_url' => $host_url,
-                                'abs_url' => $ptr->{abs_url},
-                            ),
-                    );
-            };
-
-        $self->fill_leading_path(
-            'callback' => $fill_leading_path_callback,
-        );
-    }
-
-    my %nav_links;
-
-    my %links_proto = 
-        (
-            'prev' => $self->get_coords_while_skipping_skips(
-                        \&get_prev_coords),
-            'next' => $self->get_coords_while_skipping_skips(
-                        \&get_next_coords),
-            'up' => $self->get_up_coords(),
-            'top' => $self->get_top_coords(),
-        );
-
-    while (my ($link_rel, $coords) = each(%links_proto))
-    {
-        # This is so we would avoid coordinates that point to the 
-        # root ($coords == []).
-        if (defined($coords) && @$coords == 0)
-        {
-            undef($coords);
-        }
-        if (defined($coords))
-        {
-            $nav_links{$link_rel} = $self->get_rel_url_from_coords($coords);
-        }
-    }
-
-    my $js_code = "";
-    
-    return 
-        {
-            'html' => $html,
-            'leading_path' => \@leading_path,
-            'nav_links' => \%nav_links,
-        };
-}
-
-1;
-

lib/Shlomif/NavMenu/Iterator/Base.pm

-package Shlomif::NavMenu::Iterator::Base;
-
-use strict;
-use warnings;
-
-use base qw(Shlomif::NavMenu::Tree::Iterator);
-
-use CGI;
-
-sub initialize
-{
-    my $self = shift;
-
-    $self->SUPER::initialize(@_);
-
-    my %args = (@_);
-
-    $self->{'nav_menu'} = $args{'nav_menu'} or
-        die "nav_menu not specified!";
-
-    $self->{'html'} = [];
-
-    return 0;
-}
-
-sub nav_menu
-{
-    my $self = shift;
-    return $self->{'nav_menu'};
-}
-
-sub _add_tags
-{
-    my $self = shift;
-    push (@{$self->{'html'}}, @_);
-}
-
-sub _is_root
-{
-    my $self = shift;
-
-    return ($self->stack->len() == 1);
-}
-
-sub _is_top_separator
-{
-    my $self = shift;
-
-    return $self->top->node->separator;
-}
-
-sub _get_top_host
-{
-    my $self = shift;
-
-    return 
-        $self->top->accum_state->{'host'};
-}
-
-sub get_initial_node
-{
-    my $self = shift;
-    return $self->nav_menu->get_traversed_tree();
-}
-
-sub get_node_subs
-{
-    my $self = shift;
-    my %args = (@_);
-    my $node = $args{'node'};
-    return [ @{$node->subs()} ];
-}
-
-sub get_new_accum_state
-{
-    my $self = shift;
-    my %args = (@_);
-    my $parent_item = $args{'item'};
-    my $node = $args{'node'};
-    
-    my $prev_state;
-    if (defined($parent_item))
-    {
-        $prev_state = $parent_item->accum_state();
-    }
-    else
-    {
-        $prev_state = +{};
-    }
-
-    my $show_always = 0;
-    if (exists($prev_state->{'show_always'}))
-    {
-        $show_always = $prev_state->{'show_always'};
-    }
-    if (defined($node->show_always()))
-    {
-        $show_always = $node->show_always();
-    }
-    return 
-        { 
-            'host' => ($node->host() || $prev_state->{'host'}),
-            'show_always' => $show_always,
-        };
-}
-
-sub get_results
-{
-    my $self = shift;
-
-    return join("", map { "$_\n" } @{$self->{'html'}});
-}
-
-1;
-

lib/Shlomif/NavMenu/Iterator/Html.pm

-package Shlomif::NavMenu::Iterator::Html;
-
-use base qw(Shlomif::NavMenu::Iterator::Base);
-
-sub node_start
-{
-    my $self = shift;
-
-    if ($self->_is_root())
-    {
-        return $self->start_root();
-    }
-    elsif ($self->_is_top_separator())
-    {
-        # start_sep() is short for start_separator().
-        return $self->start_sep();
-    }
-    else
-    {
-        return $self->start_regular();
-    }
-}
-
-sub node_end
-{
-    my $self = shift;
-
-    if ($self->_is_root())
-    {
-        return $self->end_root();
-    }
-    elsif ($self->_is_top_separator())
-    {
-        return $self->end_sep();
-    }
-    else
-    {
-        return $self->end_regular();
-    }
-}
-
-sub end_root
-{
-    my $self = shift;
-
-    $self->_add_tags("</ul>");
-}
-
-sub end_regular
-{
-    my $self = shift;
-    if ($self->top()->num_subs() && $self->is_expanded())
-    {
-        $self->_add_tags("</ul>");
-    }
-    $self->_add_tags("</li>");
-}
-
-sub node_should_recurse
-{
-    my $self = shift;
-    return $self->is_expanded();
-}
-
-# Get the HTML <a href=""> tag.
-#
-sub get_a_tag
-{
-    my $self = shift;
-    my $node = $self->top->node;
-
-    my $tag ="<a";
-    my $title = $node->title;
-
-    $tag .= " href=\"" .
-        CGI::escapeHTML(
-            $self->nav_menu()->get_cross_host_rel_url(
-                'host' => $self->_get_top_host(),
-                'host_url' => $node->url(),
-            )
-        ). "\"";
-    if (defined($title))
-    {
-        $tag .= " title=\"$title\"";
-    }
-    $tag .= ">" . $node->value() . "</a>";
-    return $tag;
-}
-
-1;
-

lib/Shlomif/NavMenu/Iterator/NavMenu.pm

-package Shlomif::NavMenu::Iterator::NavMenu;
-
-use base qw(Shlomif::NavMenu::Iterator::Html);
-
-sub start_root
-{
-    my $self = shift;
-    
-    $self->_add_tags("<ul class=\"navbarmain\">");
-}
-
-sub start_sep
-{
-    my $self = shift;
-
-    $self->_add_tags("</ul>");
-}
-
-
-sub start_regular
-{
-    my $self = shift;
-
-    my $top_item = $self->top;
-    my $node = $self->top->node();
-
-    if ($self->is_hidden())
-    {
-        # Do nothing
-    }
-    else
-    {
-        my $tag;
-        if ($node->CurrentlyActive())
-        {
-            $tag = "<b>" . $node->value() . "</b>";
-        }
-        else
-        {
-            $tag = $self->get_a_tag();
-        }
-        my @tags_to_add;
-        if ($self->is_role_header())
-        {
-            @tags_to_add = ("</ul>","<h2>", $tag, "</h2>",
-                "<ul class=\"navbarmain\">");
-        }
-        else
-        {
-            @tags_to_add = ("<li>", $tag);
-            if ($top_item->num_subs_to_go() && $self->is_expanded())
-            {
-                push @tags_to_add, 
-                    ("<br />", "<ul class=\"navbarnested\">");
-            }
-        }
-        $self->_add_tags(@tags_to_add);
-    }
-}
-
-sub end_sep
-{
-    my $self = shift;
-    my $class =
-        ($self->stack->len() <= 2) ?
-            "navbarmain" :
-            "navbarnested";
-    $self->_add_tags("<ul class=\"$class\">");
-}
-
-sub end_regular
-{
-    my $self = shift;
-    if ($self->is_hidden() || $self->is_role_header())
-    {
-        # Do nothing
-    }
-    else
-    {
-        return $self->SUPER::end_regular();
-    }
-}
-
-sub is_hidden
-{
-    my $self = shift;
-    return $self->top->node()->hide();
-}
-
-sub is_expanded
-{
-    my $self = shift;
-    my $node = $self->top->node();
-    return ($node->expanded() || $self->top->accum_state->{'show_always'});
-}
-
-sub is_role_header
-{
-    my $self = shift;
-    return ($self->top->node->role() eq "header");
-}
-
-1;
-

lib/Shlomif/NavMenu/Iterator/SiteMap.pm

-package Shlomif::NavMenu::Iterator::SiteMap;
-
-use strict;
-use warnings;
-
-use base qw(Shlomif::NavMenu::Iterator::Html);
-
-use CGI;
-
-sub start_root
-{
-    my $self = shift;
-    
-    $self->_add_tags("<ul>");
-}
-
-sub start_sep
-{
-}
-
-sub start_regular
-{
-    my $self = shift;
-
-    my $top_item = $self->top;
-    my $node = $self->top->node();
-
-    my $nav_menu = $self->{'nav_menu'};
-
-    $self->_add_tags("<li>");
-    my $tag = $self->get_a_tag();
-    my $title = $node->title();
-    if (defined($title))
-    {
-        $tag .= " - $title";
-    }
-    $self->_add_tags($tag);
-
-    if ($top_item->num_subs_to_go())
-    {
-        $self->_add_tags("<br />");
-        $self->_add_tags("<ul>");
-    }
-}
-
-sub end_sep
-{
-}
-
-sub is_expanded
-{
-    return 1;
-}
-
-sub get_results
-{
-    my $self = shift;
-
-    return join("", map { "$_\n" } @{$self->{'html'}});
-}
-
-1;
-

lib/Shlomif/NavMenu/Object.pm

-package Shlomif::NavMenu::Object;
-
-use strict;
-
-sub new
-{
-    my $class = shift;
-    my $self = {};
-    
-    bless($self, $class);
-    
-    $self->initialize(@_);
-    
-    return $self;
-}
-
-sub initialize
-{
-    my $self = shift;
-
-    return 0;
-}
-
-sub destroy_
-{
-    my $self = shift;
-    
-    return 0;
-}
-
-sub DESTROY
-{
-    my $self = shift;
-    
-    $self->destroy_();
-}
-
-1;

lib/Shlomif/NavMenu/Tree/Iterator.pm

-package Shlomif::NavMenu::Tree::Iterator;
-
-use strict;
-use warnings;
-
-use base qw(Shlomif::NavMenu::Object);
-
-use Shlomif::NavMenu::Tree::Iterator::Stack;
-use Shlomif::NavMenu::Tree::Iterator::Item;
-
-sub initialize
-{
-    my $self = shift;
-
-    $self->{'stack'} = Shlomif::NavMenu::Tree::Iterator::Stack->new();
-
-    return 0;
-}
-
-sub stack
-{
-    my $self = shift;
-
-    return $self->{'stack'};
-}
-
-sub top
-{
-    my $self = shift;
-    return $self->stack()->top();
-}
-
-sub push_into_stack
-{
-    my $self = shift;
-
-    my %args = (@_);
-    my $node = $args{'node'};
-    my $subs = $self->get_node_subs('node' => $node);
-    my $accum_state =
-        $self->get_new_accum_state(
-            'item' => $self->top(),
-            'node' => $node
-        );
-
-    my $new_item =
-        Shlomif::NavMenu::Tree::Iterator::Item->new(
-            'node' => $node,
-            'subs' => $subs,
-            'accum_state' => $accum_state,
-        );
-
-    $self->stack()->push($new_item);
-}
-
-sub traverse
-{
-    my $self = shift;
-
-    $self->push_into_stack('node' => $self->get_initial_node());
-
-    my $top_item;
-
-    MAIN_LOOP: while ($top_item = $self->top())
-    {
-        my $visited = $top_item->is_visited();
-
-        if (!$visited)
-        {
-            $self->node_start();
-        }
-
-        my $sub_item =
-            ($self->node_should_recurse() ?
-                $top_item->visit() :
-                undef);
-
-        if (defined($sub_item))
-        {
-            $self->push_into_stack(
-                'node' =>
-                    $self->get_node_from_sub(
-                        'item' => $top_item,
-                        'sub' => $sub_item,
-                    ),
-                );
-            next MAIN_LOOP;
-        }
-        else
-        {
-            $self->node_end();
-            $self->stack->pop();
-        }
-    }
-
-    return 0;
-}
-
-# This function can be overriden to generate a node from the sub-nodes
-# returned by get_node_subs() in a different way than the default.
-sub get_node_from_sub
-{
-    my $self = shift;
-
-    my %args = (@_);
-
-    return $args{'sub'};
-}
-
-1;
-

lib/Shlomif/NavMenu/Tree/Iterator/Item.pm

-package Shlomif::NavMenu::Tree::Iterator::Item;
-
-use strict;
-use warnings;
-
-use base qw(Shlomif::NavMenu::Object);
-
-sub initialize
-{
-    my $self = shift;
-
-    my %args = (@_);
-
-    $self->{'node'} = $args{'node'} or
-        die "node not specified!";
-
-    my $subs = $args{'subs'} or
-        die "subs not specified!";
-
-    $self->{'subs'} = $subs;
-    $self->{'sub_idx'} = -1;
-    $self->{'visited'} = 0;
-    $self->{'accum_state'} = $args{'accum_state'} or
-        die "accum_state not specified!";
-    
-    return 0;
-}
-
-sub node
-{
-    my $self = shift;
-    return $self->{'node'};
-}
-
-sub accum_state
-{
-    my $self = shift;
-    return $self->{'accum_state'};
-}
-
-sub is_visited
-{
-    my $self = shift;
-    return $self->{'visited'};
-}
-
-sub visit
-{
-    my $self = shift;
-    $self->{'visited'} = 1;
-    if ($self->num_subs_to_go())
-    {
-        return $self->{'subs'}->[++$self->{'sub_idx'}];
-    }
-    else
-    {
-        return undef;
-    }
-}
-
-sub num_subs_to_go
-{
-    my $self = shift;
-    return $self->num_subs() - $self->{'sub_idx'} - 1;
-}
-
-sub num_subs
-{
-    my $self = shift;
-    return scalar(@{$self->{'subs'}});
-}
-
-1;
-

lib/Shlomif/NavMenu/Tree/Iterator/Stack.pm

-package Shlomif::NavMenu::Tree::Iterator::Stack;
-
-use strict;
-use warnings;
-
-use base qw(Shlomif::NavMenu::Object);
-
-sub initialize
-{
-    my $self = shift;
-
-    $self->{'items'} = [];
-
-    return 0;
-}
-
-sub push
-{
-    my $self = shift;
-    my $item = shift;
-    push @{$self->{'items'}}, $item;
-    return 0;
-}
-
-sub len
-{
-    my $self = shift;
-    return scalar(@{$self->{'items'}});
-}
-
-sub top
-{
-    my $self = shift;
-    return $self->{'items'}->[-1];
-}
-
-sub item
-{
-    my $self = shift;
-    my $index = shift;
-    return $self->{'items'}->[$index];
-}
-
-sub pop
-{
-    my $self = shift;
-    return pop(@{$self->{'items'}});
-}
-
-sub is_empty
-{
-    my $self = shift;
-    return ($self->len() == 0);
-}
-
-sub reset
-{
-    my $self = shift;
-    @{$self->{'items'}} = ();
-    return 0;
-}
-
-1;
-

lib/Shlomif/NavMenu/Tree/Node.pm

-package Shlomif::NavMenu::Tree::Node;
-
-use base 'Shlomif::NavMenu::Object';
-
-use base 'Class::Accessor';
-
-__PACKAGE__->mk_accessors(
-    qw(CurrentlyActive expanded hide host role separator show_always),
-    qw(subs title url value)
-    );
-
-sub initialize
-{
-    my $self = shift;
-
-    $self->set("role", $self->get_default_role());
-
-    $self->set("subs", []);
-
-    return $self;
-}
-
-sub get_default_role
-{
-    return "normal";
-}
-
-sub expand
-{
-    my $self = shift;
-    $self->expanded(1);
-    return 0;
-}
-
-sub mark_as_current
-{
-    my $self = shift;
-    $self->expand();
-    $self->CurrentlyActive(1);
-    return 0;
-}
-
-sub _process_new_sub
-{
-    my $self = shift;
-    my $sub = shift;
-    if ($sub->expanded())
-    {
-        $self->expand();
-    }
-}
-
-sub add_sub
-{
-    my $self = shift;
-    my $sub = shift;
-    push (@{$self->subs}, $sub);
-    $self->_process_new_sub($sub);
-    return 0;
-}
-
-1;

lib/Shlomif/NavMenu/Url.pm

-package Shlomif::NavMenu::Url;
-
-use strict;
-
-use Shlomif::NavMenu::Object;
-use Data::Dumper;
-
-use vars qw(@ISA);
-
-@ISA=qw(Shlomif::NavMenu::Object);
-
-sub initialize
-{
-    my $self = shift;
-
-    my $url = shift;
-    $self->{'url'} = ((ref($url) eq "ARRAY") ? 
-        [ @$url ] :
-        [ split(/\//, $url) ])
-        ;
-    $self->{'is_dir'} = shift || 0;
-    $self->{'mode'} = shift || 'server';
-
-    return 0;
-}
-
-sub get_url
-{
-    my $self = shift;
-
-    return [ @{$self->{'url'}} ];
-}
-
-sub is_dir
-{
-    my $self = shift;
-
-    return $self->{'is_dir'};
-}
-
-sub get_relative_url
-{
-    my $base = shift;
-    my $to = shift;
-    my @this_url = @{$base->get_url()};
-    my @other_url = @{$to->get_url()};
-    my $slash_terminated = shift;
-
-    my $ret;
-
-    my @this_url_bak = @this_url;
-    my @other_url_bak = @other_url;
-    
-    while(
-        scalar(@this_url) &&
-        scalar(@other_url) &&
-        ($this_url[0] eq $other_url[0])
-    )
-    {
-        shift(@this_url);
-        shift(@other_url);
-    }
-
-    if ((! @this_url) && (! @other_url) && (! $base->is_dir()) && (! $to->is_dir()) && scalar(@this_url_bak))
-    {
-        return "./" . $this_url_bak[-1];
-    }
-
-    if (($base->{'mode'} eq "harddisk") && ($to->is_dir()))
-    {
-        push @other_url, "index.html";
-    }
-
-    $ret = "";
-
-    if ($slash_terminated)
-    {
-        if ((scalar(@this_url) == 0) && (scalar(@other_url) == 0))
-        {
-            $ret = "./";
-        }
-        else
-        {
-            $ret .= join("/", (map { ".." } @this_url), @other_url);         
-            if ($to->is_dir() && ($base->{'mode'} ne "harddisk"))
-            {
-                $ret .= "/";
-            }
-        }
-    }
-    else
-    {
-        my @components = ((map { ".." } @this_url[1..$#this_url]), @other_url);
-        $ret .= ("./" . join("/", @components)); 
-        if (($to->is_dir()) && ($base->{'mode'} ne "harddisk") && scalar(@components))
-        {
-            $ret .= "/";
-        }