view release on metacpan or  search on metacpan

lib/Rubric/WebApp.pm  view on Meta::CPAN

  $self->session->clear('current_user');
  $self->param('current_user', undef);

  return $self->redirect_root("Logged out...");
}

#pod =head2 reset_password
#pod
#pod This run mode allows a user to request that his password be reset and emailled
#pod to him.
#pod
#pod =cut

sub reset_password {
  my ($self) = @_;
  my $user       = $self->get_user
                   || $self->query->param('user')
                   && Rubric::User->retrieve($self->query->param('user'));
  my $reset_code = $self->get_reset_code;

  return $self->template("reset_login") unless $user;

  return $self->setup_reset_code($user) unless $reset_code;

  if (my $password = $user->reset_password($reset_code)) {
    $self->template("reset", { password => $password });
  } else {
    return $self->template("reset_error");
  }

}

#pod =head2 setup_reset_code
#pod
#pod This routine gets a reset code for the user and emails it to him.
#pod
#pod =cut

sub setup_reset_code {
  my ($self, $user) = @_;

  my $reset_code = $user->randomize_reset_code;

  $self->send_reset_email_to($user, $reset_code);
  $self->template("reset_sent");
}

#pod =head2 preferences
#pod
#pod This method displays account information for the current user.  Some account
#pod settings may be changed.
#pod
#pod =cut

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

  return $self->login unless $self->param('current_user');

  return $self->template("preferences")
    unless my %prefs = $self->_get_prefs_form;

  if (my %errors = $self->validate_prefs(\%prefs)) {
    return $self->template("preferences", { %prefs, %errors } );
  }

  $self->update_user(\%prefs);
}

#pod =head2 update_user(\%prefs)
#pod
#pod This method will update the current user object with the changes in C<%prefs>,
#pod which is passed by the C<preferences> method.
#pod
#pod =cut

sub update_user {
  my ($self, $prefs) = @_;
  for ($self->param('current_user')) {
    $_->password(md5_hex($prefs->{password_1})) if $prefs->{password_1};
    $_->email($prefs->{email});
    $_->update;
  }
  $self->redirect_root('updated');
}

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

  my %form;
  for (qw(password password_1 password_2 email)) {
    $form{$_} = $self->query->param($_) if $self->query->param($_);
  }
  return %form;
}

#pod =head2 validate_prefs(\%prefs)
#pod
#pod Given a set of preference updates from a form submission, this method validates
#pod them and returns a description of the validation results.  This method will
#pod probably be redesigned (possibly with Data::FormValidator) in the future.
#pod Don't count on its interface.
#pod
#pod =cut

#pod =begin future
#pod
#pod sub validate_prefs {
#pod   my ($self, $prefs) = @_;
#pod   require Data::FormValidator;
#pod
#pod   my $profile = {
#pod     required     => [qw(password)],
#pod     optional     => [qw(password_1 password_2 email)],
#pod     constraints  => {
#pod       email => 'email',
#pod       password_1 => {
#pod         params     => [qw(password_1 password_2)],
#pod         constraint => sub { $_[0] eq $_[1] },
#pod       }
#pod     },
#pod     dependency_groups => { new_password => [qw(password_1 password_2)] }
#pod   };
#pod
#pod   my $results = Data::FormValidator->check($prefs, $profile);
#pod }
#pod
#pod =end future
#pod
#pod =cut

sub validate_prefs {
  my ($self, $prefs) = @_;
  my %errors;

  if (not $prefs->{email}) {
    $errors{email_missing} = 1;
  } elsif ($prefs->{email} and $prefs->{email} !~ $Email::Address::addr_spec) {
    undef $prefs->{email};
    $errors{email_invalid} = 1;
  }

  if (
    $prefs->{password_1} and $prefs->{password_2}
    and $prefs->{password_1} ne $prefs->{password_2}
  ) {
    undef $prefs->{password_1};
    undef $prefs->{password_2};
    $errors{password_mismatch} = 1;
  }

  unless ($prefs->{password}) {
    $errors{password_missing} = 1;
  } elsif (
    md5_hex($prefs->{password}) ne $self->param('current_user')->password
  ) {
    $errors{password_wrong} = 1;
  }

  return %errors;
}

#pod =head2 newuser
#pod
#pod If the proper form information is present, this runmode creates a new user
#pod account.  If not, it presents a form.
#pod
#pod If a user is already logged in, the user is redirected to the root of the
#pod Rubric.
#pod
#pod =cut

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

  return $self->redirect_root("registration is closed...")
    if Rubric::Config->registration_closed;

  return $self->redirect_root("Already logged in...")
    if $self->param('current_user');

  my %newuser;
  $newuser{$_} = $self->query->param($_)
    for qw(username password_1 password_2 email);

  my %errors = $self->validate_newuser_form(\%newuser);
  if (%errors) {
    $self->template('newuser' => { %newuser, %errors });
  } else {
    $self->create_newuser(%newuser);
  }
}

