HTML-LinkList-0.1503/0000755000175000017500000000000011060675366012227 5ustar katkatHTML-LinkList-0.1503/README0000444000175000017500000000563311060675366013114 0ustar katkat ==== NAME ==== HTML::LinkList - Create a 'smart' list of HTML links. ==== VERSION ==== This describes version ``0.1503'' of HTML::LinkList. ==== DESCRIPTION ==== This module contains a number of functions for taking sets of URLs and labels and creating suitably formatted HTML. These links are "smart" because, if given the url of the current page, if any of the links in the list equal it, that item in the list will be formatted as a special label, not as a link; this is a Good Thing, since the user would be confused by clicking on a link back to the current page. While many website systems have plugins for "smart" navbars, they are specialized for that system only, and can't be reused elsewhere, forcing people to reinvent the wheel. I hereby present one wheel, free to be reused by anybody; just the simple functions, a backend, which can be plugged into whatever system you want. The default format for the HTML is to make an unordered list, but there are many options, enabling one to have a flatter layout with any separators you desire, or a more complicated list with differing formats for different levels. The "link_list" function uses a simple list of links -- good for a simple navbar. The "link_tree" function takes a set of nested links and makes the HTML for them -- good for making a table of contents, or a more complicated navbar. The "full_tree" function takes a list of paths and makes a full tree of all the pages and index-pages in those paths -- good for making a site map. The "breadcrumb_trail" function takes a url and makes a "breadcrumb trail" from it. The "nav_tree" function creates a set of nested links to be used as a multi-level navbar; one can give it a list of paths (as for full_tree) and it will only show the links related to the current URL. ==== REQUIRES ==== Test::More ==== INSTALLATION ==== To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install Or, if you're on a platform (like DOS or Windows) that doesn't like the "./" notation, you can do this: perl Build.PL perl Build perl Build test perl Build install In order to install somewhere other than the default, such as in a directory under your home directory, like "/home/fred/perl" go perl Build.PL --install_base /home/fred/perl as the first step instead. This will install the files underneath /home/fred/perl. You will then need to make sure that you alter the PERL5LIB variable to find the modules. Therefore you will need to change the PERL5LIB variable to add /home/fred/perl/lib PERL5LIB=/home/fred/perl/lib:${PERL5LIB} ==== AUTHOR ==== Kathryn Andersen (RUBYKAT) perlkat AT katspace dot com http://www.katspace.com/tools/html_linklist/ ==== COPYRIGHT AND LICENCE ==== Copyright (c) 2006 by Kathryn Andersen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. HTML-LinkList-0.1503/t/0000755000175000017500000000000011060675366012472 5ustar katkatHTML-LinkList-0.1503/t/pod.t0000444000175000017500000000021411060675366013434 0ustar katkat#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); HTML-LinkList-0.1503/t/50_nav_tree.t0000444000175000017500000002544311060675366014774 0ustar katkat# testing nav_tree use strict; use Test::More tests => 22; use HTML::LinkList qw(nav_tree); #===================================================================== sub make_test_html { my %args = ( test_name=>'nav_tree', test_count=>0, link_html=>'', ok_str=>'', @_ ); if ($args{link_html} ne $args{ok_str}) { my $test_file = "${args{test_name}}${args{test_count}}.html"; open(HTML, ">", $test_file) or die "could not open $test_file for writing"; print HTML< $args{test_name}

$args{test_name}

Got: $args{link_html}

Wanted: $args{ok_str} EOT close(HTML); } } #===================================================================== my @links = qw( /foo/bar/baz.html /foo/bar/biz.html /foo/wibble.html /foo/boo/thren.html /fooish.html /bringle/ /bringle/brangle.html /tray/nav.html /tray/tea_tray.html ); my %labels = ( '/tray/nav.html' => 'Navigation', '/foo/bar/baz.html' => 'Bazzy', ); my $test_count = 0; my $link_html = ''; $test_count++; # default $link_html = nav_tree(labels=>\%labels, paths=>\@links, current_url=>'/foo/wibble.html'); ok($link_html, "($test_count) default; links HTML"); my $ok_str = ''; $ok_str = '

'; is($link_html, $ok_str, "($test_count) default; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # current is dir $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, current_url=>'/foo/'); ok($link_html, "($test_count) current-is-dir; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) current-is_dir; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # current is dir with 'breadcrumb' style $test_count++; $link_html = nav_tree(labels=>\%labels, navbar_type=>'breadcrumb', paths=>\@links, current_url=>'/foo/'); ok($link_html, "($test_count) dir breadcrumb-navbar; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) dir breadcrumb-navbar; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # current is not dir with 'breadcrumb' style $test_count++; $link_html = nav_tree(labels=>\%labels, navbar_type=>'breadcrumb', paths=>\@links, current_url=>'/foo/wibble.html'); ok($link_html, "($test_count) non-dir breadcrumb-navbar; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) non-dir breadcrumb-navbar; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # lower level $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, current_url=>'/foo/bar/baz.html'); ok($link_html, "($test_count) lower level; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) lower level; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # mid-level index $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, current_url=>'/foo/bar/'); ok($link_html, "($test_count) mid level; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) mid level; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # # more complicated links # @links = qw( / /about/about_cti.html /about/contact_us.html /about/people_technology.html /products/ /products/operations_control/ /products/operations_control/Airpac.html /products/operations_control/Airpac_Overview.pdf /products/crewing/ /products/crewing/Crew_Rostering.pdf /products/maintenance/ /solutions/ /services/ /news/press_release.html ); %labels = ( '/' => 'Home', '/index.html' => 'Home', '/about/about_cti.html' => 'About CTI', '/about/people_technology.html' => 'People and Technology', ); $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, current_url=>'/products/'); ok($link_html, "($test_count) more links; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) more links; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # starting at level 2 $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, start_depth=>2, current_url=>'/products/'); ok($link_html, "($test_count) start_depth=2; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) start_depth=2; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # Including the Home in the top navbar # $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, prepend_list=>[qw(/)], current_url=>'/products/'); ok($link_html, "($test_count) more links; include Home; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) more links; include Home; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # current_parent stuff $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, prepend_list=>[qw(/)], exclude_root_parent=>1, pre_current_parent=>'', post_current_parent=>'', current_url=>'/products/crewing/'); ok($link_html, "($test_count) more links; include Home; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) more links; include Home; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } # # even more complicated links # @links = qw( / /dunes/about/about_cti.html /dunes/about/contact_us.html /dunes/about/people_technology.html /dunes/products/ /dunes/products/operations_control/ /dunes/products/operations_control/Airpac.html /dunes/products/operations_control/Airpac_Overview.pdf /dunes/products/crewing/ /dunes/products/crewing/Crew_Rostering.pdf /dunes/products/maintenance/ /dunes/solutions/ /dunes/services/ /dunes/news/press_release.html ); %labels = ( '/' => 'Home', '/index.html' => 'Home', '/dunes/' => 'Style Dunes', '/dunes/about/about_cti.html' => 'About CTI', '/dunes/about/people_technology.html' => 'People and Technology', ); # starting at level 2 and discarding level 1 $test_count++; $link_html = nav_tree(labels=>\%labels, paths=>\@links, start_depth=>2, top_level=>2, current_url=>'/dunes/products/'); ok($link_html, "($test_count) start_depth=2, top_level=2; links HTML"); $ok_str = ''; is($link_html, $ok_str, "($test_count) start_depth=2, top_level=2; values match"); # make an example html file of the difference if ($link_html ne $ok_str) { make_test_html(link_html=>$link_html, ok_str=>$ok_str, test_count=>$test_count); } HTML-LinkList-0.1503/t/00_dist.t0000444000175000017500000000044111060675366014116 0ustar katkat# Test distribution before release # Optional for end users if Test::Distribution not installed use Test::More; BEGIN { eval { require Test::Distribution; }; if($@) { plan skip_all => "Test::Distribution not installed"; } else { import Test::Distribution; } } HTML-LinkList-0.1503/t/20_link_tree.t0000444000175000017500000000546411060675366015143 0ustar katkat# testing link_tree use strict; use Test::More tests => 6; use HTML::LinkList qw(link_tree); my @links = ( '/foo/bar/baz.html', '/fooish.html', '/bringle/', ['/tray/nav.html', '/tray/tea_tray.html'], ); my %labels = ( '/tray/nav.html' => 'Navigation', '/foo/bar/baz.html' => 'Bazzy', ); my $link_html = ''; # default, no current $link_html = link_tree(labels=>\%labels, link_tree=>\@links); ok($link_html, "(1) default; links HTML"); my $ok_str = ''; $ok_str = ''; is($link_html, $ok_str, "(1) default; values match"); # not-welformed list @links = ( ['#Askew'], '#Big', ['#Lower'], ); %labels = ( '#Askew' => 'Askew Header', '#Big' => 'Big Header', '#Lower' => 'Lower Section', ); $link_html = link_tree(labels=>\%labels, link_tree=>\@links); ok($link_html, "(2) not-wellformed; links HTML"); $ok_str = ''; is($link_html, $ok_str, "(2) not-wellformed; values match"); # # (3) more complicated (example from HTML::GenToc tests) # @links = ( [ 'tfiles/test5.php#Title-Archaeology701', 'tfiles/test5.php#Title-Platinum', 'tfiles/test5.php#Title-RoutineTrafficStop' ], 'tfiles/test5.php#Series-FauxPawsProductions', [ 'tfiles/test5.php#Title-WindShiftFPP-506' ] ); %labels = ( 'tfiles/test5.php#Title-Archaeology701' => 'Archaeology 701 (Sentinel)', 'tfiles/test5.php#Title-Platinum' => 'Platinum (Sentinel)', 'tfiles/test5.php#Title-RoutineTrafficStop' => 'Routine Traffic Stop (Sentinel/ER)', 'tfiles/test5.php#Title-WindShiftFPP-506' => '(520) Wind Shift (FPP-506) (Sentinel)', 'tfiles/test5.php#Series-FauxPawsProductions' => 'Faux Paws Productions' ); my %formats = ( '0' => { 'tree_head' => '
    ', 'tree_foot' => "\n
