File Coverage

blib/lib/AnnoCPAN/Perldoc/Filter.pm

Criterion	Covered	Total	%
statement	21	59	35.5
branch	0	10	0.0
condition	0	3	0.0
subroutine	7	14	50.0
pod	0	3	0.0
total	28	89	31.4

package AnnoCPAN::Perldoc::Filter;

$VERSION = '0.10';

use strict;
use warnings;
use IO::String;
use DBI;
use Digest::MD5 'md5_hex';

sub new {
    bless {}, shift;
}

sub filter {
    my ($self, $pod) = @_;
    my $notes  = $self->find_notes($pod);
    return $pod unless @$notes;

    my $filtered_pod;
    my $fh_in  = IO::String->new($pod);
    my $fh_out = IO::String->new($filtered_pod);
    my $parser = AnnoCPAN::Perldoc::Parser->new(ac_notes => $notes);

    $parser->parse_from_filehandle($fh_in, $fh_out);

    return $filtered_pod;
}

sub find_notes {
    my ($self, $pod) = @_;
    my $signature = md5_hex($pod);
    my $db_file;
    DIR: for my $dir (@ENV{qw(HOME USERPROFILE ALLUSERSPROFILE)},
        '/var/annocpan', '.'
    ) {
        for my $file ('annopod.db', '.annopod.db') {
            no warnings 'uninitialized';
            $db_file = "$dir/$file", last DIR if -e "$dir/$file";
        }
    }
    unless ($db_file) {
        warn "Couldn't find any AnnoCPAN database\n";
        return [];
    }
    my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file")
        or die "Couldn't connect to database: $@\n";
    my $notes = $dbh->selectall_arrayref(
        'SELECT DISTINCT n.note note, n.user user, n.time time, np.pos pos
        FROM note n, notepos np, podver pv
        WHERE np.note=n.id AND np.podver=pv.id AND pv.signature=?
        ORDER by pos, time',
        {Slice => {}},
        $signature,
    ) or die "$@";
    $dbh->disconnect;
    return $notes;
}


package AnnoCPAN::Perldoc::Parser;

use base 'Pod::Parser';

sub verbatim {
    my ($self, $text, $line_num, $pod_para) = @_;
    $self->ac_section($text);
}

sub textblock {
    my ($self, $text, $line_num, $pod_para) = @_;
    $self->ac_section($text);
}

sub command {
    my ($self, $cmd, $text, $line_num, $pod_para)  = @_;
    $self->ac_section($pod_para->raw_text);
}

sub ac_section {
    my ($self, $text) = @_;
    my $pos = ++$self->{ac_pos};

    # print the original POD
    my $out_fh = $self->output_handle;
    print $out_fh $text;

    # print notes if available
    my $notes = $self->{ac_notes};
    while (@$notes and $notes->[0]{pos} == $pos) {
        my $note = shift @$notes;
        $note->{time_str} = gmtime($note->{time});
        print $out_fh <<NOTE;

=over 8

=over 4

=item AnnoCPAN note by I<$note->{user}>, $note->{time_str}:

$note->{note}

=back

=back

NOTE
    }
}

1;