HTML-Widgets-NavMenu-1.1000000755000764000764 014247414065 15616 5ustar00shlomifshlomif000000000000TODO100644000764000764 235514247414065 16374 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000Short-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. README100644000764000764 50114247414065 16533 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000This archive contains the distribution HTML-Widgets-NavMenu, version 1.1000: A Perl Module for Generating HTML Navigation Menus This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License This README file was generated by Dist::Zilla::Plugin::Readme v6.024. Changes100644000764000764 1335414247414065 17220 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000Revision history for Perl extension HTML::Widgets::NavMenu. 1.1000 2022-06-06 - Convert packages to lib/**.pm files. 1.0902 2022-05-20 - Fix for up arrow/nav-link. 1.0901 2022-05-20 - Fix for up arrow/nav-link. 1.0900 2021-04-25 - Add the experimental coords_stop option. - false by default. 1.0801 2020-07-03 - Fix and re-enable the PerlCritic test on tidyall. 1.0800 2020-07-03 - Speed up some hot spots / bottlenecks. - "A Lisp programmer knows the value of everything and the cost of nothing" - https://www.shlomifish.org/humour/fortunes/show.cgi?id=linus-torvalds-about-indirections - lib/HTML/Widgets/NavMenu/EscapeHtml.pm switched escape_html() to @EXPORT_OK - Minor back compat break. - Cleanups including explicit imports , and perlcritic. 1.0704 2019-03-11 - Convert to dzil. - Try to fix broken provides (e.g: https://metacpan.org/search?q=HTML%3A%3AWidgets%3A%3ANavMenu%3A%3AObject ) 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

    About Me

    "); } sub _end_regular { my $self = shift; if ( $self->top()->_num_subs() && $self->_is_expanded() ) { $self->_add_tags(""); } $self->_add_tags("
    • "); } sub node_should_recurse { my $self = shift; return $self->_is_expanded(); } # 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; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Iterator::Html - an iterator for HTML. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 METHODS =head2 $self->node_start() Gets called upon node start. =head2 $self->node_end() Gets called upon node end. =head2 $self->end_root() End-root event. =head2 $self->node_should_recurse() Override to determine when one should recurse to the node. =head2 $self->get_a_tag() Renders the HTML for the opening a-tag. =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut Base.pm100644000764000764 1243114247414065 25212 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::Base; $HTML::Widgets::NavMenu::Iterator::Base::VERSION = '1.1000'; use strict; use warnings; use parent qw(HTML::Widgets::NavMenu::Tree::Iterator); __PACKAGE__->mk_acc_ref( [ qw( _html nav_menu ) ] ); 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 get_initial_node { my $self = shift; return $self->nav_menu->_get_traversed_tree(); } sub get_node_subs { my ( $self, $args ) = @_; my $node = $args->{'node'}; return [ @{ $node->subs() } ]; } # 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, }; } sub get_results { my $self = shift; return [ @{ $self->_html() } ]; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Iterator::Base - base class for the iterator. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 METHODS =head2 nav_menu Internal use. =head2 $self->get_initial_node() Gets the initial node. =head2 $self->get_node_subs({ node => $node}) Gets the subs of the node. =head2 $self->get_new_accum_state( { item => $item, node => $node } ) Gets the new accumulated state. =head2 my $array_ref = $self->get_results() Returns an array reference with the resultant HTML. =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut Iterator.pm100644000764000764 1641414247414065 25244 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Treepackage HTML::Widgets::NavMenu::Tree::Iterator; $HTML::Widgets::NavMenu::Tree::Iterator::VERSION = '1.1000'; use strict; use warnings; use parent 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 _top ) ] ); sub _init { my $self = shift; $self->stack( HTML::Widgets::NavMenu::Tree::Iterator::Stack->new() ); $self->{_top} = undef(); return 0; } sub top { return shift(@_)->{_top}; } sub _construct_new_item { my ( $self, $args ) = @_; return HTML::Widgets::NavMenu::Tree::Iterator::Item->new($args); } 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 traverse { my $self = shift; my $_items = $self->stack->_items; my $push = sub { push @{$_items}, ( $self->{_top} = $self->get_new_item( { 'node' => shift(@_), 'parent_item' => $self->{_top}, } ) ); }; $push->( $self->get_initial_node() ); $self->{_is_root} = ( scalar(@$_items) == 1 ); my $co = $self->coords( [] ); MAIN_LOOP: while ( my $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 @$co, $top_item->_visited_index(); $push->( $self->get_node_from_sub( { 'item' => $top_item, 'sub' => $sub_item, } ), ); $self->{_is_root} = ( scalar(@$_items) == 1 ); next MAIN_LOOP; } else { $self->node_end(); pop @$_items; $self->{_top} = $_items->[-1]; $self->{_is_root} = ( scalar(@$_items) == 1 ); pop @$co; } } return 0; } sub get_node_from_sub { return $_[1]->{'sub'}; } 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, }; } sub get_coords { my $self = shift; return $self->coords(); } sub _is_root { my $self = shift; return $self->{_is_root}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Tree::Iterator - an iterator for HTML. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 METHODS =head2 coords Internal use. =head2 stack Internal use. =head2 $self->top() Retrieves the stack top item. =head2 $self->get_new_item({'node' => $node, 'parent_item' => $parent}) Gets the new item. =head2 $self->traverse() Traverses the tree. =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. =head2 $self->find_node_by_coords($coords, $callback) Finds a node by its coordinations. =head2 $self->get_coords() Returns the current coordinates of the object. =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut Stdout.pm100644000764000764 36714247414065 25160 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/t/lib/HTML/Widgets/NavMenu/Testuse strict; use warnings; use IO::Scalar (); open my $SAVEOUT, ">&STDOUT"; print {$SAVEOUT} ""; my $buffer = ""; tie *STDOUT, 'IO::Scalar', \$buffer; sub reset_out_buffer { $buffer = ""; } sub get_out_buffer { return $buffer; } 1; JQueryTreeView.pm100644000764000764 771614247414065 25433 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenupackage HTML::Widgets::NavMenu::JQueryTreeView; $HTML::Widgets::NavMenu::JQueryTreeView::VERSION = '1.1000'; use strict; use warnings; use parent '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__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::JQueryTreeView - A Specialized HTML::Widgets::NavMenu sub-class =head1 VERSION version 1.1000 =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 SYNOPOSIS Mostly the same as L execpt that it renders a fully expanded tree suitable for input to JQuery's treeview plugin =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 ). =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut Error000755000764000764 014247414065 23121 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenuRedirect.pm100644000764000764 621514247414065 25364 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Errorpackage HTML::Widgets::NavMenu::Error::Redirect; $HTML::Widgets::NavMenu::Error::Redirect::VERSION = '1.1000'; use strict; use warnings; use parent "HTML::Widgets::NavMenu::Error"; sub CGIpm_perform_redirect { my $self = shift; my $cgi = shift; print $cgi->redirect( $cgi->script_name() . $self->{-redirect_path} ); exit; } 1; __END__ =pod =encoding UTF-8 =head1 NAME =head1 VERSION version 1.1000 =head1 SYNOPSIS =head1 DESCRIPTION =head1 METHODS =head2 CGIpm_perform_redirect() B =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut NodeDescription.pm100644000764000764 656014247414065 25626 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenupackage HTML::Widgets::NavMenu::NodeDescription; $HTML::Widgets::NavMenu::NodeDescription::VERSION = '1.1000'; use strict; use warnings; use parent 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; __END__ =pod =encoding UTF-8 =head1 NAME =head1 VERSION version 1.1000 =head1 SYNOPSIS =head1 DESCRIPTION =head1 METHODS =head2 direct_url() B =head2 host() B =head2 host_url() B =head2 label() B =head2 title() B =head2 url_type() B =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut NavMenu.pm100644000764000764 1607714247414065 25723 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::NavMenu; $HTML::Widgets::NavMenu::Iterator::NavMenu::VERSION = '1.1000'; use strict; use warnings; use parent qw(HTML::Widgets::NavMenu::Iterator::Html); use HTML::Widgets::NavMenu::EscapeHtml qw/ escape_html /; __PACKAGE__->mk_acc_ref( [ qw( _ul_classes ) ] ); 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// ); } # 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 ]; } sub get_currently_active_text { my $self = shift; my $node = shift; return "" . $node->text() . ""; } 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(); } 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'} ); } sub get_role { my $self = shift; return $self->top->_node->role(); } sub _is_role_specified { my $self = shift; return defined( $self->get_role() ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Iterator::NavMenu - navmenu iterator. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 METHODS =head2 $self->gen_ul_tag({depth => $depth}); Generate a UL tag of depth $depth. =head2 get_currently_active_text ( $node ) Calculates the highlighted text for the node C<$node>. Normally surrounds it with C<<< ... >>> tags. =head2 $self->get_link_tag() Gets the tag for the link - an item in the menu. =head2 my @tags = $self->get_open_sub_menu_tags() Gets the tags to open a new sub menu. =head2 $self->get_role() Retrieves the current role. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut SiteMap.pm100644000764000764 735614247414065 25674 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::SiteMap; $HTML::Widgets::NavMenu::Iterator::SiteMap::VERSION = '1.1000'; use strict; use warnings; use parent qw(HTML::Widgets::NavMenu::Iterator::Html); 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; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Iterator::SiteMap - a site-map iterator. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 METHODS =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut Html000755000764000764 014247414065 24525 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/IteratorItem.pm100644000764000764 637514247414065 26134 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Iterator/Htmlpackage HTML::Widgets::NavMenu::Iterator::Html::Item; $HTML::Widgets::NavMenu::Iterator::Html::Item::VERSION = '1.1000'; use strict; use warnings; use parent 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" ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Iterator::Html::Item - an iterator item for HTML. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 METHODS =head2 get_url_type For internal use only. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut Iterator000755000764000764 014247414065 24520 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/TreeItem.pm100644000764000764 1057214247414065 26141 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Tree/Iteratorpackage HTML::Widgets::NavMenu::Tree::Iterator::Item; $HTML::Widgets::NavMenu::Tree::Iterator::Item::VERSION = '1.1000'; use strict; use warnings; use parent qw(HTML::Widgets::NavMenu::Object); __PACKAGE__->mk_acc_ref( [ qw( _node _subs _sub_idx _visited _accum_state ) ] ); 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; } } 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(); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Tree::Iterator::Item - an item for the tree iterator. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut JQTreeView.pm100644000764000764 1112614247414065 26325 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::JQTreeView; $HTML::Widgets::NavMenu::Iterator::JQTreeView::VERSION = '1.1000'; use strict; use warnings; use HTML::Widgets::NavMenu::EscapeHtml qw/ escape_html /; use parent 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; } sub _calc_open_li_tag { my $self = shift; my $id_attr = $self->_calc_li_id_attr(); return ( $self->_is_expanded_for_treeview() ? (qq{
      • }) : ("") ); return; } 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'} ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Iterator::JQTreeView - an iterator for JQuery TreeView's navigation menus. =head1 VERSION version 1.1000 =head1 SYNOPSIS See L . For internal use only. =head1 METHODS =head2 get_currently_active_text ( $node ) Calculates the highlighted text for the node C<$node>. Normally surrounds it with C<<< ... >>> tags. =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut Stack.pm100644000764000764 1037414247414065 26310 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Tree/Iteratorpackage HTML::Widgets::NavMenu::Tree::Iterator::Stack; $HTML::Widgets::NavMenu::Tree::Iterator::Stack::VERSION = '1.1000'; use strict; use warnings; use parent qw(HTML::Widgets::NavMenu::Object); __PACKAGE__->mk_acc_ref( [qw(_items)] ); sub _init { my $self = shift; $self->_items( [] ); return 0; } sub push { my $self = shift; my $item = shift; push @{ $self->_items() }, $item; return 0; } sub len { my $self = shift; return scalar( @{ $self->_items() } ); } sub top { my $self = shift; return $self->_items->[-1]; } sub item { my $self = shift; my $index = shift; return $self->_items->[$index]; } sub pop { my $self = shift; return pop( @{ $self->_items() } ); } sub is_empty { my $self = shift; return ( $self->len() == 0 ); } sub reset { my $self = shift; $#{ $self->_items() } = -1; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Tree::Iterator::Stack - a simple stack class. =head1 VERSION version 1.1000 =head1 SYNOPSIS For internal use only. =head1 METHODS =head2 $s->push($myitem) Pushes an item. =head2 $s->len($myitem) Returns the number of elements. =head2 $s->top() Returns the highest item. =head2 my $item = $s->item($index) Returns the item of index C<$index>. =head2 my $item = $s->pop() Pops the item and returns it. =head2 my $bool = $s->is_empty() Returns true if the stack is empty. =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. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut LeadingPath000755000764000764 014247414065 24210 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenuComponent.pm100644000764000764 562714247414065 26662 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/LeadingPathpackage HTML::Widgets::NavMenu::LeadingPath::Component; $HTML::Widgets::NavMenu::LeadingPath::Component::VERSION = '1.1000'; use strict; use warnings; use parent "HTML::Widgets::NavMenu::NodeDescription"; 1; __END__ =pod =encoding UTF-8 =head1 VERSION version 1.1000 =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut simple000755000764000764 014247414065 24105 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examplesH-W-NM-simple.pl100644000764000764 710714247414065 27001 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examples/simple#!/usr/bin/perl use strict; use warnings; use HTML::Widgets::NavMenu (); use File::Path qw/ mkpath /; 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' => "Top 1", 'title' => "T1 Title", 'subs' => [ { 'text' => "Home", 'url' => "", }, { 'text' => "About Me", 'title' => "About Myself", 'url' => "me/", }, { 'text' => "Links", 'title' => "Hyperlinks to other Pages", 'url' => "links/", }, ], }; my %hosts = ( 'hosts' => { 'default' => { 'base_url' => ( "http://web-cpan.berlios.de/modules/" . "HTML-Widgets-NavMenu/article/examples/simple/dest/" ), }, }, ); my @pages = ( { 'path' => "", 'title' => "John Doe's Homepage", 'content' => <<'EOF',

        Hi! This is the homepage of John Doe. I hope you enjoy your stay here.

        EOF }, { 'path' => "me/", 'title' => "About Myself", 'content' => <<'EOF',

        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 }, { 'path' => "links/", 'title' => "Cool Links", 'content' => <<'EOF',

        Perl-Related Links

        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, oct('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); } complex000755000764000764 014247414065 24263 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examplesH-W-NM-complex.pl100644000764000764 2612414247414065 27355 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examples/complex#!/usr/bin/perl use strict; use warnings; use HTML::Widgets::NavMenu (); use File::Path qw/ mkpath /; 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, oct('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); } cgi-script000755000764000764 014247414065 24660 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examplesH-W-NM-serve.pl100755000764000764 3412114247414065 27426 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examples/cgi-script#!/usr/bin/perl use strict; use warnings; use HTML::Widgets::NavMenu; use CGI; 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' => "

        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() } ), }; }; push @pages, ( { 'path' => "perl/japhs/", 'title' => "Perl JAPHs", 'content' => "

        JAPHs for fun and profit.

        ", }, { 'path' => "open-source/yowza/", 'title' => "A Wonderful Yowza", 'content' => "

        Yowza is da-bomb man!

        ", } ); my $cgi = CGI->new(); my $path_info = $cgi->path_info(); if ( $cgi->param("hi") ) { print $cgi->header( -type => "text/plain" ); print( map { "$_ => $ENV{$_}\n" } keys(%ENV) ); exit; } my $found = 0; PAGE_LOOP: foreach my $page (@pages) { my $path = $page->{'path'}; my $title = $page->{'title'}; my $content = $page->{'content'}; if ( $path_info eq "/$path" ) { $found = 1; render_page( "/" . $path, $title, $content ); last; } } sub render_page { my ( $path, $title, $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(); print $cgi->header(); my $template = Template->new( { 'POST_CHOMP' => 1, } ); my $vars = { 'title' => $title, 'css_style' => $css_style, 'nav_menu_text' => join( "\n", @{ $nav_menu_results->{'html'} } ) . "\n", 'content' => $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 %]
        [% FOREACH key = nav_links.keys.sort %] [% key %] [% END %]
        [% nav_menu_text %]

        [% title %]

        [% content %]
        EOF $template->process( \$nav_links_template, $vars ); } if ( !$found ) { eval { render_page( $path_info, "Not a title", "Page Contents" ); }; if ($@) { $@->CGIpm_perform_redirect($cgi); } } GetCurrentlyActive.pm100644000764000764 1235514247414065 30130 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::GetCurrentlyActive; $HTML::Widgets::NavMenu::Iterator::GetCurrentlyActive::VERSION = '1.1000'; use strict; use warnings; use parent '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() ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME =head1 VERSION version 1.1000 =head1 SYNOPSIS =head1 DESCRIPTION =head1 METHODS =head2 does_item_expand() B =head2 get_final_coords() B =head2 get_initial_node() B =head2 item_matches() B =head2 node_end() B =head2 node_should_recurse() B =head2 node_start() B =head2 =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut NavMenu000755000764000764 014247414065 25172 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/IteratorHeaderRole.pm100644000764000764 1060514247414065 27724 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/lib/HTML/Widgets/NavMenu/Iterator/NavMenupackage HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole; $HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole::VERSION = '1.1000'; use strict; use warnings; use parent qw(HTML::Widgets::NavMenu::Iterator::NavMenu); __PACKAGE__->mk_acc_ref( [ qw( _was_role ) ] ); 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(); } } sub _end_handle_role { my $self = shift; if ( $self->get_role() eq "header" ) { # Do nothing; } else { return $self->SUPER::_end_handle_role(); } } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole - a nav-menu iterator for the HeaderRole sub-class. =head1 VERSION version 1.1000 =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. =head2 $self->_end_handle_role() Ends the role. Accepts the C<"header"> role and defaults to the default behaviour with all others. =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-HTML-Widgets-NavMenu.git =head1 AUTHOR Shlomi Fish =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2005 by Shlomi Fish. This is free software, licensed under: The MIT (X11) License =cut with-embellishments000755000764000764 014247414065 26600 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examplesH-W-NM-embellish.pl100644000764000764 3247714247414065 32177 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examples/with-embellishments#!/usr/bin/perl use strict; use warnings; use HTML::Widgets::NavMenu (); use File::Path qw/ mkpath /; 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, oct('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 %]
      [% FOREACH key = nav_links.keys.sort %] [% key %] [% END %]
      [% nav_menu_text %]

      [% title %]

      [% content %]
      EOF $template->process( \$nav_links_template, $vars, $out ); close($out); } fine-grained-site-flow000755000764000764 014247414065 27053 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examplesH-W-NM-fine-grained-site-flow.pl100644000764000764 3370214247414065 34735 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.1000/examples/article-examples/fine-grained-site-flow#!/usr/bin/perl use strict; use warnings; use HTML::Widgets::NavMenu (); use File::Path qw/ mkpath /; 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' => "

      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() } ), }; }; push @pages, ( { 'path' => "perl/japhs/", 'title' => "Perl JAPHs", 'content' => "

      JAPHs for fun and profit.

      ", }, { 'path' => "open-source/yowza/", 'title' => "A Wonderful Yowza", 'content' => "

      Yowza is da-bomb man!

      ", } ); 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, oct('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 %]
      [% FOREACH key = nav_links.keys.sort %] [% key %] [% END %]
      [% nav_menu_text %]

      [% title %]

      [% content %]
      EOF $template->process( \$nav_links_template, $vars, $out ); close($out); }