Commits

Anonymous committed 8d46a64

Nav-Menu:

Added the url_type and rec_url_type keys for a tree node that control
the url_type.

Comments (0)

Files changed (8)

module/HTML/Widgets/NavMenu/Test/Data.pm

     },
 );
 
+my @url_type_menu =
+(
+    'current_host' => "default",
+    'hosts' =>
+        { 
+        'default' => 
+            { 
+                'base_url' => "http://www.hello.com/",
+                'trailing_url_base' => "/",
+            },
+        },
+    'tree_contents' =>
+    {
+        'host' => "default",
+        'text' => "Top 1",
+        'title' => "T1 Title",
+        'subs' =>
+        [
+            {
+                'text' => "Home",
+                'url' => "",
+            },
+            {
+                'text' => "About Me",
+                'title' => "About Myself",
+                'url' => "me/",
+                'url_type' => "site_abs",
+            },
+            {
+                'text' => "Yowza",
+                'url' => "yowza/",
+                'url_type' => "full_abs",
+            },
+        ],
+    },
+);
+
+my @rec_url_type_menu =
+(
+    'current_host' => "default",
+    'hosts' =>
+        { 
+        'default' => 
+            { 
+                'base_url' => "http://www.hello.com/~shlomif/",
+                'trailing_url_base' => "/~shlomif/",
+            },
+        },
+    'tree_contents' =>
+    {
+        'host' => "default",
+        'text' => "Top 1",
+        'title' => "T1 Title",
+        'rec_url_type' => "full_abs",
+        'subs' =>
+        [
+            {
+                'text' => "Home",
+                'url' => "",
+            },
+            {
+                'text' => "About Me",
+                'title' => "About Myself",
+                'url' => "me/",
+                'url_type' => "site_abs",
+            },
+            {
+                'text' => "Hoola",
+                'url' => "tedious/to/write/",
+            },
+            {
+                'text' => "Yowza",
+                'url' => "yowza/",
+                'url_type' => "rel",
+                'show_always' => 1,
+                'subs' =>
+                [
+                    {
+                        'url' => "yowza/howza/",
+                        'text' => "This should be full_abs again",
+                    },
+                ],
+            },
+        ],
+    },
+);
+
 sub get_test_data
 {
     return
             'hidden_item' => \@hidden_item_nav_menu,
             'header_role' => \@header_role_nav_menu,
             'selective_expand' => \@selective_expand_nav_menu,
+            'url_type_menu' => \@url_type_menu,
+            'rec_url_type_menu' => \@rec_url_type_menu,
         };
 }
 
-* Restore the abs_url directive only as url_type or whatever.
-    - Add a url_type accessor to LeadingPath::Component.
+* Write tests to test the url_type and rec_url_type of the leading path,
+and site map.
 
-* Add an option to link to the pages as:
+* Use HTML::Widgets::NavMenu::Tree::Node and its accessors for the rest
+  of the $ptr->{text} etc. manipulations.
 
-1. By relative URLs. (../../../hello/world/yes.html)
-
-2. By site-abs URLs (/hoola/hello/world/yes.html)
-
-3. By fully qualified URLs (http://www.mysite.org/hoola/hello/world/yes.html)
+* Encapsulate the predicate call within its own re-usable (and over-ridable)
+function.
 
 * Write full documentation for the module.
 
 Long-Term:
 ----------
 
+* Write a unit-test for HTML::Widgets::NavMenu::get_cross_host_rel_url().
+
 * Use Build.PL instead of Makefile.PL. (?)
 
 * Make the module support URLs with CGI GET parameters properly.
 path and doesn't expand in others.
     - test more expand types.
 
+* In HTML::Widgets::NavMenu::Tree::Node - make sure url_type accepts only
+its enum values.
 
+
+

module/lib/HTML/Widgets/NavMenu.pm

 use base qw(Class::Accessor);
 
 __PACKAGE__->mk_accessors(
-    qw(host host_url title label direct_url)
+    qw(host host_url title label direct_url url_type)
     );
 
 sub initialize
     return $self->{'current_host'};
 }
 
+sub get_full_abs_url
+{
+    my $self = shift;
+    my %args = (@_);
+    my $host = $args{host};
+    my $host_url = $args{host_url};
+    
+    return ($self->{hosts}->{$host}->{base_url} . $host_url);
+}
+
 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};
+    my $url_type = $args{url_type};
 
-    if ($abs_url)
+    if (($host ne $self->current_host()) || ($url_type eq "full_abs"))
     {
-        return $host_url;
+        return $self->get_full_abs_url(@_);
     }
