File Coverage

blib/lib/HTML/FormatNroff.pm

Criterion	Covered	Total	%
statement	150	224	66.9
branch	50	94	53.1
condition	3	3	100.0
subroutine	37	49	75.5
pod	40	44	90.9
total	280	414	67.6

package HTML::FormatNroff;

use strict;
use warnings;
use 5.004;
use parent 'HTML::Formatter';

use HTML::FormatNroff::Table::Nroff;

our $VERSION = 0.6;

sub default_values {
    (
        name          => "",      # man page name
        section       => 1,       # section of manual
        man_date      => "",      # date for section
        project       => "",      # name of project
        tables        => [],
        fonts         => [],
        current_table => undef,
        ignore        => 0,
        man_header    => 1,
        page_width    => "6",
        divs          => [],
    );
}

sub dt_start {
    my ($self) = @_;

    $self->vspace(1);
    $self->textout( "\n.ti +" . $self->{'lm'} . "\n " );
    1;
}

sub dd_start {
    my ($self) = @_;

    $self->adjust_lm(+6);
    $self->vspace(0);
    $self->textout( "\n.ti +" . $self->{'lm'} . "\n " );
    1;
}

sub configure {
    my ( $self, $arg ) = @_;

    my $key;
    foreach $key ( keys %$arg ) {
        $self->{$key} = $$arg{$key};
    }
    $self;
}

sub begin {
    my $self = shift;
    $self->HTML::Formatter::begin;
    $self->{lm} = 0;
}

sub end {
    shift->collect("\n");
}

sub html_start {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    unless ( $self->{man_header} ) { return 1; }

    unless ( $self->{man_date} ) {
        my ( $sec, $min, $hr, $mday, $mon, $year, $wday, $yday, $isdst ) =
          localtime();
        my $this_mon = (
            'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
            'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'
        )[$mon];
        $self->{man_date} = "$mday" . " $this_mon" . " $year";
    }

    $self->out( ".TH \""
          . $self->{name} . "\" \""
          . $self->{section} . "\" \""
          . $self->{man_date} . "\" \""
          . $self->{project}
          . "\"" );
    1;
}

sub font_start {
    my ( $self, $font ) = @_;

    push( @{ $self->{'fonts'} }, $font );

    $self->textout( '\f' . "$font" );
}

sub font_end {
    my ($self) = @_;

    pop( @{ $self->{'fonts'} } );

    my $font = pop( @{ $self->{'fonts'} } );
    push( @{ $self->{'fonts'} }, $font );

    unless ($font) {
        $font = 'R';
    }
    $self->textout( '\f' . "$font" );
}

sub i_start {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->font_start('I');
}

sub i_end {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->font_end();
}

sub b_start {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->font_start('B');
    1;
}

sub b_end {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->font_end();
}

sub table_start {
    my ( $self, $node ) = @_;

    if ( $self->{ignore} ) { return 1; }

    if ( defined( $self->{'current_table'} ) ) {
        push( @{ $self->{'tables'} }, $self->{'current_table'} );
    }

    my %attr = ( page_width => $self->{'page_width'}, );

    for (qw{align width}) {
        $attr{$_} = lc( $node->attr('$_') ) if defined $node->attr('$_');
    }

    unless ( $node->attr('align') ) {
        if ( $self->{'center'} ) {
            $attr{align} = 'center';
        }
    }

    $self->{'current_table'} = HTML::FormatNroff::Table::Nroff->new( $self, %attr );
}

sub tr_start {
    my ( $self, $node ) = @_;

    if ( $self->{ignore} ) { return 1; }

    my %attr = ();

    for (qw{align width}) {
        $attr{$_} = lc( $node->attr('$_') ) if defined $node->attr('$_');
    }

    $self->{'current_table'}->add_row(%attr);
}

sub tr_end {
    my ($self) = @_;
}

sub a_start {
    my ($self) = @_;
}

sub a_end {
    my ($self) = @_;
}

sub td_start {
    my ( $self, $node ) = @_;

    if ( $self->{ignore} ) { return 1; }

    $self->start_data($node);
}

sub td_end {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->{'current_table'}->end_data();
}

sub th_start {
    my ( $self, $node ) = @_;

    if ( $self->{ignore} ) { return 1; }

    $self->start_data( $node, 'header' );
}

# internal helping routine for processing table cells

sub start_data {
    my ( $self, $node, $header ) = @_;

    if ( $self->{ignore} ) { return 1; }

    my %attr = ( header => $header, );

    for (qw{align valign nowrap rowspan colspan}) {
        $attr{$_} = lc( $node->attr('$_') ) if defined $node->attr('$_');
    }

    $self->{'current_table'}->start_data(%attr);
}

