libpod-tree-perl 1.17-1 / usr / share / perl5 / Pod / Tree / HTML.pm

# Copyright (c) 1999-2007 by Steven McDougall.  This module is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.

use strict;
use HTML::Stream;
use IO::File;
use IO::String;
use Pod::Tree;
use Text::Template;


package Pod::Tree::BitBucket;

sub new      { bless {}, shift }
sub AUTOLOAD { shift }


package Pod::Tree::StrStream;

sub new
{
    my($class, $ref) = @_;

    if ($ref)
    {
	return bless $ref, $class
    }
    else
    {
	my $st = '';
	return bless \$st, $class;
    }
}

sub print
{
    my $st = shift;
    $$st  .= join('', @_);
}

sub get
{
    my $st = shift;
    my $s  = $$st;
    $$st   = '';
    $s
}


package Pod::Tree::HTML;

use constant BGCOLOR => '#ffffff';
use constant TEXT    => '#000000';

our $VERSION = '1.10';

sub new
{
    my($class, $source, $dest, %options) = @_;
    defined $dest or die "Pod::Tree::HTML::new: not enough arguments\n";

    my $tree         = _resolve_source($source);
    my($fh, $stream) = _resolve_dest  ($dest  , $tree, \%options);

    my $options = { bgcolor     => BGCOLOR,
		    depth       => 0,
		    hr          => 1,
		    link_map    => Pod::Tree::HTML::LinkMap->new(),
		    text        => TEXT,
		    toc         => 1,
		    };

    my $HTML = { tree        => $tree,
		 root        => $tree->get_root,
		 stream      => $stream,
		 fh          => $fh,
		 text_method => 'text',
		 options     => $options,
		 };

    bless $HTML, $class;

    $HTML->set_options(%options);
    $HTML
}


sub _resolve_source
{
    my $source = shift;
    my $ref    = ref $source;
    local *isa = \&UNIVERSAL::isa;

    isa($source, 'Pod::Tree') and return $source;

    my $tree = new Pod::Tree;
    not $ref		     and $tree->load_file      ( $source);
    isa($source, 'IO::File') and $tree->load_fh	       ( $source);
    $ref eq 'SCALAR'         and $tree->load_string    ($$source);
    $ref eq 'ARRAY'          and $tree->load_paragraphs( $source);

    $tree->loaded or 
	die "Pod::Tree::HTML::_resolve_source: Can't load POD from $source\n";

    $tree
}


sub _resolve_dest
{
    my($dest, $tree, $options) = @_;

    $tree->has_pod or $options->{empty} or
	return (undef, new Pod::Tree::BitBucket);

    local *isa = \&UNIVERSAL::isa;
    local *can = \&UNIVERSAL::can;

    isa($dest, 'HTML::Stream') and return (undef, 		   $dest);
    isa($dest, 'IO::File'    ) and return ($dest, new HTML::Stream $dest);
    can($dest, 'print'       ) and return ($dest, new HTML::Stream $dest);

    if (ref $dest eq 'SCALAR')
    {
	my $fh = new IO::String $$dest;
	return ($fh, new HTML::Stream $fh);
    }

    if (ref $dest eq '' and $dest)
    {
	my $fh = new IO::File;
	$fh->open($dest, '>') or die "Pod::Tree::HTML::new: Can't open $dest: $!\n";
	return ($fh, new HTML::Stream $fh);
    }

    die "Pod::Tree::HTML::_resolve_dest: Can't write HTML to $dest\n";
}


sub set_options
{
    my($html, %options) = @_;

    my($key, $value);
    while (($key, $value) = each %options)
    {
	$html->{options}{$key} = $value;
    }
}


sub get_options
{
    my($html, @options) = @_;

    map { $html->{options}{$_} } @options
}


sub get_stream { shift->{stream} }


sub translate
{
    my($html, $template) = @_;

    if ($template)
    {
	$html->_template($template);
    }
    else
    {
	$html->_translate;
    }
}