", }, '1' => { 'tree_head' => '" }, ); $link_html = link_tree(labels=>\%labels, link_tree=>\@links, formats=>\%formats); ok($link_html, "(3) not-wellformed; links HTML"); $ok_str = '
  1. Faux Paws Productions
'; is($link_html, $ok_str, "(3) not-wellformed; values match"); HTML-LinkList-0.1503/t/pod-coverage.t0000444000175000017500000000025411060675366015231 0ustar katkat#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); HTML-LinkList-0.1503/t/10_link_list.t0000444000175000017500000000331111060675366015143 0ustar katkat# testing link_list use strict; use Test::More tests => 6; use HTML::LinkList qw(link_list); my @links = qw( /foo/bar/baz.html /fooish.html /bringle/ /tray/nav.html /tray/tea_tray.html ); my %labels = ( '/tray/nav.html' => 'Navigation', '/foo/bar/baz.html' => 'Bazzy', ); my $link_html = ''; # default, no current $link_html = link_list(labels=>\%labels, urls=>\@links); ok($link_html, "(1) default; links HTML"); my $ok_str = ''; $ok_str = ''; is($link_html, $ok_str, "(1) default; values match"); # default format with current $link_html = link_list(labels=>\%labels, urls=>\@links, current_url=>'/fooish.html'); ok($link_html, "(2) default with current; links HTML"); $ok_str = ''; is($link_html, $ok_str, "(2) default with current; values match"); # para, no current $link_html = link_list(labels=>\%labels, urls=>\@links, links_head=>'

', links_foot=>'

', pre_item=>'', post_item=>'', item_sep=>' :: '); ok($link_html, "(3) para; links HTML"); $ok_str = '

Bazzy :: Fooish :: Bringle :: Navigation :: Tea Tray

'; is($link_html, $ok_str, "(3) para; values match"); HTML-LinkList-0.1503/t/40_breadcrumb_trail.t0000444000175000017500000000157611060675366016472 0ustar katkat# testing dir_tree use strict; use Test::More tests => 4; use HTML::LinkList qw(breadcrumb_trail); my @links = qw( /foo/bar/baz.html /foo/bar/thing.html /foo/wibble.html /fooish.html /bringle/ /tray/nav.html /tray/tea_tray.html ); my %labels = ( '/tray/nav.html' => 'Navigation', '/foo/bar/baz.html' => 'Bazzy', ); my $link_html = ''; # default $link_html = breadcrumb_trail(labels=>\%labels, current_url=>'/foo/bar/baz.html'); ok($link_html, "(1) default; links HTML"); my $ok_str = ''; $ok_str = '

Home > Foo > Bar > Bazzy

'; is($link_html, $ok_str, "(1) default; values match"); # root $link_html = breadcrumb_trail(labels=>\%labels, current_url=>'/index.html'); ok($link_html, "(2) root; links HTML"); $ok_str = '

Home

'; is($link_html, $ok_str, "(2) root; values match"); HTML-LinkList-0.1503/t/30_full_tree.t0000444000175000017500000000717711060675366015154 0ustar katkat# testing full_tree use strict; use Test::More tests => 10; use HTML::LinkList qw(full_tree); my @links = qw( /foo/bar/baz.html /fooish.html /bringle/ /tray/nav.html /tray/tea_tray.html ); my %labels = ( '/tray/nav.html' => 'Navigation', '/foo/bar/baz.html' => 'Bazzy', ); my $link_html = ''; # default, no current $link_html = full_tree(labels=>\%labels, paths=>\@links); ok($link_html, "(1) default; links HTML"); my $ok_str = ''; $ok_str = ''; is($link_html, $ok_str, "(1) default; values match"); # start_depth $link_html = full_tree(labels=>\%labels, paths=>\@links, start_depth=>1); ok($link_html, "(2) start_depth=1; links HTML"); $ok_str = ''; is($link_html, $ok_str, "(2) start_depth=1; values match"); # start_depth and end_depth $link_html = full_tree(labels=>\%labels, paths=>\@links, start_depth=>1, end_depth=>2); ok($link_html, "(3) start_depth=1, end_depth=2; links HTML"); $ok_str = ''; is($link_html, $ok_str, "(3) start_depth=1, end_depth=2; values match"); # preserve_order, no current $link_html = full_tree(labels=>\%labels, paths=>\@links, preserve_order=>1); ok($link_html, "(4) preserve_order; links HTML"); $ok_str = ''; $ok_str = ''; is($link_html, $ok_str, "(4) preserve_order; values match"); # differing formats, no current my %formats = ( '1' => { tree_head=>"
    ", tree_foot=>"
