view release on metacpan or  search on metacpan

lib/AnnoCPAN/PodToHtml.pm  view on Meta::CPAN

    # this is low-level use of Pod::Parser, in AnnoCPAN::DBI

    my $parser = AnnoCPAN::PodToHtml->new;

    my %methods = (
        VERBATIM,  'verbatim',
        TEXTBLOCK, 'textblock',
        COMMAND,   'command',
    );

    sub html {
        my ($self) = @_;
        my $method = $methods{$self->type};
        my @args = $self->content;
        if ($method eq 'command') {
            # split into command and content
            @args = $args[0] =~ /==?(\S+)\s+(.*)/s;
        }
        my $html = $parser->$method(@args);
    }

=head1 DESCRIPTION

This is a subclass of L<Pod::Parser> for converting POD into HTML. It overrides
the C<verbatim>, C<textblock>, C<command>, and C<interior_sequence> methods.

=cut

my $root_uri_rel  = AnnoCPAN::Config->option('root_uri_rel');
my $pre_line_wrap = AnnoCPAN::Config->option('pre_line_wrap');

use constant {
    VERBATIM  => 1,
    TEXTBLOCK => 2,
    COMMAND   => 4,
};

sub verbatim {
    my ($self, $text, $line_num, $pod_para) = @_;
    return '' if $self->{annocpan_begin_depth};
    $text =~ s/(.{$pre_line_wrap})(?=.)/$1\n\0<span class="line_cont"\0>+\0<\/span\0>/mgo;
    for ($text) {
        s/(?<!\0)&/&amp;/g;
        s/(?<!\0)</&lt;/g;
        s/(?<!\0)>/&gt;/g;
        s/\0//g;
    }
    my $ret = "<pre>$text</pre>\n";
    $ret = "<div class=\"content\"><div>$ret</div></div>\n"
        unless $self->{annocpan_simple};
    if ($self->{annocpan_print}) {
        my $out_fh = $self->output_handle();
        print $out_fh $ret;
    }
    $ret;
}

sub textblock {
    my ($self, $text, $line_num, $pod_para) = @_;
    return '' if $self->{annocpan_begin_depth};
    my $out_fh = $self->{_OUTPUT};
    my $p = $self->interpolate($text, $line_num);
    for ($p) {
        s/(?<!\0)&/&amp;/g;
        s/(?<!\0)</&lt;/g;
        s/(?<!\0)>/&gt;/g;
        s/\0//g;
    }
    my $ret = "<p>$p</p>\n";
    $ret = "<div class=\"content\">$ret</div>\n"
        unless $self->{annocpan_simple};
    if ($self->{annocpan_print}) {
        my $out_fh = $self->output_handle();
        print $out_fh $ret;
    }
    $ret;
}

sub command {
    my ($self, $cmd, $text, $line_num, $pod_para)  = @_;
    my $p = $self->interpolate($text, $line_num);
    for ($p) {
        s/(?<!\0)&/&amp;/g;
        s/(?<!\0)</&lt;/g;
        s/(?<!\0)>/&gt;/g;
    }
    $p =~ s/\0//g;
    my $method = "ac_c_$cmd";
    $method = "ac_c_default" unless $self->can($method);
    my $ret = $self->$method($p);
    return '' if $self->{annocpan_begin_depth};
    if ($self->{annocpan_print}) {
        my $out_fh = $self->output_handle();
        print $out_fh $ret;
    }
    $ret;
}


sub interior_sequence { 
    my ($self, $seq_command, $seq_argument) = @_ ;
    #print "interior_sequence($seq_command, $seq_argument)\n";
    my $method = "ac_i_$seq_command";
    $method = "ac_i_default" unless $self->can($method);
    my $ret = $self->$method($seq_argument);
    $ret;
}


# trims surrounding whitespace, replaces interior whitespace by underscores,
# removes HTML tags, and URI-escapes non-word characters
sub filter_anchor {
    my ($s) = @_;
    $s = lc $s;
    for ($s) {
        s/^\s+//; 
        s/\s+$//;
        s/\s+/_/g; 
        s/<.*?>//g;
        s/\0//g;
        s/(\W)/sprintf "%%%02x", ord($1)/eg;