Date: Wed, 16 Apr 2014 21:09:47 +0000 (UTC) From: Dag-Erling Smørgrav <des@FreeBSD.org> To: src-committers@freebsd.org, svn-src-user@freebsd.org Subject: svn commit: r264556 - in user/des/fbp: lib/FBP/Controller t Message-ID: <201404162109.s3GL9lwg038740@svn.freebsd.org>
next in thread | raw e-mail | index | archive | help
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@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@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();
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?201404162109.s3GL9lwg038740>