-
-    return
-        ($host eq $self->{current_host}) ?
-            get_relative_url(
-                $self->path_info(),
-                $host_url
-            ) :
-            ($self->{hosts}->{$host}->{base_url} . $host_url);
+    elsif ($url_type eq "rel")
+    {
+        return get_relative_url($self->path_info(), $host_url);
+    }
+    elsif ($url_type eq "site_abs")
+    {
+        return ($self->{hosts}->{$host}->{trailing_url_base} . $host_url);
+    }
+    else
+    {
+        die "Unknown url_type \"$url_type\"!\n";
+    }
 }
 
 sub gen_blank_nav_menu_tree_node
 
     if (exists($sub_contents->{url}))
     {
-        if (($sub_contents->{url} eq $path_info) && ($host eq $self->{current_host}))
+        if (($sub_contents->{url} eq $path_info) && ($host eq $self->current_host()))
         {
             $$current_coords_ptr = [ @$coords ];
             $new_item->mark_as_current();
     my $callback = shift || (sub { });
     my $ptr = $self->{tree_contents};
     my $host = $ptr->{host};
+    my $rec_url_type = "rel";
     my $idx = 0;
     my $internal_callback = sub {
-        $callback->('idx' => $idx, 'ptr' => $ptr, 'host' => $host);
+        $callback->('idx' => $idx, 'ptr' => $ptr, 'host' => $host, 'rec_url_type' => $rec_url_type,);
     };
     $internal_callback->();
     foreach my $c (@$coords)
         {
             $host = $ptr->{host};
         }
+        if ($ptr->{rec_url_type})
+        {
+            $rec_url_type = $ptr->{rec_url_type};
+        }
         $internal_callback->();
     }
-    return { 'ptr' => $ptr, 'host' => $host };
+    return { 'ptr' => $ptr, 'host' => $host, 'rec_url_type' => $rec_url_type, };
 }
 
 sub is_skip
     return $self->get_cross_host_rel_url(
         'host' => $host,
         'host_url' => ($ptr->{url} || ""),
-        'abs_url' => $ptr->{abs_url},
+        'url_type' => ($ptr->{url_type} || $node_ret->{rec_url_type} || "rel"),
     );
 }
 
                 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} || "";
 
+                my $url_type = 
+                    ($ptr->{url_type} || $args{rec_url_type} || "rel");
+
                 push @leading_path,
                     HTML::Widgets::NavMenu::LeadingPath::Component->new(
                         'host' => $host,
                             $self->get_cross_host_rel_url(
                                 'host' => $host,
                                 'host_url' => $host_url,
-                                'abs_url' => $ptr->{abs_url},
+                                'url_type' => $url_type,
                             ),
+                        'url_type' => $url_type,
                     );
             };
 
 another using relative URLs if possible and fully-qualified (i.e: C<http://>)
 URLs if not.
 
-Currently the only key present in the hash is the C<base_url> one that points
+Currently the only key required in the hash is the C<base_url> one that points
 to a string containing the absolute URL to the sub-site. The base URL may
 have trailing components if it does not reside on the domain's root directory.
 
+An optional key that is required only if you wish to use the "site_abs" 
+url_type (see below), is C<trailing_url_base>, which denotes the component of
+the site that appears after the hostname. For C<http://www.myhost.com/~myuser/>
+it is C</~myuser/>.
+
 Here's an example for a minimal hosts value:
 
             'hosts' =>
             {
                 'default' =>
                 {
-                    'base_url' => "http://www.hello.com/"
+                    'base_url' => "http://www.hello.com/",
+                    'trailing_url_base' => "/",
                 },
             },
 
         't2' => 
         {
             'base_url' => "http://www.shlomifish.org/",
+            'trailing_url_base' => "/",
         },
         'vipe' =>
         {
             'base_url' => "http://vipe.technion.ac.il/~shlomif/",
+            'trailing_url_base' => "/~shlomif/",
         },
     },
 
 function is similar to C<'expand_re'> but its propagation semantics the 
 opposite.
 
+=item 'url_type'
+
+This specifies the URL type to use to render this item. It can be:
+
+1. C<"rel"> - the default. This means a fully relative URL (if possible), like
+C<"../../me/about.html">.
+
+2. C<"site_abs"> - this uses a URL absolute to the site, using a slash at
+the beginning. Like C<"/~shlomif/me/about.html">. For this to work the current
+host needs to have a C<'trailing_url_base'> value set.
+
+3. C<"full_abs"> - this uses a fully qualified URL (e.g: with C<http://> at 
+the beginning, even if both the current path and the pointed path belong
+to the same host. Something like C<http://vipe.technion.ac.il/~shlomif/me/about.html>.
+
+=item 'rec_url_type'
+
+This is similar to C<'url_type'> only it recurses, to the sub-tree of the
+node. If both C<'url_type'> and C<'rec_url_type'> are specified for a node,
+then the value of C<'url_type'> will hold.
+
 =back
 
 =head1 Predicate Values
 A direct URL (usable for inclusion in an A tag ) from the current page to this
 page.
 
+=item url_type
+
+This is the C<url_type> (see above) that holds for this node.
+
 =back
 
 =head1 SEE ALSO

module/lib/HTML/Widgets/NavMenu/Iterator/Base.pm

+package HTML::Widgets::NavMenu::Iterator::Base;
+
+use strict;
+use warnings;
+
+use base qw(HTML::Widgets::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();
+    }
+    
+    my $rec_url_type;
+    if (exists($prev_state->{'rec_url_type'}))
+    {
+        $rec_url_type = $prev_state->{'rec_url_type'};
+    }
+    if (defined($node->rec_url_type()))
+    {
+        $rec_url_type = $node->rec_url_type();
+    }
+    return
+        {
+            'host' => ($node->host() || $prev_state->{'host'}),
+            'show_always' => $show_always,
+            'rec_url_type' => $rec_url_type,
+        };
+}
+
+sub get_results
+{
+    my $self = shift;
+
+    return join("", map { "$_\n" } @{$self->{'html'}});
+}
+
+1;
+

