HTML-Widgets-NavMenu-1.0900000755001750001750 014041243217 15605 5ustar00shlomifshlomif000000000000TODO100644001750001750 235514041243217 16363 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900Short-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. README100644001750001750 50114041243217 16522 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900This archive contains the distribution HTML-Widgets-NavMenu, version 1.0900: 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.017. COPYING100644001750001750 206414041243217 16723 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900This is the MIT/X11 license: -------------- Copyright 2004 Shlomi Fish. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Changes100644001750001750 1310314041243217 17177 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900Revision history for Perl extension HTML::Widgets::NavMenu. 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.0900 =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 Iterator.pm100644001750001750 1641414041243217 25233 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Treepackage HTML::Widgets::NavMenu::Tree::Iterator; $HTML::Widgets::NavMenu::Tree::Iterator::VERSION = '1.0900'; 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.0900 =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.pm100644001750001750 36714041243217 25147 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/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.pm100644001750001750 771614041243217 25422 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenupackage HTML::Widgets::NavMenu::JQueryTreeView; $HTML::Widgets::NavMenu::JQueryTreeView::VERSION = '1.0900'; 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.0900 =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 NavMenu.pm100644001750001750 1607714041243217 25712 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::NavMenu; $HTML::Widgets::NavMenu::Iterator::NavMenu::VERSION = '1.0900'; 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.0900 =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.pm100644001750001750 735614041243217 25663 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::SiteMap; $HTML::Widgets::NavMenu::Iterator::SiteMap::VERSION = '1.0900'; 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.0900 =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 Html000755001750001750 014041243217 24514 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/IteratorItem.pm100644001750001750 637514041243217 26123 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Iterator/Htmlpackage HTML::Widgets::NavMenu::Iterator::Html::Item; $HTML::Widgets::NavMenu::Iterator::Html::Item::VERSION = '1.0900'; 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.0900 =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 Iterator000755001750001750 014041243217 24507 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/TreeItem.pm100644001750001750 1057214041243217 26130 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Tree/Iteratorpackage HTML::Widgets::NavMenu::Tree::Iterator::Item; $HTML::Widgets::NavMenu::Tree::Iterator::Item::VERSION = '1.0900'; 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.0900 =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.pm100644001750001750 1112614041243217 26314 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Iteratorpackage HTML::Widgets::NavMenu::Iterator::JQTreeView; $HTML::Widgets::NavMenu::Iterator::JQTreeView::VERSION = '1.0900'; 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.0900 =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.pm100644001750001750 1037414041243217 26277 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Tree/Iteratorpackage HTML::Widgets::NavMenu::Tree::Iterator::Stack; $HTML::Widgets::NavMenu::Tree::Iterator::Stack::VERSION = '1.0900'; 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.0900 =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 simple000755001750001750 014041243217 24074 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/examples/article-examplesH-W-NM-simple.pl100644001750001750 710714041243217 26770 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/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

        $title

        $content
        EOF close($out); } complex000755001750001750 014041243217 24252 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/examples/article-examplesH-W-NM-complex.pl100644001750001750 2612414041243217 27344 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/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

        $title

        $content
        EOF close($out); } cgi-script000755001750001750 014041243217 24647 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/examples/article-examplesH-W-NM-serve.pl100755001750001750 3412114041243217 27415 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/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 %]

        [% 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); } } NavMenu000755001750001750 014041243217 25161 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/IteratorHeaderRole.pm100644001750001750 1060514041243217 27713 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/lib/HTML/Widgets/NavMenu/Iterator/NavMenupackage HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole; $HTML::Widgets::NavMenu::Iterator::NavMenu::HeaderRole::VERSION = '1.0900'; 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.0900 =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-embellishments000755001750001750 014041243217 26567 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/examples/article-examplesH-W-NM-embellish.pl100644001750001750 3247714041243217 32166 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/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 %]

      [% title %]

      [% content %]
      EOF $template->process( \$nav_links_template, $vars, $out ); close($out); } fine-grained-site-flow000755001750001750 014041243217 27042 5ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/examples/article-examplesH-W-NM-fine-grained-site-flow.pl100644001750001750 3370214041243217 34724 0ustar00shlomifshlomif000000000000HTML-Widgets-NavMenu-1.0900/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 %]

      [% title %]

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