view release on metacpan or  search on metacpan

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

    SCALE       => 1000,
};

my $recent_notes = AnnoCPAN::Config->option('recent_notes') || 25;

__PACKAGE__->table('note');
__PACKAGE__->columns(
    Essential => qw(id pod min_ver max_ver note ip time score user section));

sub recent {
    my ($self, $start, $count) = @_;
    $start ||= 0;
    $count ||= $recent_notes;
    return $self->retrieve_from_sql(
        "1 ORDER BY time DESC LIMIT $start, $count");

}

__PACKAGE__->set_sql(recent_by_author =>  "SELECT DISTINCT n.id
    FROM note n, distver dv, podver pv, pod p
    WHERE dv.pause_id=? AND pv.distver=dv.id AND pv.pod=p.id
    AND n.pod=p.id
    ORDER BY n.time DESC LIMIT $recent_notes"
);

sub count_by_author {
    my ($self, $pause_id) = @_;
    return $self->sql_count_by_author->select_val($pause_id);
}

__PACKAGE__->set_sql(count_by_author =>  "SELECT count(distinct n.id)
    FROM note n, distver dv, podver pv, pod p
    WHERE dv.pause_id=? AND pv.distver=dv.id AND pv.pod=p.id
    AND n.pod=p.id"
);

__PACKAGE__->has_a(pod      => 'AnnoCPAN::DBI::Pod');
__PACKAGE__->has_a(user     => 'AnnoCPAN::DBI::User');
__PACKAGE__->has_a(section  => 'AnnoCPAN::DBI::Section'); 

sub create { # Class::DBI
    my ($self, $data) = @_;
    my $section = $data->{section};
    my $pos     = $section->pos;

    my $podver  = $section->podver;
    # delete cached html
    $podver->flush_cache;

    # make sure the note is not there already, to avoid duplicates
    # if people reload, submit twice, or are otherwise repetitive
    my @notes   = $self->search(
        note    => $data->{note},
        ip      => $data->{ip},
        pod     => $data->{pod},
        section => $data->{section},
    );
    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) = @_;
    ($self->status != AnnoCPAN::DBI::Note::HIDDEN);
}

sub hide {
    my ($self) = @_;
    return unless $self->is_visible;
    $self->status(AnnoCPAN::DBI::Note::HIDDEN);
    $self->update;
    $self->podver->html('');
    $self->podver->update;
}

sub unhide {