package Pod::Tree::HTML;
use 5.006;
use strict;
use warnings;

# 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 HTML::Stream;
use IO::File;
use IO::String;
use Pod::Tree;
use Text::Template;

use Pod::Tree::BitBucket;
use Pod::Tree::StrStream;
use Pod::Tree::HTML::LinkMap;

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

our $VERSION = '1.31';

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 = Pod::Tree->new;
    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, Pod::Tree::BitBucket->new );

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

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

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

    if ( ref $dest eq '' and $dest ) {
        my $fh = IO::File->new;
        $fh->open( $dest, '>' ) or die "Pod::Tree::HTML::new: Can't open $dest: $!\n";
        return ( $fh, HTML::Stream->new($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 = Pod::Tree::StrStream->new;
    $html->{stream} = HTML::Stream->new($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 = Text::Template->new( 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) {
        $child->is_pod or next;
        $i++ and $node1 = $child;
        $node1 and last;
    }

    $node1 or return undef;    ##no critic (ProhibitExplicitReturnUndef)

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

    $title or return undef;    ##no critic (ProhibitExplicitReturnUndef)
    $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];
        $node->is_c_head2 and $html->_emit_toc_2($nodes), next;
        $node->is_c_head1 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];
        $node->is_c_head1 and last;
        $node->is_c_head2 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;
}

__END__

=head1 NAME

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

=head1 SYNOPSIS

  use Pod::Tree::HTML;

  $source   =   Pod::Tree->new(%options);
  $source   =  "file.pod";
  $source   =   IO::File->new;
  $source   = \$pod;
  $source   = \@pod;

  $dest     =   HTML::Stream->new;
  $dest     =   IO::File->new;
  $dest     =  "file.html";

  $html     =   Pod::Tree::HTML->new($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<$url> >> 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 = MyMapper->new;
    $html   = Pod::Tree::HTML->new(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.
