view release on metacpan or  search on metacpan

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

        WHERE podver.distver=distver.id AND distver.dist=dist.id
        AND dist.name=? AND podver.path=?');

__PACKAGE__->set_sql(note_count_all => '
    SELECT dv.pause_id, dv.path dist_path, pv.path pod_path, 
        count(*) note_count
    FROM distver dv, podver pv, section s, notepos np
    WHERE pv.distver=dv.id AND s.podver=pv.id AND np.section=s.id
    AND np.status >= 0 GROUP BY dist_path, pod_path 
    ORDER BY dist_path, pod_path'
);

=head2 AnnoCPAN::DBI::Section

Represents a paragraph in a POD document. Columns:

    id
    podver
    pos
    content
    type 

=cut

package AnnoCPAN::DBI::Section;
use base 'AnnoCPAN::DBI';
use AnnoCPAN::PodToHtml;
use AnnoCPAN::PodParser ':all';

__PACKAGE__->table('section');
__PACKAGE__->columns(Essential => qw(id podver pos content type));
__PACKAGE__->has_a(podver => 'AnnoCPAN::DBI::PodVer');
__PACKAGE__->add_trigger(before_delete  => \&before_delete);


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


sub html {
    my ($self) = @_;
    $self->{parser} ||= AnnoCPAN::PodToHtml->new;
    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 = $self->{parser}->$method(@args);
}


sub before_delete {
    my ($self) = @_;
    # make sure no notes use us as their reference section...
    for my $note ($self->original_notes) {
        my $max_sim = 0;
        my $best_sect;
        for my $notepos ($note->notepos) {
            if ($notepos->section->id != $self->id 
                and $notepos->score > $max_sim) 
            {
                $max_sim   = $notepos->score;
                $best_sect = $notepos->section;
            }
        }
        $note->section($best_sect);
        $note->update;
    }
}

=head2 AnnoCPAN::DBI::User

Represents an AnnoCPAN user. Columns:

    id
    username
    password
    name
    email
    profile 
    reputation
    member_since
    last_visit
    privs

Note that some of these columns are unused, but they exist for historical
reasons.

Other Methods:

=over

=cut

package AnnoCPAN::DBI::User;
use base 'AnnoCPAN::DBI';
__PACKAGE__->table('user');
__PACKAGE__->columns(Essential => qw(id username password name email profile 
    reputation member_since last_visit privs));

=item $user->can_delete($note)

Return true if the user has the authority to delete $note (an
AnnoCPAN::DBI::Note object).

=cut

sub can_delete {
    my ($user, $note) = @_;
    ($user->privs > 1 or $user == $note->user);
}

=item $user->can_edit($note)

Return true if the user has the authority to edit $note (an
AnnoCPAN::DBI::Note object).

=cut

sub can_edit { shift->can_delete(@_) }

=item $user->can_move($note)

Return true if the user has the authority to move $note (an
AnnoCPAN::DBI::Note object).

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

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