AnnoCPAN

 view release on metacpan or  search on metacpan

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

    my ($self) = @_;
    my $note = $self->param_obj('Note');
    my $podver = $note->section->podver; 
    my $uri = sprintf "/dist/%s/%s", $podver->distver->distver, $podver->path;
    $self->redirect($uri);
    #$self->Show({ podver => $podver });
}

sub Show_notepos {
    my ($self) = @_;
    my $note = $self->param_obj('Note');
    ({ note => $note }, 'show_notepos');
}

sub Update_notepos {
    my ($self) = @_;
    my $note = $self->param_obj('Note');
    my $vars = { note => $note };
    my $user = $self->user;
    if ($user && $user->can_hide($note)) {
        my %to_hide;
        @to_hide{$self->param('hide')} = ();
        my $ref = $self->param('ref');
        for my $notepos ($note->notepos) {
            if ($notepos->id eq $ref) {
                $note->section($notepos->section);
                $note->update;
            }
            if (exists $to_hide{$notepos->id}) {
                $notepos->hide;
            } else {
                $notepos->unhide;
            }
        }
        $vars->{message} = "Note bindings updated";
    } else {
        $vars->{error} = "Edit not authorized";
    }
    ($vars, 'show_notepos');
}

=item $obj->Show_dist($vars)

Displays one distribution (distver) page. Uses the id CGI parameter or 
$vars->{distver}.

=cut

sub Show_dist {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $distver = $vars->{distver} || $self->param_obj('DistVer');
    ({ 
        distver   => $distver,
        %$vars,
    }, "show_dist");
}

=item $obj->Edit

The edit screen (like Show, but includes the edit form).

=cut

sub Edit {
    my ($self, $vars) = @_;
    $vars ||= {};

    my $notepos   = $self->param_obj('NotePos');
    ({ 
        podver   => $notepos->podver,
        note     => $notepos->note,
        %$vars,
        #message => "here ($section, $podver)" . $podver->pod->name,
    }, "edit");
}

sub Raw_note {
    my ($self, $vars) = @_;
    my $notepos = $self->param_obj('NotePos');
    my $text = $notepos->note->note;
    ({ note => $text }, 'note.txt', 'text/plain');
}

sub Create {
    my ($self, $vars) = @_;
    $vars ||= {};

    # get user, see if can edit
    my $user = $self->user
        or return $self->error("Not logged in; can't create note");

    my $section = $self->param_obj('Section');
    my $podver  = $section->podver;
    ({ 
        podver   => $podver,
        section  => $section,
        %$vars,
        #message => "here ($section, $podver)" . $podver->name,
    }, "edit");
}

sub _search_podver {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $pod_name  = $self->param('name');
    return $self->Main unless $pod_name;
    my @pods = AnnoCPAN::DBI::Pod->search(name => $pod_name);
    return $self->error("not found") unless @pods;
    return $self->choose_podver($vars, \@pods);
}

sub _search_dist {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $dist_name  = $self->param('name');
    return $self->Main unless $dist_name;

    my $author     = uc $self->param('author');

    # try distvers first
    my @distvers = AnnoCPAN::DBI::DistVer->search(distver => $dist_name);
    @distvers = grep { $_->pause_id eq $author } @distvers if $author;

    unless (@distvers) {
        my ($dist) = AnnoCPAN::DBI::Dist->search(name => $dist_name);
        @distvers = $dist->distvers if $dist;
        @distvers = grep { $_->pause_id eq $author } @distvers if $author;
        if (@distvers == 1) {
            $self->redirect($self->distver_uri($distvers[0]));
            return;
        }
    }

    return $self->choose_distver($vars, \@distvers) if @distvers;
    return $self->error("not found");
}

sub _search_author {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $pause_id  = $self->param('name');
    return $self->Main unless $pause_id;
    my @distvers = AnnoCPAN::DBI::DistVer->search(pause_id => $pause_id);

    # get only unique dists XXX this should be done in SQL
    my %seen;
    for (@distvers) {
        $seen{$_->dist} = $_->dist;
    }

    return $self->error("not found") unless @distvers;
    ({
        %$vars, dists => [ values %seen ], author => uc $pause_id,
        note_count => AnnoCPAN::DBI::Note->count_by_author($pause_id),
    }, 'show_author');
}