sub _translate
{
    my $html    = shift;
    my $stream  = $html->{stream};
    my $bgcolor = $html->{options}{bgcolor};
    my $text 	= $html->{options}{text};
    my $title   = $html->_make_title;
    my $base    = $html->{options}{base};
    my $css     = $html->{options}{css};

    $stream->HTML->HEAD;

    defined $title and $stream->TITLE->text($title)->_TITLE;
    defined $base  and $stream->BASE(href => $base);
    defined $css   and $stream->LINK(href => $css,
				     type => "text/css",
				     rel  => "stylesheet");

    $stream->_HEAD
	   ->BODY(BGCOLOR => $bgcolor, TEXT => $text);

    $html->emit_toc;
    $html->emit_body;

    $stream->nl
	   ->_BODY
	   ->_HTML
}


sub _template
{
    my ($html, $tSource) = @_;

    my 	$fh	    = $html->{fh};
    my  $sStream    = new Pod::Tree::StrStream;
    $html->{stream} = new HTML::Stream $sStream;

    our $bgcolor = $html->{options}{bgcolor};
    our $text 	 = $html->{options}{text};
    our $title   = $html->_make_title;
    our $base    = $html->{options}{base};
    our $css     = $html->{options}{css};

    $html->emit_toc;
    our $toc = $sStream->get;

    $html->emit_body;
    our $body = $sStream->get;

    my $template = new Text::Template SOURCE => $tSource or
	die "Can't create Text::Template object: $Text::Template::ERROR\n";

    $template->fill_in(OUTPUT => $fh) or
	die $Text::Template::ERROR;
}


sub _make_title
{
    my $html  = shift;

    my $title = $html->{options}{title};
    defined $title and return $title;

    my $children = $html->{root}->get_children;
    my $node1;
    my $i = 0;
    for my $child (@$children)
    {
	is_pod $child or next;
	$i++ and $node1 = $child;
	$node1 and last;
    }

    $node1 or return undef;

    my $text = $node1->get_deep_text;
    ($title) = split m(\s+-), $text;

    $title  or return undef;      # to quiet -w
    $title =~ s(\s+$)();

    $title
}


sub emit_toc
{
    my $html = shift;
    $html->{options}{toc} or return;

    my $root  = $html->{root};
    my $nodes = $root->get_children;
    my @nodes = @$nodes;

    $html->_emit_toc_1(\@nodes);

    $html->{options}{hr} > 0 and $html->{stream}->HR;
}


sub _emit_toc_1
{
    my($html, $nodes) = @_;
    my $stream = $html->{stream};

    $stream->UL;

    while (@$nodes)
    {
	my $node = $nodes->[0];
	is_c_head2 $node and $html->_emit_toc_2   ($nodes), next;
	is_c_head1 $node and $html->_emit_toc_item($node );
	shift @$nodes;
    }

    $stream->_UL;
}


sub _emit_toc_2
{
    my($html, $nodes) = @_;
    my $stream = $html->{stream};

    $stream->UL;

    while (@$nodes)
    {
	my $node = $nodes->[0];
	is_c_head1 $node and last;
	is_c_head2 $node and $html->_emit_toc_item($node);
	shift @$nodes;
    }

    $stream->_UL;
}


sub _emit_toc_item
{
    my($html, $node) = @_;
    my $stream = $html->{stream};
    my $target = $html->_make_anchor($node);

    $stream->LI->A(HREF => "#$target");
    $html->_emit_children($node);
    $stream->_A;
}


sub emit_body
{
    my $html = shift;
    my $root = $html->{root};
    $html->_emit_children($root);
}


sub _emit_children
{
    my($html, $node) = @_;

    my $children = $node->get_children;

    for my $child (@$children)
    {
	$html->_emit_node($child);
    }
}


sub _emit_siblings
{
    my($html, $node) = @_;

    my $siblings = $node->get_siblings;

    if (@$siblings==1 and $siblings->[0]{type} eq 'ordinary')
    {
	# don't put <p></p> around a single ordinary paragraph
	$html->_emit_children($siblings->[0]);
    }
    else
    {
	for my $sibling (@$siblings)
	{
	    $html->_emit_node($sibling);
	}
    }
    
}


sub _emit_node
{
    my($html, $node) = @_;
    my $type = $node->{type};

    for ($type)
    {
	/command/  and $html->_emit_command ($node);
	/for/      and $html->_emit_for     ($node);
	/item/     and $html->_emit_item    ($node);
	/list/     and $html->_emit_list    ($node);
	/ordinary/ and $html->_emit_ordinary($node);
	/sequence/ and $html->_emit_sequence($node);
	/text/     and $html->_emit_text    ($node);
	/verbatim/ and $html->_emit_verbatim($node);
    }
}


