svn commit: r264556 - in user/des/fbp: lib/FBP/Controller t
Dag-Erling Smørgrav
des at FreeBSD.org
Wed Apr 16 21:09:48 UTC 2014
Author: des
Date: Wed Apr 16 21:09:47 2014
New Revision: 264556
URL: http://svnweb.freebsd.org/changeset/base/264556
Log:
Controller.
Added:
user/des/fbp/lib/FBP/Controller/Poll.pm (contents, props changed)
user/des/fbp/t/controller_Poll.t
Modified:
user/des/fbp/lib/FBP/Controller/Root.pm
Added: user/des/fbp/lib/FBP/Controller/Poll.pm
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ user/des/fbp/lib/FBP/Controller/Poll.pm Wed Apr 16 21:09:47 2014 (r264556)
@@ -0,0 +1,269 @@
+package FBP::Controller::Poll;
+use Moose;
+use Storable qw(dclone);
+use Try::Tiny;
+use namespace::autoclean;
+
+BEGIN { extends 'FBP::Controller'; }
+
+=head1 NAME
+
+FBP::Controller::Poll - Catalyst Controller
+
+=head1 DESCRIPTION
+
+Catalyst Controller.
+
+=head1 METHODS
+
+=head2 poll
+
+Start of poll-related chain
+
+=cut
+
+sub poll :Chained('/') :Path :CaptureArgs(1) {
+ my ($self, $c, $pid) = @_;
+
+ $self->require_user($c);
+ $c->detach('/default')
+ unless $pid =~ m/^(\d+)$/;
+ $pid = $1;
+ my $poll = $c->model('FBP::Poll')->find($pid);
+ $c->detach('/default')
+ unless $poll && $poll->active;
+ $c->stash(poll => $poll);
+ my $psession = ($c->session->{$pid} //= {});
+ if (!$$psession{answers}) {
+ # Retrieve user's existing vote, if any
+ my $answers = ($$psession{answers} = {});
+ foreach my $question ($poll->questions) {
+ my $votes = $c->user->votes->search(question => $question->id);
+ $answers->{$question->id} = [ $votes->get_column('option')->all() ]
+ if $votes;
+ }
+ }
+ $$psession{qid} //= $poll->questions->first->id;
+ $c->log->debug("Retrieved poll #$pid");
+ $c->stash(title => $poll->title);
+}
+
+=head2 see
+
+View a specific poll
+
+=cut
+
+sub see :Chained('poll') :PathPart('') :Args(0) {
+ my ($self, $c) = @_;
+
+ my $poll = $c->stash->{poll};
+ $c->stash(questions => $poll->questions->
+ search_rs(undef, { order_by => { -asc => 'rank' } }));
+}
+
+=head2 vote
+
+Vote in a poll
+
+=cut
+
+sub vote :Chained('poll') :Path :Args(0) {
+ my ($self, $c) = @_;
+
+ # Retrieve the poll and its list of questions
+ my $poll = $c->stash->{poll};
+ my $pid = $poll->id;
+ my $questions = $poll->questions;
+ $c->detach('/default')
+ unless $poll && $questions;
+ my $psession = $c->session->{$pid};
+ my $answers = $$psession{answers};
+
+ # Retrieve the current question
+ my $qid = $$psession{qid};
+ my $question;
+ if ($qid) {
+ $question = $poll->questions->find($qid);
+ } else {
+ $question = $questions->slice(0, 1)->first;
+ }
+ $c->detach('/default')
+ unless $question;
+ $c->log->debug("Retrieved question #$qid");
+
+ # Did the user submit any answers?
+ if ($c->req->params->{qid} ~~ $qid && $c->req->params->{answer}) {
+ my $answer = $c->req->params->{answer};
+ $answer = [ $answer ]
+ unless ref($answer);
+ if (@$answer) {
+ try {
+ $question->validate_answer(@$answer);
+ $answers->{$qid} = $answer;
+ } catch {
+ $$psession{vote_error} = $_;
+ };
+ }
+ }
+
+ # Did the user press any of the buttons?
+ if ($$psession{vote_error}) {
+ # Ignore the buttons - stay on the same question
+ } elsif ($c->req->params->{done}) {
+ # Validate all the answers
+ for ($question = $questions->first;
+ $question && !$$psession{vote_error};
+ $question = $questions->next) {
+ try {
+ my $answer = $answers->{$question->id};
+ $question->validate_answer(@{$answer // []});
+ } catch {
+ $$psession{vote_error} = $_;
+ };
+ }
+ # If an error was found, $question now refers to the first
+ # question which was not answered correctly, and we will jump
+ # to that question and display an error message. If not, the
+ # voter has answered all the questions.
+ if (!$$psession{vote_error}) {
+ # XXX do something!
+ $c->response->redirect($c->uri_for('/poll', $pid, 'review'));
+ $c->detach();
+ }
+ } elsif ($c->req->params->{prev} && $question->prev) {
+ $question = $question->prev;
+ $c->log->debug("On to question #" . $question->id);
+ } elsif ($c->req->params->{next} && $question->next) {
+ $question = $question->next;
+ }
+
+ # Debugging
+ if ($question->id != $qid) {
+ $c->log->debug("On to question #" . $question->id);
+ }
+ if ($$psession{vote_error}) {
+ $c->log->debug($$psession{vote_error});
+ }
+
+ # Store the current question
+ $$psession{qid} = $qid = $question->id;
+
+ # If this was a POST, redirect so reload will work
+ if ($c->req->method eq 'POST') {
+ $c->response->redirect($c->request->uri);
+ $c->detach();
+ }
+
+ # Otherwise, display the page
+ $c->stash(answer => { map { $_ => 1 } @{$answers->{$qid} // []} });
+ if ($$psession{vote_error}) {
+ $c->stash(error => $$psession{vote_error});
+ delete($$psession{vote_error});
+ }
+ $c->stash(question => $question);
+}
+
+=head2 review
+
+Review the answers and submit.
+
+=cut
+
+sub review :Chained('poll') :Path :Args(0) {
+ my ($self, $c) = @_;
+
+ # Retrieve poll, questions, answers
+ my $poll = $c->stash->{poll};
+ my $pid = $poll->id;
+ my $questions = $poll->questions;
+ my $psession = $c->session->{$pid};
+ my $answers = $$psession{answers};
+ $c->detach('/default')
+ unless $poll && $questions && $answers;
+
+ # Validate the answers
+ try {
+ $poll->validate_answer(%$answers);
+ } catch {
+ $c->stash(error => $_);
+ $c->detach();
+ };
+
+ # Did the user press any of the buttons?
+ if ($$psession{vote_error}) {
+ # Ignore the buttons - stay on the same question
+ } elsif ($c->req->params->{confirm}) {
+ try {
+ $poll->commit_answer($c->user, %$answers);
+ } catch {
+ $c->stash(error => $_);
+ $c->detach();
+ };
+ delete($$psession{qid});
+ $c->response->redirect($c->uri_for('/poll', $pid, 'done'));
+ $c->detach;
+ } elsif ($c->req->params->{return}) {
+ delete($$psession{qid});
+ $c->response->redirect($c->uri_for('/poll', $pid, 'vote'));
+ $c->detach;
+ }
+
+ # If this was a POST, redirect so reload will work
+ if ($c->req->method eq 'POST') {
+ $c->response->redirect($c->request->uri);
+ $c->detach();
+ }
+
+ # Hammer $answers into something Template::Toolkit can process
+ my $options = $c->model('FBP::Option');
+ $answers = dclone($answers);
+ foreach my $qid (keys(%$answers)) {
+ $$answers{$qid} =
+ [ map { $options->find($_) } @{$$answers{$qid}} ];
+ }
+ $c->stash(answers => $answers);
+}
+
+=head2 done
+
+Thank the user for voting.
+
+=cut
+
+sub done :Chained('poll') :Path :Args(0) {
+ my ($self, $c) = @_;
+
+ my $poll = $c->stash->{poll};
+ my $pid = $poll->id;
+ #delete($c->session->{$pid});
+}
+
+=head2 default
+
+Default page.
+
+=cut
+
+sub default :Path {
+ my ($self, $c) = @_;
+
+ $c->detach('/default');
+}
+
+=head1 AUTHOR
+
+Dag-Erling Smørgrav <des at freebsd.org>
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+# $FreeBSD$
Modified: user/des/fbp/lib/FBP/Controller/Root.pm
==============================================================================
--- user/des/fbp/lib/FBP/Controller/Root.pm Wed Apr 16 21:09:17 2014 (r264555)
+++ user/des/fbp/lib/FBP/Controller/Root.pm Wed Apr 16 21:09:47 2014 (r264556)
@@ -1,8 +1,9 @@
package FBP::Controller::Root;
+use utf8;
use Moose;
use namespace::autoclean;
-BEGIN { extends 'Catalyst::Controller' }
+BEGIN { extends 'FBP::Controller' }
#
# Sets the actions in this controller to be registered with no prefix
@@ -20,28 +21,120 @@ FBP::Controller::Root - Root Controller
=head1 METHODS
+=head2 auto
+
+Common code for every action
+
+=cut
+
+sub auto :Private {
+ my ($self, $c) = @_;
+
+ $c->log->debug("FBP::Controller::Root::auto()");
+ # Stash various constants
+ $c->stash(title => $c->config->{'title'});
+
+ # Stash active polls
+ if ($c->user_exists) {
+ $c->log->debug("number of polls: " . int($c->model('FBP::Poll')->count()));
+ my $polls = $c->model('FBP::Poll')->
+ search({ starts => { '<=', $c->now }, ends => { '>=', $c->now } });
+ $c->log->debug("active polls: " . int($polls->count()));
+ $c->stash(polls => $polls);
+ }
+
+ 1;
+}
+
=head2 index
-The root page (/)
+The front page
=cut
sub index :Path :Args(0) {
- my ( $self, $c ) = @_;
+ my ($self, $c) = @_;
+
+ # nothing
+}
+
+=head2 login
+
+Display the login page and process login information
+
+=cut
+
+sub login :Local :Args(0) {
+ my ($self, $c) = @_;
+
+ $c->log->debug("FBP::Controller::Root::login()");
+ if ($c->user_exists) {
+ my $login = $c->user->login;
+ $c->log->debug("user $login already authenticated");
+ $c->response->redirect($c->uri_for('/polls'));
+ $c->detach();
+ }
+ my ($login, $password) = @{$c->request->params}{'login', 'password'};
+ if ($login && $password &&
+ $c->authenticate({ login => $login, password => $password })) {
+ $c->log->debug("user $login successfully authenticated");
+ $c->change_session_id();
+ $c->response->redirect($c->uri_for('/polls'));
+ }
+}
+
+=head2 logout
+
+Log the user out and return to the front page
- # Hello World
- $c->response->body( $c->welcome_message );
+=cut
+
+sub logout :Local :Args(0) {
+ my ($self, $c) = @_;
+
+ if ($c->user_exists) {
+ my $login = $c->user->login;
+ $c->delete_session();
+ $c->logout();
+ $c->log->debug("user $login successfully authenticated");
+ }
+ $c->response->redirect($c->uri_for('/'));
+}
+
+=head2 polls
+
+List of active polls.
+
+=cut
+
+sub polls :Local :Args(0) {
+ my ($self, $c) = @_;
+
+ $c->stash(title => 'Active polls');
+}
+
+=head2 help
+
+Display help text.
+
+=cut
+
+sub help :Local :Args(0) {
+ my ($self, $c) = @_;
+
+ $c->stash(title => 'Help');
}
=head2 default
-Standard 404 error page
+Default page.
=cut
sub default :Path {
- my ( $self, $c ) = @_;
- $c->response->body( 'Page not found' );
+ my ($self, $c) = @_;
+
+ $c->stash(template => 'fof.tt');
$c->response->status(404);
}
@@ -55,7 +148,7 @@ sub end : ActionClass('RenderView') {}
=head1 AUTHOR
-Dag-Erling Smørgrav
+Dag-Erling Smørgrav <des at freebsd.org>
=head1 LICENSE
@@ -67,3 +160,5 @@ it under the same terms as Perl itself.
__PACKAGE__->meta->make_immutable;
1;
+
+# $FreeBSD$
Added: user/des/fbp/t/controller_Poll.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ user/des/fbp/t/controller_Poll.t Wed Apr 16 21:09:47 2014 (r264556)
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+use Catalyst::Test 'FBP';
+use FBP::Controller::Poll;
+
+ok( request('/poll')->is_success, 'Request should succeed' );
+done_testing();
More information about the svn-src-user
mailing list