\n", }, '2' => { pre_item=>'(', post_item=>')', item_sep=>",\n", tree_sep=>' -> ', tree_head=>"
\n", tree_foot=>"", }, '3' => { pre_item=>' {{ ', post_item=>' }} ', item_sep=>" ::\n", }, ); $link_html = full_tree(labels=>\%labels, paths=>\@links, formats=>\%formats, preserve_order=>1); ok($link_html, "(5) formats; links HTML"); $ok_str = ''; is($link_html, $ok_str, "(5) formats; values match"); HTML-LinkList-0.1503/t/01_load.t0000444000175000017500000000020011060675366014064 0ustar katkatuse Test::More tests => 1; BEGIN { use_ok( 'HTML::LinkList' ); } diag( "Testing HTML::LinkList ${HTML::LinkList::VERSION}" ); HTML-LinkList-0.1503/lib/0000755000175000017500000000000011060675366012775 5ustar katkatHTML-LinkList-0.1503/lib/HTML/0000755000175000017500000000000011060675366013541 5ustar katkatHTML-LinkList-0.1503/lib/HTML/LinkList.pm0000444000175000017500000012606311060675366015636 0ustar katkatpackage HTML::LinkList; use strict; use warnings; =head1 NAME HTML::LinkList - Create a 'smart' list of HTML links. =head1 VERSION This describes version B<0.1503> of HTML::LinkList. =cut our $VERSION = '0.1503'; =head1 SYNOPSIS use HTML::LinkList qw(link_list); # default formatting my $html_links = link_list(current_url=>$url, urls=>\@links_in_order, labels=>\%labels, descriptions=>\%desc); # paragraph with ' :: ' separators my $html_links = link_list(current_url=>$url, urls=>\@links_in_order, labels=>\%labels, descriptions=>\%desc, links_head=>'

', links_foot=>'

