view release on metacpan or  search on metacpan

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

}

__PACKAGE__->set_sql(
    pod_dist => "SELECT pod.id id, pod.name name FROM dist, pod, pod_dist
                 WHERE pod_dist.pod=pod.id AND pod_dist.dist=dist.id
                 AND pod.name=? AND dist.id=?");

__PACKAGE__->set_sql(
    families => 'SELECT pod id, count(*) c FROM pod_dist GROUP BY id
        HAVING c>1');

__PACKAGE__->set_sql(
    by_author => "SELECT DISTINCT p.id, p.name 
        FROM pod p, distver dv, podver pv 
        WHERE dv.pause_id=? AND pv.distver=dv.id AND pv.pod=p.id");

sub count_notes {
    my ($self) = @_;
    return $self->sql_count_notes->select_val($self->id);
}

__PACKAGE__->set_sql(count_notes => 'SELECT count(*) 
    FROM note n 
    WHERE pod=?'
);

sub latest_note_date {
    my ($self) = @_;
    return $self->sql_latest_note_date->select_val($self->id);
}

__PACKAGE__->set_sql(latest_note_date => 'SELECT time
    FROM note n 
    WHERE pod=?
    ORDER BY time DESC
    LIMIT 1'
);

sub join_pods {
    my ($self, @others) = @_;
    my (@notes)   = map { $_->notes }   (@others); 
    my (@podvers) = map { $_->podvers } (@others); 
    my (@pod_dists) = map { $_->pod_dists } (@others); 

    # steal the notes and podvers
    for my $child (@notes, @podvers, @pod_dists) {
        $child->pod($self);
        $child->update;
    }

    # union of all the notes/podvers
    push @notes,   $self->notes;
    push @podvers, $self->podvers;

    # boldly translate the notes to where they have never been before
    for my $note (@notes) {
        for my $podver (@podvers) {
            my ($np) = AnnoCPAN::DBI::NotePos->search_podver_note(
                $podver, $note);
            unless ($np) {
                $note->guess_section($podver);
            }
        }
    }

    # delete the other pods
    $_->delete for @others;
    $self;
}

=head2 AnnoCPAN::DBI::PodDist

Links a pod with a dist (its a many-to-many relationship).
Columns:

    id 
    dist 
    pod

=cut


package AnnoCPAN::DBI::PodDist;
use base 'AnnoCPAN::DBI';
__PACKAGE__->table('pod_dist');
__PACKAGE__->columns(Essential => qw(id dist pod));
__PACKAGE__->has_a(dist => 'AnnoCPAN::DBI::Dist');
__PACKAGE__->has_a(pod => 'AnnoCPAN::DBI::Pod');


sub notes { return shift->pod->notes }
sub podvers { return shift->pod->podvers }

=head2 AnnoCPAN::DBI::DistVer

Represents a specific version of a distribution
Columns:

    id
    dist 
    version 
    path 
    pause_id 
    distver 
    mtime

=cut

package AnnoCPAN::DBI::DistVer;
use base 'AnnoCPAN::DBI';
__PACKAGE__->table('distver');
__PACKAGE__->columns(Essential => qw(id dist version path pause_id 
    distver mtime maturity));
__PACKAGE__->has_a(dist => 'AnnoCPAN::DBI::Dist');

sub translate_notes {
    my ($self) = @_;
    for my $podver ($self->podvers) {
        for my $note ($podver->pod->notes) {
            $note->guess_section($podver);
        }
    }
}

sub count_visible_notes {
    my ($self) = @_;
    return $self->sql_count_visible_notes->select_val($self->id);
}

__PACKAGE__->set_sql(count_visible_notes => 'SELECT count(*) 
    FROM distver dv, podver pv, section s, notepos np
    WHERE dv.id=?  AND pv.distver=dv.id AND s.podver=pv.id AND np.section=s.id
    AND np.status >= 0'
);

sub latest_visible_note_date {
    my ($self) = @_;
    return $self->sql_latest_visible_note_date->select_val($self->id);
}

__PACKAGE__->set_sql(latest_visible_note_date => 'SELECT n.time
    FROM distver dv, podver pv, section s, notepos np, note n
    WHERE dv.id=?  
    AND pv.distver=dv.id AND s.podver=pv.id AND np.section=s.id AND np.note=n.id
    AND np.status >= 0 
    ORDER BY n.time DESC LIMIT 1'
);

=head2 AnnoCPAN::DBI::PodVer

Represents a specific version of a document (a "pod").
Columns:

    id
    pod
    distver
    path
    description
    html

=cut

package AnnoCPAN::DBI::PodVer;
use base 'AnnoCPAN::DBI';
__PACKAGE__->table('podver');
__PACKAGE__->columns(Essential => qw(id pod distver path description signature));
__PACKAGE__->columns(Others => qw(html));
__PACKAGE__->has_a(pod => 'AnnoCPAN::DBI::Pod');
__PACKAGE__->has_a(distver => 'AnnoCPAN::DBI::DistVer');

sub mtime { shift->distver->mtime }
sub name  { shift->pod->name }
sub raw_sections {
    my ($self) = @_;
    my $pv = $self->id;
    #my $sth = AnnoCPAN::DBI::Section->sql_Retrieve("podver=$pv order by pos");
    my $sth = AnnoCPAN::DBI::Section->sql_Retrieve("podver=$pv");
    $sth->execute;
    $sth->fetchall_hash;
}

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

}

__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;