AnnoCPAN

 view release on metacpan or  search on metacpan

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

    );
    return if @notes;

    # create the note
    my $note    = $self->SUPER::create($data);
    AnnoCPAN::DBI::NotePos->create({ 
        note => $note, section => $section, 
        score => SCALE, status => ORIGINAL });

    $self->reset_dbh;
    unless (fork) {
        # child process
        nice(+19);
        close STDIN;
        close STDOUT;
        close STDERR;
        # Now "translate" the note to other versions
        my $pod = $data->{pod};
        for my $pv ($pod->podvers) {
            if ($pv->id != $podver->id) { # note was not added here
                $note->guess_section($pv);
            }
        }
        exit;
    }
    return $note; # only parent returns
}

sub simple_create { shift->SUPER::create(@_) }
sub simple_update { shift->SUPER::update(@_) }

sub guess_section {
    my ($self, $podver) = @_;

    # delete cached html
    $podver->flush_cache;

    # XXX version check might go here
    my $ref_section = $self->section or return;
    my $orig_cont = $ref_section->content;

    my $max_sim   = AnnoCPAN::Config->option('min_similarity') || 0;
    my $best_sect;
    for my $sect ($podver->raw_sections) {
        next if $sect->{type} & COMMAND; # can't attach notes to commands
        my $sim = similarity($orig_cont, $sect->{content}, $max_sim);
        if ($sim > $max_sim) {
            $max_sim   = $sim;
            $best_sect = $sect;
        }
    }
    if ($best_sect) {
        AnnoCPAN::DBI::NotePos->create({ note => $self, 
            section => $best_sect->{id}, score => int($max_sim * SCALE),
            status => CALCULATED });
        return 1;
    }
    return;
}

sub update {
    my $self = shift;
    for my $pv ($self->pod->podvers) {
        $pv->flush_cache;
    }
    $self->SUPER::update(@_);
}

sub delete {
    my $self = shift;
    for my $pv ($self->pod->podvers) {
        $pv->flush_cache;
    }
    $self->SUPER::delete(@_);
}

sub ref_notepos {
    my ($self) = @_;
    AnnoCPAN::DBI::NotePos->retrieve(note => $self, section => $self->section);
}

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

    my $p = AnnoCPAN::PodToHtml->new(annocpan_simple => 1);
    my $pod = $self->note;

    # clean up and split the pod
    $pod =~ s/\r\n?/\n/g;       # normalize newlines
    $pod =~ s/^\s*\n//;         # get rid of leading blank lines
    my @paragraphs = split /\n\s*\n/, $pod;

    my $errors = '';
    $p->errorsub(sub {
        my $err = shift;
        $err =~ s/at line.*//;
        for ($err) {
            s/&/&/g;
            s/</&lt;/g;
            s/>/&gt;/g;
        }
        $errors .= qq{<p class="error">$err</p>\n};
    });

    my $ret = '';
    for my $para (@paragraphs) {
        my $method = $para =~ /^ / ? 'verbatim' : 'textblock';
        $ret .= $p->$method($para);
    }
    return $errors . $ret;
}

package AnnoCPAN::DBI::NotePos;
use base 'AnnoCPAN::DBI';
__PACKAGE__->table('notepos');
__PACKAGE__->columns(Essential => qw(id note section score status));
__PACKAGE__->has_a(note     => 'AnnoCPAN::DBI::Note');
__PACKAGE__->has_a(section  => 'AnnoCPAN::DBI::Section');

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



( run in 0.491 second using v1.01-cache-2.11-cpan-63c85eba8c4 )