sub th_end {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->{'current_table'}->end_data();
}

sub table_end {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->{'current_table'}->output();
    $self->{'current_table'} = pop( @{ $self->{'tables'} } );
}

sub p_start {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->textout("\n.PP\n");

}

sub p_end {
    my $self = shift;

}

sub goto_lm {
}

sub br_start {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->textout("\n.br\n");
}

sub hr_start {
    my $self = shift;

    if ( $self->{ignore} ) { return 1; }

    $self->textout("\n.br\n.ta 6.5i\n.tc _\n\t\n.br\n");
}

sub header_start {
    my ( $self, $level, $node ) = @_;

    if ( $self->{ignore} ) { return 1; }

    $self->textout("\n.SH ");
    1;
}

sub header_end {
    my ( $self, $level, $node ) = @_;

    if ( $self->{ignore} ) { return 1; }

    $self->textout("\n");
    1;
}

sub out {
    my $self = shift;
    my $text = shift;

    if ( $self->{ignore} ) { return 1; }

    if ( defined $self->{vspace} ) {
        $self->nl( $self->{vspace} );
        $self->{vspace} = undef;
    }

    if ($text) {
        $self->collect($text);
    }
}

sub pre_out {
    my ( $self, $pre ) = @_;

    if ( $self->{ignore} ) { return 1; }

    if ( defined $self->{vspace} ) {
        $self->nl( $self->{vspace} );
        $self->{vspace} = undef;
    }
    my $indent = ' ' x $self->{lm};
    $pre =~ s/^/$indent/mg;
    $self->collect($pre);
    $self->{'out'}++;
}

sub nl {
    my ( $self, $cnt ) = @_;

    if ( $self->{ignore} ) { return 1; }

    $self->collect("\n.sp $cnt\n");
    $self->{'out'}++;
}

sub adjust_lm {
    my ( $self, $indent ) = @_;

    $self->{lm} += $indent;
}

sub adjust_rm {
    my $self = shift;
}

sub bullet {
    my ( $self, $tag ) = @_;

    if ( $self->{'lm'} > 0 ) {
        $self->textout( "\n.ti +" . $self->{'lm'} . "\n$tag " );
    }
}

sub textflow {
    my ( $self, $node ) = @_;

    if ( $self->{ignore} ) { return 1; }

    if ( ( !defined( $self->{'current_table'} ) )
        and $self->{'center'} ) {
        $self->textout("\n.ce\n");
    }
    if ( $self->{'underline'} ) {
        $self->textout("\n.ul\n");
    }

    if ( $self->{'lm'} > 0 ) {
        my $repl = "\n.ti +" . $self->{'lm'} . "\n ";
        $node =~ s/\n/$repl/;
    }

    if ( defined( $self->{'current_table'} ) ) {

        $self->{'current_table'}->add_text($node)
          or $self->SUPER::textflow($node);
    }
    else {
        $self->SUPER::textflow($node);
    }
}

sub textout {
    my ( $self, $text ) = @_;

    if ( $self->{ignore} ) { return 1; }

    if ( defined( $self->{'current_table'} ) ) {
        $self->{'current_table'}->add_text($text)
          || $self->out($text);
    }
    else {
        $self->out($text);
    }
}

sub blockquote_start {
    my ( $self, $node ) = @_;

    $self->textout("\n.PP\n.in +5\n");
}

sub blockquote_end {
    my ( $self, $node ) = @_;

    $self->textout("\n.in -5\n.PP\n");
}

# all the push/pop is so we can safely ignore nested divs.

sub div_start {
    my ( $self, $node ) = @_;

    my $type = lc $node->attr('type');

    push( @{ $self->{'divs'} }, $type );

    if ( $type =~ /nroff_ignore/ ) {
        $self->{'ignore'} = 1;
    }
}

sub div_end {
    my ( $self, $node ) = @_;

    my $type = pop( @{ $self->{'divs'} } );

    if ( $type =~ /nroff_ignore/ ) {
        $self->{ignore} = 0;
    }
}

sub meta_start {
    my ( $self, $node ) = @_;

    my $meta_name = lc $node->attr('NAME');
    unless ( $meta_name eq 'nroff-control' ) {
        return 1;
    }
    my $meta_content = lc $node->attr('CONTENT');

    if ( $meta_content eq 'ignore_start' ) {
        $self->{'ignore'} = 1;
    }
    else {
        $self->{'ignore'} = 0;
    }
}

1;

__END__