view release on metacpan or  search on metacpan

lib/Pod/Tree/HTML.pm  view on Meta::CPAN

    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;