#pod =head2 validate_newuser_form(\%newuser)
#pod
#pod Given a set of user data from a form submission, this method validates them and
#pod returns a description of the validation results.  This method will probably be
#pod redesigned (possibly with Data::FormValidator) in the future.  Don't count on
#pod its interface.
#pod
#pod =cut

sub validate_newuser_form {
  my ($self, $newuser) = @_;
  my %errors;

  if ($newuser->{username} and $newuser->{username} !~ /^[\pL\d_.]+$/) {
    undef $newuser->{username};
    $errors{username_invalid} = 1;
  } elsif (Rubric::User->retrieve($newuser->{username})) {
    undef $newuser->{username};
    $errors{username_taken} = 1;
  }

  unless ($newuser->{email}) {

lib/Rubric/WebApp.pm  view on Meta::CPAN

 page         - which page (see check_pager_data)

=head2 setup

This method, called by CGI::Application's initialization process, sets up
the dispatch table for requests, as described above.

=head2 entries

This passes off responsibility to the class named in the C<entries_query_class>
configuration option.  This option defaults to Rubric::WebApp::Entries.

=head2 entry

This displays the single requested entry.

=head2 get_entry

This method gets the next part of the path, assumes it to be a Rubric::Entry
id, and puts the corresponding entry in the "entry" parameter.

=head2 link

This runmode displays entries that point to a given link, identified either by
URI or MD5 sum.

=head2 get_link

This method look for a C<uri> or, failing that, C<url> query parameter.  If
found, it finds a Rubric::Link for that URI and puts it in the "link"
parameter.

=head2 tag_cloud

=head2 calendar

=head2 login

If the user is logged in, this request is immediately redirected to the root of
the Rubric site.  Otherwise, a login form is provided.

=head2 logout

This run mode unsets the "current_user" parameter in the session and the WebApp
object, then redirects the user to the root of the Rubric site.

=head2 reset_password

This run mode allows a user to request that his password be reset and emailled
to him.

=head2 setup_reset_code

This routine gets a reset code for the user and emails it to him.

=head2 preferences

This method displays account information for the current user.  Some account
settings may be changed.

=head2 update_user(\%prefs)

This method will update the current user object with the changes in C<%prefs>,
which is passed by the C<preferences> method.

=head2 validate_prefs(\%prefs)

Given a set of preference updates from a form submission, this method validates
them and returns a description of the validation results.  This method will
probably be redesigned (possibly with Data::FormValidator) in the future.
Don't count on its interface.

=begin future

sub validate_prefs {
  my ($self, $prefs) = @_;
  require Data::FormValidator;

  my $profile = {
    required     => [qw(password)],
    optional     => [qw(password_1 password_2 email)],
    constraints  => {
      email => 'email',
      password_1 => {
        params     => [qw(password_1 password_2)],
        constraint => sub { $_[0] eq $_[1] },
      }
    },
    dependency_groups => { new_password => [qw(password_1 password_2)] }
  };

  my $results = Data::FormValidator->check($prefs, $profile);
}

=end future

=head2 newuser

If the proper form information is present, this runmode creates a new user
account.  If not, it presents a form.

If a user is already logged in, the user is redirected to the root of the
Rubric.

=head2 validate_newuser_form(\%newuser)

Given a set of user data from a form submission, this method validates them and
returns a description of the validation results.  This method will probably be
redesigned (possibly with Data::FormValidator) in the future.  Don't count on
its interface.

=head2 create_newuser(\%newuser)

This method creates a new user account from the given description.  It sends
the user a validation email (if needed) and displays an account creation page.

=head2 send_reset_email_to($user)

This method sends an email to the given user with a URI to reset his password.

=head2 send_verification_email_to($user)

This method sends a verification email to the given user.

=head2 verify

This runmode attempts to verify a user account.  It expects a request to be
in the form: C< /verify/username/verification_code >

=head2 get_reset_code

This gets the next part of the path and puts it in the C<reset_code>
parameter.

=head2 get_verification_code

This gets the next part of the path and puts it in the C<verification_code>
parameter.

=head2 get_user

This gets the next part of the path and puts it in the C<user> parameter.

=head2 display_entries

This method searches (with Rubric::Entry) for entries matching the requested
user and tags.  It pages the result (with C<page_entries>) and renders the
resulting page with C<render_entries>.

=head2 page_entries($iterator)

Given a Class::DBI::Iterator, this method sets up parameters describing the