my %HeadTag = ( head1 => { 'open' => 'H1', 'close' => '_H1', level => 1 },
	        head2 => { 'open' => 'H2', 'close' => '_H2', level => 2 },
	        head3 => { 'open' => 'H3', 'close' => '_H3', level => 3 },
	        head4 => { 'open' => 'H4', 'close' => '_H4', level => 4 } );

sub _emit_command
{
    my($html, $node) = @_;
    my $stream   = $html->{stream};
    my $command  = $node->get_command;
    my $head_tag = $HeadTag{$command};
    $head_tag or return;
    my $anchor   = $html->_make_anchor($node);

    $html->_emit_hr($head_tag->{level});

    my $tag;
    $tag = $head_tag->{'open'};
    $stream->$tag()->A(NAME => $anchor);

    $html->_emit_children($node);

    $tag = $head_tag->{'close'};
    $stream->_A->$tag();
}


sub _emit_hr
{
    my($html, $level) = @_;
    $html->{options}{hr} > $level or return;
    $html->{skip_first}++ or return;
    $html->{stream}->HR;
}


sub _emit_for
{
    my($html, $node) = @_;
    
    my $interpreter = lc $node->get_arg;
    my $emit        = "_emit_for_$interpreter";

    $html->$emit($node) if $html->can($emit);
}

sub _emit_for_html
{
    my($html, $node) = @_;

    my $stream = $html->{stream};
    $stream->P;
    $stream->io->print($node->get_text);
    $stream->_P;
}

sub _emit_for_image
{
    my($html, $node) = @_;

    my $stream = $html->{stream};
    my $link    = $node->get_text;
       $link    =~ s(\s+$)();

    $stream->IMG(src => $link);
}


sub _emit_item
{
    my($html, $node) = @_;

    my $stream    = $html->{stream};
    my $item_type = $node->get_item_type;
    for ($item_type)
    {
	/bullet/ and do
	{
	    $stream->LI();
	    $html->_emit_siblings($node);
	    $stream->_LI();
	};

	/number/ and do
	{
	    $stream->LI();
	    $html->_emit_siblings($node);
	    $stream->_LI();
	};

	/text/   and do
	{
	    my $anchor = $html->_make_anchor($node);
	    $stream->DT->A(NAME => "$anchor");
	    $html->_emit_children($node);
	    $stream->_A->_DT->DD;
	    $html->_emit_siblings($node);
	    $stream->_DD;
	};
    }

}


my %ListTag  = (bullet => { 'open' => 'UL', 'close' => '_UL' },
		number => { 'open' => 'OL', 'close' => '_OL' },
		text   => { 'open' => 'DL', 'close' => '_DL' } );

sub _emit_list
{
    my($html, $node) = @_;
    my($list_tag, $tag);    # to quiet -w, see beloew

    my $stream    = $html->{stream};
    my $list_type = $node->get_list_type;

    $list_type and $list_tag = $ListTag{$list_type};
    $list_tag  and $tag      = $list_tag->{'open'};
    $tag and $stream->$tag();

    $html->_emit_children($node);
    
    $list_tag and $tag = $list_tag->{'close'};
    $tag and $stream->$tag();
}


sub _emit_ordinary
{
    my($html, $node) = @_;
    my $stream = $html->{stream};

    $stream->P;
    $html->_emit_children($node);
    $stream->_P;
}


sub _emit_sequence
{
    my($html, $node) = @_;

    for ($node->get_letter)
    {
	/I|B|C|F/ and $html->_emit_element($node), last;
	/S/       and $html->_emit_nbsp   ($node), last;
	/L/       and $html->_emit_link   ($node), last;
	/X/       and $html->_emit_index  ($node), last;
	/E/       and $html->_emit_entity ($node), last;
    }
}


my %ElementTag = (I => { 'open' => 'I'   , 'close' => '_I'    },
		  B => { 'open' => 'B'   , 'close' => '_B'    },
		  C => { 'open' => 'CODE', 'close' => '_CODE' },
		  F => { 'open' => 'I'   , 'close' => '_I'    } );