sub _search_both {

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

    ({ %{$vars||{}}, message => $message }, "message");
}

sub _error {
    my ($self, $message, $vars) = @_;
    ({ %{$vars||{}}, error => $message }, "error");
}

sub _log {
    my ($self, $message) = @_;
    push @{$self->{log}}, $message;
}

=item $obj->About

The "about" page. Uses the about.pod file.

=cut

sub About {
    my $parser = AnnoCPAN::PodToHtml->new(annocpan_print => 1);
    my $html;
    my $fh = IO::String->new($html);
    $parser->parse_from_file('about.pod', $fh);
    ({ content => $html }, 'about');
}

sub Faq { ({}, 'faq') }
sub News { ({}, 'news') }
sub Motd { ({}, 'motd') }
sub Note_help { ({}, 'note_help') }
sub Policy { ({}, 'policy') }
sub Contact { ({}, 'contact') }

sub Show_user {
    my ($self) = @_;
    my $u = $self->param_obj('User', 'username');
    ({ a_user => $u }, 'show_user');
}

sub Move {
    my ($self) = @_;
    my $notepos = $self->param_obj('NotePos');
    shift->Show({ podver => $notepos->podver });
}

sub Do_move {
    my ($self) = @_;
    return $self->_do_move if $self->param('fast');
    my ($vars) = $self->_do_move;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

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

    my $notepos = $self->param_obj('NotePos');
    my $section = $self->param_obj('Section');

    # get user, see if can edit
    my $user = $self->user
        or return $self->_error("Not logged in; can't move");

    $user->can_move($notepos->note)
        or return $self->_error("Move not authorized");

    $section->podver eq $notepos->section->podver
        or return $self->_error("Move not within the same document");

    my $podver = $section->podver;

    $notepos->section($section);
    $notepos->status(AnnoCPAN::DBI::Note::MOVED);
    $notepos->score(AnnoCPAN::DBI::Note::SCALE);
    $notepos->update;

    $podver->flush_cache;

    $self->_message("note moved", { podver => $podver });
}