', pre_item=>'', post_item=>'' pre_active_item=>'', post_active_item=>'', item_sep=>" :: "); # multi-level list my $html_links = link_tree( current_url=>$url, link_tree=>\@list_of_lists, labels=>\%labels, descriptions=>\%desc); =head1 DESCRIPTION This module contains a number of functions for taking sets of URLs and labels and creating suitably formatted HTML. These links are "smart" because, if given the url of the current page, if any of the links in the list equal it, that item in the list will be formatted as a special label, not as a link; this is a Good Thing, since the user would be confused by clicking on a link back to the current page. While many website systems have plugins for "smart" navbars, they are specialized for that system only, and can't be reused elsewhere, forcing people to reinvent the wheel. I hereby present one wheel, free to be reused by anybody; just the simple functions, a backend, which can be plugged into whatever system you want. The default format for the HTML is to make an unordered list, but there are many options, enabling one to have a flatter layout with any separators you desire, or a more complicated list with differing formats for different levels. The "link_list" function uses a simple list of links -- good for a simple navbar. The "link_tree" function takes a set of nested links and makes the HTML for them -- good for making a table of contents, or a more complicated navbar. The "full_tree" function takes a list of paths and makes a full tree of all the pages and index-pages in those paths -- good for making a site map. The "breadcrumb_trail" function takes a url and makes a "breadcrumb trail" from it. The "nav_tree" function creates a set of nested links to be used as a multi-level navbar; one can give it a list of paths (as for full_tree) and it will only show the links related to the current URL. =cut =head1 FUNCTIONS To export a function, add it to the 'use' call. use HTML::LinkList qw(link_list); To export all functions do: use HTML::LinkList ':all'; =cut use Data::Dumper; require Exporter; our @ISA = qw(Exporter); # Items which are exportable. # # This allows declaration use HTML::LinkList ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( link_list link_tree full_tree breadcrumb_trail nav_tree ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. our @EXPORT = qw( ); =head2 link_list $links = link_list( current_url=>$url, urls=>\@links_in_order, labels=>\%labels, descriptions=>\%desc, pre_desc=>' ', post_desc=>'', links_head=>'', pre_item=>'
  • ', post_item=>'
  • ' pre_active_item=>'', post_active_item=>'', item_sep=>"\n"); Generates a simple list of links, from list of urls (and optional labels) taking into account of the "current" URL. This provides a large number of options to customize the appearance of the list. The default setup is for a simple UL list, but setting the options can enable you to make it something other than a list altogether, or add in CSS styles or classes to make it look just like you want. Required: =over =item urls The urls in the order you want them displayed. If this list is empty, then nothing will be generated. =back Options: =over =item current_url The link to the current page. If one of the links equals this, then that is deemed to be the "active" link and is just displayed as a label rather than a link. =item descriptions Optional hash of descriptions, to put next to the links. The keys of this hash are the urls. =item hide_ext If a site is hiding link extensions (such as using MultiViews with Apache) you may wish to hide the extensions (while using the full URLs to check various things). (default: 0 (false)) =item item_sep String to put between items. =item labels A hash whose keys are links and whose values are labels. These are the labels for the links; if no label is given, then the last part of the link is used for the label, with some formatting. =item links_head String to begin the list with. =item links_foot String to end the list with. =item pre_desc String to prepend to each description. =item post_desc String to append to each description. =item pre_item String to prepend to each item. =item post_item String to append to each item. =item pre_active_item An additional string to put in front of each "active" item, after pre_item. The "active" item is the link which matches 'current_url'. =item post_active_item An additional string to append to each active item, before post_item. =item prefix_url A prefix to prepend to all the links. (default: empty string) =back =cut sub link_list { my %args = ( current_url=>'', prefix_url=>'', labels=>undef, urls=>undef, links_head=>'", pre_item=>'
  • ', post_item=>'
  • ', pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n", hide_ext=>0, @_ ); my @link_order = @{$args{urls}}; if (!defined $args{urls} or !@{$args{urls}}) { return ''; } my %format = (exists $args{format} ? %{$args{format}} : ( pre_item=>$args{pre_item}, post_item=>$args{post_item}, pre_active_item=>$args{pre_active_item}, post_active_item=>$args{post_active_item}, pre_current_parent=>$args{pre_current_parent}, post_current_parent=>$args{post_current_parent}, pre_desc=>$args{pre_desc}, post_desc=>$args{post_desc}, item_sep=>$args{item_sep}, )); # correct the current_url $args{current_url} = make_canonical($args{current_url}); my %current_parents = extract_current_parents(%args); my @items = (); foreach my $link (@link_order) { my $label = (exists $args{labels}->{$link} ? $args{labels}->{$link} : ''); my $item = make_item(%args, format=>\%format, current_parents=>\%current_parents, this_link=>$link, this_label=>$label); push @items, $item; } my $list = join($format{item_sep}, @items); return ($list ? join('', $args{links_head}, $list, $args{links_foot}) : ''); } # link_list =head2 link_tree $links = link_tree( current_url=>$url, link_tree=>\@list_of_lists, labels=>\%labels, descriptions=>\%desc, pre_desc=>' ', post_desc=>'', links_head=>'', subtree_head=>'', pre_item=>'
  • ', post_item=>'
  • ' pre_active_item=>'', post_active_item=>'', item_sep=>"\n", tree_sep=>"\n", formats=>\%formats); Generates nested lists of links from a list of lists of links. This is useful for things such as table-of-contents or site maps. By default, this will return UL lists, but this is highly configurable. Required: =over =item link_tree A list of lists of urls, in the order you want them displayed. If a url is not in this list, it will not be displayed. =back Options: =over =item current_url The link to the current page. If one of the links equals this, then that is deemed to be the "active" link and is just displayed as a label rather than a link. =item descriptions Optional hash of descriptions, to put next to the links. The keys of this hash are the urls. =item exclude_root_parent If this is true, then the "current_parent" display options are not used for the "root" ("/") path, it isn't counted as a "parent" of the current_url. =item formats A reference to a hash containing advanced format settings. For example: my %formats = ( # level 1 and onwards '1' => { tree_head=>"
      ", tree_foot=>"
    \n", }, # level 2 and onwards '2' => { tree_head=>"\n", }, # level 3 and onwards '3' => { pre_item=>'(', post_item=>')', item_sep=>",\n", tree_sep=>' -> ', tree_head=>"
    \n", tree_foot=>"", } ); The formats hash enables you to control the formatting on a per-level basis. Each key of the hash corresponds to a level-number; the sub-hashes contain format arguments which will apply from that level onwards. If an argument isn't given in the sub-hash, then it will fall back to the previous level (or to the default, if there is no setting for that format-argument for a previous level). The only difference between the names of the arguments in the sub-hash and in the global format arguments is that instead of 'subtree_head' and subtree_foot' it uses 'tree_head' and 'tree_foot'. =item hide_ext If a site is hiding link extensions (such as using MultiViews with Apache) you may wish to hide the extensions (while using the full URLs to check various things). (default: 0 (false)) =item item_sep The string to separate each item. =item labels A hash whose keys are links and whose values are labels. These are the labels for the links; if no label is given, then the last part of the link is used for the label, with some formatting. =item links_head The string to prepend the top-level tree with. (default: ) =item pre_desc String to prepend to each description. =item post_desc String to append to each description. =item pre_item String to prepend to each item. (default:
  • ) =item post_item String to append to each item. (default:
  • ) =item pre_active_item An additional string to put in front of each "active" item, after pre_item. The "active" item is the link which matches 'current_url'. (default: ) =item post_active_item An additional string to append to each active item, before post_item. (default: ) =item pre_current_parent An additional string to put in front of a link which is a parent of the 'current_url' link, after pre_item. =item post_current_parent An additional string to append to a link which is a parent of the 'current_url' link, before post_item. =item prefix_url A prefix to prepend to all the links. (default: empty string) =item subtree_head The string to prepend to lower-level trees. (default: ) =item tree_sep The string to separate each tree. =back =cut sub link_tree { my %args = ( current_url=>'', prefix_url=>'', link_tree=>undef, links_head=>'", subtree_head=>'", last_subtree_head=>'", pre_item=>'
  • ', post_item=>'
  • ', pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n", tree_sep=>"\n", @_ ); # correct the current_url $args{current_url} = make_canonical($args{current_url}); my %current_parents = extract_current_parents(%args); $args{tree_depth} = 0; $args{end_depth} = 0; if (defined $args{link_tree} and @{$args{link_tree}}) { my %default_format = make_default_format(%args); my %formats = make_extra_formats(%args); my @link_tree = @{$args{link_tree}}; my $list = traverse_lol(\@link_tree, %args, formats=>\%formats, current_format=>\%default_format, current_parents=>\%current_parents); return $list if $list; } return ''; } # link_tree =head2 full_tree $links = full_tree( paths=>\@list_of_paths, labels=>\%labels, descriptions=>\%desc, hide=>$hide_regex, nohide=>$nohide_regex, start_depth=>0, end_depth=>0, top_level=>0, preserve_order=>0, preserve_paths=>0, ... ); Given a set of paths this will generate a tree of links in the style of I. This will figure out all the intermediate paths and construct the nested structure for you, clustering parents and children together. The formatting options are as for L. Required: =over =item paths A reference to a list of paths: that is, URLs relative to the top of the site. For example, if the full URL is http://www.example.com/foo.html then the path is /foo.html If the full URL is http://www.example.com/~frednurk/foo.html then the path is /foo.html This does not require that every possible path be given; all the intermediate paths will be figured out from the list. =back Options: =over =item append_list Array of paths to append to the top-level links. They are used as-is, and are not part of the processing done to the "paths" list of paths. (see L) =item descriptions Optional hash of descriptions, to put next to the links. The keys of this hash are the paths. =item end_depth End your tree at this depth. If zero, then go all the way. (see L) =item exclude_root_parent If this is true, then the "current_parent" display options are not used for the "root" ("/") path, it isn't counted as a "parent" of the current_url. =item hide If the path matches this string, don't include it in the tree. =item hide_ext If a site is hiding link extensions (such as using MultiViews with Apache) you may wish to hide the extensions (while using the full URLs to check various things). (default: 0 (false)) =item labels Hash containing replacement labels for one or more paths. If no label is given for '/' (the root path) then 'Home' will be used. =item last_subtree_head The string to prepend to the last lower-level tree. Only used if end_depth is not zero. =item last_subtree_foot The string to append to the last lower-level tree. Only used if end_depth is not zero. =item nohide If the path matches this string, it will be included even if it matches the 'hide' string. =item prefix_url A prefix to prepend to all the links. (default: empty string) =item prepend_list Array of paths to prepend to the top-level links. They are used as-is, and are not part of the processing done to the "paths" list of paths. =item preserve_order Preserve the ordering of the paths in the input list of paths; otherwise the links will be sorted alphabetically. Note that if preserve_order is true, the structure is at the whims of the order of the original list of paths, and so could end up odd-looking. (default: false) =item preserve_paths Do not extract intermediate paths or reorder the input list of paths. This speeds things up, but assumes that the input paths are complete and in good order. (default: false) =item start_depth Start your tree at this depth. Zero is the root, level 1 is the files/sub-folders in the root, and so on. (default: 0) =item top_level Decide which level is the "top" level. Useful when you set the start_depth to something greater than 1. =back =cut sub full_tree { my %args = ( paths=>undef, current_url=>'', links_head=>'", subtree_head=>'", last_subtree_head=>'", pre_item=>'
  • ', post_item=>'
  • ', pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n", tree_sep=>"\n", hide=>'', nohide=>'', preserve_order=>0, preserve_paths=>0, labels=>{}, start_depth=>0, end_depth=>0, top_level=>0, @_ ); # correct the current_url $args{current_url} = make_canonical($args{current_url}); my %current_parents = extract_current_parents(%args); # set the root label if (!$args{labels}->{'/'}) { $args{labels}->{'/'} = 'Home'; } my @path_list = (); if ($args{preserve_paths}) { @path_list = filter_out_paths(%args, paths=>$args{paths}); } else { @path_list = extract_all_paths(paths=>$args{paths}, preserve_order=>$args{preserve_order}); @path_list = filter_out_paths(%args, paths=>\@path_list); } my @list_of_lists = build_lol(%args, paths=>\@path_list, depth=>0); $args{tree_depth} = 0; $args{end_depth} = 0; my %default_format = make_default_format(%args); my %formats = make_extra_formats(%args); my $list = traverse_lol(\@list_of_lists, %args, formats=>\%formats, current_format=>\%default_format, current_parents=>\%current_parents); return $list if $list; return ''; } # full_tree =head2 breadcrumb_trail $links = breadcrumb_trail( current_url=>$url, labels=>\%labels, descriptions=>\%desc, links_head=>'

    ', links_foot=>"\n

    ", subtree_head=>'', subtree_foot=>"\n", pre_item=>'', post_item=>'', pre_active_item=>'', post_active_item=>'', item_sep=>"\n", tree_sep=>' > ', ... ); Given the current url, make a breadcrumb trail from it. By default, this is laid out with '>' separators, but it can be set up to give a nested set of UL lists (as for L). The formatting options are as for L. Required: =over =item current_url The current url to be made into a breadcrumb-trail. =back Options: =over =item descriptions Optional hash of descriptions, to put next to the links. The keys of this hash are the urls. =item exclude_root_parent If this is true, then the "current_parent" display options are not used for the "root" ("/") path, it isn't counted as a "parent" of the current_url. =item hide_ext If a site is hiding link extensions (such as using MultiViews with Apache) you may wish to hide the extensions (while using the full URLs to check various things). (default: 0 (false)) =item labels Hash containing replacement labels for one or more URLS. If no label is given for '/' (the root path) then 'Home' will be used. =back =cut sub breadcrumb_trail { my %args = ( current_url=>'', links_head=>'

    ', links_foot=>"\n

    ", subtree_head=>'', subtree_foot=>'', last_subtree_head=>'{', last_subtree_foot=>'}', pre_item=>'', post_item=>'', pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n", tree_sep=>' > ', hide=>'', nohide=>'', labels=>{}, paths=>[], start_depth=>0, end_depth=>undef, top_level=>0, @_ ); # correct the current_url $args{current_url} = make_canonical($args{current_url}); # set the root label if (!$args{labels}->{'/'}) { $args{labels}->{'/'} = 'Home'; } # make a list of paths consisting only of the current_url my @paths = ($args{current_url}); my @path_list = extract_all_paths(paths=>\@paths); @path_list = filter_out_paths(%args, paths=>\@path_list); my @list_of_lists = build_lol(%args, paths=>\@path_list, depth=>0); $args{tree_depth} = 0; $args{end_depth} = 0; my %default_format = make_default_format(%args); my %formats = make_extra_formats(%args); my $list = traverse_lol(\@list_of_lists, %args, formats=>\%formats, current_format=>\%default_format, ); return $list if $list; return ''; } # breadcrumb_trail =head2 nav_tree $links = nav_tree( paths=>\@list_of_paths, labels=>\%labels, current_url=>$url, hide=>$hide_regex, nohide=>$nohide_regex, preserve_order=>1, descriptions=>\%desc, ... ); This takes a list of links, and the current URL, and makes a nested navigation tree, consisting of (a) the top-level links (b) the links leading to the current URL (c) the links on the same level as the current URL, (d) the related links just above this level, depending on whether this is an index-page or a content page. Optionally one can hide links which match match the 'hide' option. The formatting options are as for L, with some additions. Required: =over =item current_url The link to the current page. If one of the links equals this, then that is deemed to be the "active" link and is just displayed as a label rather than a link. This is also used to determine which links to show and which ones to filter out. =item paths A reference to a list of paths: that is, URLs relative to the top of the site. For example, if the full URL is http://www.example.com/foo.html then the path is /foo.html This does not require that every possible path be given; all the intermediate paths will be figured out from the list. =back Options: =over =item append_list Array of paths to append to the top-level links. They are used as-is, and are not part of the processing done to the "paths" list of paths. (see L) =item descriptions Optional hash of descriptions, to put next to the links. The keys of this hash are the paths. =item end_depth End your tree at this depth. If zero, then go all the way. By default this is set to the depth of the current_url. =item exclude_root_parent If this is true, then the "current_parent" display options are not used for the "root" ("/") path, it isn't counted as a "parent" of the current_url. =item hide If a path matches this string, don't include it in the tree. =item hide_ext If a site is hiding link extensions (such as using MultiViews with Apache) you may wish to hide the extensions (while using the full URLs to check various things). (default: 0 (false)) =item labels Hash containing replacement labels for one or more paths. If no label is given for '/' (the root path) then 'Home' will be used. =item last_subtree_head The string to prepend to the last lower-level tree. =item last_subtree_foot The string to append to the last lower-level tree. =item nohide If the path matches this string, it will be included even if it matches the 'hide' string. =item prefix_url A prefix to prepend to all the links. (default: empty string) =item prepend_list Array of paths to prepend to the top-level links. They are used as-is, and are not part of the processing done to the "paths" list of paths. =item preserve_order Preserve the ordering of the paths in the input list of paths; otherwise the links will be sorted alphabetically. (default: true) =item preserve_paths Do not extract intermediate paths or reorder the input list of paths. This speeds things up, but assumes that the input paths are complete and in good order. (default: false) =item start_depth Start your tree at this depth. Zero is the root, level 1 is the files/sub-folders in the root, and so on. (default: 1) =item top_level Decide which level is the "top" level. Useful when you set the start_depth to something greater than 1. =back =cut sub nav_tree { my %args = ( paths=>undef, current_url=>'', links_head=>'", subtree_head=>'", last_subtree_head=>'", pre_item=>'
  • ', post_item=>'
  • ', pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n", tree_sep=>"\n", hide=>'', nohide=>'', preserve_order=>1, preserve_paths=>0, include_home=>0, labels=>{}, start_depth=>1, end_depth=>undef, top_level=>1, navbar_type=>'normal', @_ ); # correct the current_url $args{current_url} = make_canonical($args{current_url}); my $current_is_index = ($args{current_url} =~ m#/$#); my %current_parents = extract_current_parents(%args); # set the end depth if isn't already set # if this is an index-page, then make the depth its depth + 1 # if this is a content-page, make the depth its depth my $current_url_depth = path_depth($args{current_url}); $args{end_depth} = ($current_is_index ? $current_url_depth + 1 : $current_url_depth) if (!defined $args{end_depth}); # set the root label if (!$args{labels}->{'/'}) { $args{labels}->{'/'} = 'Home'; } my @path_list = (); if ($args{preserve_paths}) { @path_list = filter_out_paths(%args, paths=>$args{paths}); } else { @path_list = extract_all_paths(paths=>$args{paths}, preserve_order=>$args{preserve_order}); @path_list = filter_out_paths(%args, paths=>\@path_list); } my @list_of_lists = build_lol(%args, paths=>\@path_list, depth=>0); $args{tree_depth} = 0; my %default_format = make_default_format(%args); my %formats = make_extra_formats(%args); my $list = traverse_lol(\@list_of_lists, %args, formats=>\%formats, current_format=>\%default_format, current_parents=>\%current_parents); return $list if $list; return ''; } # nav_tree =head1 Private Functions These functions cannot be exported. =head2 make_item $item = make_item( this_label=>$label, this_link=>$link, hide_ext=>0, current_url=>$url, current_parents=>\%current_parents, descriptions=>\%desc, format=>\%format, ); %format = ( pre_desc=>' ', post_desc=>'', pre_item=>'
  • ', post_item=>'
  • ' pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n"); ); Format a link item. See L for the formatting options. =over =item this_label The label of the required link. If there is no label, this uses the base-name of the last part of the link, capitalizing it and replacing underscores and dashes with spaces. =item this_link The URL of the required link. =item current_url The link to the current page. If one of the links equals this, then that is deemed to be the "active" link and is just displayed as a label rather than a link. =item current_parents URLs of the parents of the current item. =item descriptions Optional hash of descriptions, to put next to the links. The keys of this hash are the links (not the labels). =item defer_post_item Don't add the 'post_item' string if this is true. (needed for nested lists) (default: false) =item no_link Don't make a link for this, just a label. =back =cut sub make_item { my %args = ( this_link=>'', this_label=>'', hide_ext=>0, current_url=>'', current_parents=>{}, prefix_url=>'', defer_post_item=>0, no_link=>0, @_ ); my $link = $args{this_link}; my $prefix_url = $args{prefix_url}; my $label = $args{this_label}; my %format = %{$args{format}}; if (!$label) { $label = $link if !$label; if ($link =~ /([-\w]+)\.\w+$/) # file { $label = $1; } elsif ($link =~ /([-\w]+)\/?$/) # dir { $label = $1; } else # give up { $label = $link; $label =~ s#/# :: #g; } # prettify $label =~ s#_# #g; $label =~ s#-# #g; $label =~ s/([-\w]+)/\u\L$1/g; } # if we are hiding the extensions of files # we need to display an extensionless link # while doing checks with the original link my $display_link = $link; if ($args{hide_ext}) { if ($link =~ /(.*)\.[-\w]+$/) # file { $display_link = $1; } } my $item = ''; my $desc = ''; if (exists $args{descriptions}->{$link} and defined $args{descriptions}->{$link} and $args{descriptions}->{$link}) { $desc = join('', $format{pre_desc}, $args{descriptions}->{$link}, $format{post_desc}); } if (link_is_active(this_link=>$link, current_url=>$args{current_url})) { $item = join('', $format{pre_item}, $format{pre_active_item}, $label, $format{post_active_item}, $desc, ); } elsif ($args{no_link}) { $item = join('', $format{pre_item}, $label, $desc); } elsif ($args{current_url} and exists $args{current_parents}->{$link} and $args{current_parents}->{$link}) { $item = join('', $format{pre_item}, $format{pre_current_parent}, '', $label, '', $format{post_current_parent}, $desc); } else { $item = join('', $format{pre_item}, '', $label, '', $desc); } if (!$args{defer_post_item}) { $item = join('', $item, $format{post_item}); } return $item; } # make_item =head2 make_canonical my $new_url = make_canonical($url); Make a URL canonical; remove the 'index.*' and add on a needed '/' -- this assumes that directory names never have a '.' in them. =cut sub make_canonical { my $url = shift; return $url if (!$url); if ($url =~ m#^(/)index\.\w+$#) { $url = $1; } elsif ($url =~ m#^(.*/)index\.\w+$#) { $url = $1; } elsif ($url =~ m#/[-\w]+$#) # no dots; a directory { $url .= '/'; # add the slash } return $url; } # make_canonical =head2 get_index_path my $new_url = get_index_path($url); Get the "index" part of this path. That is, if this path is not for an index-page, then get the parent index-page path for this path. (Removes the trailing slash). =cut sub get_index_path { my $url = shift; return $url if (!$url); $url = make_canonical($url); if ($url =~ m#^(.*)/[-\w]+\.\w+$#) { $url = $1; } elsif ($url ne '/') { $url =~ s#/$##; } return $url; } # get_index_path =head2 get_index_parent my $new_url = get_index_parent($url); Get the parent of the "index" part of this path. (Removes the trailing slash). =cut sub get_index_parent { my $url = shift; return $url if (!$url); $url = get_index_path($url); if ($url =~ m#^(.*)/[-\w]+$#) { $url = $1; } return $url; } # get_index_parent =head2 path_depth my $depth = path_depth($url); Calculate the "depth" of the given path. =cut sub path_depth { my $url = shift; return 0 if ($url eq '/'); # root is zero $url =~ s#/$##; # remove trailing / $url =~ s#^/##; # remove leading / my @url = split('/', $url); return scalar @url; } # path_depth =head2 link_is_active if (link_is_active(this_link=>$link, current_url=>$url)) ... Check if the given link is "active", that is, if it matches the 'current_url'. =cut sub link_is_active { my %args = ( this_link=>'', current_url=>'', @_ ); my $link = make_canonical($args{this_link}); my $current_url = $args{current_url}; # if there is no current link, is not active. return 0 if (!$current_url); return 1 if ($link eq $current_url); return 0; } # link_is_active =head2 traverse_lol $links = traverse_lol(\@list_of_lists, labels=>\%labels, tree_depth=>$depth current_format=>\%format, ... ); Traverse the list of lists (of urls) to produce a nested collection of links. This consumes the list_of_lists! =cut sub traverse_lol { my $lol_ref = shift; my %args = ( current_url=>'', labels=>undef, prefix_url=>'', hide_ext=>0, @_ ); my $tree_depth = $args{tree_depth}; my %format = ( %{$args{current_format}}, (exists $args{formats}->{$tree_depth} ? %{$args{formats}->{$tree_depth}} : ()) ); my @items = (); while (@{$lol_ref}) { my $ll = shift @{$lol_ref}; if (!ref $ll) # an item { my $link = $ll; my $label = (exists $args{labels}->{$link} ? $args{labels}->{$link} : ''); my $item = make_item(this_link=>$link, this_label=>$label, defer_post_item=>1, %args, format=>\%format); if (ref $lol_ref->[0]) # next one is a list { $ll = shift @{$lol_ref}; my $sublist = traverse_lol($ll, %args, tree_depth=>$tree_depth + 1, current_format=>\%format); $item = join($format{tree_sep}, $item, $sublist); } $item = join('', $item, $format{post_item}); push @items, $item; } else # a reference to a list { if (defined $args{start_depth} && $args{tree_depth} < $args{start_depth}) { return traverse_lol($ll, %args, current_format=>\%format); } else { my $sublist = traverse_lol($ll, %args, tree_depth=>$tree_depth + 1, current_format=>\%format); my $item = join($format{tree_sep}, $format{pre_item}, $sublist); $item = join('', $item, $format{post_item}); push @items, $item; } } } my $list = join($format{item_sep}, @items); return join('', (($args{end_depth} && $tree_depth == $args{end_depth} ) ? $args{last_subtree_head} : $format{tree_head}), $list, (($args{end_depth} && $tree_depth == $args{end_depth} ) ? $args{last_subtree_foot} : $format{tree_foot}) ); } # traverse_lol =head2 extract_all_paths my @all_paths = extract_all_paths(paths=>\@paths, preserve_order=>0); Extract all possible paths out of a list of paths. Thus, if one has /foo/bar/baz.html then that would make / /foo/ /foo/bar/ /foo/bar/baz.html If 'preserve_order' is true, this preserves the ordering of the paths in the input list; otherwise the output paths are sorted alphabetically. =cut sub extract_all_paths { my %args = ( paths=>undef, preserve_order=>0, @_ ); my %paths = (); # keep track of the order of the paths in the list of paths my $order = 1; foreach my $path (@{$args{paths}}) { my @path_split = split('/', $path); # first path as-is $paths{$path} = $order; pop @path_split; while (@path_split) { # these paths are index-pages. should end in '/' my $newpath = join('/', @path_split, ''); # give this path the same order-num as the full path # but only if it hasn't already been added $paths{$newpath} = $order if (!exists $paths{$newpath}); pop @path_split; } $order++ if ($args{preserve_order}); } return sort { return $a cmp $b if ($paths{$a} == $paths{$b}); return $paths{$a} <=> $paths{$b}; } keys %paths; } # extract_all_paths =head2 extract_current_parents my %current_parents = extract_current_parents(current_url=>$url, exclude_root_parent=>0); Extract the "parent" paths of the current url /foo/bar/baz.html then that would make / /foo/ /foo/bar/ If 'exclude_root_parent' is true, then the '/' is excluded from the list of parents. =cut sub extract_current_parents { my %args = ( current_url=>undef, exclude_root_parent=>0, @_ ); my %paths = (); if ($args{current_url}) { my $current_url = $args{current_url}; my @path_split = split('/', $current_url); pop @path_split; # remove the current url while (@path_split) { # these paths are index-pages. should end in '/' my $newpath = join('/', @path_split, ''); $paths{$newpath} = 1; pop @path_split; } if ($args{exclude_root_parent}) { delete $paths{"/"}; } } return %paths; } # extract_current_parents =head2 build_lol my @lol = build_lol( paths=>\@paths, current_url=>$url, navbar_type=>'', ); Build a list of lists of paths, given a simple list of paths. Assumes that this list has already been filtered. =over =item paths Reference to list of paths; this is consumed. =back =cut sub build_lol { my %args = ( paths=>undef, depth=>0, start_depth=>0, end_depth=>0, current_url=>'', navbar_type=>'', prepend_list=>undef, append_list=>undef, @_ ); my $paths_ref = $args{paths}; my $depth = $args{depth}; my @list_of_lists = (); while (@{$paths_ref}) { my $path = $paths_ref->[0]; my $can_path = make_canonical($path); my $path_depth = path_depth($can_path); my $path_is_index = ($can_path =~ m#/$#); if ($path_depth == $depth) { shift @{$paths_ref}; # use this path push @list_of_lists, $path; } elsif ($path_depth > $depth) { push @list_of_lists, [build_lol( %args, prepend_list=>undef, append_list=>undef, paths=>$paths_ref, depth=>$path_depth, navbar_type=>$args{navbar_type}, current_url=>$args{current_url}, )]; } elsif ($path_depth < $depth) { return @list_of_lists; } } # prepend the given list to the top level if (defined $args{prepend_list} and @{$args{prepend_list}}) { # if the list of lists is a single item which is a list # then add the extra list to that item if ($#list_of_lists == 0 and ref($list_of_lists[0]) eq "ARRAY") { unshift @{$list_of_lists[0]}, @{$args{prepend_list}}; } else { unshift @list_of_lists, @{$args{prepend_list}}; } } # append the given list to the top level if (defined $args{append_list} and @{$args{append_list}}) { # if the list of lists is a single item which is a list # then add the extra list to that item if ($#list_of_lists == 0 and ref($list_of_lists[0]) eq "ARRAY") { push @{$list_of_lists[0]}, @{$args{append_list}}; } else { push @list_of_lists, @{$args{append_list}}; } } return @list_of_lists; } # build_lol =head2 filter_out_paths my @filtered_paths = filter_out_paths( paths=>\@paths, current_url=>$url, hide=>$hide, nohide=>$nohide, start_depth=>$start_depth, end_depth=>$end_depth, top_level=>$top_level, navbar_type=>'', ); Filter out the paths we don't want from our list of paths. Returns a list of the paths we want. =cut sub filter_out_paths { my %args = ( paths=>undef, start_depth=>0, end_depth=>0, top_level=>0, current_url=>'', navbar_type=>'', hide=>'', nohide=>'', @_ ); my $paths_ref = $args{paths}; my $hide = $args{hide}; my $nohide = $args{nohide}; my $current_url_depth = path_depth($args{current_url}); my $current_url_is_index = ($args{current_url} =~ m#/$#); # the current-url dir is the current url without the filename my $current_index_path = get_index_path($args{current_url}); my $current_index_path_depth = path_depth($current_index_path); my $current_index_parent = get_index_parent($args{current_url}); my @wantedpaths = (); foreach my $path (@{$paths_ref}) { my $can_path = make_canonical($path); my $path_depth = path_depth($can_path); my $path_is_index = ($can_path =~ m#/$#); if ($hide and $nohide and not($path =~ /$nohide/) and $path =~ /$hide/) { # skip this one } elsif ($hide and !$nohide and $path =~ /$hide/) { # skip this one } elsif ($path_depth < $args{start_depth}) { # skip this one } elsif ($args{end_depth} and $path_depth > $args{end_depth}) { # skip this one } # a breadcrumb-navbar shows the parent, self, # and the children of dirs or siblings of non-dirs elsif ($args{navbar_type} eq 'breadcrumb' and $args{current_url} and !( ($path_depth <= $current_url_depth and $args{current_url} =~ /^$path/) or ( $path eq $args{current_url} ) or ( $current_url_is_index and $path_depth >= $current_url_depth and $path =~ /^$current_index_path\// ) or ( !$current_url_is_index and $path_depth >= $current_url_depth and $path =~ /^$current_index_parent\// ) ) ) { # skip this one } # a navbar shows the parent, the children # and the current level # and the top level (if we are starting at $top_level) # and the siblings of one's parent if one is a contents-page # or siblings of oneself if one is an index-page elsif (($args{navbar_type} or $args{do_navbar}) # backwards compatibility and $args{current_url} and !( ($path_depth <= $current_url_depth and $args{current_url} =~ /^$path/) or ( $path eq $args{current_url} ) or ( $path_depth >= $current_url_depth and $path =~ /^$current_index_path\// ) or ( $args{start_depth} == $args{top_level} and $path_depth == $args{start_depth} ) or ( !$current_url_is_index and $path_depth == $current_url_depth - 1 and $path =~ /^$current_index_parent\// ) or ( $current_url_is_index and $path_depth == $current_url_depth and $path =~ /^$current_index_parent\// ) ) ) { # skip this one } else { # keep this path push @wantedpaths, $path; } } return @wantedpaths; } # filter_out_paths =head2 make_default_format my %default_format = make_default_format(%args); Make the default format hash from the args. Returns a hash of format options. =cut sub make_default_format { my %args = ( links_head=>'", subtree_head=>'", last_subtree_head=>'", pre_item=>'
  • ', post_item=>'
  • ', pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n", tree_sep=>"\n", @_ ); my %default_format = ( pre_item=>$args{pre_item}, post_item=>$args{post_item}, pre_active_item=>$args{pre_active_item}, post_active_item=>$args{post_active_item}, pre_current_parent=>$args{pre_current_parent}, post_current_parent=>$args{post_current_parent}, pre_desc=>$args{pre_desc}, post_desc=>$args{post_desc}, item_sep=>$args{item_sep}, tree_sep=>$args{tree_sep}, tree_head=>$args{links_head}, tree_foot=>$args{links_foot}, ); return %default_format; } # make_default_format =head2 make_extra_formats my %formats = make_extra_formats(%args); Transforms the subtree_head and subtree_foot into the "formats" method of formatting. Returns a hash of hashes of format options. =cut sub make_extra_formats { my %args = ( formats=>undef, links_head=>'", subtree_head=>'", last_subtree_head=>'", pre_item=>'
  • ', post_item=>'
  • ', pre_active_item=>'', post_active_item=>'', pre_current_parent=>'', post_current_parent=>'', item_sep=>"\n", tree_sep=>"\n", @_ ); my %formats = (); if (defined $args{formats}) { %formats = %{$args{formats}}; } if ($args{links_head} ne $args{subtree_head} || $args{links_foot} ne $args{subtree_foot}) { if (!exists $formats{1}) { $formats{1} = {}; } $formats{1}->{tree_head} = $args{subtree_head}; $formats{1}->{tree_foot} = $args{subtree_foot}; } return %formats; } # make_extra_formats =head1 REQUIRES Test::More =head1 INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install Or, if you're on a platform (like DOS or Windows) that doesn't like the "./" notation, you can do this: perl Build.PL perl Build perl Build test perl Build install In order to install somewhere other than the default, such as in a directory under your home directory, like "/home/fred/perl" go perl Build.PL --install_base /home/fred/perl as the first step instead. This will install the files underneath /home/fred/perl. You will then need to make sure that you alter the PERL5LIB variable to find the modules. Therefore you will need to change the PERL5LIB variable to add /home/fred/perl/lib PERL5LIB=/home/fred/perl/lib:${PERL5LIB} =head1 SEE ALSO perl(1). =head1 BUGS Please report any bugs or feature requests to the author. =head1 AUTHOR Kathryn Andersen (RUBYKAT) perlkat AT katspace dot com http://www.katspace.com/tools/html_linklist/ =head1 COPYRIGHT AND LICENCE Copyright (c) 2006 by Kathryn Andersen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of HTML::LinkList __END__ HTML-LinkList-0.1503/TODO0000444000175000017500000000023611060675366012716 0ustar katkatTODO list for HTML-LinkList =========================== 1. add accesskeys option; e.g. accesskey="h" for Home Added:07/09/08, 16:53 Priority: medium HTML-LinkList-0.1503/MANIFEST0000444000175000017500000000041411060675366013355 0ustar katkatBuild.PL Makefile.PL Changes MANIFEST MANIFEST.SKIP META.yml # Will be created by "make dist" README TODO lib/HTML/LinkList.pm t/00_dist.t t/01_load.t t/pod-coverage.t t/pod.t t/10_link_list.t t/20_link_tree.t t/30_full_tree.t t/40_breadcrumb_trail.t t/50_nav_tree.t HTML-LinkList-0.1503/META.yml0000444000175000017500000000065111060675366013500 0ustar katkat--- name: HTML-LinkList version: 0.1503 author: - Kathryn Andersen abstract: Create a 'smart' list of HTML links. license: perl resources: license: http://dev.perl.org/licenses/ build_requires: Test::More: 0 provides: HTML::LinkList: file: lib/HTML/LinkList.pm version: 0.1503 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 HTML-LinkList-0.1503/Makefile.PL0000444000175000017500000000063111060675366014177 0ustar katkat# Note: this file was auto-generated by Module::Build::Compat version 0.03 use ExtUtils::MakeMaker; WriteMakefile ( 'PL_FILES' => {}, 'INSTALLDIRS' => 'site', 'NAME' => 'HTML::LinkList', 'EXE_FILES' => [], 'VERSION_FROM' => 'lib/HTML/LinkList.pm', 'PREREQ_PM' => { 'Test::More' => 0 } ) ; HTML-LinkList-0.1503/Changes0000444000175000017500000001423611060675366013526 0ustar katkatRevision history for HTML-LinkList ================================== 0.1503 Sun 07 September 2008 ---------------------------- * (2008-09-07) A few tweaks with TODO and Changes. 0.1502 Sun 07 September 2008 ---------------------------- * (2008-09-07) Make the Build make a traditional Makefile.PL * (2008-09-07) Tweak to improve prettifying links. 0.1501 Sat 26 May 2007 ---------------------- * (26 May 2007) fix formats Fixed a bug in the advanced formats stuff. 0.15 Tue 22 May 2007 -------------------- * (22 May 2007) advanced formats Added "formats" option for advanced formatting. 0.14 Sat 19 May 2007 -------------------- * (19 May 2007) uneven lists Enable this to deal with lists of lists where the first item isn't a normal item, but a sub-list, but the next item is a normal item. 0.13 Mon 11 September 2006 -------------------------- * (11 Sep 2006) hide_ext Added the 'hide_ext' option, to hide extensions of files in links (useful for MultiViews sites). 0.12 Tue 23 May 2006 -------------------- * (23 May 2006) description improvements Added 'pre_desc' and 'post_desc' options to enable one to put a string before and after the descriptions. 0.11 Thu 20 April 2006 ---------------------- * (20 Apr 2006) preserve_paths option Added the 'preserve_paths' option; if this is true, then the input paths are not sorted, nor do they have intermediate paths extracted. This speeds things up slightly, and can be useful if you already have a full list of paths and don't need to do that processing on it again. 0.1002 Mon 17 April 2006 ------------------------ * (17 Apr 2006) navbar fix If there are paths that are too similar, such as one subdir in a directory being called "foo", and another called "foobar", then it would pick up the foobar stuff in foo when it shouldn't. 0.1001 Thu 13 April 2006 ------------------------ * (12 Apr 2006) fixed nohide bug The 'nohide' option was being ignored in some circumstances. 0.10 Sat 01 April 2006 ---------------------- * (1 Apr 2006) breadcrumb-navbar Added a hybrid breadcrumb-navbar: nav_tree(navbar_type=>'breadcrumb') which starts off like a breadcrumb-trail, showing the parent(s) of the current URL, but also showing the current level, not just the current URL. Useful in situations where you don't want a full-blown navigation tree. 0.09 Thu 16 March 2006 ---------------------- * (16 Mar 2006) documentation tweaking * (16 Mar 2006) exclude_root_parent Added the 'exclude_root_parent' option, which excludes the root "/" path from being counted as a "parent" to the current_url when using the 'pre_current_parent' and 'post_current_parent' options. This can be useful if you want to use those options but don't want the root/Home link to be displayed differently. * (16 Mar 2006) prepend_list and append_list Added new options (to 'full_tree', 'nav_tree') 'prepend_list' and 'append_list' which enable you to prepend or append a list of links to be added to your "top level" as-is. * (16 Mar 2006) removed nav_bar Removed the 'nav_bar' function because it was horrible and made yucky navbars. With use of CSS and choice of levels and separators, the 'nav_tree' should be sufficient, since while the UL list is the default, it can be set up to use paragraphs and so on. 0.08 Thu 16 February 2006 ------------------------- * (16 Feb 2006) top_level option Added a new 'top_level' option, useful for starting a navigation tree further down its hierarchy. 0.07 Thu 02 February 2006 ------------------------- * (2 Feb 2006) depth fixes - enabled start_depth and end_depth to be changed for nav_tree without wierdness happening. It used to be that end_depth was ignored, and if start_depth was anything other than 1, one would get too many links. * (25 Jan 2006) empty lists Added a check to see that the generated list wasn't empty; before this, it would *always* put on the list_head and list_foot stuff even if there was nothing there. Which meant that you could end up with something like which is Not Nice. * (25 Jan 2006) parent_item_sep Added the 'parent_item_sep' parameter to 'nav_bar'. 0.0601 Thu 19 January 2006 -------------------------- * (19 Jan 2006) corrected error in changelog 0.06 Thu 19 January 2006 ------------------------ * (19 Jan 2006) mostly nav_bar - added new function nav_bar, which does an across-the-top navbar - added new option 'nohide' to override 'hide' - renamed a number of options - restructured the way some things were done 0.0502 Tue 17 January 2006 -------------------------- * (17 Jan 2006) futher correction to navbar This time fer shure! 0.0501 Tue 17 January 2006 -------------------------- * (17 Jan 2006) corrected navbar error My feature enhancement... didn't do what I thought it did. Oops. 0.05 Tue 17 January 2006 ------------------------ * (17 Jan 2006) improved navbar Now the navbar shows the next level up when the current page is not an index page; the siblings of its parent. 0.04 Fri 13 January 2006 ------------------------ * (13 Jan 2006) improved nav_tree Revamped the logic and the options to make nav_tree more sensible and simpler to use. * (12 Jan 2006) nomenclature Stop referring to directories; they're index pages. Renamed 'dir_tree' to 'full_tree'. 0.03 Thu 12 January 2006 ------------------------ * (12 Jan 2006) renames,additions,nav_tree - renamed breadcrumb_tree to breadcrumb_trail - added the 'preserve_order' option to dir_tree - added new function 'nav_tree' to make a nested navbar - updated documentation - fixes and tweaks 0.02 Wed 11 January 2006 ------------------------ * (11 Jan 2006) breadcrumb_tree Added the 'breadcrumb_tree' function which makes a breadcrumb trail from the current_url. * (11 Jan 2006) minor fixes Made the checking of the 'current_url' better. 0.01 Mon 09 January 2006 ------------------------ * (9 Jan 2006) tweaking documentation * (9 Jan 2006) commit tweaking The ModDevAid stuff needed to not try to chmod non-existant scripts. * (9 Jan 2006) fixing tests Just some minor bugs with the tests. * (9 Jan 2006) initial checkin HTML-LinkList-0.1503/MANIFEST.SKIP0000444000175000017500000000115411060675366014124 0ustar katkat# Version control files and dirs. \bRCS\b \bCVS\b ,v$ ^_darcs/ # ModDevAid ^version.txt$ ^old_version.txt$ ^darcs_prebuild.pl$ ^mod_devaid.conf$ # distro files ^HTML-LinkList-* # ExtUtils::MakeMaker generated files and dirs. ^Makefile$ ^blib/ ^blibdirs$ ^pm_to_blib$ ^MakeMaker-\d # Module::Build ^Build$ ^_build/ # Temp, old, vi and emacs files. ~$ \.old$ ^#.*#$ ^\.# \.swp$ \.bak$ HTML-LinkList-0.1503/Build.PL0000444000175000017500000000077511060675366013532 0ustar katkatuse strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'HTML::LinkList', license => 'perl', dist_author => 'Kathryn Andersen', dist_version_from => 'lib/HTML/LinkList.pm', requires => { # module requirements here }, build_requires => { 'Test::More' => 0, }, create_makefile_pl => 'traditional', # add_to_cleanup => [ 'HTML-LinkList-*' ], ); $builder->create_build_script();