sub _emit_element
{
    my($html, $node) = @_;

    my $letter = $node->get_letter;
    my $stream = $html->{stream};

    my $tag;
    $tag = $ElementTag{$letter}{'open'};
    $stream->$tag();
    $html->_emit_children($node);
    $tag = $ElementTag{$letter}{'close'};
    $stream->$tag();
}


sub _emit_nbsp
{
    my($html, $node) = @_;

    my $old_method = $html->{text_method};
    $html->{text_method} = 'text_nbsp';
    $html->_emit_children($node);
    $html->{text_method} = $old_method;
}


sub _emit_link
{
    my($html, $node) = @_;

    my $stream = $html->{stream};
    my $target = $node->get_target;
    my $domain = $target->get_domain;
    my $method = "make_${domain}_URL";
    my $url    = $html->$method($target);

    $stream->A(HREF=>$url);
    $html->_emit_children($node);
    $stream->_A;
}

sub make_POD_URL
{
    my($html, $target) = @_;

    my $link_map = $html->{options}{link_map};

    return $link_map->url($html, $target) if $link_map->can("url");

    $html->make_mapped_URL($target)
}


sub make_mapped_URL
{
    my($html, $target) = @_;

    my $link_map = $html->{options}{link_map};
    my $base     = $html->{options}{base} || '';
    my $page     = $target->get_page;
    my $section  = $target->get_section;
    my $depth    = $html->{options}{depth};

    ($base, $page, $section) = $link_map->map($base, $page, $section, $depth);

       $base     =~ s(/$)();
       $page    .= '.html' if $page;
    my $fragment = $html->escape_2396($section);
    my $url      = $html->assemble_url($base, $page, $fragment);

    $url
}

sub make_HTTP_URL
{
    my($html, $target) = @_;

    $target->get_page
}


sub _emit_index
{
    my($html, $node) = @_;

    my $stream = $html->{stream};
    my $anchor = $html->_make_anchor($node);
    $stream->A(NAME=>$anchor)->_A;
}


sub _emit_entity
{
    my($html, $node) = @_;

    my $stream = $html->{stream};
    my $entity  = $node->get_deep_text;
    $stream->ent($entity);
}


sub _emit_text
{
    my($html, $node) = @_;
    my $stream       = $html->{stream};
    my $text         = $node->get_text;
    my $text_method  = $html->{text_method};

    $stream->$text_method($text);
}


sub _emit_verbatim
{
    my($html, $node) = @_;
    my $stream = $html->{stream};
    my $text   = $node->get_text;
       $text   =~ s(\n\n$)();

    $stream->PRE->text($text)->_PRE;
}


sub _make_anchor
{
    my($html, $node) = @_;
    my $text = $node->get_deep_text;
       $text =~ s(   \s*\n\s*/  )( )xg;  # close line breaks
       $text =~ s( ^\s+ | \s+$  )()xg;   # clip leading and trailing WS
       $html->escape_2396($text)
}

 
sub bin { oct '0b' . join '', @_ }

my @LinkFormat = ( sub { my($b,$p,$f)=@_; ""         },
		   sub { my($b,$p,$f)=@_;      "#$f" },
                   sub { my($b,$p,$f)=@_;    "$p"    },
                   sub { my($b,$p,$f)=@_;    "$p#$f" },
                   sub { my($b,$p,$f)=@_; "$b/"      },
                   sub { my($b,$p,$f)=@_;      "#$f" },
                   sub { my($b,$p,$f)=@_; "$b/$p"    },
                   sub { my($b,$p,$f)=@_; "$b/$p#$f" } );

sub assemble_url
{
    my($html, $base, $page, $fragment) = @_;

    my $i    = bin map { length($_) ? 1 : 0 } ($base, $page, $fragment);
    my $url  = $LinkFormat[$i]($base, $page, $fragment);

    $url
}

