HTML-Widgets-NavMenu-1.0703 000755 000764 000764 0 12535757554 15642 5 ustar 00shlomif shlomif 000000 000000 TODO 000444 000764 000764 2355 12535757554 16415 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 Short-Term:
-----------
* Make sure H::W::NM will associate the breadcrumbs trail with a category,
if this category expands there. So, for example:
http://www.shlomifish.org/philosophy/case-for-file-swapping/
will generate the breadcrumbs trail of:
Shlomi Fish -> Philosophy.
* Create a 'show' directive - like 'show_always' only with a predicate.
Long-Term:
----------
* Add a way to manage sub-menu objects, where a navigation menu can refer
to a sub-navigation menu.
- Perhaps it should be done by simply adding a reference to the tree?
* Make the module support URLs with CGI GET parameters properly.
* Add support for more attributes other than class="" to the ul and li
tags.
- like id=""
* Add a host-based regexp arbitrator to the predicate:
{ 'host_re' => { 't2' => "^home/", 'vipe' => "^home2/" } }
* In HTML::Widgets::NavMenu::Tree::Node - make sure url_type accepts only
its enum values.
* Give an option to render a sub-set of the navigation-menu, starting
at a certain coords/url-path.
* Release on CPAN as version 0.8.0.
- change the version in $VERSION.
- document the changes in Changes.
- update the readme.
* Maybe make a way to implement a generic backend to the data using various
kinds of databases/etc.
TODO-Rejects 000444 000764 000764 1476 12535757554 20015 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 * Refactor get_next_coords().
- I don't see too much point to it. It is working as it is, and it's
only one function that doesn't affect the rest of the code.
* Create a base class for classes with 'subs' functionality - like
get_nth_sub, add_sub, num_subs, etc. Both ..::Node and ..::Item share it.
- They have slightly different semantics, and besides - it's not
too much duplicate code. It would be more trouble than it's worth.
* Future direction: generate the tree once and then be able to render
it for different path_info()/current_host() configurations. (and the
generated tree re-used by all other members).
- the problem is that the expand() operations and the expanded()
flag depends on this combination. Thus, the generated tree is
different for any path_info()/current_host().
Changes 000444 000764 000764 11506 12535757554 17236 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 Revision history for Perl extension HTML::Widgets::NavMenu.
1.0703 2015-06-10
- Fix broken links to the examples' version control repositories.
- Thanks to Anne for inspiring it.
1.0702 2013-05-21
- Add t/cpan-changes.t
- Correct this file.
- Add scripts/bump-version-number.pl .
1.0701 2012-12-09
- Fix typo: https://rt.cpan.org/Ticket/Display.html?id=81840
- Thanks to GUIMARD and lintian.
1.0700 2012-12-09
- Add the li_id attribute to the tree's nodes to add an id="..." attribute
to the
tags.
1.0603 2012-09-18
- Update the URLs to the repository, and sites.
1.0602 2012-09-17
- Get rid of trailing space.
- Update the contact details.
1.0601 2012-09-05
- Moved away tag-release.pl to scripts/tag-release.pl so it won't
be installed by default.
- Moved away output.pl under examples.
1.0600 2011-04-16
- Add HTML::Widgets::NavMenu::JQueryTreeView for generating navigation
menu that this jQuery plugin can handle well:
- http://bassistance.de/jquery-plugins/jquery-plugin-treeview/
1.0501 2010-11-14
- Now generating the Makefile.PL from the Build.PL using
create_makefile_pl (less error-prone).
1.0500 2010-11-12
- Convert from Class::Accessor to Class::XSAccessor for extra speed.
- Add the tag-release.pl file.
1.0400 2009-12-09
- Got rid of the dependency on Error.pm.
- moved the HTML/ directory with the test scripts-support code from
the root of the distribution to unde t/lib .
1.0302 2009-06-25
- Fixed some broken links and other inaccuracies in the POD of
lib/HTML/Widgets/NavMenu.pm .
1.0301 2009-06-23
- Changed the 'license' in Build.PL from "bsd" to the more accurate
"mit".
- Added keywords and links to the META.yml.
1.0300 2009-06-14
- Refactoring: Made HTML::Widgets::NavMenu::Object a sub-class of
Class::Accessor to remove many "use base" calls to it.
- In progress - converting a flat %args hash (splatted into the @_)
into a single $args hash-ref.
- Removed a use lib "." from HTML::Widgets::NavMenu - it's a leftover
statement that could be a subtle bug.
- Refactoring: converted direct $self->{'field'} accesses to
accessors. (from all the classes).
- Fixed a bug with the HeaderRole where an empty
was created.
1.0201 2008-03-28
- Fixed a case where a non-capturing expand in a node inside a
capturing expand caused the upper node to be non-capturing too.
1.0200 2008-03-23
- Removed trailing whitespace from "# TEST" lines - this can confuse
early versions of Test-Count
- Fixed a "# TEST" instead of a "# TESTbr" line that confused Test-Count.
- Added the no_leading_dot option with a test.
1.0100 2008-02-08
- Fixed a bug in HTML::Widgets::NavMenu::Url:
relative URL from a non-dir to a dir. It accidently had an
extraneous "../".
- Fixed the _get_leading_path_of_coords function in HTML::Widgets::NavMenu
to properly generate the topmost item of the breadcrumbs trail, which
should be in coords = [0] and not coord = []. The latter is meaningless
and ignored. This caused a subtle bug in combining the breadcrumbs
trails of my homesite.
- it became apparent when the URL of the [0] item was not empty.
- Added the 'capt' key to the 'expand' => keys for "capturing" regex.
1.0001 2006-09-11
- Added "use strict" and "use warnings" to all modules.
- Added a Test::Pod based test.
- Added a Test::Pod::Coverage test, and added POD to all modules.
- Some internal methods were prefixed with an underscore.
- Added the examples directory.
1.0000 2005-11-06
- Made sure that the breadcrumbs trail in expanded sections will
display the components of the expanded sections.
- Fixed the POD.
- Added the link to the article to the POD.
- Bumped the major version number to 1.x and kept some digits into the
future to make CPAN and CPAN.pm happy.
0.10.2 2005-08-24
(backdated - module was released on 17-August-2005)
- Added IO::Scalar to the Perl modules this module depends on. (it
is needed by the tests, but was not explicitly specified yet, because
it was believed to be part of the core distribution).
0.10.1 2005-07-25
- Fixed the building using "perl Makefile.PL" and "make".
0.10.0 2005-07-12
- Added tests and refactored the code to have a 100% test coverage.
0.8.0 2005-04-23
- get_cross_host_rel_url is now part of the API.
- Now returning nav_links_obj
- Added some tests
0.6.0 2005-03-24
- no longer making use of the CGI.pm module.
- extracted two methods in HTML::Widgets::NavMenu::Iterator::NavMenu
that can now be over-rided by the user.
0.4.0 2005-01-20
- Added the url_is_abs option to the nodes.
- Many code cleanups.
0.2.0 2005-01-02
- First non-developer CPAN Release.
MANIFEST 000444 000764 000764 3476 12535757554 17063 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 Build.PL
COPYING
Changes
MANIFEST
META.json
META.yml Module meta-data (added by MakeMaker)
Makefile.PL
README
TODO
TODO-Rejects
examples/README
examples/article-examples/cgi-script/H-W-NM-serve.pl
examples/article-examples/complex/H-W-NM-complex.pl
examples/article-examples/fine-grained-site-flow/H-W-NM-fine-grained-site-flow.pl
examples/article-examples/simple/H-W-NM-simple.pl
examples/article-examples/with-embellishments/H-W-NM-embellish.pl
examples/output.pl
inc/Test/Run/Builder.pm
lib/HTML/Widgets/NavMenu.pm
lib/HTML/Widgets/NavMenu/EscapeHtml.pm
lib/HTML/Widgets/NavMenu/ExpandVal.pm
lib/HTML/Widgets/NavMenu/HeaderRole.pm
lib/HTML/Widgets/NavMenu/Iterator/Base.pm
lib/HTML/Widgets/NavMenu/Iterator/Html.pm
lib/HTML/Widgets/NavMenu/Iterator/JQTreeView.pm
lib/HTML/Widgets/NavMenu/Iterator/NavMenu.pm
lib/HTML/Widgets/NavMenu/Iterator/NavMenu/HeaderRole.pm
lib/HTML/Widgets/NavMenu/Iterator/SiteMap.pm
lib/HTML/Widgets/NavMenu/JQueryTreeView.pm
lib/HTML/Widgets/NavMenu/Object.pm
lib/HTML/Widgets/NavMenu/Predicate.pm
lib/HTML/Widgets/NavMenu/TagGen.pm
lib/HTML/Widgets/NavMenu/Tree/Iterator.pm
lib/HTML/Widgets/NavMenu/Tree/Iterator/Item.pm
lib/HTML/Widgets/NavMenu/Tree/Iterator/Stack.pm
lib/HTML/Widgets/NavMenu/Tree/Node.pm
lib/HTML/Widgets/NavMenu/Url.pm
scripts/bump-version-number.pl
scripts/tag-release.pl
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
t/09leading-path.t
t/10ul-classes.t
t/11predicate.t
t/12x-host-rel-url.t
t/13escape-html.t
t/14tag-gen.t
t/15aspetersen-inherit.t
t/16redirect.t
t/17nav-coords-unit.t
t/18url.t
t/cpan-changes.t
t/lib/HTML/Widgets/NavMenu/Test/Data.pm
t/lib/HTML/Widgets/NavMenu/Test/Stdout.pm
t/lib/HTML/Widgets/NavMenu/Test/Util.pm
t/pod-coverage.t
t/pod.t
t/style-trailing-space.t
Build.PL 000444 000764 000764 2640 12535757554 17216 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 use strict;
use warnings;
use File::Spec;
use lib File::Spec->catdir(File::Spec->curdir(), "inc");
use Test::Run::Builder;
my $build = Test::Run::Builder->new(
'module_name' => "HTML::Widgets::NavMenu",
configure_requires =>
{
'Module::Build' => '0.36',
},
'requires' =>
{
'Test::More' => 0,
'Class::XSAccessor' => 0,
'perl' => "5.6.1",
'IO::Scalar' => 0,
},
'license' => "mit",
meta_merge =>
{
resources =>
{
repository => "https://bitbucket.org/shlomif/perl-html-widgets-navmenu",
homepage => "http://web-cpan.shlomifish.org/modules/HTML-Widgets-NavMenu/",
},
keywords =>
[
"arrows",
"bar",
"breadcrumbs",
"css",
"expand",
"hidden",
"html",
"menu",
"menus",
"nav-bar",
"navbar",
"navigation",
"navigation aids",
"nav-menu",
"navmenu",
"next",
"prev",
"previous",
"pure-perl",
"site-map",
"skipped",
"trail",
"tree",
"unexpand",
"up",
"widget",
"widgets",
"xhtml",
],
},
create_makefile_pl => 'traditional',
);
$build->create_build_script;
Makefile.PL 000444 000764 000764 707 12535757554 17656 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 # Note: this file was auto-generated by Module::Build::Compat version 0.4210
require 5.006001;
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'HTML::Widgets::NavMenu',
'VERSION_FROM' => 'lib/HTML/Widgets/NavMenu.pm',
'PREREQ_PM' => {
'Class::XSAccessor' => 0,
'IO::Scalar' => 0,
'Test::More' => 0
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [],
'PL_FILES' => {}
)
;
META.yml 000444 000764 000764 6476 12535757554 17206 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 ---
abstract: 'A Perl Module for Generating HTML Navigation Menus'
author:
- 'Shlomi Fish, Eshlomif@cpan.orgE, L .'
build_requires: {}
configure_requires:
Module::Build: '0.36'
dynamic_config: 1
generated_by: 'Module::Build version 0.421, CPAN::Meta::Converter version 2.142060'
keywords:
- arrows
- bar
- breadcrumbs
- css
- expand
- hidden
- html
- menu
- menus
- nav-bar
- navbar
- navigation
- 'navigation aids'
- nav-menu
- navmenu
- next
- prev
- previous
- pure-perl
- site-map
- skipped
- trail
- tree
- unexpand
- up
- widget
- widgets
- xhtml
license: mit
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: HTML-Widgets-NavMenu
provides:
HTML::Widgets::NavMenu:
file: lib/HTML/Widgets/NavMenu.pm
version: '1.0703'
HTML::Widgets::NavMenu::Error:
file: lib/HTML/Widgets/NavMenu.pm
HTML::Widgets::NavMenu::Error::Redirect:
file: lib/HTML/Widgets/NavMenu.pm
HTML::Widgets::NavMenu::EscapeHtml:
file: lib/HTML/Widgets/NavMenu/EscapeHtml.pm
HTML::Widgets::NavMenu::ExpandVal:
file: lib/HTML/Widgets/NavMenu/ExpandVal.pm
HTML::Widgets::NavMenu::HeaderRole:
file: lib/HTML/Widgets/NavMenu/HeaderRole.pm
HTML::Widgets::NavMenu::Iterator::Base:
file: lib/HTML/Widgets/NavMenu/Iterator/Base.pm
HTML::Widgets::NavMenu::Iterator::GetCurrentlyActive:
file: lib/HTML/Widgets/NavMenu.pm
HTML::Widgets::NavMenu::Iterator::Html:
file: lib/HTML/Widgets/NavMenu/Iterator/Html.pm
HTML::Widgets::NavMenu::Iterator::Html::Item:
file: lib/HTML/Widgets/NavMenu/Iterator/Html.pm
HTML::Widgets::NavMenu::Iterator::JQTreeView:
file: lib/HTML/Widgets/NavMenu/Iterator/JQTreeView.pm
HTML::Widgets::NavMenu::Iterator::NavMenu:
file: lib/HTML/Widgets/NavMenu/Iterator/NavMenu.pm
HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole:
file: lib/HTML/Widgets/NavMenu/Iterator/NavMenu/HeaderRole.pm
HTML::Widgets::NavMenu::Iterator::SiteMap:
file: lib/HTML/Widgets/NavMenu/Iterator/SiteMap.pm
HTML::Widgets::NavMenu::JQueryTreeView:
file: lib/HTML/Widgets/NavMenu/JQueryTreeView.pm
HTML::Widgets::NavMenu::LeadingPath::Component:
file: lib/HTML/Widgets/NavMenu.pm
HTML::Widgets::NavMenu::NodeDescription:
file: lib/HTML/Widgets/NavMenu.pm
HTML::Widgets::NavMenu::Object:
file: lib/HTML/Widgets/NavMenu/Object.pm
HTML::Widgets::NavMenu::Predicate:
file: lib/HTML/Widgets/NavMenu/Predicate.pm
HTML::Widgets::NavMenu::TagGen:
file: lib/HTML/Widgets/NavMenu/TagGen.pm
HTML::Widgets::NavMenu::Tree::Iterator:
file: lib/HTML/Widgets/NavMenu/Tree/Iterator.pm
HTML::Widgets::NavMenu::Tree::Iterator::Item:
file: lib/HTML/Widgets/NavMenu/Tree/Iterator/Item.pm
HTML::Widgets::NavMenu::Tree::Iterator::Stack:
file: lib/HTML/Widgets/NavMenu/Tree/Iterator/Stack.pm
HTML::Widgets::NavMenu::Tree::Node:
file: lib/HTML/Widgets/NavMenu/Tree/Node.pm
HTML::Widgets::NavMenu::Url:
file: lib/HTML/Widgets/NavMenu/Url.pm
requires:
Class::XSAccessor: '0'
IO::Scalar: '0'
Test::More: '0'
perl: v5.6.1
resources:
homepage: http://web-cpan.shlomifish.org/modules/HTML-Widgets-NavMenu/
license: http://www.opensource.org/licenses/mit-license.php
repository: https://bitbucket.org/shlomif/perl-html-widgets-navmenu
version: '1.0703'
META.json 000444 000764 000764 11004 12535757554 17355 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 {
"abstract" : "A Perl Module for Generating HTML Navigation Menus",
"author" : [
"Shlomi Fish, Eshlomif@cpan.orgE, L ."
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.421",
"keywords" : [
"arrows",
"bar",
"breadcrumbs",
"css",
"expand",
"hidden",
"html",
"menu",
"menus",
"nav-bar",
"navbar",
"navigation",
"navigation aids",
"nav-menu",
"navmenu",
"next",
"prev",
"previous",
"pure-perl",
"site-map",
"skipped",
"trail",
"tree",
"unexpand",
"up",
"widget",
"widgets",
"xhtml"
],
"license" : [
"mit"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "HTML-Widgets-NavMenu",
"prereqs" : {
"configure" : {
"requires" : {
"Module::Build" : "0.36"
}
},
"runtime" : {
"requires" : {
"Class::XSAccessor" : "0",
"IO::Scalar" : "0",
"Test::More" : "0",
"perl" : "v5.6.1"
}
}
},
"provides" : {
"HTML::Widgets::NavMenu" : {
"file" : "lib/HTML/Widgets/NavMenu.pm",
"version" : "1.0703"
},
"HTML::Widgets::NavMenu::Error" : {
"file" : "lib/HTML/Widgets/NavMenu.pm"
},
"HTML::Widgets::NavMenu::Error::Redirect" : {
"file" : "lib/HTML/Widgets/NavMenu.pm"
},
"HTML::Widgets::NavMenu::EscapeHtml" : {
"file" : "lib/HTML/Widgets/NavMenu/EscapeHtml.pm"
},
"HTML::Widgets::NavMenu::ExpandVal" : {
"file" : "lib/HTML/Widgets/NavMenu/ExpandVal.pm"
},
"HTML::Widgets::NavMenu::HeaderRole" : {
"file" : "lib/HTML/Widgets/NavMenu/HeaderRole.pm"
},
"HTML::Widgets::NavMenu::Iterator::Base" : {
"file" : "lib/HTML/Widgets/NavMenu/Iterator/Base.pm"
},
"HTML::Widgets::NavMenu::Iterator::GetCurrentlyActive" : {
"file" : "lib/HTML/Widgets/NavMenu.pm"
},
"HTML::Widgets::NavMenu::Iterator::Html" : {
"file" : "lib/HTML/Widgets/NavMenu/Iterator/Html.pm"
},
"HTML::Widgets::NavMenu::Iterator::Html::Item" : {
"file" : "lib/HTML/Widgets/NavMenu/Iterator/Html.pm"
},
"HTML::Widgets::NavMenu::Iterator::JQTreeView" : {
"file" : "lib/HTML/Widgets/NavMenu/Iterator/JQTreeView.pm"
},
"HTML::Widgets::NavMenu::Iterator::NavMenu" : {
"file" : "lib/HTML/Widgets/NavMenu/Iterator/NavMenu.pm"
},
"HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole" : {
"file" : "lib/HTML/Widgets/NavMenu/Iterator/NavMenu/HeaderRole.pm"
},
"HTML::Widgets::NavMenu::Iterator::SiteMap" : {
"file" : "lib/HTML/Widgets/NavMenu/Iterator/SiteMap.pm"
},
"HTML::Widgets::NavMenu::JQueryTreeView" : {
"file" : "lib/HTML/Widgets/NavMenu/JQueryTreeView.pm"
},
"HTML::Widgets::NavMenu::LeadingPath::Component" : {
"file" : "lib/HTML/Widgets/NavMenu.pm"
},
"HTML::Widgets::NavMenu::NodeDescription" : {
"file" : "lib/HTML/Widgets/NavMenu.pm"
},
"HTML::Widgets::NavMenu::Object" : {
"file" : "lib/HTML/Widgets/NavMenu/Object.pm"
},
"HTML::Widgets::NavMenu::Predicate" : {
"file" : "lib/HTML/Widgets/NavMenu/Predicate.pm"
},
"HTML::Widgets::NavMenu::TagGen" : {
"file" : "lib/HTML/Widgets/NavMenu/TagGen.pm"
},
"HTML::Widgets::NavMenu::Tree::Iterator" : {
"file" : "lib/HTML/Widgets/NavMenu/Tree/Iterator.pm"
},
"HTML::Widgets::NavMenu::Tree::Iterator::Item" : {
"file" : "lib/HTML/Widgets/NavMenu/Tree/Iterator/Item.pm"
},
"HTML::Widgets::NavMenu::Tree::Iterator::Stack" : {
"file" : "lib/HTML/Widgets/NavMenu/Tree/Iterator/Stack.pm"
},
"HTML::Widgets::NavMenu::Tree::Node" : {
"file" : "lib/HTML/Widgets/NavMenu/Tree/Node.pm"
},
"HTML::Widgets::NavMenu::Url" : {
"file" : "lib/HTML/Widgets/NavMenu/Url.pm"
}
},
"release_status" : "stable",
"resources" : {
"homepage" : "http://web-cpan.shlomifish.org/modules/HTML-Widgets-NavMenu/",
"license" : [
"http://www.opensource.org/licenses/mit-license.php"
],
"repository" : {
"url" : "https://bitbucket.org/shlomif/perl-html-widgets-navmenu"
}
},
"version" : "1.0703"
}
README 000444 000764 000764 2313 12535757554 16577 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 HTML-Widgets-NavMenu
====================
HTML::Widgets::NavMenu generates a navigation menu for a site. It can also
generate a complete site map, a path of leading components, and also keeps
track of navigation links ("Next", "Prev", "Up", etc.)
It accepts as input a nested tree with the input for the various nodes in
the site, and generates the HTML as output. It has a detailed API documentation
in the embedded POD, and many examples in the tests and in sites created
by the author. Currently, it lacks developer's and extender's information,
but hopefully one can find his way around the code easily enough.
HTML::Widgets::NavMenu is covered by many automated tests.
INSTALLATION
To install this module type the following:
perl Build.PL
./Build
./Build test
./Build install
after you install all of its dependencies.
Alternatively use the CPAN.pm module:
# perl -MCPAN -e 'install HTML::Widgets::NavMenu'
Or the new CPANPLUS.pm module
# perl -MCPANPLUS -e 'install HTML::Widgets::NavMenu'
COPYRIGHT AND LICENCE
Copyright (C) 2004 by Shlomi Fish
This library is free software; you can redistribute it and/or modify
it under the MIT X11 license. (see the file COPYING for its text.)
COPYING 000444 000764 000764 2064 12535757554 16755 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 This is the MIT/X11 license:
--------------
Copyright 2004 Shlomi Fish.
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
lib 000755 000764 000764 0 12535757554 16331 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 HTML 000755 000764 000764 0 12535757554 17075 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib Widgets 000755 000764 000764 0 12535757554 20503 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML NavMenu.pm 000444 000764 000764 107236 12535757554 22620 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets use strict;
use warnings;
package HTML::Widgets::NavMenu;
our $VERSION = '1.0703';
package HTML::Widgets::NavMenu::Error;
use base "HTML::Widgets::NavMenu::Object";
package HTML::Widgets::NavMenu::Error::Redirect;
use strict;
use vars qw(@ISA);
@ISA=("HTML::Widgets::NavMenu::Error");
sub CGIpm_perform_redirect
{
my $self = shift;
my $cgi = shift;
print $cgi->redirect($cgi->script_name() . $self->{-redirect_path});
exit;
}
package HTML::Widgets::NavMenu::NodeDescription;
use strict;
use base qw(HTML::Widgets::NavMenu::Object);
__PACKAGE__->mk_acc_ref([
qw(host host_url title label direct_url url_type)]
);
sub _init
{
my ($self, $args) = @_;
while (my ($k, $v) = each(%$args))
{
$self->$k($v);
}
return 0;
}
1;
package HTML::Widgets::NavMenu::LeadingPath::Component;
use vars qw(@ISA);
@ISA = (qw(HTML::Widgets::NavMenu::NodeDescription));
package HTML::Widgets::NavMenu::Iterator::GetCurrentlyActive;
use base 'HTML::Widgets::NavMenu::Iterator::Base';
__PACKAGE__->mk_acc_ref([qw(
_item_found
_leading_path_coords
_ret_coords
_temp_coords
_tree
)]);
sub _init
{
my $self = shift;
my $args = shift;
$self->SUPER::_init($args);
$self->_tree($args->{'tree'});
$self->_item_found(0);
return 0;
}
sub get_initial_node
{
my $self = shift;
return $self->_tree;
}
sub item_matches
{
my $self = shift;
my $item = $self->top();
my $url = $item->_node()->url();
my $nav_menu = $self->nav_menu();
return
(
($item->_accum_state()->{'host'} eq $nav_menu->current_host()) &&
(defined($url) && ($url eq $nav_menu->path_info()))
);
}
sub does_item_expand
{
my $self = shift;
my $item = $self->top();
return $item->_node()->capture_expanded();
}
sub node_start
{
my $self = shift;
if ($self->item_matches())
{
my @coords = @{$self->get_coords()};
$self->_ret_coords([ @coords ]);
$self->_temp_coords([ @coords, (-1) ]);
$self->top()->_node()->mark_as_current();
$self->_item_found(1);
}
elsif ($self->does_item_expand())
{
my @coords = @{$self->get_coords()};
$self->_leading_path_coords([ @coords]);
}
}
sub node_end
{
my $self = shift;
if ($self->_item_found())
{
# Skip the first node, because the coords refer
# to the nodes below it.
my $idx = pop(@{$self->_temp_coords()});
if ($idx >= 0)
{
my $node = $self->top()->_node();
$node->update_based_on_sub(
$node->get_nth_sub(
$idx
)
);
}
}
}
sub node_should_recurse
{
my $self = shift;
return (! $self->_item_found());
}
sub get_final_coords
{
my $self = shift;
return $self->_ret_coords();
}
sub _get_leading_path_coords
{
my $self = shift;
return ($self->_ret_coords() || $self->_leading_path_coords());
}
package HTML::Widgets::NavMenu;
use base 'HTML::Widgets::NavMenu::Object';
use HTML::Widgets::NavMenu::Url;
require HTML::Widgets::NavMenu::Iterator::NavMenu;
require HTML::Widgets::NavMenu::Iterator::SiteMap;
require HTML::Widgets::NavMenu::Tree::Node;
require HTML::Widgets::NavMenu::Predicate;
__PACKAGE__->mk_acc_ref([qw(
_current_coords
current_host
_hosts
_no_leading_dot
_leading_path_coords
path_info
_traversed_tree
_tree_contents
_ul_classes
)]);
sub _init
{
my $self = shift;
my %args = (@_);
$self->_register_path_info(\%args);
$self->_hosts($args{hosts});
$self->_tree_contents($args{tree_contents});
$self->current_host($args{current_host})
or die "Current host was not specified.";
$self->_ul_classes($args{'ul_classes'} || []);
$self->_no_leading_dot(
exists($args{'no_leading_dot'}) ? $args{'no_leading_dot'} : 0
);
return 0;
}
sub _get_nav_menu_traverser_args
{
my $self = shift;
return
{
'nav_menu' => $self,
'ul_classes' => $self->_ul_classes(),
};
}
sub _get_nav_menu_traverser
{
my $self = shift;
return
HTML::Widgets::NavMenu::Iterator::NavMenu->new(
$self->_get_nav_menu_traverser_args()
);
}
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))
{
my $error = HTML::Widgets::NavMenu::Error::Redirect->new();
$error->{'-redirect_path'} = ($redir_path."/");
$error->{'msg'} = "Need to redirect";
die $error;
}
$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 =
HTML::Widgets::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 $no_leading_dot = 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),
$no_leading_dot,
);
return $ret;
}
sub _get_full_abs_url
{
my ($self, $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_ref
{
my ($self, $args) = @_;
my $host = $args->{host};
my $host_url = $args->{host_url};
my $url_type = $args->{url_type};
my $url_is_abs = $args->{url_is_abs};
if ($url_is_abs)
{
return $host_url;
}
elsif (($host ne $self->current_host()) || ($url_type eq "full_abs"))
{
return $self->_get_full_abs_url($args);
}
elsif ($url_type eq "rel")
{
# TODO : convert to a method.
return _get_relative_url(
$self->path_info(), $host_url, $self->_no_leading_dot()
);
}
elsif ($url_type eq "site_abs")
{
return ($self->_hosts->{$host}->{trailing_url_base} . $host_url);
}
else
{
die "Unknown url_type \"$url_type\"!\n";
}
}
sub get_cross_host_rel_url
{
my $self = shift;
return $self->get_cross_host_rel_url_ref({@_});
}
sub _get_url_to_item
{
my $self = shift;
my $item = shift;
return $self->get_cross_host_rel_url_ref(
{
'host' => $item->_accum_state()->{'host'},
'host_url' => ($item->_node->url() || ""),
'url_type' => $item->get_url_type(),
'url_is_abs' => $item->_node->url_is_abs(),
}
);
}
sub _gen_blank_nav_menu_tree_node
{
my $self = shift;
return HTML::Widgets::NavMenu::Tree::Node->new();
}
sub _create_predicate
{
my ($self, $args) = @_;
return
HTML::Widgets::NavMenu::Predicate->new(
'spec' => $args->{'spec'},
);
}
sub _create_new_nav_menu_item
{
my ($self, $args) = @_;
my $sub_contents = $args->{sub_contents};
my $new_item = $self->_gen_blank_nav_menu_tree_node();
$new_item->set_values_from_hash_ref($sub_contents);
if (exists($sub_contents->{'expand'}))
{
my $expand_val =
$self->_create_predicate(
{
'spec' => $sub_contents->{'expand'},
}
)->evaluate(
'path_info' => $self->path_info(),
'current_host' => $self->current_host(),
)
;
if ($expand_val)
{
$new_item->expand($expand_val);
}
}
return $new_item;
}
sub _render_tree_contents
{
my $self = shift;
my $sub_contents = shift;
my $path_info = $self->path_info();
my $new_item =
$self->_create_new_nav_menu_item(
{ sub_contents => $sub_contents },
);
if (exists($sub_contents->{subs}))
{
foreach my $sub_contents_sub (@{$sub_contents->{subs}})
{
$new_item->add_sub(
$self->_render_tree_contents(
$sub_contents_sub,
)
);
}
}
return $new_item;
}
sub gen_site_map
{
my $self = shift;
my $iterator =
HTML::Widgets::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->_get_traversed_tree());
my @dest_coords;
my $i;
for($i=0;$iget_nth_sub($coords[$i]);
}
if ($branches[$i]->_num_subs())
{
@dest_coords = (@coords,0);
}
else
{
for($i--;$i>=0;$i--)
{
if ($branches[$i]->_num_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;
}
else
{
return [ @coords[0 .. ($#coords-1)] ];
}
}
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 _is_skip
{
my $self = shift;
my $coords = shift;
my $iterator = $self->_get_nav_menu_traverser();
my $ret = $iterator->find_node_by_coords($coords);
my $item = $ret->{item};
return $item->_node()->skip();
}
sub _get_coords_while_skipping_skips
{
my $self = shift;
my $callback = shift;
my $coords = shift(@_);
if (!$coords)
{
$coords = $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->_get_traversed_tree();
# 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->get_nth_sub($c);
}
# As long as there is something deeper
while (my $num_subs = $branch->_num_subs())
{
my $index = $num_subs-1;
# We are going to return it, so store it
push @coords, $index;
# Recurse into the sub-branch
$branch = $branch->get_nth_sub($index);
}
return \@coords;
}
=begin comment
sub get_rel_url_from_coords
{
my $self = shift;
my $coords = shift;
my ($ptr,$host);
my $iterator = $self->_get_nav_menu_traverser();
my $node_ret = $iterator->find_node_by_coords($coords);
my $item = $node_ret->{'item'};
return $self->_get_url_to_item($item);
}
=end comment
=cut
# 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'});
$self->_leading_path_coords($gen_retval->{'leading_path_coords'});
}
return $self->_traversed_tree();
}
sub _gen_traversed_tree
{
my $self = shift;
my $tree =
$self->_render_tree_contents(
$self->_tree_contents(),
);
my $find_coords_iterator =
HTML::Widgets::NavMenu::Iterator::GetCurrentlyActive->new(
{
'nav_menu' => $self,
'tree' => $tree,
}
);
$find_coords_iterator->traverse();
my $current_coords = $find_coords_iterator->get_final_coords() || [];
my $leading_path_coords =
$find_coords_iterator->_get_leading_path_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,
'leading_path_coords' => $leading_path_coords,
};
}
sub _get_leading_path_of_coords
{
my $self = shift;
my $coords = shift;
if (! @$coords )
{
$coords = [ 0 ];
}
my @leading_path;
my $iterator = $self->_get_nav_menu_traverser();
COORDS_LOOP:
while (1)
{
my $ret = $iterator->find_node_by_coords(
$coords
);
my $item = $ret->{item};
my $node = $item->_node();
# This is a workaround for the root link.
my $host_url = (defined($node->url()) ? ($node->url()) : "");
my $host = $item->_accum_state()->{'host'};
my $url_type =
($node->url_is_abs() ?
"full_abs" :
$item->get_url_type()
);
push @leading_path,
HTML::Widgets::NavMenu::LeadingPath::Component->new(
{
'host' => $host,
'host_url' => $host_url,
'title' => $node->title(),
'label' => $node->text(),
'direct_url' => $self->_get_url_to_item($item),
'url_type' => $url_type,
}
);
if ((scalar(@$coords) == 1) && ($coords->[0] == 0))
{
last COORDS_LOOP;
}
}
continue
{
$coords = $self->_get_up_coords($coords);
}
return [ reverse(@leading_path) ];
}
sub _get_leading_path
{
my $self = shift;
return $self->_get_leading_path_of_coords(
$self->_leading_path_coords()
);
}
sub render
{
my $self = shift;
my %args = (@_);
return $self->_render_generic(
{ %args , _iter_method => '_get_nav_menu_traverser',}
);
}
sub _render_generic
{
my $self = shift;
my $args = shift;
my $method = $args->{_iter_method};
my $iterator = $self->$method();
$iterator->traverse();
my $html = $iterator->get_results();
my %nav_links;
my %nav_links_obj;
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))
{
my $obj =
$self->_get_leading_path_of_coords(
$coords
)->[-1];
$nav_links_obj{$link_rel} = $obj;
$nav_links{$link_rel} = $obj->direct_url();
}
}
my $js_code = "";
return
{
'html' => $html,
'leading_path' => $self->_get_leading_path(),
'nav_links' => \%nav_links,
'nav_links_obj' => \%nav_links_obj,
};
}
1;
__END__
=head1 NAME
HTML::Widgets::NavMenu - A Perl Module for Generating HTML Navigation Menus
=head1 SYNOPSIS
use HTML::Widgets::NavMenu;
my $nav_menu =
HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
'current_host' => "default",
'hosts' =>
{
'default' =>
{
'base_url' => "http://www.hello.com/"
},
},
'tree_contents' =>
{
'host' => "default",
'text' => "Top 1",
'title' => "T1 Title",
'expand_re' => "",
'subs' =>
[
{
'text' => "Home",
'url' => "",
},
{
'text' => "About Me",
'title' => "About Myself",
'url' => "me/",
},
],
},
);
my $results = $nav_menu->render();
my $nav_menu_html = join("\n", @{$results->{'html'}});
=head1 DESCRIPTION
This module generates a navigation menu for a site. It can also generate
a complete site map, a path of leading components, and also keeps
track of navigation links ("Next", "Prev", "Up", etc.) You can start from the
example above and see more examples in the tests, in the C
directory of the HTML-Widgets-NavMenu tarball, and complete working sites
in the version control repositories at
L
and L.
=head1 USAGE
=head2 my $nav_menu = HTML::Widgets::NavMenu->new(@args)
To use this module call the constructor with the following named arguments:
=over 4
=item hosts
This should be a hash reference that maps host-IDs to another hash reference
that contains information about the hosts. An HTML::Widgets::NavMenu navigation
menu can spread across pages in several hosts, which will link from one to
another using relative URLs if possible and fully-qualified (i.e: C)
URLs if not.
Currently the only key required in the hash is the C 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, which denotes the component of
the site that appears after the hostname. For C
it is C~myuser/>.
Here's an example for a minimal hosts value:
'hosts' =>
{
'default' =>
{
'base_url' => "http://www.hello.com/",
'trailing_url_base' => "/",
},
},
And here's a two-hosts value from my personal site, which is spread across
two sites:
'hosts' =>
{
't2' =>
{
'base_url' => "http://www.shlomifish.org/",
'trailing_url_base' => "/",
},
'vipe' =>
{
'base_url' => "http://vipe.technion.ac.il/~shlomif/",
'trailing_url_base' => "/~shlomif/",
},
},
=item current_host
This parameter indicate which host-ID of the hosts in C is the
one that the page for which the navigation menu should be generated is. This
is important so cross-site and inner-site URLs will be handled correctly.
=item path_info
This is the path relative to the host's C of the currently displayed
page. The path should start with a "/"-character, or otherwise a re-direction
excpetion will be thrown (this is done to aid in using this module from within
CGI scripts).
=item tree_contents
This item gives the complete tree for the navigation menu. It is a nested
Perl data structure, whose syntax is fully explained in the section
"The Input Tree of Contents".
=item ul_classes
This is an optional parameter whose value is a reference to an array that
indicates the values of the class="" arguments for the CulE> tags
whose depthes are the indexes of the array.
For example, assigning:
'ul_classes' => [ "FirstClass", "second myclass", "3C" ],
Will assign "FirstClass" as the class of the top-most ULs, "second myclass"
as the classes of the ULs inner to it, and "3C" as the class of the ULs inner
to the latter ULs.
If classes are undef, the UL tag will not contain a class parameter.
=item no_leading_dot
When this parameter is set to 1, the object will try to generate URLs that
do not start with "./" when possible. That way, the generated markup will
be a little more compact. This option is not enabled by default for
backwards compatibility, but is highly recommended.
=back
A complete invocation of an HTML::Widgets::NavMenu constructor can be
found in the SYNOPSIS above.
After you _init an instance of the navigation menu object, you need to
get the results using the render function.
=head2 $results = $nav_menu->render()
render() should be called after a navigation menu object is constructed
to prepare the results and return them. It returns a hash reference with the
following keys:
=over 4
=item 'html'
This key points to a reference to an array that contains the tags for the
HTML. One can join these tags to get the full HTML. It is possible to
delimit them with newlines, if one wishes the markup to be easier to read.
=item 'leading_path'
This is a reference to an array of node description objects. These indicate the
intermediate pages in the site that lead from the front page to the
current page. The methods supported by the class of these objects is described
below under "The Node Description Component Class".
=item 'nav_links_obj'
This points to a hash reference whose keys are link IDs for
the Firefox "Site Navigation Toolbar"
( L ) and compatible programs,
and its values are Node Description objects. (see "The Node Description
Class" below). Here's a sample code that renders the links as
Clink rel=...E> into the page header:
my $nav_links = $results->{'nav_links_obj'};
# Sort the keys so their order will be preserved
my @keys = (sort { $a cmp $b } keys(%$nav_links));
foreach my $key (@keys)
{
my $value = $nav_links->{$key};
my $url = CGI::escapeHTML($value->direct_url());
my $title = CGI::escapeHTML($value->title());
print {$fh} "\n";
}
=item 'nav_links'
This points to a hash reference whose keys are link IDs compatible with the
Firefox Site Navigation ( L ) and its
values are the URLs to these links. This key/value pair is provided for
backwards compatibility with older versions of HTML::Widgets::NavMenu. In new
code, one is recommended to use C<'nav_links_obj'> instead.
This sample code renders the links as Clink rel=...E> into the
page header:
my $nav_links = $results->{'nav_links'};
# Sort the keys so their order will be preserved
my @keys = (sort { $a cmp $b } keys(%$nav_links));
foreach my $key (@keys)
{
my $url = $nav_links->{$key};
print {$fh} "\n";
}
=back
=head2 $results = $nav_menu->render_jquery_treeview()
Renders a fully expanded tree suitable for input to JQuery's treeview plugin:
L - otherwise
the same as render() .
=head2 $text = $nav_menu->gen_site_map()
This function can be called to generate a site map based on the tree of
contents. It returns a reference to an array containing the tags of the
site map.
=head2 $url = $nav_menu->get_cross_host_rel_url_ref({...})
This function can be called to calculate a URL to a different part of the
site. It accepts four named arguments, passed as a hash-ref:
=over 8
=item 'host'
This is the host ID
=item 'host_url'
This is URL within the host.
=item 'url_type'
C<'rel'>, C<'full_abs'> or C<'site_abs'>.
=item 'url_is_abs'
A flag that indicates if C<'host_url'> is already absolute.
=back
=head2 $url = $nav_menu->get_cross_host_rel_url(...)
This is like get_cross_host_rel_url_ref() except that the arguments
are clobbered into the arguments list. It is kept here for compatibility
sake.
=head1 The Input Tree of Contents
The input tree is a nested Perl data structure that represnets the tree
of the site. Each node is respresented as a Perl hash reference, with its
sub-nodes contained in an array reference of its C<'subs'> value. A
non-existent C<'subs'> means that the node is a leaf and has no sub-nodes.
The top-most node is mostly a dummy node, that just serves as the father
of all other nodes.
Following is a listing of the possible values inside a node hash and what
their respective values mean.
=over 4
=item 'host'
This is the host-ID of the host as found in the C<'hosts'> key to the
navigation menu object constructor. It implicitly propagates downwards in the
tree. (i.e: all nodes of the sub-tree spanning from the node will implicitly
have it as their value by default.)
Generally, a host must always be specified and so the first node should
specify it.
=item 'url'
This contains the URL of the node within the host. The URL should not
contain a leading slash. This value does not propagate further.
The URL should be specified for every nodes except separators and the such.
=item 'text'
This is the text that will be presented to the user as the text of the
link inside the navigation bar. E.g.: if C<'text'> is "Hi There", then the
link will look something like this:
Hi There
Or
Hi There
if it's the current page. Not that this text is rendered into HTML
as is, and so should be escaped to prevent HTML-injection attacks.
=item 'title'
This is the text of the link tag's title attribute. It is also not
processed and so the user of the module should make sure it is escaped
if needed, to prevent HTML-injection attacks. It is optional, and if not
specified, no title will be presented.
=item 'subs'
This item, if specified, should point to an array reference containing the
sub-nodes of this item, in order.
=item 'separator'
This key if specified and true indicate that the item is a separator, which
should just leave a blank line in the HTML. It is best to accompany it with
C<'skip'> (see below).
If C<'separator'> is specified, it is usually meaningless to specify all
other node keys except C<'skip'>.
=item 'skip'
This key if true, indicates that the node should be skipped when traversing
site using the Mozilla navigation links. Instead the navigation will move
to the next or previous nodes.
=item 'hide'
This key if true indicates that the item should be part of the site's flow
and site map, but not displayed in the navigation menu.
=item 'role'
This indicates a role of an item. It is similar to a CSS class, or to
DocBook's "role" attribute, only induces different HTML markup. The vanilla
HTML::Widgets::NavMenu does not distinguish between any roles, but see
L.
=item 'expand'
This specifies a predicate (a Perl value that is evaluated to a boolean
value, see "Predicate Values" below.) to be matched against the path and
current host to determine if the navigation menu should be expanded at this
node. If it does, all of the nodes up to it will expand as well.
=item 'show_always'
This value if true, indicates that the node and all nodes below it (until
'show_always' is explicitly set to false) must be always displayed. Its
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 at
the beginning, even if both the current path and the pointed path belong
to the same host. Something like C.
=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.
=item 'url_is_abs'
This flag, if true, indicates that the URL specified by the C<'url'> key
is an absolute URL like C and should not be
treated as a path within the site. All links to the page associated with
this node will contain the URL verbatim.
Note that using absolute URLs as part of the site flow is discouraged
because once they are accessed, the navigation within the primary site
is lost. A better idea would be to create a separate page within the
site, that will link to the external URL.
=item li_id
This is the HTML ID attribute that will be assigned to the specific
C<<
>> tag of the navigation menu. So if you have:
'tree_contents' =>
{
'host' => "default",
'text' => "Top 1",
'title' => "T1 Title",
'expand_re' => "",
'subs' =>
[
{
'text' => "Home",
'url' => "",
},
{
'text' => "About Me",
'title' => "About Myself",
'url' => "me/",
'li_id' => 'about_me',
},
],
},
Then the HTML for the About me will look something like:
=back
=head1 Predicate Values
An explicitly specified predicate value is a hash reference that contains
one of the following three keys with their appropriate values:
=over 4
=item 'cb' => \&predicate_func
This specifies a sub-routine reference (or "callback" or "cb"), that will be
called to determine the result of the predicate. It accepts two named arguments
- C<'path_info'> which is the path of the current page (without the leading
slash) and C<'current_host'> which is the ID of the current host.
Here is an example for such a callback:
sub predicate_cb1
{
my %args = (@_);
my $host = $args{'current_host'};
my $path = $args{'path_info'};
return (($host eq "true") && ($path eq "mypath/"));
}
=item 're' => $regexp_string
This specifies a regular expression to be matched against the path_info
(regardless of what current_host is), to determine the result of the
predicate.
=item 'bool' => [ 0 | 1 ]
This specifies the constant boolean value of the predicate.
=back
Note that if C<'cb'> is specified then both C<'re'> and C<'bool'> will
be ignored, and C<'re'> over-rides C<'bool'>.
Orthogonal to these keys is the C<'capt'> key which specifies whether this
expansion "captures" or not. This is relevant to the behaviour in the
breadcrumbs' trails, if one wants the item to appear there or not. The
default value is true.
If the predicate is not a hash reference, then HTML::Widgets::NavMenu will
try to guess what it is. If it's a sub-routine reference, it will be an
implicit callback. If it's one of the values C<"0">, C<"1">, C<"yes">,
C<"no">, C<"true">, C<"false">, C<"True">, C<"False"> it will be considered
a boolean. If it's a different string, a regular expression match will
be attempted. Else, an excpetion will be thrown.
Here are some examples for predicates:
# Always expand.
'expand' => { 'bool' => 1, };
# Never expand.
'expand' => { 'bool' => 0, };
# Expand under home/
'expand' => { 're' => "^home/" },
# Expand under home/ when the current host is "foo"
sub expand_path_home_host_foo
{
my %args = (@_);
my $host = $args{'current_host'};
my $path = $args{'path_info'};
return (($host eq "foo") && ($path =~ m!^home/!));
}
'expand' => { 'cb' => \&expand_path_home_host_foo, },
=head1 The Node Description Class
When retrieving the leading path or the C, an array of objects
is returned. This section describes the class of these objects, so one will
know how to use them.
Basically, it is an object that has several accessors. The accessors are:
=over 4
=item host
The host ID of this node.
=item host_url
The URL of the node within the host. (one given in its 'url' key).
=item label
The label of the node. (one given in its 'text' key). This is not
SGML-escaped.
=item title
The title of the node. (that can be assigned to the URL 'title' attribute).
This is not SGML-escaped.
=item direct_url
A direct URL (usable for inclusion in an A tag ) from the current page to this
page.
=item url_type
This is the C (see above) that holds for this node.
=back
=head1 SEE ALSO
See the article Shlomi Fish wrote for Perl.com for a gentle introduction to
HTML-Widgets-NavMenu:
L
=over 4
=item L
An HTML::Widgets::NavMenu sub-class that contains support for another
role. Used for the navigation menu in L.
=item L
A module written by Yosef Meller for maintaining a navigation menu.
HTML::Widgets::NavMenu originally utilized it, but no longer does. This module
does not makes links relative on its own, and tends to generate a lot of
JavaScript code by default. It also does not have too many automated test
scripts.
=item L
A module by Don Owens for generating hierarchical HTML menus. I could not
quite understand its tree traversal semantics, so I ended up not using it. Also
seems to require that each of the tree node will have a unique ID.
=item L
This module also generates a navigation menu. The CPAN version is relatively
old, and the author sent me a newer version. After playing with it a bit, I
realized that I could not get it to do what I want (but I cannot recall
why), so I abandoned it.
=back
=head1 AUTHORS
Shlomi Fish, Eshlomif@cpan.orgE, L .
=head1 THANKS
Thanks to Yosef Meller (L) for writing
the module HTML::Widget::SideBar on which initial versions of this modules
were based. (albeit his code is no longer used here).
=head1 COPYRIGHT AND LICENSE
Copyright 2004, Shlomi Fish. All rights reserved.
You can use, modify and distribute this module under the terms of the MIT X11
license. ( L ).
=cut
NavMenu 000755 000764 000764 0 12535757554 22054 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets Object.pm 000444 000764 000764 3144 12535757554 23757 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::Object;
use strict;
use warnings;
use Class::XSAccessor;
sub new
{
my $class = shift;
my $self = {};
bless $self, $class;
$self->_init(@_);
return $self;
}
sub _init
{
my $self = shift;
return 0;
}
sub destroy_
{
my $self = shift;
return 0;
}
sub DESTROY
{
my $self = shift;
$self->destroy_();
}
=head2 __PACKAGE__->mk_accessors(qw(method1 method2 method3))
Equivalent to L's mk_accessors only using Class::XSAccessor.
It beats running an ugly script on my code, and can be done at run-time.
Gotta love dynamic languages like Perl 5.
=cut
sub mk_accessors
{
my $package = shift;
return $package->mk_acc_ref([@_]);
}
=head2 __PACKAGE__->mk_acc_ref([qw(method1 method2 method3)])
Creates the accessors in the array-ref of names at run-time.
=cut
sub mk_acc_ref
{
my $package = shift;
my $names = shift;
my $mapping = +{ map { $_ => $_ } @$names };
eval <<"EOF";
package $package;
Class::XSAccessor->import(
accessors => \$mapping,
);
EOF
}
=head1 NAME
HTML::Widgets::NavMenu::Object - a base object for HTML::Widgets::NavMenu
=head1 SYNOPSIS
For internal use only
=head1 FUNCTIONS
=head2 my $obj = HTML::Widgets::NavMenu::Object->new(@args)
Instantiates a new object. Calls C<$obj-E_init()> with C<@args>.
=head2 my $obj = HTML::Widgets::NavMenu::Object->destroy_();
A method that can be used to explicitly destroy an object.
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
HeaderRole.pm 000444 000764 000764 2445 12535757554 24566 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::HeaderRole;
use strict;
use warnings;
use base 'HTML::Widgets::NavMenu';
require HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole;
sub _get_nav_menu_traverser
{
my $self = shift;
return
HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole->new(
$self->_get_nav_menu_traverser_args()
);
}
1;
__END__
=head1 NAME
HTML::Widgets::NavMenu::HeaderRole - A Specialized HTML::Widgets::NavMenu
sub-class
=head1 SYNOPOSIS
Mostly the same as L except for the ability to
specify C<'role' =E "header"> as one of the node attributes.
=head1 DESCRIPTION
This module is constructed and invoked similarly to HTML::Widgets::NavMenu.
The only difference is that it is meaningful to specify C<"header"> as the
value of the C<'role'>.
In that case, the link or bolded label will be rendered within its own
Ch2E> header. The HTML will look something like this:
An example of this use can be found on the Perl Beginners Site
( L ).
=head1 SEE ALSO
L for the complete documentation of the super-class.
=head1 AUTHORS
Shlomi Fish, L .
=cut
EscapeHtml.pm 000444 000764 000764 1327 12535757554 24577 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::EscapeHtml;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT);
=head1 NAME
HTML::Widgets::NavMenu::EscapeHtml - provides a function to escape HTML.
=head1 SYNOPSIS
use HTML::Widgets::NavMenu::EscapeHtml;
my $escaped_html = escape_html($html);
=head2 escape_html()
Escapes the HTML.
=cut
@EXPORT=(qw(escape_html));
sub escape_html
{
my $string = shift;
$string =~ s{&}{&}gso;
$string =~ s{<}{<}gso;
$string =~ s{>}{>}gso;
$string =~ s{"}{"}gso;
return $string;
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
ExpandVal.pm 000444 000764 000764 1657 12535757554 24442 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::ExpandVal;
use strict;
use warnings;
use base 'HTML::Widgets::NavMenu::Object';
__PACKAGE__->mk_acc_ref([
qw(_capture)],
);
sub _init
{
my ($self, $args) = @_;
$self->_capture($args->{'capture'});
return 0;
}
sub is_capturing
{
my $self = shift;
return $self->_capture();
}
=head1 NAME
HTML::Widgets::NavMenu::ExpandVal - an expand value that differentiates among
different expands
For internal use only.
=head1 SYNOPSIS
my $expand_val = HTML::Widgets::NavMenu::ExpandVal->new('capture' => $bool);
=head1 FUNCTIONS
=head2 my $expand_val = HTML::Widgets::NavMenu::ExpandVal->new('capture' => $bool);
Creates a new object.
=head2 $expand_val->is_capturing()
Returns whether or not it is a capturing expansion.
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
JQueryTreeView.pm 000444 000764 000764 2357 12535757554 25450 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::JQueryTreeView;
use strict;
use warnings;
use base 'HTML::Widgets::NavMenu';
require HTML::Widgets::NavMenu::Iterator::JQTreeView;
sub _get_nav_menu_traverser
{
my $self = shift;
return
HTML::Widgets::NavMenu::Iterator::JQTreeView->new(
$self->_get_nav_menu_traverser_args()
);
}
1;
__END__
=head1 NAME
HTML::Widgets::NavMenu::JQueryTreeView - A Specialized HTML::Widgets::NavMenu
sub-class
=head1 SYNOPOSIS
Mostly the same as L execpt that it renders a fully
expanded tree suitable for input to JQuery's treeview plugin
=head1 DESCRIPTION
This module renders all nodes but places C< class="open" >
and C< class="close" > attributes in the opening C<<
>> tags.
An example of this use can be found in Shlomi Fish's Homepage
( L ).
=head1 SEE ALSO
L for the complete documentation of the super-class.
=head1 AUTHORS
Shlomi Fish ( L ).
=head1 COPYRIGHT AND LICENSE
Copyright 2004, Shlomi Fish. All rights reserved.
You can use, modify and distribute this module under the terms of the MIT X11
license. ( L ).
=cut
Predicate.pm 000444 000764 000764 7273 12535757554 24460 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::Predicate;
use strict;
use warnings;
use base 'HTML::Widgets::NavMenu::Object';
__PACKAGE__->mk_acc_ref([
qw(type bool regexp callback _capture)],
);
use HTML::Widgets::NavMenu::ExpandVal;
sub _init
{
my $self = shift;
my %args = (@_);
my $spec = $args{'spec'};
$self->_process_spec($spec);
return 0;
}
my %true_vals = (map { $_ => 1 } (qw(1 yes true True)));
sub _is_true_bool
{
my $self = shift;
my $val = shift;
return exists($true_vals{$val});
}
my %false_vals = (map { $_ => 1 } (qw(0 no false False)));
sub _is_false_bool
{
my $self = shift;
my $val = shift;
return exists($false_vals{$val});
}
sub _get_normalized_spec
{
my $self = shift;
my $spec = shift;
if (ref($spec) eq "HASH")
{
return $spec;
}
if (ref($spec) eq "CODE")
{
return +{ 'cb' => $spec };
}
if ($self->_is_true_bool($spec))
{
return +{ 'bool' => 1, };
}
if ($self->_is_false_bool($spec))
{
return +{ 'bool' => 0, };
}
# Default to regular expression
if (ref($spec) eq "")
{
return +{ 're' => $spec, };
}
die "Unknown spec type!";
}
sub _process_spec
{
my $self = shift;
my $spec = shift;
# TODO: Replace me with the real logic.
$self->_assign_spec(
$self->_get_normalized_spec(
$spec,
),
);
}
sub _assign_spec
{
my $self = shift;
my $spec = shift;
if (exists($spec->{'cb'}))
{
$self->type("callback");
$self->callback($spec->{'cb'});
}
elsif (exists($spec->{'re'}))
{
$self->type("regexp");
$self->regexp($spec->{'re'});
}
elsif (exists($spec->{'bool'}))
{
$self->type("bool");
$self->bool($spec->{'bool'});
}
else
{
die "Neither 'cb' nor 're' nor 'bool' were specified in the spec.";
}
$self->_capture(
(
(!exists($spec->{capt})) ? 1 : $spec->{capt}
)
);
}
sub _evaluate_bool
{
my ($self, $args) = @_;
my $path_info = $args->{'path_info'};
my $current_host = $args->{'current_host'};
my $type = $self->type();
if ($type eq "callback")
{
return $self->callback()->(
%$args
);
}
elsif ($type eq "bool")
{
return $self->bool();
}
else # $type eq "regexp"
{
my $re = $self->regexp();
return (($re eq "") || ($path_info =~ /$re/));
}
}
sub evaluate
{
my $self = shift;
my $bool = $self->_evaluate_bool({@_});
if (!$bool)
{
return $bool;
}
else
{
return HTML::Widgets::NavMenu::ExpandVal->new(
{
capture => $self->_capture()
},
);
}
}
=head1 NAME
HTML::Widgets::NavMenu::Predicate - a predicate object for
HTML::Widgets::NavMenu
=head1 SYNOPSIS
my $pred = HTML::Widgets::NavMenu::Predicate->new('spec' => $spec);
=head1 FUNCTIONS
=head2 my $pred = HTML::Widgets::NavMenu::Predicate->new('spec' => $spec)
Creates a new object.
=head2 $pred->evaluate( 'path_info' => $path_info, 'current_host' => $current_host )
Evaluates the predicate in the context of C<$path_info> and C<$current_host>
and returns the result.
=head2 $pred->type()
The type of the predicate.
=head2 $pred->bool()
Sets/gets the boolean value in case the type is a boolean.
=head2 $pred->callback()
Sets/gets the callback in case the type is callback.
=head2 $pred->regexp()
Sets/gets the regular expression in case the type is "regexp".
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
Url.pm 000444 000764 000764 5611 12535757554 23314 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::Url;
use strict;
use warnings;
use base 'HTML::Widgets::NavMenu::Object';
__PACKAGE__->mk_acc_ref([qw(
_url
_is_dir
_mode
)]);
=head1 NAME
HTML::Widgets::NavMenu::Url - URL manipulation class.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=cut
sub _init
{
my $self = shift;
my ($url, $is_dir, $mode) = @_;
# TODO - extract a method.
$self->_url(
(ref($url) eq "ARRAY")
? [ @$url ]
: [ split(/\//, $url) ]
);
$self->_is_dir($is_dir || 0);
$self->_mode($mode || 'server');
return 0;
}
sub _get_url
{
my $self = shift;
return [ @{$self->_url()} ];
}
sub _get_relative_url
{
my $base = shift;
my $url = $base->_get_url_worker(@_);
return ( ($url eq "") ? "./" : $url);
}
sub _get_url_worker
{
my $base = shift;
my $to = shift;
my $slash_terminated = shift;
my $no_leading_dot = shift;
my $prefix = ($no_leading_dot ? "" : "./");
my @this_url = @{$base->_get_url()};
my @other_url = @{$to->_get_url()};
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))
{
if ((!$base->_is_dir() ) ne (!$to->_is_dir()))
{
die "Two identical URLs with non-matching _is_dir()'s";
}
if (! $base->_is_dir())
{
if (scalar(@this_url_bak))
{
return $prefix . $this_url_bak[-1];
}
else
{
die "Root URL is not a directory";
}
}
}
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 = $prefix;
}
else
{
if (! $base->_is_dir())
{
pop(@this_url);
}
$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 .= ($prefix . join("/", @components));
if (($to->_is_dir()) && ($base->_mode() ne "harddisk") && scalar(@components))
{
$ret .= "/";
}
}
#if (($to->_is_dir()) && (scalar(@other_url) || $slash_terminated))
return $ret;
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
TagGen.pm 000444 000764 000764 2310 12535757554 23710 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu package HTML::Widgets::NavMenu::TagGen;
use strict;
use warnings;
use base 'HTML::Widgets::NavMenu::Object';
use HTML::Widgets::NavMenu::EscapeHtml;
__PACKAGE__->mk_acc_ref([
qw(name attributes)]
);
=head1 NAME
HTML::Widgets::NavMenu::TagGen - class to generate tags.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=head2 name
For internal use.
=head2 attributes
For internal use.
=cut
sub _init
{
my ($self, $args) = @_;
$self->name($args->{'name'});
$self->attributes($args->{'attributes'});
return 0;
}
=head2 $self->gen($attribute_values, $is_standalone)
Generate the tag.
=cut
sub gen
{
my $self = shift;
my $attr_values = shift;
my $is_standalone = shift || 0;
my @tag_list = keys(%$attr_values);
@tag_list = (grep { defined($attr_values->{$_}) } @tag_list);
@tag_list = (sort { $a cmp $b } @tag_list);
my $attr_spec = $self->attributes();
return "<" . $self->name() .
join("", map { " $_=\"" .
($attr_spec->{$_}->{'escape'} ?
escape_html($attr_values->{$_})
: $attr_values->{$_}
) . "\""
} @tag_list) .
($is_standalone ? " /" : "") . ">";
}
1;
Iterator 000755 000764 000764 0 12535757554 23645 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu JQTreeView.pm 000444 000764 000764 3514 12535757554 26330 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Iterator package HTML::Widgets::NavMenu::Iterator::JQTreeView;
use strict;
use warnings;
# For escape_html().
use HTML::Widgets::NavMenu::EscapeHtml;
use base qw(HTML::Widgets::NavMenu::Iterator::NavMenu);
sub _init
{
my $self = shift;
my $args = shift;
$self->SUPER::_init($args);
# Make a fresh copy just to be on the safe side.
$self->_ul_classes([ @{$args->{'ul_classes'}} ]);
return 0;
}
=head1 NAME
HTML::Widgets::NavMenu::Iterator::JQTreeView - an iterator for JQuery
TreeView's navigation menus.
=head1 SYNOPSIS
See L .
For internal use only.
=head1 METHODS
=cut
sub _calc_open_li_tag
{
my $self = shift;
my $id_attr = $self->_calc_li_id_attr();
return
(
$self->_is_expanded_for_treeview()
? (qq{
})
: ("
")
);
return;
}
=head2 get_currently_active_text ( $node )
Calculates the highlighted text for the node C<$node>. Normally surrounds it
with C<<< ... >>> tags.
=cut
sub _start_handle_non_role
{
my $self = shift;
my $top_item = $self->top;
my @tags_to_add = ($self->_calc_open_li_tag(), $self->get_link_tag());
if ($top_item->_num_subs_to_go() && $self->_is_expanded())
{
push @tags_to_add, ($self->get_open_sub_menu_tags());
}
$self->_add_tags(@tags_to_add);
return;
}
sub _start_handle_role
{
my $self = shift;
return $self->_start_handle_non_role();
}
sub _is_expanded
{
return 1;
}
sub _is_expanded_for_treeview
{
my $self = shift;
my $node = $self->top->_node();
return ($node->expanded() || $self->top->_accum_state->{'show_always'});
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
Html.pm 000444 000764 000764 5060 12535757554 25245 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Iterator package HTML::Widgets::NavMenu::Iterator::Html::Item;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Tree::Iterator::Item);
sub get_url_type
{
my $item = shift;
return
($item->_node()->url_type() ||
$item->_accum_state()->{'rec_url_type'} ||
"rel");
}
package HTML::Widgets::NavMenu::Iterator::Html;
=head1 NAME
HTML::Widgets::NavMenu::Iterator::Html - an iterator for HTML.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=cut
use base qw(HTML::Widgets::NavMenu::Iterator::Base);
use HTML::Widgets::NavMenu::EscapeHtml;
sub _construct_new_item
{
my $self = shift;
my $args = shift;
return HTML::Widgets::NavMenu::Iterator::Html::Item->new(
$args,
);
}
=head2 $self->node_start()
Gets called upon node start.
=cut
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();
}
}
=head2 $self->node_end()
Gets called upon node end.
=cut
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();
}
}
=head2 $self->end_root()
End-root event.
=cut
sub end_root
{
my $self = shift;
$self->_add_tags("
");
}
sub _end_regular
{
my $self = shift;
if ($self->top()->_num_subs() && $self->_is_expanded())
{
$self->_add_tags("");
}
$self->_add_tags("
");
}
=head2 $self->node_should_recurse()
Override to determine when one should recurse to the node.
=cut
sub node_should_recurse
{
my $self = shift;
return $self->_is_expanded();
}
=head2 $self->get_a_tag()
Renders the HTML for the opening a-tag.
=cut
# Get the HTML tag.
#
sub get_a_tag
{
my $self = shift;
my $item = $self->top();
my $node = $item->_node;
my $tag ="title;
$tag .= " href=\"" .
escape_html(
$self->nav_menu()->_get_url_to_item($item)
). "\"";
if (defined($title))
{
$tag .= " title=\"$title\"";
}
$tag .= ">" . $node->text() . "";
return $tag;
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
Base.pm 000444 000764 000764 5124 12535757554 25214 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Iterator package HTML::Widgets::NavMenu::Iterator::Base;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Tree::Iterator);
__PACKAGE__->mk_acc_ref([qw(
_html
nav_menu
)]);
=head1 NAME
HTML::Widgets::NavMenu::Iterator::Base - base class for the iterator.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=head2 nav_menu
Internal use.
=cut
sub _init
{
my $self = shift;
my $args = shift;
$self->SUPER::_init($args);
$self->nav_menu($args->{'nav_menu'}) or
die "nav_menu not specified!";
$self->_html([]);
return 0;
}
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;
}
=head2 $self->get_initial_node()
Gets the initial node.
=cut
sub get_initial_node
{
my $self = shift;
return $self->nav_menu->_get_traversed_tree();
}
=head2 $self->get_node_subs({ node => $node})
Gets the subs of the node.
=cut
sub get_node_subs
{
my ($self, $args) = @_;
my $node = $args->{'node'};
return [ @{$node->subs()} ];
}
=head2 $self->get_new_accum_state( { item => $item, node => $node } )
Gets the new accumulated state.
=cut
# TODO : This method is too long - refactor.
sub get_new_accum_state
{
my ($self, $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() ? $node->host() : $prev_state->{'host'}),
'show_always' => $show_always,
'rec_url_type' => $rec_url_type,
};
}
=head2 my $array_ref = $self->get_results()
Returns an array reference with the resultant HTML.
=cut
sub get_results
{
my $self = shift;
return [ @{$self->_html()} ];
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
NavMenu.pm 000444 000764 000764 10403 12535757554 25727 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Iterator package HTML::Widgets::NavMenu::Iterator::NavMenu;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Iterator::Html);
use HTML::Widgets::NavMenu::EscapeHtml;
__PACKAGE__->mk_acc_ref([qw(
_ul_classes
)]);
=head1 NAME
HTML::Widgets::NavMenu::Iterator::NavMenu - navmenu iterator.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=cut
sub _init
{
my $self = shift;
my $args = shift;
$self->SUPER::_init($args);
# Make a fresh copy just to be on the safe side.
$self->_ul_classes([ @{$args->{'ul_classes'}} ]);
return 0;
}
sub _calc_li_id_attr
{
my $self = shift;
my $li_id = $self->top()->_li_id;
return
(defined ($li_id)
? qq/ id="/ . escape_html($li_id) . qq/"/
: q//
);
}
=head2 $self->gen_ul_tag({depth => $depth});
Generate a UL tag of depth $depth.
=cut
# Depth is 1 for the uppermost depth.
sub gen_ul_tag
{
my ($self, $args) = @_;
my $depth = $args->{'depth'};
my $class = $self->_get_ul_class({'depth' => $depth});
return "
";
}
sub _get_ul_class
{
my ($self, $args) = @_;
my $depth = $args->{'depth'};
return $self->_ul_classes->[$depth-1];
}
=head2 get_currently_active_text ( $node )
Calculates the highlighted text for the node C<$node>. Normally surrounds it
with C<<< ... >>> tags.
=cut
sub get_currently_active_text
{
my $self = shift;
my $node = shift;
return "" . $node->text() . "";
}
=head2 $self->get_link_tag()
Gets the tag for the link - an item in the menu.
=cut
sub get_link_tag
{
my $self = shift;
my $node = $self->top->_node();
if ($node->CurrentlyActive())
{
return $self->get_currently_active_text($node);
}
else
{
return $self->get_a_tag();
}
}
sub _start_root
{
my $self = shift;
$self->_add_tags(
$self->gen_ul_tag(
{
'depth' => $self->stack->len()
}
)
);
}
sub _start_sep
{
my $self = shift;
$self->_add_tags("
");
}
sub _start_handle_role
{
my $self = shift;
return $self->_start_handle_non_role();
}
=head2 my @tags = $self->get_open_sub_menu_tags()
Gets the tags to open a new sub menu.
=cut
sub get_open_sub_menu_tags
{
my $self = shift;
return (" ",
$self->gen_ul_tag(
{'depth' => $self->stack->len()}
)
);
}
sub _start_handle_non_role
{
my $self = shift;
my $top_item = $self->top;
my @tags_to_add = (("
_calc_li_id_attr() . ">"),
$self->get_link_tag());
if ($top_item->_num_subs_to_go() && $self->_is_expanded())
{
push @tags_to_add, ($self->get_open_sub_menu_tags());
}
$self->_add_tags(@tags_to_add);
}
sub _start_regular
{
my $self = shift;
my $top_item = $self->top;
my $node = $self->top->_node();
if ($self->_is_hidden())
{
# Do nothing
}
else
{
if ($self->_is_role_specified())
{
$self->_start_handle_role();
}
else
{
$self->_start_handle_non_role();
}
}
}
sub _end_sep
{
my $self = shift;
$self->_add_tags(
$self->gen_ul_tag(
{
'depth' => $self->stack->len()-1
}
)
);
}
sub _end_handle_role
{
my $self = shift;
return $self->_end_handle_non_role();
}
sub _end_handle_non_role
{
my $self = shift;
return $self->SUPER::_end_regular();
}
sub _end_regular
{
my $self = shift;
if ($self->_is_hidden())
{
# Do nothing
}
elsif ($self->_is_role_specified())
{
$self->_end_handle_role();
}
else
{
$self->_end_handle_non_role();
}
}
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'});
}
=head2 $self->get_role()
Retrieves the current role.
=cut
sub get_role
{
my $self = shift;
return $self->top->_node->role();
}
sub _is_role_specified
{
my $self = shift;
return defined($self->get_role());
}
1;
SiteMap.pm 000444 000764 000764 1750 12535757554 25705 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Iterator package HTML::Widgets::NavMenu::Iterator::SiteMap;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Iterator::Html);
=head1 NAME
HTML::Widgets::NavMenu::Iterator::SiteMap - a site-map iterator.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=cut
sub _start_root
{
my $self = shift;
$self->_add_tags("
");
}
sub _start_sep
{
}
sub _start_regular
{
my $self = shift;
my $top_item = $self->top;
my $node = $self->top->_node();
$self->_add_tags("
");
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(" ");
$self->_add_tags("
");
}
}
sub _end_sep
{
}
sub _is_expanded
{
return 1;
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
NavMenu 000755 000764 000764 0 12535757554 25216 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Iterator HeaderRole.pm 000444 000764 000764 3162 12535757554 27725 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Iterator/NavMenu package HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Iterator::NavMenu);
__PACKAGE__->mk_acc_ref([qw(
_was_role
)]);
=head1 NAME
HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole - a nav-menu iterator
for the HeaderRole sub-class.
=head1 OVER-RIDED METHODS
=head2 $iter->_start_handle_role()
Handles the handling the role. Accepts the C<"header"> role and defaults to the
default behaviour with all others.
=cut
sub _start_handle_non_role
{
my $self = shift;
if ($self->_was_role())
{
$self->_add_tags(
$self->gen_ul_tag({'depth' => $self->stack->len()-2})
);
}
$self->_was_role(0);
return $self->SUPER::_start_handle_non_role();
}
sub _start_handle_role
{
my $self = shift;
if ($self->get_role() eq "header")
{
if (! $self->_was_role())
{
$self->_add_tags("
");
}
$self->_add_tags(
"
", $self->get_link_tag(), "
",
);
$self->_was_role(1);
}
else
{
return $self->SUPER::_start_handle_role();
}
}
=head2 $self->_end_handle_role()
Ends the role. Accepts the C<"header"> role and defaults to the
default behaviour with all others.
=cut
sub _end_handle_role
{
my $self = shift;
if ($self->get_role() eq "header")
{
# Do nothing;
}
else
{
return $self->SUPER::_end_handle_role();
}
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
Tree 000755 000764 000764 0 12535757554 22753 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu Iterator.pm 000444 000764 000764 10673 12535757554 25266 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Tree package HTML::Widgets::NavMenu::Tree::Iterator;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Object);
use HTML::Widgets::NavMenu::Tree::Iterator::Stack;
use HTML::Widgets::NavMenu::Tree::Iterator::Item;
__PACKAGE__->mk_acc_ref([qw(
coords
stack
)]);
=head1 NAME
HTML::Widgets::NavMenu::Tree::Iterator - an iterator for HTML.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=head2 coords
Internal use.
=head2 stack
Internal use.
=cut
sub _init
{
my $self = shift;
$self->stack(HTML::Widgets::NavMenu::Tree::Iterator::Stack->new());
return 0;
}
=head2 $self->top()
Retrieves the stack top item.
=cut
sub top
{
my $self = shift;
return $self->stack()->top();
}
sub _construct_new_item
{
my ($self, $args) = @_;
return HTML::Widgets::NavMenu::Tree::Iterator::Item->new(
$args
);
}
=head2 $self->get_new_item({'node' => $node, 'parent_item' => $parent})
Gets the new item.
=cut
sub get_new_item
{
my ($self, $args) = @_;
my $node = $args->{'node'};
my $parent_item = $args->{'parent_item'};
return
$self->_construct_new_item(
{
'node' => $node,
'subs' => $self->get_node_subs( { 'node' => $node } ),
'accum_state' =>
$self->get_new_accum_state(
{
'item' => $parent_item,
'node' => $node,
}
),
}
);
}
sub _push_into_stack
{
my $self = shift;
my $node = shift;
$self->stack()->push(
$self->get_new_item(
{
'node' => $node,
'parent_item' => $self->top(),
}
),
);
}
=head2 $self->traverse()
Traverses the tree.
=cut
sub traverse
{
my $self = shift;
$self->_push_into_stack($self->get_initial_node());
$self->coords([]);
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))
{
push @{$self->coords()}, $top_item->_visited_index();
$self->_push_into_stack(
$self->get_node_from_sub(
{
'item' => $top_item,
'sub' => $sub_item,
}
),
);
next MAIN_LOOP;
}
else
{
$self->node_end();
$self->stack->pop();
pop(@{$self->coords()})
}
}
return 0;
}
=head2 $self->get_node_from_sub()
This function can be overridden to generate a node from the sub-nodes
returned by get_node_subs() in a different way than the default.
=cut
sub get_node_from_sub
{
my $self = shift;
my $args = shift;
return $args->{'sub'};
}
=head2 $self->find_node_by_coords($coords, $callback)
Finds a node by its coordinations.
=cut
sub find_node_by_coords
{
my $self = shift;
my $coords = shift;
my $callback = shift || (sub { });
my $idx = 0;
my $item =
$self->get_new_item(
{
'node' => $self->get_initial_node(),
}
);
my $internal_callback =
sub {
$callback->(
'idx' => $idx,
'item' => $item,
'self' => $self,
);
};
$internal_callback->();
foreach my $c (@$coords)
{
$item =
$self->get_new_item(
{
'node' =>
$self->get_node_from_sub(
{
'item' => $item,
'sub' => $item->_get_sub($c),
}
),
'parent_item' => $item,
}
);
$idx++;
$internal_callback->();
}
return +{ 'item' => $item, };
}
=head2 $self->get_coords()
Returns the current coordinates of the object.
=cut
sub get_coords
{
my $self = shift;
return $self->coords();
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
Node.pm 000444 000764 000764 7263 12535757554 24343 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Tree package HTML::Widgets::NavMenu::Tree::Node;
use strict;
use warnings;
use base 'HTML::Widgets::NavMenu::Object';
__PACKAGE__->mk_acc_ref([
qw(
CurrentlyActive expanded hide host li_id role rec_url_type
separator show_always skip subs text title url url_is_abs url_type
)]
);
use HTML::Widgets::NavMenu::ExpandVal;
=head1 NAME
HTML::Widgets::NavMenu::Tree::Node - an iterator for HTML.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=head2 CurrentlyActive
Internal use.
=head2 expanded
Internal use.
=head2 CurrentlyActive
Internal use.
=head2 hide
Internal use.
=head2 host
Internal use.
=head2 li_id
Internal use.
=head2 role
Internal use.
=head2 rec_url_type
Internal use.
=head2 separator
Internal use.
=head2 show_always
Internal use.
=head2 skip
Internal use.
=head2 subs
Internal use.
=head2 text
Internal use.
=head2 title
Internal use.
=head2 url
Internal use.
=head2 url_is_abs
Internal use.
=head2 url_type
Internal use.
=cut
sub _init
{
my $self = shift;
$self->subs([]);
return $self;
}
=head2 $self->expand()
Expands the node.
=cut
sub expand
{
my $self = shift;
my $v = @_ ? (shift(@_)) :
HTML::Widgets::NavMenu::ExpandVal->new({capture => 1})
;
# Don't set it to something if it's already capture_expanded(),
# otherwise it can set as a non-capturing expansion.
if (! $self->capture_expanded())
{
$self->expanded($v);
}
return 0;
}
=head2 $self->mark_as_current()
Marks the node as the current node.
=cut
sub mark_as_current
{
my $self = shift;
$self->expand();
$self->CurrentlyActive(1);
return 0;
}
sub _process_new_sub
{
my $self = shift;
my $sub = shift;
$self->update_based_on_sub($sub);
}
=head2 $self->update_based_on_sub
Propagate changes.
=cut
sub update_based_on_sub
{
my $self = shift;
my $sub = shift;
if (my $expand_val = $sub->expanded())
{
$self->expand($expand_val);
}
}
=head2 $self->add_sub()
Adds a new subroutine.
=cut
sub add_sub
{
my $self = shift;
my $sub = shift;
push (@{$self->subs}, $sub);
$self->_process_new_sub($sub);
return 0;
}
=head2 $self->get_nth_sub($idx)
Get the $idx sub.
=cut
sub get_nth_sub
{
my $self = shift;
my $idx = shift;
return $self->subs()->[$idx];
}
sub _num_subs
{
my $self = shift;
return scalar(@{$self->subs()});
}
=head2 $self->list_regular_keys()
Customisation to list the regular keys.
=cut
sub list_regular_keys
{
my $self = shift;
return (qw(host li_id rec_url_type role show_always text title url url_type));
}
=head2 $self->list_boolean_keys()
Customisation to list the boolean keys.
=cut
sub list_boolean_keys
{
my $self = shift;
return (qw(hide separator skip url_is_abs));
}
=head2 $self->set_values_from_hash_ref($hash)
Set the values from the hash ref.
=cut
sub set_values_from_hash_ref
{
my $self = shift;
my $sub_contents = shift;
foreach my $key ($self->list_regular_keys())
{
if (exists($sub_contents->{$key}))
{
$self->$key($sub_contents->{$key});
}
}
foreach my $key ($self->list_boolean_keys())
{
if ($sub_contents->{$key})
{
$self->$key(1);
}
}
}
=head2 my $bool = $self->capture_expanded()
Tests whether the node is expanded and in a capturing way.
=cut
sub capture_expanded
{
my $self = shift;
if (my $e = $self->expanded())
{
return $e->is_capturing();
}
else
{
return;
}
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
Iterator 000755 000764 000764 0 12535757554 24544 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Tree Stack.pm 000444 000764 000764 2776 12535757554 26320 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Tree/Iterator package HTML::Widgets::NavMenu::Tree::Iterator::Stack;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Object);
__PACKAGE__->mk_acc_ref([qw(_items)]);
sub _init
{
my $self = shift;
$self->reset();
return 0;
}
=head1 NAME
HTML::Widgets::NavMenu::Tree::Iterator::Stack - a simple stack class.
=head1 SYNOPSIS
For internal use only.
=head1 METHODS
=cut
sub push
{
my $self = shift;
my $item = shift;
push @{$self->_items()}, $item;
return 0;
}
=head2 $s->push($myitem)
Pushes an item.
=cut
sub len
{
my $self = shift;
return scalar(@{$self->_items()});
}
=head2 $s->len($myitem)
Returns the number of elements.
=cut
sub top
{
my $self = shift;
return $self->_items->[-1];
}
=head2 $s->top()
Returns the highest item.
=cut
sub item
{
my $self = shift;
my $index = shift;
return $self->_items->[$index];
}
=head2 my $item = $s->item($index)
Returns the item of index C<$index>.
=cut
sub pop
{
my $self = shift;
return pop(@{$self->_items()});
}
=head2 my $item = $s->pop()
Pops the item and returns it.
=cut
sub is_empty
{
my $self = shift;
return ($self->len() == 0);
}
=head2 my $bool = $s->is_empty()
Returns true if the stack is empty.
=cut
sub reset
{
my $self = shift;
$self->_items([]);
return 0;
}
=head2 $s->reset();
Empties the stack
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
Item.pm 000444 000764 000764 3047 12535757554 26141 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/lib/HTML/Widgets/NavMenu/Tree/Iterator package HTML::Widgets::NavMenu::Tree::Iterator::Item;
use strict;
use warnings;
use base qw(HTML::Widgets::NavMenu::Object);
__PACKAGE__->mk_acc_ref([qw(
_node
_subs
_sub_idx
_visited
_accum_state
)]);
=head1 NAME
HTML::Widgets::NavMenu::Tree::Iterator::Item - an item for the tree iterator.
=head1 SYNOPSIS
For internal use only.
=cut
sub _init
{
my ($self, $args) = @_;
$self->_node($args->{'node'}) or
die "node not specified!";
$self->_subs($args->{'subs'}) or
die "subs not specified!";
$self->_sub_idx(-1);
$self->_visited(0);
$self->_accum_state($args->{'accum_state'}) or
die "accum_state not specified!";
return 0;
}
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($self->_sub_idx()+1)];
}
else
{
return undef;
}
}
sub _visited_index
{
my $self = shift;
return $self->_sub_idx();
}
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()});
}
sub _get_sub
{
my $self = shift;
my $sub_num = shift;
return $self->_subs()->[$sub_num];
}
sub _li_id {
return shift->_node->li_id();
}
=head1 COPYRIGHT & LICENSE
Copyright 2006 Shlomi Fish, all rights reserved.
This program is released under the following license: MIT X11.
=cut
1;
examples 000755 000764 000764 0 12535757554 17401 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 README 000444 000764 000764 170 12535757554 20374 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples article-examples contain the examples from the following article:
http://www.perl.com/pub/a/2005/07/07/navwidgets.html
output.pl 000444 000764 000764 1702 12535757554 21433 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples #!/usr/bin/perl
use strict;
use warnings;
use HTML::Widgets::NavMenu;
my $nav_menu =
HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
'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 $results = $nav_menu->render();
my $nav_menu_html = join("\n", @{$results->{'html'}});
print $nav_menu_html;
article-examples 000755 000764 000764 0 12535757554 22640 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples with-embellishments 000755 000764 000764 0 12535757554 26624 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples/article-examples H-W-NM-embellish.pl 000444 000764 000764 32022 12535757554 32202 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples/article-examples/with-embellishments #!/usr/bin/perl
use strict;
use warnings;
use HTML::Widgets::NavMenu;
use File::Path;
use Template;
my $css_style = <<"EOF";
a:hover { background-color : palegreen; }
.body {
float : left;
width : 70%;
padding-bottom : 1em;
padding-top : 0em;
margin-left : 1em;
background-color : white;
}
.navbar {
float : left;
background-color : moccasin;
width : 20%;
border-color : black;
border-width : thick;
border-style : double;
padding-left : 0.5em;
}
.navbar ul
{
font-family: sans-serif;
font-size : small;
margin-left : 0.3em;
padding-left : 1em;
}
.navlinks
{
background-color:
#30C020;
margin-bottom : 0.2em;
padding-left: 0.5em;
padding-bottom: 0.2em;
border-style: solid;
border-width: thin;
border-color: black;
}
.breadcrumb
{
background-color: #4190e1;
padding-bottom: 0.3em;
padding-left: 0.5em;
padding-top: 0.3em;
margin-bottom: 0.2em;
border-style: solid;
border-width: thin;
border-color: #FF8080;
font-size: 80%;
}
.breadcrumb :link
{
color: #FFFF00 ;
}
.breadcrumb :link:hover
{
color: red;
}
.breadcrumb :visited
{
color: #F5F5DC;
}
.breadcrumb :visited:hover
{
color: #800000;
}
EOF
my $nav_menu_tree =
{
'host' => "default",
'text' => "HTML-Widgets-NavMenu Example",
'title' => "HTML-Widgets-NavMenu",
'subs' =>
[
{
'text' => "Home",
'url' => "",
},
{
'text' => "About Myself",
'url' => "me/",
'subs' =>
[
{
'text' => "Bio",
'url' => "personal.html",
'title' => "A Short Biography of Myself",
},
{
'text' => "Contact",
'url' => "me/contact-me/",
'title'=> "How to Contact me in Every Conceivable Way",
},
{
'text' => "My Resumés",
'url' => "me/resumes/",
'subs' =>
[
{
'text' => "English Resumé",
'url' => "resume.html",
},
{
'text' => "Detailed English Resumé",
'url' => "resume_detailed.html",
},
],
},
],
},
{
'text' => "Humour",
'url' => "humour/",
'title' => "My Humorous Creations",
'subs' =>
[
{
'text' => "The Enemy",
'url' => "humour/TheEnemy/",
'title' => "The Enemy and How I Helped to Fight It",
},
{
'text' => "TOWTF",
'url' => "humour/TOWTF/",
'title' => "The One with the Fountainhead",
},
{
'text' => "The Pope",
'url' => "humour/Pope/",
'title' => "The Pope Died on Sunday",
},
{
'text' => "Humour Archive",
'title' => "Archive of Humorous Bits I came up with",
'url' => "humour.html",
},
{
'text' => "Fortune Cookies Collection",
'title' => "Collection of Files for Input to the UNIX 'fortune' Program",
'url' => "humour/fortunes/",
},
],
},
{
'text' => "Math-Ventures",
'url' => "MathVentures/",
'title' => "Mathematical Riddles and their Solutions",
},
{
'text' => "Computer Art",
'url' => "art/",
'title' => "Computer art I created while explaining how.",
'subs' =>
[
{
'text' => "Back to my Homepage",
'url' => "art/bk2hp/",
'title' => "A Back to my Homepage logo not unlike the one from the movie "Back to the Future"",
},
{
'text' => "Linux Banner",
'url' => "art/linux_banner/",
'title' => "Linux - Because Software Problems should not Cost Money",
},
],
},
{
'text' => "Software",
'url' => "open-source/",
'title' => "Pages related to Software (mostly Open-Source)",
'subs' =>
[
{
'text' => "Freecell Solver",
'url' => "open-source/projects/freecell-solver/",
},
{
'text' => "MikMod for Java",
'title' => "A Player for MOD Files (a type of Music Files) for the Java Environment",
'url' => "jmikmod/",
},
{
'text' => "FCFS RWLock",
'title' => "A First-Come First-Served Readers/Writers Lock",
'url' => "rwlock/",
},
{
'text' => "Quad-Pres",
'title' => "A Tool for Creating HTML Presentations",
'url' => "open-source/projects/quad-pres/",
},
{
'text' => "Favourite OSS",
'title' => "Favourite Open-Source Software",
'url' => "open-source/favourite/",
},
{
'text' => "Interviews",
'title' => "Interviews with Open-Source People",
'url' => "open-source/interviews/",
},
{
'text' => "Contributions",
'title' => "Contributions to Other Projects, that I did not Start",
'url' => "open-source/contributions/",
},
{
'text' => "Bits and Bobs",
'title' => "Various Small-Scale Open-Source Works",
'url' => "open-source/bits.html",
},
{
'text' => "Portability Libraries",
'title' => "Cross-Platform Abstraction Libraries",
'url' => "abstraction/",
},
{
'text' => "Software Tools",
'title' => "Software Construction and Management Tools",
'url' => "software-tools/",
},
],
},
{
'text' => "Lectures",
'url' => "lecture/",
'title' => "Presentations I Wrote (Mostly Technical)",
'subs' =>
[
{
'text' => "Perl for Newbies",
'url' => "lecture/Perl/Newbies/",
},
{
'text' => "Freecell Solver",
'url' => "lecture/Freecell-Solver/",
},
{
'text' => "Lambda Calculus",
'title' => "A presentation about a Turing-complete programming environment with only two primitives",
'url' => "lecture/lc/",
},
{
'text' => "The Gimp",
'title' => "A Presentation about the GNU Image Manipulation Program",
'url' => "lecture/Gimp/",
},
{
'text' => "GNU Autotools",
'url' => "lecture/Autotools/",
},
{
'text' => "Web Meta Lecture",
'title' => "A Presentation about the Web Meta Language",
'url' => "lecture/WebMetaLecture/",
},
],
},
{
'text' => "Essays",
'url' => "essays/",
'title' => "Various Essays and Articles about Technology and Philosophy in General",
'subs' =>
[
{
'text' => "Index to Essays",
'url' => "essays/Index/",
'title' => "Index to Essays and Articles I wrote.",
},
{
'text' => "Open Source",
'url' => "essays/open-source/",
'title' => "Essays about Open-Source",
},
{
'text' => "Life",
'url' => "essays/life/",
'title' => "Essays about Life, the Universe and Everything",
},
],
},
{
'text' => "Cool Links",
'url' => "links.html",
'title' => "An incomplete list of links I find cool and/or useful.",
},
{
'text' => "Site Map",
'url' => "site-map/",
'title' => "A site map for the site with all the pages",
},
],
};
my %hosts =
(
'hosts' =>
{
'default' =>
{
'base_url' => ("http://web-cpan.berlios.de/modules/" .
"HTML-Widgets-NavMenu/article/examples/simple/dest/"),
},
},
);
my @page_paths =
("", "me/", "personal.html", "me/contact-me/", "me/resumes/", "resume.html",
"resume_detailed.html", "humour/", "humour/TheEnemy/", "humour/TOWTF/",
"humour/Pope/", "humour.html", "humour/fortunes/", "MathVentures/",
"art/", "art/bk2hp/", "art/linux_banner/", "open-source/",
"open-source/projects/freecell-solver/", "jmikmod/", "rwlock/",
"open-source/projects/quad-pres/", "open-source/favourite/",
"open-source/interviews/", "open-source/contributions/",
"open-source/bits.html", "abstraction/", "software-tools/", "lecture/",
"lecture/Perl/Newbies/", "lecture/Freecell-Solver/", "lecture/lc/",
"lecture/Gimp/", "lecture/Autotools/", "lecture/WebMetaLecture/",
"essays/", "essays/Index/", "essays/open-source/", "essays/life/",
"links.html");
my @pages =
(map {
+{ 'path' => $_, 'title' => "Title for $_",
'content' => "
Content for $_
" }
} @page_paths);
# Add the site-map page.
{
my $site_map_path = "site-map/";
my $site_map_generator =
HTML::Widgets::NavMenu->new(
path_info => "/$site_map_path",
current_host => "default",
hosts => \%hosts,
tree_contents => $nav_menu_tree
);
push @pages,
{
'path' => $site_map_path,
'title' => "Site Map",
'content' => join("\n", @{$site_map_generator->gen_site_map()}),
};
};
foreach my $page (@pages)
{
my $path = $page->{'path'};
my $nav_menu =
HTML::Widgets::NavMenu->new(
path_info => "/$path",
current_host => "default",
hosts => \%hosts,
tree_contents => $nav_menu_tree,
);
my $nav_menu_results = $nav_menu->render();
my $file_path = $path;
if (($file_path =~ m{/$}) || ($file_path eq ""))
{
$file_path .= "index.html";
}
my $full_path = "dest/$file_path";
$full_path =~ m{^(.*)/[^/]+$};
# mkpath() throws an exception if it isn't successful, which will cause
# this program to terminate. This is what we want.
mkpath($1, 0, 0755);
open my $out, ">", $full_path or
die "Could not open \"$full_path\" for writing!";
my $template =
Template->new(
{
'POST_CHOMP' => 1,
}
);
my $vars =
{
'title' => $page->{'title'},
'css_style' => $css_style,
'nav_menu_text' => join("\n", @{$nav_menu_results->{'html'}}) . "\n",
'content' => $page->{'content'} . "\n",
'breadcrumbs' => $nav_menu_results->{leading_path},
'nav_links' => $nav_menu_results->{'nav_links_obj'},
};
my $nav_links_template = <<'EOF';
[% USE HTML %]
[% title %]
[% FOREACH key = nav_links.keys.sort %]
[% END %]
[% FOREACH c = breadcrumbs %]
[% UNLESS loop.first %] → [% END %]
[% c.label %]
[% END %]
My name is John Doe and I've been exploring the art and science of creating
navigation menus for 10 years now. I find navigation menus to be a fascinating
subject, and think everyone should be interested in them.
EOF
},
);
foreach my $page (@pages)
{
my $path = $page->{'path'};
my $title = $page->{'title'};
my $content = $page->{'content'};
my $nav_menu =
HTML::Widgets::NavMenu->new(
path_info => "/$path",
current_host => "default",
hosts => \%hosts,
tree_contents => $nav_menu_tree,
);
my $nav_menu_results = $nav_menu->render();
my $nav_menu_text = join("\n", @{$nav_menu_results->{'html'}});
my $file_path = $path;
if (($file_path =~ m{/$}) || ($file_path eq ""))
{
$file_path .= "index.html";
}
my $full_path = "dest/$file_path";
$full_path =~ m{^(.*)/[^/]+$};
# mkpath() throws an exception if it isn't successful, which will cause
# this program to terminate. This is what we want.
mkpath($1, 0, 0755);
open my $out, ">", $full_path or
die "Could not open \"$full_path\" for writing!";
print {$out} <<"EOF";
$title
$nav_menu_text
$title
$content
EOF
close($out);
}
fine-grained-site-flow 000755 000764 000764 0 12535757554 27077 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples/article-examples H-W-NM-fine-grained-site-flow.pl 000444 000764 000764 33140 12535757554 34752 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples/article-examples/fine-grained-site-flow #!/usr/bin/perl
use strict;
use warnings;
use HTML::Widgets::NavMenu;
use File::Path;
use Template;
my $css_style = <<"EOF";
a:hover { background-color : palegreen; }
.body {
float : left;
width : 70%;
padding-bottom : 1em;
padding-top : 0em;
margin-left : 1em;
background-color : white;
}
.navbar {
float : left;
background-color : moccasin;
width : 20%;
border-color : black;
border-width : thick;
border-style : double;
padding-left : 0.5em;
}
.navbar ul
{
font-family: sans-serif;
font-size : small;
margin-left : 0.3em;
padding-left : 1em;
}
.navlinks
{
background-color:
#30C020;
margin-bottom : 0.2em;
padding-left: 0.5em;
padding-bottom: 0.2em;
border-style: solid;
border-width: thin;
border-color: black;
}
.breadcrumb
{
background-color: #4190e1;
padding-bottom: 0.3em;
padding-left: 0.5em;
padding-top: 0.3em;
margin-bottom: 0.2em;
border-style: solid;
border-width: thin;
border-color: #FF8080;
font-size: 80%;
}
.breadcrumb :link
{
color: #FFFF00 ;
}
.breadcrumb :link:hover
{
color: red;
}
.breadcrumb :visited
{
color: #F5F5DC;
}
.breadcrumb :visited:hover
{
color: #800000;
}
EOF
my $nav_menu_tree =
{
'host' => "default",
'text' => "HTML-Widgets-NavMenu Example",
'title' => "HTML-Widgets-NavMenu",
'subs' =>
[
{
'text' => "Home",
'url' => "",
},
{
'text' => "About Myself",
'url' => "me/",
'subs' =>
[
{
'text' => "Bio",
'url' => "personal.html",
'title' => "A Short Biography of Myself",
},
{
'text' => "Contact",
'url' => "me/contact-me/",
'title'=> "How to Contact me in Every Conceivable Way",
},
{
'text' => "My Resumés",
'url' => "me/resumes/",
'subs' =>
[
{
'text' => "English Resumé",
'url' => "resume.html",
'skip' => 1,
},
{
'text' => "Detailed English Resumé",
'url' => "resume_detailed.html",
'skip' => 1,
},
],
},
],
},
{
'text' => "Humour",
'url' => "humour/",
'title' => "My Humorous Creations",
'show_always' => 1,
'subs' =>
[
{
'text' => "The Enemy",
'url' => "humour/TheEnemy/",
'title' => "The Enemy and How I Helped to Fight It",
},
{
'text' => "TOWTF",
'url' => "humour/TOWTF/",
'title' => "The One with the Fountainhead",
},
{
'text' => "The Pope",
'url' => "humour/Pope/",
'title' => "The Pope Died on Sunday",
},
{
'text' => "Humour Archive",
'title' => "Archive of Humorous Bits I came up with",
'url' => "humour.html",
},
{
'text' => "Fortune Cookies Collection",
'title' => "Collection of Files for Input to the UNIX 'fortune' Program",
'url' => "humour/fortunes/",
},
],
},
{
'text' => "Math-Ventures",
'url' => "MathVentures/",
'title' => "Mathematical Riddles and their Solutions",
},
{
'text' => "Computer Art",
'url' => "art/",
'title' => "Computer art I created while explaining how.",
'subs' =>
[
{
'text' => "Back to my Homepage",
'url' => "art/bk2hp/",
'title' => "A Back to my Homepage logo not unlike the one from the movie "Back to the Future"",
},
{
'text' => "Linux Banner",
'url' => "art/linux_banner/",
'title' => "Linux - Because Software Problems should not Cost Money",
},
],
},
{
'text' => "Software",
'url' => "open-source/",
'expand' => { 're' => "^(open-source|perl)/", },
'title' => "Pages related to Software (mostly Open-Source)",
'subs' =>
[
{
'text' => "Freecell Solver",
'url' => "open-source/projects/freecell-solver/",
},
{
'text' => "MikMod for Java",
'title' => "A Player for MOD Files (a type of Music Files) for the Java Environment",
'url' => "jmikmod/",
},
{
'text' => "FCFS RWLock",
'title' => "A First-Come First-Served Readers/Writers Lock",
'url' => "rwlock/",
},
{
'text' => "Quad-Pres",
'title' => "A Tool for Creating HTML Presentations",
'url' => "open-source/projects/quad-pres/",
},
{
'text' => "Favourite OSS",
'title' => "Favourite Open-Source Software",
'url' => "open-source/favourite/",
},
{
'text' => "Interviews",
'title' => "Interviews with Open-Source People",
'url' => "open-source/interviews/",
},
{
'text' => "Contributions",
'title' => "Contributions to Other Projects, that I did not Start",
'url' => "open-source/contributions/",
},
{
'text' => "Bits and Bobs",
'title' => "Various Small-Scale Open-Source Works",
'url' => "open-source/bits.html",
},
{
'text' => "Portability Libraries",
'title' => "Cross-Platform Abstraction Libraries",
'url' => "abstraction/",
'hide' => 1,
},
{
'text' => "Software Tools",
'title' => "Software Construction and Management Tools",
'url' => "software-tools/",
'hide' => 1,
},
],
},
{
'text' => "Lectures",
'url' => "lecture/",
'expand' => { 're' => "^lecture/", },
'title' => "Presentations I Wrote (Mostly Technical)",
'subs' =>
[
{
'text' => "Perl for Newbies",
'url' => "lecture/Perl/Newbies/",
},
{
'text' => "Freecell Solver",
'url' => "lecture/Freecell-Solver/",
},
{
'text' => "Lambda Calculus",
'title' => "A presentation about a Turing-complete programming environment with only two primitives",
'url' => "lecture/lc/",
},
{
'text' => "The Gimp",
'title' => "A Presentation about the GNU Image Manipulation Program",
'url' => "lecture/Gimp/",
},
{
'text' => "GNU Autotools",
'url' => "lecture/Autotools/",
},
{
'text' => "Web Meta Lecture",
'title' => "A Presentation about the Web Meta Language",
'url' => "lecture/WebMetaLecture/",
},
],
},
{
'text' => "Essays",
'url' => "essays/",
'title' => "Various Essays and Articles about Technology and Philosophy in General",
'subs' =>
[
{
'text' => "Index to Essays",
'url' => "essays/Index/",
'title' => "Index to Essays and Articles I wrote.",
},
{
'text' => "Open Source",
'url' => "essays/open-source/",
'title' => "Essays about Open-Source",
},
{
'text' => "Life",
'url' => "essays/life/",
'title' => "Essays about Life, the Universe and Everything",
},
],
},
{
'text' => "Cool Links",
'url' => "links.html",
'title' => "An incomplete list of links I find cool and/or useful.",
},
{
'text' => "Site Map",
'url' => "site-map/",
'title' => "A site map for the site with all the pages",
},
],
};
my %hosts =
(
'hosts' =>
{
'default' =>
{
'base_url' => ("http://web-cpan.berlios.de/modules/" .
"HTML-Widgets-NavMenu/article/examples/simple/dest/"),
},
},
);
my @page_paths =
("", "me/", "personal.html", "me/contact-me/", "me/resumes/", "resume.html",
"resume_detailed.html", "humour/", "humour/TheEnemy/", "humour/TOWTF/",
"humour/Pope/", "humour.html", "humour/fortunes/", "MathVentures/",
"art/", "art/bk2hp/", "art/linux_banner/", "open-source/",
"open-source/projects/freecell-solver/", "jmikmod/", "rwlock/",
"open-source/projects/quad-pres/", "open-source/favourite/",
"open-source/interviews/", "open-source/contributions/",
"open-source/bits.html", "abstraction/", "software-tools/", "lecture/",
"lecture/Perl/Newbies/", "lecture/Freecell-Solver/", "lecture/lc/",
"lecture/Gimp/", "lecture/Autotools/", "lecture/WebMetaLecture/",
"essays/", "essays/Index/", "essays/open-source/", "essays/life/",
"links.html");
my @pages =
(map {
+{ 'path' => $_, 'title' => "Title for $_",
'content' => "
",
}
);
foreach my $page (@pages)
{
my $path = $page->{'path'};
my $nav_menu =
HTML::Widgets::NavMenu->new(
path_info => "/$path",
current_host => "default",
hosts => \%hosts,
tree_contents => $nav_menu_tree,
);
my $nav_menu_results = $nav_menu->render();
my $file_path = $path;
if (($file_path =~ m{/$}) || ($file_path eq ""))
{
$file_path .= "index.html";
}
my $full_path = "dest/$file_path";
$full_path =~ m{^(.*)/[^/]+$};
# mkpath() throws an exception if it isn't successful, which will cause
# this program to terminate. This is what we want.
mkpath($1, 0, 0755);
open my $out, ">", $full_path or
die "Could not open \"$full_path\" for writing!";
my $template =
Template->new(
{
'POST_CHOMP' => 1,
}
);
my $vars =
{
'title' => $page->{'title'},
'css_style' => $css_style,
'nav_menu_text' => join("\n", @{$nav_menu_results->{'html'}}) . "\n",
'content' => $page->{'content'} . "\n",
'breadcrumbs' => $nav_menu_results->{leading_path},
'nav_links' => $nav_menu_results->{'nav_links_obj'},
};
my $nav_links_template = <<'EOF';
[% USE HTML %]
[% title %]
[% FOREACH key = nav_links.keys.sort %]
[% END %]
[% FOREACH c = breadcrumbs %]
[% UNLESS loop.first %] → [% END %]
[% c.label %]
[% END %]
EOF
$template->process(\$nav_links_template, $vars, $out);
close($out);
}
complex 000755 000764 000764 0 12535757554 24307 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples/article-examples H-W-NM-complex.pl 000444 000764 000764 25475 12535757554 27406 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/examples/article-examples/complex #!/usr/bin/perl
use strict;
use warnings;
use HTML::Widgets::NavMenu;
use File::Path;
my $css_style = <<"EOF";
a:hover { background-color : palegreen; }
.body {
float : left;
width : 70%;
padding-bottom : 1em;
padding-top : 0em;
margin-left : 1em;
background-color : white
}
.navbar {
float : left;
background-color : moccasin;
width : 20%;
border-color : black;
border-width : thick;
border-style : double;
padding-left : 0.5em;
}
.navbar ul
{
font-family: sans-serif;
font-size : small;
margin-left : 0.3em;
padding-left : 1em;
}
EOF
my $nav_menu_tree =
{
'host' => "default",
'text' => "HTML-Widgets-NavMenu Example",
'title' => "HTML-Widgets-NavMenu",
'subs' =>
[
{
'text' => "Home",
'url' => "",
},
{
'text' => "About Myself",
'url' => "me/",
'subs' =>
[
{
'text' => "Bio",
'url' => "personal.html",
'title' => "A Short Biography of Myself",
},
{
'text' => "Contact",
'url' => "me/contact-me/",
'title'=> "How to Contact me in Every Conceivable Way",
},
{
'text' => "My Resumés",
'url' => "me/resumes/",
'subs' =>
[
{
'text' => "English Resumé",
'url' => "resume.html",
},
{
'text' => "Detailed English Resumé",
'url' => "resume_detailed.html",
},
],
},
],
},
{
'text' => "Humour",
'url' => "humour/",
'title' => "My Humorous Creations",
'subs' =>
[
{
'text' => "The Enemy",
'url' => "humour/TheEnemy/",
'title' => "The Enemy and How I Helped to Fight It",
},
{
'text' => "TOWTF",
'url' => "humour/TOWTF/",
'title' => "The One with the Fountainhead",
},
{
'text' => "The Pope",
'url' => "humour/Pope/",
'title' => "The Pope Died on Sunday",
},
{
'text' => "Humour Archive",
'title' => "Archive of Humorous Bits I came up with",
'url' => "humour.html",
},
{
'text' => "Fortune Cookies Collection",
'title' => "Collection of Files for Input to the UNIX 'fortune' Program",
'url' => "humour/fortunes/",
},
],
},
{
'text' => "Math-Ventures",
'url' => "MathVentures/",
'title' => "Mathematical Riddles and their Solutions",
},
{
'text' => "Computer Art",
'url' => "art/",
'title' => "Computer art I created while explaining how.",
'subs' =>
[
{
'text' => "Back to my Homepage",
'url' => "art/bk2hp/",
'title' => "A Back to my Homepage logo not unlike the one from the movie "Back to the Future"",
},
{
'text' => "Linux Banner",
'url' => "art/linux_banner/",
'title' => "Linux - Because Software Problems should not Cost Money",
},
],
},
{
'text' => "Software",
'url' => "open-source/",
'title' => "Pages related to Software (mostly Open-Source)",
'subs' =>
[
{
'text' => "Freecell Solver",
'url' => "open-source/projects/freecell-solver/",
},
{
'text' => "MikMod for Java",
'title' => "A Player for MOD Files (a type of Music Files) for the Java Environment",
'url' => "jmikmod/",
},
{
'text' => "FCFS RWLock",
'title' => "A First-Come First-Served Readers/Writers Lock",
'url' => "rwlock/",
},
{
'text' => "Quad-Pres",
'title' => "A Tool for Creating HTML Presentations",
'url' => "open-source/projects/quad-pres/",
},
{
'text' => "Favourite OSS",
'title' => "Favourite Open-Source Software",
'url' => "open-source/favourite/",
},
{
'text' => "Interviews",
'title' => "Interviews with Open-Source People",
'url' => "open-source/interviews/",
},
{
'text' => "Contributions",
'title' => "Contributions to Other Projects, that I did not Start",
'url' => "open-source/contributions/",
},
{
'text' => "Bits and Bobs",
'title' => "Various Small-Scale Open-Source Works",
'url' => "open-source/bits.html",
},
{
'text' => "Portability Libraries",
'title' => "Cross-Platform Abstraction Libraries",
'url' => "abstraction/",
},
{
'text' => "Software Tools",
'title' => "Software Construction and Management Tools",
'url' => "software-tools/",
},
],
},
{
'text' => "Lectures",
'url' => "lecture/",
'title' => "Presentations I Wrote (Mostly Technical)",
'subs' =>
[
{
'text' => "Perl for Newbies",
'url' => "lecture/Perl/Newbies/",
},
{
'text' => "Freecell Solver",
'url' => "lecture/Freecell-Solver/",
},
{
'text' => "Lambda Calculus",
'title' => "A presentation about a Turing-complete programming environment with only two primitives",
'url' => "lecture/lc/",
},
{
'text' => "The Gimp",
'title' => "A Presentation about the GNU Image Manipulation Program",
'url' => "lecture/Gimp/",
},
{
'text' => "GNU Autotools",
'url' => "lecture/Autotools/",
},
{
'text' => "Web Meta Lecture",
'title' => "A Presentation about the Web Meta Language",
'url' => "lecture/WebMetaLecture/",
},
],
},
{
'text' => "Essays",
'url' => "essays/",
'title' => "Various Essays and Articles about Technology and Philosophy in General",
'subs' =>
[
{
'text' => "Index to Essays",
'url' => "essays/Index/",
'title' => "Index to Essays and Articles I wrote.",
},
{
'text' => "Open Source",
'url' => "essays/open-source/",
'title' => "Essays about Open-Source",
},
{
'text' => "Life",
'url' => "essays/life/",
'title' => "Essays about Life, the Universe and Everything",
},
],
},
{
'text' => "Cool Links",
'url' => "links.html",
'title' => "An incomplete list of links I find cool and/or useful.",
},
],
};
my %hosts =
(
'hosts' =>
{
'default' =>
{
'base_url' => ("http://web-cpan.berlios.de/modules/" .
"HTML-Widgets-NavMenu/article/examples/simple/dest/"),
},
},
);
my @page_paths =
("", "me/", "personal.html", "me/contact-me/", "me/resumes/", "resume.html",
"resume_detailed.html", "humour/", "humour/TheEnemy/", "humour/TOWTF/",
"humour/Pope/", "humour.html", "humour/fortunes/", "MathVentures/",
"art/", "art/bk2hp/", "art/linux_banner/", "open-source/",
"open-source/projects/freecell-solver/", "jmikmod/", "rwlock/",
"open-source/projects/quad-pres/", "open-source/favourite/",
"open-source/interviews/", "open-source/contributions/",
"open-source/bits.html", "abstraction/", "software-tools/", "lecture/",
"lecture/Perl/Newbies/", "lecture/Freecell-Solver/", "lecture/lc/",
"lecture/Gimp/", "lecture/Autotools/", "lecture/WebMetaLecture/",
"essays/", "essays/Index/", "essays/open-source/", "essays/life/",
"links.html");
my @pages =
(map {
+{ 'path' => $_, 'title' => "Title for $_",
'content' => "
Content for $_
" }
} @page_paths);
foreach my $page (@pages)
{
my $path = $page->{'path'};
my $title = $page->{'title'};
my $content = $page->{'content'};
my $nav_menu =
HTML::Widgets::NavMenu->new(
path_info => "/$path",
current_host => "default",
hosts => \%hosts,
tree_contents => $nav_menu_tree,
);
my $nav_menu_results = $nav_menu->render();
my $nav_menu_text = join("\n", @{$nav_menu_results->{'html'}});
my $file_path = $path;
if (($file_path =~ m{/$}) || ($file_path eq ""))
{
$file_path .= "index.html";
}
my $full_path = "dest/$file_path";
$full_path =~ m{^(.*)/[^/]+$};
# mkpath() throws an exception if it isn't successful, which will cause
# this program to terminate. This is what we want.
mkpath($1, 0, 0755);
open my $out, ">", $full_path or
die "Could not open \"$full_path\" for writing!";
print {$out} <<"EOF";
$title
$nav_menu_text
$title
$content
EOF
close($out);
}
inc 000755 000764 000764 0 12535757554 16334 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 Test 000755 000764 000764 0 12535757554 17253 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/inc Run 000755 000764 000764 0 12535757554 20017 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/inc/Test Builder.pm 000444 000764 000764 3360 12535757554 22102 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/inc/Test/Run package Test::Run::Builder;
use strict;
use warnings;
use Module::Build;
use vars qw(@ISA);
@ISA = (qw(Module::Build));
sub ACTION_runtest
{
my ($self) = @_;
my $p = $self->{properties};
$self->depends_on('code');
local @INC = @INC;
# Make sure we test the module in blib/
unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
File::Spec->catdir($p->{base_dir}, $self->blib, 'arch'));
$self->do_test_run_tests;
}
sub ACTION_distruntest {
my ($self) = @_;
$self->depends_on('distdir');
my $start_dir = $self->cwd;
my $dist_dir = $self->dist_dir;
chdir $dist_dir or die "Cannot chdir to $dist_dir: $!";
# XXX could be different names for scripts
$self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
or die "Error executing 'Build.PL' in dist directory: $!";
$self->run_perl_script('Build')
or die "Error executing 'Build' in dist directory: $!";
$self->run_perl_script('Build', [], ['runtest'])
or die "Error executing 'Build test' in dist directory";
chdir $start_dir;
}
sub do_test_run_tests
{
my $self = shift;
require Test::Run::CmdLine::Iface;
my $test_run =
Test::Run::CmdLine::Iface->new(
{
'test_files' => [glob("t/*.t")],
}
# 'backend_params' => $self->_get_backend_params(),
);
return $test_run->run();
}
sub ACTION_tags
{
my $self = shift;
return
$self->do_system(
"ctags",
qw(-f tags --recurse --totals
--exclude=blib/** --exclude=t/lib/**
--exclude=**/.svn/** --exclude='*~'),
"--exclude=".$self->dist_name()."-*/**",
qw(--languages=Perl --langmap=Perl:+.t)
);
}
1;
t 000755 000764 000764 0 12535757554 16026 5 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703 07tree-iter.t 000444 000764 000764 14554 12535757554 20450 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
package MyIter;
use strict;
use base 'HTML::Widgets::NavMenu::Tree::Iterator';
__PACKAGE__->mk_accessors(qw(
_results
_data
));
sub _init
{
my $self = shift;
$self->SUPER::_init(@_);
my $args = shift;
$self->_data($args->{'data'});
$self->_results([]);
return 0;
}
sub append
{
my $self = shift;
push @{$self->_results()}, @_;
return 0;
}
sub get_initial_node
{
my $self = shift;
return $self->_data();
}
sub get_node_subs
{
my ($self, $args) = @_;
my $node = $args->{'node'};
return
exists($node->{'childs'}) ?
[ @{$node->{'childs'}} ] :
[];
}
sub get_new_accum_state
{
my ($self, $args) = @_;
my $parent_item = $args->{'item'};
my $node = $args->{'node'};
if (!defined($parent_item))
{
return $node->{'accum'};
}
my $prev_state =
$parent_item->_accum_state();
return ($node->{'accum'} || $prev_state);
}
sub node_start
{
my $self = shift;
my $top_item = $self->top;
my $node = $self->top->_node();
$self->append(join("-", "Start", $node->{'id'}, $top_item->_accum_state));
}
sub node_end
{
my $self = shift;
my $node = $self->top->_node();
$self->append(join("-", "End", $node->{'id'}));
}
sub node_should_recurse
{
my $self = shift;
my $node = $self->top->_node();
return $node->{'recurse'};
}
1;
package MyIterComplexSubs;
use vars qw(@ISA);
@ISA=qw(MyIter);
sub get_node_from_sub
{
my $self = shift;
my $args = shift;
my $item = $args->{'item'};
my $sub = $args->{'sub'};
my $node = $item->_node();
return $node->{'subs_db'}->{$sub};
}
1;
package main;
use Test::More tests => 4;
use strict;
sub test_traverse
{
my ($data, $expected, $test_name, $class) = (@_);
$class ||= "MyIter";
my $traverser =
$class->new(
{
'data' => $data
},
);
$traverser->traverse();
is_deeply($traverser->_results(), $expected, $test_name);
}
{
my $data =
{
'id' => "A",
'recurse' => 1,
'accum' => "one",
'childs' =>
[
{
'id' => "B",
'accum' => "two",
},
{
'id' => "C",
'recurse' => 1,
'childs' =>
[
{
'id' => "FG",
},
],
},
],
};
my @expected = ("Start-A-one", "Start-B-two", "End-B",
"Start-C-one", "Start-FG-one", "End-FG", "End-C", "End-A");
# TEST
test_traverse($data, \@expected, "Simple example for testing the Tree traverser.");
}
# This test checks that the should_recurse predicate is honoured.
{
my $data =
{
'id' => "A",
'recurse' => 1,
'accum' => "one",
'childs' =>
[
{
'id' => "B",
'accum' => "two",
},
{
'id' => "C",
'recurse' => 0,
'childs' =>
[
{
'id' => "FG",
},
],
},
],
};
my @expected = ("Start-A-one", "Start-B-two", "End-B",
"Start-C-one", "End-C", "End-A");
# TEST
test_traverse($data, \@expected, "Example with recurse = 0");
}
{
my $data =
{
'id' => "A",
'recurse' => 1,
'accum' => "one",
'childs' =>
[
{
'id' => "B",
'accum' => "two",
},
{
'id' => "C",
'recurse' => 0,
'childs' =>
[
{
'id' => "FG",
},
{
'id' => "E",
'recurse' => 0,
'childs' =>
[
{
'id' => "Y",
},
{
'id' => "Z",
},
],
},
],
},
{
'id' => "AGH",
'recurse' => 1,
'accum' => "three",
'childs' =>
[
{
'id' => "MON",
'recurse' => 0,
'accum' => "four",
'childs' =>
[
{
'id' => "HELLO",
'recurse' => 1,
},
],
},
{
'id' => "KOJ",
'recurse' => 1,
},
],
}
],
};
my @expected = ("Start-A-one", "Start-B-two", "End-B",
"Start-C-one", "End-C", "Start-AGH-three",
"Start-MON-four", "End-MON", "Start-KOJ-three", "End-KOJ",
"End-AGH", "End-A");
# TEST
test_traverse($data, \@expected, "Example with lots of weird combinations");
}
{
my $data =
{
'id' => "A",
'recurse' => 1,
'accum' => "one",
'childs' => [qw(hello good)],
'subs_db' =>
{
'hello' =>
{
'id' => "BOK",
'accum' => "two",
},
'good' =>
{
'id' => "C",
},
},
};
my @expected = ("Start-A-one", "Start-BOK-two", "End-BOK",
"Start-C-one", "End-C", "End-A");
# TEST
test_traverse($data, \@expected, "Example with complex sub resolution",
"MyIterComplexSubs");
}
09leading-path.t 000444 000764 000764 12672 12535757554 21106 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use strict;
use lib './t/lib';
use Test::More tests => 34;
use HTML::Widgets::NavMenu;
use HTML::Widgets::NavMenu::Test::Data;
my $test_data = get_test_data();
# This check tests that a leading path with a URL that is not registered
# in the nav menu still has one component of the root.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/non-existent-path/",
@{$test_data->{'minimal'}},
);
my $rendered =
$nav_menu->render();
my @leading_path = @{$rendered->{'leading_path'}};
# TEST
ok ((scalar(@leading_path) == 1), "Checking for a leading path of len 1");
my $component = $leading_path[0];
# TEST
is ($component->label(), "Home", "Testing for title of leading_path");
# TEST
is ($component->direct_url(), "../", "Testing for direct_url");
}
# This check tests the url_type behaviour of the leading-path
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/yowza/howza/",
@{$test_data->{'rec_url_type_menu'}},
);
my $rendered =
$nav_menu->render();
my @leading_path = @{$rendered->{'leading_path'}};
# TEST
ok ((scalar(@leading_path) == 3), "Checking for a leading path of len 3");
my $component = $leading_path[0];
# TEST
is ($component->label(), "Home", "Testing for title of leading_path");
# TEST
is ($component->direct_url(), "http://www.hello.com/~shlomif/",
"Testing for direct_url");
# TEST
is ($component->url_type(), "full_abs", "Testing for url_type");
$component = $leading_path[1];
# TEST
is ($component->label(), "Yowza", "Testing for label of leading_path");
# TEST
is ($component->direct_url(), "../",
"Testing for direct_url");
# TEST
is ($component->url_type(), "rel", "Testing for url_type");
$component = $leading_path[2];
# TEST
is ($component->label(), "This should be full_abs again",
"Testing for label of leading_path");
# TEST
is ($component->direct_url(), "http://www.hello.com/~shlomif/yowza/howza/",
"Testing for direct_url");
# TEST
is ($component->url_type(), "full_abs", "Testing for url_type");
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/sub-dir/",
@{$test_data->{'url_is_abs_menu'}},
);
my $rendered =
$nav_menu->render();
my @leading_path = @{$rendered->{'leading_path'}};
# TEST
ok ((scalar(@leading_path) == 3), "Checking for a leading path of len 1");
my $component = $leading_path[0];
# TEST
is ($component->label(), "Home", "Testing for title of leading_path");
# TEST
is ($component->direct_url(), "../", "Testing for direct_url");
$component = $leading_path[1];
# TEST
is ($component->title(), "Google it!",
"Testing for title of leading_path");
# TEST
is ($component->direct_url(), "http://www.google.com/",
"Testing for direct_url");
# TEST
is ($component->url_type(), "full_abs", "Testing for url_type");
$component = $leading_path[2];
# TEST
is ($component->direct_url(), "./",
"Testing for direct_url");
# TEST
is ($component->url_type(), "rel", "Testing for url_type");
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/open-source/alohaware/",
@{$test_data->{'selective_expand'}},
);
my $rendered =
$nav_menu->render();
my @leading_path = @{$rendered->{'leading_path'}};
# TEST
ok ((scalar(@leading_path) == 2), "Checking for a leading path of len 2");
my $component = $leading_path[-1];
# TEST
is ($component->title(), "Open Source Software I Wrote",
"Testing for title of leading_path");
# TEST
is ($component->direct_url(), "../",
"Testing for direct_url");
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/puzzles/bar/",
@{$test_data->{'root_path_not_slash'}},
);
my $rendered =
$nav_menu->render();
my @leading_path = @{$rendered->{'leading_path'}};
# TEST
is (scalar(@leading_path), 2, "Checking for a leading path of len 2");
my $component = $leading_path[0];
# TEST
is ($component->label(), "Home",
"Points to Home");
# TEST
is ($component->direct_url(), "../",
"Testing for direct_url");
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/humour/by-others/foo.html",
@{$test_data->{'non_capturing_expand'}},
);
my $rendered =
$nav_menu->render();
my @lp = @{$rendered->{'leading_path'}};
# TEST
is (scalar(@lp), 3, "Checking for a leading path of len 2");
# TEST
is ($lp[0]->direct_url(), "./../../", "lp[0]");
# TEST
is ($lp[1]->direct_url(), "./../", "lp[1]");
# TEST
is ($lp[2]->direct_url(), "./", "lp[2]");
}
# This test is to check that a non-capturing expand does not influence
# the upper capturing expands to not capture.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/humour/humanity/",
@{$test_data->{'non_capturing_expand_nested'}},
);
my $rendered =
$nav_menu->render();
my @lp = @{$rendered->{'leading_path'}};
# TEST
is (scalar(@lp), 2, "Checking for a leading path of len 2");
# TEST
is ($lp[0]->direct_url(), "../../", "Pointing to the home");
# TEST
is ($lp[1]->direct_url(), "../", "Pointing to the humour");
}
16redirect.t 000444 000764 000764 3253 12535757554 20323 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl
use strict;
use warnings;
package MockCGI;
sub new
{
my $self = {};
bless $self, shift;
return $self;
}
sub redirect
{
my ($self, $path) = (@_);
return "ReDirect-To: $path";
}
sub script_name
{
my $self = shift;
return "{{{Script Name}}}";
}
package main;
use vars qw($exit_count);
BEGIN
{
*CORE::GLOBAL::exit = sub { $exit_count++; };
}
use lib './t/lib';
use Test::More tests => 6;
use HTML::Widgets::NavMenu::Test::Data;
use HTML::Widgets::NavMenu::Test::Stdout;
use HTML::Widgets::NavMenu;
my $test_data = get_test_data();
{
eval {
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "",
@{$test_data->{'minimal'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
};
# TEST
isa_ok ($@, "HTML::Widgets::NavMenu::Error::Redirect", "\$@");
reset_out_buffer();
$exit_count = 0;
$@->CGIpm_perform_redirect(MockCGI->new());
# TEST
is(get_out_buffer(), "ReDirect-To: {{{Script Name}}}/",
"Checking that redirect-to works");
# TEST
is($exit_count, 1, "Counting an exit");
}
{
eval {
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/hello/world//",
@{$test_data->{'minimal'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
};
# TEST
isa_ok ($@, "HTML::Widgets::NavMenu::Error::Redirect", "\$@");
reset_out_buffer();
$exit_count = 0;
$@->CGIpm_perform_redirect(MockCGI->new());
# TEST
is(get_out_buffer(), "ReDirect-To: {{{Script Name}}}/hello/world/",
"Checking that redirect-to works");
# TEST
is($exit_count, 1, "Counting an exit");
}
02site-map.t 000444 000764 000764 14050 12535757554 20251 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use strict;
use lib './t/lib';
use Test::More tests => 6;
use HTML::Widgets::NavMenu;
use HTML::Widgets::NavMenu::Test::Data;
my $test_data = get_test_data();
sub validate_site_map
{
my $results = shift;
my $expected_string = shift;
my $test_blurb = shift;
my @result = @$results;
my @expected = (split(/\n/, $expected_string));
is_deeply(\@expected, \@result, $test_blurb);
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "hello/",
@{$test_data->{'minimal'}},
);
my $results = $nav_menu->gen_site_map();
my $expected_text = <<"EOF";
EOF
# TEST
validate_site_map($results, $expected_text, "site_map - complex");
}
# Now testing that the separator is safely skipped and does not generate
# a double
EOF
# TEST
validate_site_map($results, $expected_text, "site_map - separator");
}
# This is a test for the rec_url_type directive.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/darling/",
@{$test_data->{'rec_url_type_menu'}},
);
my $results = $nav_menu->gen_site_map();
my $expected_text = <<"EOF";
EOF
# TEST
validate_site_map($results, $expected_text, "site_map - rec_url_type");
}
# This is a test for the url_is_abs directive.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/darling/",
@{$test_data->{'url_is_abs_menu'}},
);
my $results = $nav_menu->gen_site_map();
my $expected_text = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Testing ul classes for no CSS class to be assigned.");
}
# This test tests the show_always directive which causes the entire
# sub-tree to expand at any URL.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'show_always'}},
'ul_classes' => [ "FirstClass", "secondclass 2C", "ThirdClass" ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu ($rendered, $expected_string, "Nav Menu with depth classes");
}
# This test tests the escaping of the class names.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'show_always'}},
'ul_classes' => [ "F&F Class", "sec", "T\"C" ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu ($rendered, $expected_string, "Nav Menu with depth classes");
}
pod-coverage.t 000444 000764 000764 254 12535757554 20704 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!perl -T
use Test::More;
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
all_pod_coverage_ok();
03nav-links.t 000444 000764 000764 6576 12535757554 20433 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use strict;
use lib './t/lib';
use Test::More tests => 14;
use HTML::Widgets::NavMenu;
use HTML::Widgets::NavMenu::Test::Data;
my $test_data = get_test_data();
my @site_args =
(
'current_host' => "default",
'hosts' => { 'default' => { 'base_url' => "http://www.hello.com/" }, },
'tree_contents' =>
{
'host' => "default",
'text' => "Top 1",
'title' => "T1 Title",
'expand_re' => "",
'subs' =>
[
{
'text' => "Home",
'url' => "",
},
{
'text' => "About Me",
'title' => "About Myself",
'url' => "me/",
},
{
'text' => "Last Page",
'title' => "Last Page",
'url' => "last-page.html",
}
],
},
);
# The purpose of this test is to check for the in-existence of navigation
# links from the first page. Generally, there shouldn't be "top", "up" and
# "prev" nav-links and only "next".
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/",
@site_args
);
my $rendered = $nav_menu->render();
my $nav_links = $rendered->{'nav_links'};
# TEST
ok ((scalar(keys(%$nav_links)) == 1) && (exists($nav_links->{'next'})),
"Lack of Nav-Links in the First Page");
my $obj_nav_links = $rendered->{'nav_links_obj'};
my $next = $obj_nav_links->{'next'};
# TEST
is ($next->host(), "default", "Checking for \$next->host().");
# TEST
is ($next->label(), "About Me", "Checking for label()");
# TEST
is ($next->title(), "About Myself", "Checking for title()");
# TEST
is ($next->direct_url(), "./me/", "Checking for direct_url()");
# TEST
is ($next->host_url(), "me/", "Checking for host_url()");
}
# The purpose of this test is to check for up arrow leading from the middle
# page to the "Home" page
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@site_args
);
my $rendered = $nav_menu->render();
my $nav_links = $rendered->{'nav_links'};
# TEST
is($nav_links->{'up'}, "../",
"Up page leading upwards to the first page.");
# TEST
is($nav_links->{'top'}, "../",
"Top nav-link leading topwards to the first page.");
my $nav_links_obj = $rendered->{'nav_links_obj'};
my $up = $nav_links_obj->{'up'};
# TEST
is ($up->direct_url(), "../", "direct_url()");
# TEST
is ($up->host(), "default");
# TEST
is ($up->label(), "Home");
}
# This tests for behaviour with url_is_abs:
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/",
@{$test_data->{'url_is_abs_menu'}},
);
my $rendered = $nav_menu->render();
my $nav_links = $rendered->{'nav_links'};
# TEST
is ($nav_links->{'next'}, "http://www.google.com/",
"Next nav_link in url_is_abs site");
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/sub-dir/",
@{$test_data->{'url_is_abs_menu'}},
);
my $rendered = $nav_menu->render();
my $nav_links = $rendered->{'nav_links'};
# TEST
is ($nav_links->{'up'}, "http://www.google.com/",
"Up nav_link in url_is_abs site");
# TEST
is ($nav_links->{'prev'}, "http://www.google.com/",
"Prev nav_link in url_is_abs site");
}
cpan-changes.t 000444 000764 000764 262 12535757554 20657 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
eval 'use Test::CPAN::Changes';
plan skip_all => 'Test::CPAN::Changes required for this test' if $@;
changes_ok();
04nav-menu.t 000444 000764 000764 54157 12535757554 20276 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use strict;
use lib './t/lib';
use Test::More tests => 30;
use HTML::Widgets::NavMenu;
use HTML::Widgets::NavMenu::HeaderRole;
use HTML::Widgets::NavMenu::JQueryTreeView;
use HTML::Widgets::NavMenu::Test::Data;
my $test_data = get_test_data();
sub test_nav_menu
{
local $Test::Builder::Level = $Test::Builder::Level+1;
my $rendered = shift;
my $expected_string = shift;
my $test_blurb = shift;
my @result = (@{$rendered->{html}});
my @expected = (split(/\n/, $expected_string));
is_deeply (\@result, \@expected, $test_blurb);
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/hello/",
@{$test_data->{'minimal'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu for minimal - 2");
}
# This test tests that an expand_re directive should not cause
# the current coords to be assigned to it, thus marking a site
# incorrectly.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'expand_re'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu for expand_re");
}
# This test tests that an empty expand_re directive works after a successful
# pattern match.
{
my $string = "aslkdjofisvniowgvnoaifnaoiwfb";
$string =~ s{ofisvniowgvnoaifnaoiwfb$}{};
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'expand_re'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu for empty expand_re after successful pattern match");
}
# This test tests the show_always directive which causes the entire
# sub-tree to expand at any URL.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'show_always'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu with show_always");
}
# This test tests a menu auto-expands if the current URL is an item
# inside it.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/bio.html",
@{$test_data->{'items_in_sub'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu with a selected sub-item");
}
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'separator'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu with a role of \"header\"");
}
{
my $nav_menu = HTML::Widgets::NavMenu::HeaderRole->new(
'path_info' => "/me/",
@{$test_data->{'header_role'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu with a selected item with a role of \"header\" ");
}
# Test the selective expand. (test #1)
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/bio/test.html",
@{$test_data->{'selective_expand'}},
'ul_classes' => [ "one", "two", "three" ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_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";
EOF
# TEST
test_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";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu for rec_url_type - 1");
}
# Test the url_is_abs directive
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/hello/",
@{$test_data->{'url_is_abs_menu'}},
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Special Chars Nav Menu");
}
# Test a special chars-based URL.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/&\"you\"/",
@{$test_data->{'special_chars_menu'}},
'current_host' => "default",
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Nav Menu with a special chars URL.");
}
# Test a special chars-based URL.
{
my %args = (@{$test_data->{'special_chars_menu'}});
delete($args{'current_host'});
eval {
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/&\"you\"/",
%args,
);
};
# TEST
like ($@, qr!^Current host!,
"Checking for exception");
}
# This is to test that the cb2 is working properly.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/not-exist/",
@{$test_data->{'mixed_expand_menu'}},
'current_host' => "other",
'ul_classes' => [ "one", "two", "three" ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "Non Capturing Expand");
}
# This test tests that the URLs do not have "./" prepended to them
# when given the no_leading_dot option.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/bio.html",
@{$test_data->{'items_in_sub'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
no_leading_dot => 1,
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string, "JQTreeView Nav Menu with Hidden Item");
}
# Test HTML::Widgets::NavMenu::JQueryTreeView with li_id.
{
my $nav_menu = HTML::Widgets::NavMenu::JQueryTreeView->new(
'path_info' => "/me/",
@{$test_data->{'with_ids_nav_menu'}},
'ul_classes' => [ "one", "two", "three" ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string,
"JQTreeView Nav Menu with li_id");
}
# Test HTML::Widgets::NavMenu (non-JQueryTreeView) with li_id.
{
my $nav_menu = HTML::Widgets::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'with_ids_nav_menu'}},
'ul_classes' => [ "one", "two", "three" ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";
EOF
# TEST
test_nav_menu($rendered, $expected_string,
"Non-JQTreeView Nav Menu with li_id");
}
06tree-iter-item.t 000444 000764 000764 6772 12535757554 21366 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use Test::More tests => 33;
use strict;
BEGIN {
use_ok ('HTML::Widgets::NavMenu::Tree::Iterator::Item'); # TEST
}
# Let's test the constructor:
# see if it's throwing exceptions when it should.
sub does_throw_exception
{
my $args = shift;
my $new_item;
eval {
$new_item = HTML::Widgets::NavMenu::Tree::Iterator::Item->new(
{@$args}
);
};
if ($@)
{
return (1, undef);
}
else
{
return (0, $new_item);
}
}
{
my @args_components =
(
[ 'node' => +{ 'hello' => 'world', }, ],
[ 'subs' => [], ],
[ 'accum_state' => +{ 'yes' => "sir", }, ],
);
# TEST*2*2*2
for(my $i=0;$i<(2**@args_components);$i++)
{
my @args = (map { ($i & (1<<$_)) ? (@{$args_components[$_]}) : () } (0 .. $#args_components));
my ($exception_thrown, $new_item) = does_throw_exception(\@args);
if ($i == (2**@args_components)-1)
{
ok(((!$exception_thrown) && $new_item),
"Checking for constructor success with good arguments");
}
else
{
ok($exception_thrown, "Checking for constructor failure - No. $i");
}
}
}
{
my $item =
HTML::Widgets::NavMenu::Tree::Iterator::Item->new(
{
'node' => "Hello",
'subs' => [],
'accum_state' => 5,
}
);
# TEST
is ($item->_node(), "Hello", "Getting the node()");
}
{
my $item =
HTML::Widgets::NavMenu::Tree::Iterator::Item->new(
{
'node' => "Hello",
'subs' => [],
'accum_state' => "Foobardom",
}
);
# TEST
is ($item->_accum_state(), "Foobardom", "Getting Foobardom");
}
{
my $item =
HTML::Widgets::NavMenu::Tree::Iterator::Item->new(
{
'node' => "Hello",
'subs' => ["ONE", "Two", "threE3", "4.0"],
'accum_state' => 5,
}
);
ok ((!$item->_is_visited()), "Item is not visited at start"); # TEST
is ($item->_num_subs_to_go(), 4, "Num subs to go at start"); # TEST
is ($item->_num_subs(), 4, "Num subs at start"); # TEST
is ($item->_visit(), "ONE", "First sub"); # TEST
is ($item->_num_subs_to_go(), 3, "Num subs to go after first visit"); # TEST
ok ($item->_is_visited(), "Item is visited after first visit"); # TEST
is ($item->_visit(), "Two", "Second sub"); # TEST
ok ($item->_is_visited(), "Item is visited after second visit"); # TEST
is ($item->_num_subs_to_go(), 2, "Num subs to go (3)"); # TEST
is ($item->_num_subs(), 4, "Num subs at middle"); # TEST
is ($item->_visit(), "threE3", "Third sub"); # TEST
ok ($item->_is_visited(), "Item is visited after third visit"); # TEST
is ($item->_num_subs_to_go(), 1, "Num subs to go (4)"); # TEST
is ($item->_visit(), "4.0", "Fourth sub"); # TEST
ok ($item->_is_visited(), "Item is visited after fourth visit"); # TEST
is ($item->_num_subs_to_go(), 0, "Num subs to go (end)"); # TEST
ok ((!defined($item->_visit())), "No more subs"); # TEST
ok ($item->_is_visited(), "Item is visited after no more subs"); # TEST
is ($item->_num_subs_to_go(), 0, "Num subs to go (end 2)"); # TEST
is ($item->_num_subs(), 4, "Num subs at finish"); # TEST
ok ((!defined($item->_visit())), "No more subs (2)"); # TEST
is ($item->_node(), "Hello", "item->_node() is correct"); # TEST
}
pod.t 000444 000764 000764 214 12535757554 17107 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!perl -T
use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();
14tag-gen.t 000444 000764 000764 4452 12535757554 20044 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use Test::More tests => 12;
use strict;
BEGIN {
use_ok ('HTML::Widgets::NavMenu::TagGen'); # TEST
}
{
my $test_tag =
HTML::Widgets::NavMenu::TagGen->new(
{
'name' => "a",
'attributes' =>
{
'href' => { 'escape' => 1, },
'title' => { 'escape' => 0, },
'id' => { 'escape' => 1, },
'iname' => { 'escape' => 0, },
},
}
);
# TEST
is ($test_tag->gen({'href' => "http://www.mysite.com/",}),
q{},
"Simple Tag Test");
# TEST
is ($test_tag->gen({'href' => "/hello&you",}),
q{},
"Escaping");
# TEST
is ($test_tag->gen({'href' => "http://www.mysite.com/",}, 1),
q{},
"Standalone Tag");
# TEST
is ($test_tag->gen({'href' => "/hello&you",}, 1),
q{},
"Standalone Tag with Escaping");
# TEST
is ($test_tag->gen({}), q{}, "Empty Tag");
# TEST
is ($test_tag->gen({}, 1), q{}, "Empty Standalone Tag");
# TEST
is ($test_tag->gen({'title' => "This is me&yours title"}),
q{},
"Non-escaping for unescaped attribute");
# TEST
is ($test_tag->gen({'title' => "Hello", 'href' => "/hi/", 'id' => "myid"}),
q{},
"Multiple Attributes");
# TEST
is ($test_tag->gen({'title' => "Hello",
'href' => "/hi/", 'id' => "myid"}, 1),
q{},
"Multiple Attributes Standalone");
my $string = "<Hello&";
# TEST
is ($test_tag->gen({map { $_ => $string } (qw(href title id iname))}),
q{},
"Selective Escaping");
# TEST
is ($test_tag->gen({map { $_ => $string } (qw(href title id iname))}, 1),
q{},
"Selective Escaping Standalone");
}
13escape-html.t 000444 000764 000764 1365 12535757554 20723 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use Test::More tests => 9;
use strict;
BEGIN {
use_ok ('HTML::Widgets::NavMenu::EscapeHtml'); # TEST
}
{
# TEST
is (escape_html("hello"), "hello", "Simple 1");
# TEST
is (escape_html("hi\nYou rule."), "hi\nYou rule.", "Simple 2 with WS");
# TEST
is (escape_html("D&D"), "D&D", "Ampersand");
# TEST
is (escape_html("Hello"), "<b>Hello</b>", "Tags");
# TEST
is (escape_html("&"), "&", "Double amp");
# TEST
is (escape_html("&"), "&<hello>", "Seq of 2");
# TEST
is (escape_html(q{Hi "phony"}), q{Hi "phony"}, "Double quotes");
# TEST
is (escape_html(q{"<&>"}), q{"<&>"}, "All in one");
}
01unit.t 000444 000764 000764 2626 12535757554 17476 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl -w
use strict;
use Test::More tests => 9;
use HTML::Widgets::NavMenu;
{
my $text = "test/foo";
my $url = HTML::Widgets::NavMenu::_text_to_url_obj($text);
my $components = $url->_get_url();
ok (scalar(@$components) == 2); # TEST
ok ($components->[0] eq "test"); # TEST
ok ($components->[1] eq "foo"); # TEST
ok (! $url->_is_dir()); # TEST
}
{
my $url1 = HTML::Widgets::NavMenu::Url->new(["links.html"], 0, "server");
my $url2 = HTML::Widgets::NavMenu::Url->new(["links.html"], 0, "server");
my $rel_url = $url1->_get_relative_url($url2, 0);
ok ($rel_url eq "./links.html", "Checking for same file to itself link"); # TEST
}
{
my $root_url = HTML::Widgets::NavMenu::Url->new("", 1);
my $current_url = HTML::Widgets::NavMenu::Url->new("open-source/", 1);
ok ($current_url->_get_relative_url($root_url, 1) eq "../",
"Checking for link to root directory"); # TEST
}
{
# TEST
ok ((HTML::Widgets::NavMenu::_get_relative_url("open-source/", "") eq "../"),
"_get_relative_url(): Checking for link to root directory"
);
}
{
eval {
my $iter = HTML::Widgets::NavMenu::Iterator::Base->new();
};
# TEST
like($@, qr{^nav_menu not specified},
"nav_menu not specified");
}
{
my $obj = HTML::Widgets::NavMenu::Object->new();
# TEST
isa_ok($obj, "HTML::Widgets::NavMenu::Object",
"Testing creation of object");
}
15aspetersen-inherit.t 000444 000764 000764 4140 12535757554 22326 0 ustar 00shlomif shlomif 000000 000000 HTML-Widgets-NavMenu-1.0703/t #!/usr/bin/perl
use strict;
use warnings;
package MyCustom::NavMenu::Iterator;
use base 'HTML::Widgets::NavMenu::Iterator::NavMenu';
sub get_open_sub_menu_tags
{
my $self = shift;
return (" ",
$self->gen_ul_tag({'depth' => $self->stack->len()}));
}
sub get_currently_active_text
{
my $self = shift;
my $node = shift;
return "" . $node->text() . "";
}
1;
package MyCustom::NavMenu;
use base 'HTML::Widgets::NavMenu';
sub _get_nav_menu_traverser
{
my $self = shift;
return
MyCustom::NavMenu::Iterator->new(
$self->_get_nav_menu_traverser_args()
);
}
package main;
use lib './t/lib';
use Test::More tests => 1;
use HTML::Widgets::NavMenu;
use HTML::Widgets::NavMenu::Test::Data;
my $test_data = get_test_data();
sub validate_nav_menu
{
my $rendered = shift;
my $expected_string = shift;
my $test_blurb = shift;
my @result = (@{$rendered->{html}});
my @expected = (split(/\n/, $expected_string));
is_deeply (\@expected, \@result, $test_blurb);
}
# This test tests that an inherited nav menu similar to what Stephen Petersen
# needs works.
{
my $nav_menu = MyCustom::NavMenu->new(
'path_info' => "/me/",
@{$test_data->{'show_always'}},
'ul_classes' => [ "navbarmain", ("navbarnested") x 5 ],
);
my $rendered =
$nav_menu->render();
my $expected_string = <<"EOF";