view release on metacpan or  search on metacpan

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

    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+$//;

    return ({%vars, error => "invalid login"}, "new_user")
        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;