sub escape_2396
{
    my($html, $text) = @_;
    $text =~ s(([^\w\-.!~*'()]))(sprintf("%%%02x", ord($1)))eg;
    $text
}


package Pod::Tree::HTML::LinkMap;

sub new
{
    my $class = shift;
    bless {}, $class
}

sub url
{
    my($link_map, $html, $target) = @_;

    my $depth    = $html->{options}{depth};
    my $base     = join '/', ('..') x $depth;

    my $page     = $target->get_page;
       $page     =~ s(::)(/)g;
       $page    .= '.html' if $page;

    my $section  = $target->get_section;
    my $fragment = $html->escape_2396 ($section);

    my $url      = $html->assemble_url($base, $page, $fragment);
    $url
}


__END__

=head1 NAME

Pod::Tree::HTML - Generate HTML from a Pod::Tree

=head1 SYNOPSIS

  use Pod::Tree::HTML;
  
  $source   =   new Pod::Tree %options;
  $source   =  "file.pod";
  $source   =   new IO::File;
  $source   = \$pod;
  $source   = \@pod;
  
  $dest     =   new HTML::Stream;
  $dest     =   new IO::File;
  $dest     =  "file.html";
  
  $html     =   new Pod::Tree::HTML $source, $dest, %options;
  
              $html->set_options(%options);
  @values   = $html->get_options(@keys);
  
              $html->translate;
              $html->translate($template);
              $html->emit_toc;
              $html->emit_body;
  
  $fragment = $html->escape_2396 ($section);
  $url      = $html->assemble_url($base, $page, $fragment);


=head1 REQUIRES

C<HTML::Stream>, C<Text::Template>


=head1 DESCRIPTION

C<Pod::Tree::HTML> reads a POD and translates it to HTML.
The source and destination are fixed when the object is created.
Options are provided for controlling details of the translation.

The C<translate> method does the actual translation.

For convenience, 
C<Pod::Tree::HTML> can read PODs from a variety of sources,
and write HTML to a variety of destinations.
The C<new> method resolves the I<$source> and I<$dest> arguments.

C<Pod::Tree::HTML> can also use C<Text::Template> to fill in an HTML
template file.


=head2 Source resolution

C<Pod::Tree::HTML> can obtain a POD from any of 5 sources.
C<new> resolves I<$source> by checking these things,
in order:

=over 4

=item 1

If I<$source> C<isa> C<POD::Tree>, 
then the POD is taken from that tree.

=item 2

If I<$source> is not a reference, 
then it is taken to be the name of a file containing a POD.

=item 3

If I<$source> C<isa> C<IO::File>, 
then it is taken to be an C<IO::File> object that is already
open on a file containing a POD.

=item 4

If I<$source> is a SCALAR reference,
then the text of the POD is taken from that scalar.

=item 5

if I<$source> is an ARRAY reference,
then the paragraphs of the POD are taken from that array.

=back

If I<$source> isn't any of these things,
C<new> C<die>s.
 

=head2 Destination resolution

C<Pod::Tree::HTML> can write HTML to any of 5 destinations.
C<new> resolves I<$dest> by checking these things,
in order:

=over 4

=item 1

If I<$dest> C<isa> C<HTML::Stream>,
then C<Pod::Tree::HTML> writes HTML to that stream.

=item 2

If I<$dest> C<isa> C<IO::File>,
then C<Pod::Tree::HTML> writes HTML to that file.

=item 3

If I<$dest> has a C<print> method,
then C<Pod::Tree::HTML> passes HTML to that method.

=item 4

If I<$dest> is a SCALAR reference,
then C<Pod::Tree::HTML> writes HTML to that scalar.

=item 5

If I<$dest> is a string,
then C<Pod::Tree::HTML> writes HTML to the file with that name.

=back

If I<$dest> isn't any of these things,
C<new> C<die>s.


=head1 METHODS

=over 4

=item I<$html> = C<new> C<Pod::Tree::HTML> I<$source>, I<$dest>, I<%options>

Creates a new C<Pod::Tree::HTML> object.

I<$html> reads a POD from I<$source>,
and writes HTML to I<$dest>.
See L</Source resolution> and L</Destination resolution> for details.

Options controlling the translation may be passed in the I<%options> hash.
See L</OPTIONS> for details.

=item I<$html>->C<set_options>(I<%options>)

Sets options controlling the translation.
See L</OPTIONS> for details.

=item I<@values> = I<$html>->C<get_options>(I<@keys>)

Returns the current values of the options specified in I<@keys>.
See L</OPTIONS> for details.

=item I<$html>->C<translate>

=item I<$html>->C<translate>(I<$template>)

Translates the POD to HTML.
This method should only be called once.

In the second form,
I<$template> is the name of a file containing a template.
The template will be filled in by the C<Text::Template> module.
Here is a minimal template,
showing example usage of all the variables that are set by C<Pod::Tree::HTML>.

  <html>
   <head>
    <base href="{$base}">
    <link href="{$css}" rel="stylesheet" type="text/css">
    <title>{$title}</title>
   </head>
   <body bgcolor="{$bgcolor}" text="{$text}">
    {$toc}
    {$body}
   </body>
  </html>

The program fragments in the template are evaulted in the C<Pod::Tree::HTML> package.
Any variables that you set in this package will be available to your template.

When a template is used, the destination must not be an C<HTML::Stream> object.

C<translate> doesn't return anything.
The first form always returns.
The second form C<die>s if there is an error creating or filling in the template.


=item I<$html>->C<emit_toc>

=item I<$html>->C<emit_body>

Emits the table of contents and body of the HTML document.

These methods are called automatically by C<translate>.
They are exposed in the API for applications that wish to embed the 
HTML inside a larger document.

=back

=head2 Utility methods

These methods are provided for implementors who write their own link
mapper objects.

=over 4

=item I<$fragment> = I<$html>->C<escape_2396>(I<$section>)

Escapes I<$section> according to RFC 2396. For example, the section

    some section

is returned as

    some%20section

=item I<$url> = I<$html>->C<assemble_url>(I<$base>, I<$page>, I<$fragment>)

Assembles I<$base>, I<$page>, and I<$fragment> into a URL, of the form

    $base/$page#$fragment

Attempts to construct a valid URL, even if some of I<$base>, I<$page>,
and I<$fragment> are empty.

=back


=head1 OPTIONS

=over 4

=item C<base> => I<$url>

Specifies a base URL for relative HTML links.


=item C<bgcolor> => I<#rrggbb>

Set the background color to I<#rrggbb>.
Default is white.


=item C<css> => I<$url>

Specifies a Cascading Style Sheet for the generated HTML page.


=item C<depth> => I<$depth>

Specifies the depth of the generated HTML page in a directory tree.
See L</LINK MAPPING> for details.


=item C<empty> => C<1>

Causes the C<translate> method to emit an HTML file, even if the POD is empty.
If this option is not provided, then no HTML file is created for empty PODs.


=item C<hr> => I<$level>

Controls the profusion of horizontal lines in the output, as follows:

    $level   horizontal lines
    0 	     none
    1 	     between TOC and body
    2 	     after each =head1
    3 	     after each =head1 and =head2

Default is level 1.


=item C<link_map> => I<$link_map>

Sets the link mapper. 
See L</LINK MAPPING> for details.


=item C<text> => I<#rrggbb>

Set the text color to I<#rrggbb>.
Default is black.


=item C<title> => I<title>

Set the page title to I<title>.
If no C<title> option is given, 
C<Pod::Tree::HTML> will attempt construct a title from the 
second paragrah of the POD.
This supports the following style:

    =head1 NAME
    
    ls - list contents of directory


=item C<toc> => [C<0>|C<1>]

Includes or omits the table of contents.
Default is to include the TOC.

=back


=head1 LINKS and TARGETS

C<Pod::Tree::HTML> automatically generates HTML destination anchors for
all =headI<n> command paragraphs,
and for text items in =over lists.
The text of the paragraph becomes the C<name> attribute of the anchor.
Markups are ignored and the text is escaped according to RFC 2396.

For example, the paragraph

	=head1 C<Foo> Bar

is translated to 

	<h1><a name="Foo%20Bar"><code>Foo</code> Bar</a></h1>

To link to a heading, 
simply give the text of the heading in an C<< LZ<><> >> markup.
The text must match exactly; 
markups may vary.
Either of these would link to the heading shown above

	L</C<Foo> Bar>
	L</Foo Bar>

To generate destination anchors in other places,
use the index (C<< XZ<><> >>) markup

	We can link to X<this text> this text.

and link to it as usual

	L</this text> uses the index markup.

Earlier versions of this module also emitted the content of the XZ<><>
markup as visible text. However, L<perlpod> now specifies that XZ<><>
markups render as an empty string, so C<Pod::Tree::HTML> has been
changed to do that.


=head1 LINK MAPPING

The POD specification provides the C<< LZ<><> >> markup to link from
one document to another. HTML provides anchors (C<< <a href=""></a> >>) 
for the same purpose. Obviously, a POD2HTML translator should
convert the first to the second.

In general, this is a hard problem.
In particular, the POD format is not powerful enough to support the kind
of hyper-linking that people want in a complex documentation system.

Rather than try to be all things to all people,
C<Pod::Tree::HTML> uses a I<link mapper> object to translate 
the target of a POD link to a URL.
The default link mapper does a simple translation, described below.
If you don't like the default translation,
you can provide your own link mapper
with the L<< C<link_map> => I<$link_map> >> option.


=head2 Default

The default link mapper obtains the I<page> and I<section> from the target.
It translates C<::> sequences in the I<page> to C</>,
and returns a URL of the form [C<../>...][I<page>C<.html>][C<#>I<section>]

If the L<< C<depth> => I<$depth> >> option is given,
a corresponding number of C<../> sequences are prepended to I<page>.

This is a relative URL, 
so it will be interpreted relative to the L<< C<base> => I<$base> >> option,
if any.


=head2 Custom

To use your own link mapper,
create a link mapper object and provide it to C<Pod::Tree::HTML>
with the C<link_map> option

    sub MyMapper::new { bless {}, shift }
    
    sub MyMapper::url
    {
        my($mapper, $html, $target) = @_;
        ...
	return $url;
    }
    
    $mapper = new MyMapper;
    $html   = new Pod::Tree::HTML link_map => $mapper;

Your object should implement one method

=over 4

=item I<$url> = I<$mapper>->C<url>(I<$html>, I<$target>)

When I<$html>->C<translate>() encounters an C<< LZ<><> >> markup, 
it calls I<$mapper>->C<url>. 
I<$html> is the C<Pod::Tree::HTML> object itself.
I<$target> is a C<Pod::Tree::Node> object representing the 
the target of the link. 
See L<Pod::Tree::Node/target nodes> for information on interpreting I<$target>.

The C<url> method must return a string, 
which will be emitted as the value of the C<href> attribute of an HTML 
anchor: C<< <a href=" >>I<$url>C<< "> >>...C<< </a> >>

C<Pod:Tree:HTML> provides the C<escape_2396> and C<assemble_url>
methods for convenience in implementing link mappers.

=back

If the link mapper does not provide a C<url> method,
C<Pod::Tree::HTML> will call C<map> 

=over 4

=item (I<$base>, I<$page>, I<$section>) = I<$mapper>-E<gt>C<map>(I<$base>, I<$page>, I<$section>, I<$depth>);

Where

=over 4

=item I<$base>

is the URL given in the C<base> option.

=item I<$page>

is the man page named in the LE<lt>E<gt> markup.

=item I<$section>

is the man page section given in the LE<lt>E<gt> markup.

=item I<$depth>

is the value of the C<depth> option.

=back

The C<map> method may perform arbitrary mappings on its arguments.
C<Pod::Tree::HTML> takes the returned values and constructs a URL 
of the form [I<$base>/][I<$page>C<.html>][C<#>I<$fragment>]

=back

The C<map> method is 

=over 4

=item *

deprecated

=item *

less flexible than the C<url> method

=item *

supported for backwards compatibility with
older versions of C<Pod::Tree::HTML>

=back


=head1 DIAGNOSTICS

=over 4

=item C<Pod::Tree::HTML::new: not enough arguments>

(F) C<new> called with fewer than 2 arguments.

=item C<Pod::Tree::HTML::new: Can't load POD from $source>

(F) C<new> couldn't resolve the I<$source> argument.
See L</Source resolution> for details.

=item C<Pod::Tree::HTML::new: Can't write HTML to $dest>

(F) C<new> couldn't resolve the I<$dest> argument.
See L</Destination resolution> for details.

=item C<Pod::Tree::HTML::new: Can't open $dest: $!>

(F) The destination file couldn't be opened.

=back


=head1 SEE ALSO

perl(1), L<C<Pod::Tree>>, L<C<Pod::Tree::Node>>,  L<C<Text::Template>>


=head1 AUTHOR

Steven McDougall, swmcd@world.std.com


=head1 COPYRIGHT

Copyright (c) 1999-2009 by Steven McDougall. This module is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.