sub Hide {
    my ($self) = @_;
    return $self->_hide if $self->param('fast');
    my ($vars) = $self->_hide;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

sub _hide {
    my ($self) = @_;
    my $notepos_id = $self->param('notepos');

    my $notepos = $self->param_obj('NotePos');

    my $note    = $notepos->note;
    my $section = $notepos->section;
    
    # get user, see if can edit
    my $user = $self->user
        or return $self->_error("not logged in; can't move");
    $user->can_hide($note)
        or return $self->_error("move not authorized");

    my $podver = $section->podver;
    $podver->flush_cache;

    $notepos->status(AnnoCPAN::DBI::Note::HIDDEN);
    $notepos->update;

    $self->_message("note hidden", { podver => $notepos->podver });
}

=item $obj->Save

Save a new note (comes from the Edit mode). Uses the pid, pos, id, and note CGI
parameters.

=cut

sub Save {
    my ($self) = @_;
    return $self->_save if $self->param('fast');
    my ($vars) = $self->_save;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

# to save new note, need section and note text
# to save edited note, need notepos and note text
sub _save {
    my ($self) = @_;
    my $note_text    = $self->param('note_text');

    my ($note, $podver);

    # get user, see if can edit
    my $user = $self->user
        or return $self->_error("Not logged in; can't save note");

    if ($self->param('notepos')) { # edit existing note
        my $notepos = $self->param_obj('NotePos');
        $podver = $notepos->podver;
        $note   = $notepos->note;

        $user->can_edit($note)
            or return $self->_error("Edit not authorized");
        $note->note($note_text);
        $note->ip($ENV{REMOTE_ADDR});
        #$note->time(time);
        $note->update;
        $note->remove_from_object_index;

    } else { # create new note
        my $section = $self->param_obj('Section');
        $podver  = $section->podver;
        $note = AnnoCPAN::DBI::Note->create({
            pod         => $podver->pod, 
            min_ver     => '',
            max_ver     => '',
            note        => $note_text, 
            ip          => $ENV{REMOTE_ADDR},
            time        => time,
            user        => $self->user,
            section     => $section,
        }) or return $self->_error("Duplicate note?");
    }
    ({ note => $note, podver => $podver, notepos => $note->ref_notepos }, 
        'note');
}

=item $obj->New_user

"Create new user" screen.

=cut

sub New_user {
    ({}, "new_user");
}

=item $obj->Create_user

Coming from the New_user form, create a new account. Uses the login, passwd,
passwd2, and email CGI parameters. Checks that the login and password are not
blank, that the passwords match, and that the login is not already taken.

=cut

sub Create_user {
    my ($self) = @_;
    my $login   = $self->param('login');
    my $passwd  = $self->param('passwd');
    my $passwd2 = $self->param('passwd2');
    my $email   = $self->param('email');
    my %vars = (login => $login, email => $email);

    return ({%vars, error => "missing password"}, "new_user")
        unless (length $passwd);

    return ({%vars, error => "missing login"}, "new_user")
        unless (length $login);

    $login =~ s/^\s+//;
    $login =~ s/\s+$//;

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

        unless ($login =~ /^\w+$/);

    if (AnnoCPAN::DBI::User->retrieve(username => $login)) {
        return ({%vars, error => 'login already taken'}, "new_user");
    }

    if ($passwd ne $passwd2) {
        return ({%vars, error => "passwords don't match"}, "new_user");
    }

    my $user = AnnoCPAN::DBI::User->create({
        username => $login,
        password => crypt($passwd, $login),
        email    => $email,
        member_since => time,
        privs    => 1,
    });
    $self->set_login_cookies($user);
    $self->Main({%vars, message => "account created"});
}

=item $sub->Login

Log in; comes from the login form on login_form.html. Uses the login and
passwd CGI parameters.

=cut

sub Login {
    my ($self) = @_;
    my $passwd  = $self->param('passwd');

    my $user = eval { $self->param_obj('User', 'username') };
    unless ($user and crypt($passwd, $user->password) eq $user->password) {
        return $self->Main({error => 'invalid login/password'});
    }
    $self->set_login_cookies($user);
    my $from = $self->param('from');
    $self->redirect($from =~ /logout/ ? '/' : $from);
    return;
    #$self->Main({message => "welcome, you have logged in!"});
}

=item $obj->Logout

Log out. Clears the authentication key.

=cut

sub Logout {
    my ($self) = @_;
    $self->delete_cookie('key');
    $self->user(undef);
    $self->redirect($self->param('from'));
    return;
    #$self->Main({message => "You have logged out"});
}

sub Prefs {
    my ($self) = @_;
    return $self->error("Can't edit prefs without logging in first!")
        unless $self->user;
    ({}, 'prefs');
}

sub Save_prefs {
    my ($self) = @_;
    # XXX untaint
    my $user = $self->user;
    return $self->error("Can't edit prefs without logging in first!")
        unless $user;
    AnnoCPAN::DBI::Prefs->search(user => $user)->delete_all;
    for my $name (@{AnnoCPAN::Config->option('prefs')}) {
        AnnoCPAN::DBI::Prefs->create({user => $user, name => $name, 
            value => $self->param($name) || '' });
    }
    ({ message => 'Preferences saved'}, 'prefs');
}


sub Delete {
    my ($self) = @_;
    return $self->_delete if $self->param('fast');
    my ($vars) = $self->_delete;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

# global delete
sub _delete {
    my ($self) = @_;

    my $notepos = $self->param_obj('NotePos');
    my $note    = $notepos->note;
    my $podver  = $notepos->podver;

    # get user, see if can delete
    my $user = $self->user
        or return $self->_error("not logged in; can't delete");
    $user->can_delete($note)
        or return $self->_error("deletion not authorized");

    $note->delete;

    $self->_message("note deleted", { podver => $podver });
}


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

    my ($vars) = $self->Main;

    my $link = AnnoCPAN::Config->option('root_uri_abs');
    my $rss  = AnnoCPAN::Feed->note_rss(notes => $vars->{recent}, 
        link => $link, title => 'AnnoCPAN Recent Notes');

    ({ %$vars, rss => $rss }, 'rss', 'text/xml');
}


sub Author_recent {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $pause_id  = $self->param('pause_id');
    my @recent = AnnoCPAN::DBI::Note->search_recent_by_author($pause_id);
    ({notes => \@recent, author => uc $pause_id, %$vars }, "show_author_recent");
}

sub Author_rss {