module/lib/HTML/Widgets/NavMenu/Iterator/Html.pm

 sub get_a_tag
 {
     my $self = shift;
-    my $node = $self->top->node;
+    my $item = $self->top();
+    my $node = $item->node;
 
     my $tag ="<a";
     my $title = $node->title;
             $self->nav_menu()->get_cross_host_rel_url(
                 'host' => $self->_get_top_host(),
                 'host_url' => $node->url(),
+                'url_type' => 
+                    ($node->url_type() ||
+                        $item->accum_state()->{'rec_url_type'} ||
+                        "rel"),
             )
         ). "\"";
     if (defined($title))

module/lib/HTML/Widgets/NavMenu/Tree/Node.pm

 use base 'Class::Accessor';
 
 __PACKAGE__->mk_accessors(
-    qw(CurrentlyActive expanded hide host role separator show_always),
-    qw(subs title url text)
+    qw(CurrentlyActive expanded hide host role rec_url_type),
+    qw(separator show_always subs text title url url_type),
     );
 
 sub initialize
 {
     my $self = shift;
 
-    return (qw(host role show_always title url text));
+    return (qw(host rec_url_type role show_always text title url url_type));
 }
 
 sub list_boolean_keys

module/t/04nav-menu.t

 
 use strict;
 
-use Test::More tests => 12;
+use Test::More tests => 14;
 
 use HTML::Widgets::NavMenu;
 use HTML::Widgets::NavMenu::HeaderRole;
     ok (validate_nav_menu($rendered, $expected_string), 
         "Selective Expand Nav-Menu #2"); 
 }
+
+# This is a test for the url_type directive.
+{
+    my $nav_menu = HTML::Widgets::NavMenu->new(
+        'path_info' => "/darling/",
+        @{$test_data->{'url_type_menu'}},
+    );
+
+    my $rendered = 
+        $nav_menu->render();
+
+    my $expected_string = <<"EOF";
+<ul>
+<li>
+<a href="../">Home</a>
+</li>
+<li>
+<a href="/me/" title="About Myself">About Me</a>
+</li>
+<li>
+<a href="http://www.hello.com/yowza/">Yowza</a>
+</li>
+</ul>
+EOF
+
+    # TEST
+    ok (validate_nav_menu($rendered, $expected_string), 
+        "Nav Menu for url_type - 1"); 
+}
+
+# This is a test for the rec_url_type directive.
+# Also test the behaviour of the url_type when a trailing_url_base
+# is specified
+{
+    my $nav_menu = HTML::Widgets::NavMenu->new(
+        'path_info' => "/darling/",
+        @{$test_data->{'rec_url_type_menu'}},
+    );
+
+    my $rendered = 
+        $nav_menu->render();
+
+    my $expected_string = <<"EOF";
+<ul>
+<li>
+<a href="http://www.hello.com/~shlomif/">Home</a>
+</li>
+<li>
+<a href="/~shlomif/me/" title="About Myself">About Me</a>
+</li>
+<li>
+<a href="http://www.hello.com/~shlomif/tedious/to/write/">Hoola</a>
+</li>
+<li>
+<a href="../yowza/">Yowza</a>
+<br />
+<ul>
+<li>
+<a href="http://www.hello.com/~shlomif/yowza/howza/">This should be full_abs again</a>
+</li>
+</ul>
+</li>
+</ul>
+EOF
+
+    # TEST
+    ok (validate_nav_menu($rendered, $expected_string), 
+        "Nav Menu for rec_url_type - 1"); 
+}

module/t/08tree-node.t

 #!/usr/bin/perl -w
 
-use Test::More tests => 32;
+use Test::More tests => 34;
 
 use strict;
 
     is($node->title(), "It's Raining", "Set/get title"); # TEST
     $node->set("host", "vipe");
     is($node->host(), "vipe", "Set/get host"); # TEST
+    $node->set("url_type", "site_abs");
+    is($node->url_type(), "site_abs", "Set/get url_type"); # TEST
 
     # Testing again for the same values to see that they are still OK.
 
     is($node->show_always(), 1, "Set/get show_always");  # TEST
     is($node->title(), "It's Raining", "Set/get title"); # TEST
     is($node->host(), "vipe", "Set/get host"); # TEST
+    is($node->url_type(), "site_abs", "Set/get url_type"); # TEST
 }
 
 {