Date: Wed, 16 Apr 2014 21:09:17 +0000 (UTC) From: Dag-Erling Smørgrav <des@FreeBSD.org> To: src-committers@freebsd.org, svn-src-user@freebsd.org Subject: svn commit: r264555 - in user/des/fbp/lib/FBP: . Model Schema/Result Message-ID: <201404162109.s3GL9HAe038653@svn.freebsd.org>
next in thread | raw e-mail | index | archive | help
Author: des Date: Wed Apr 16 21:09:17 2014 New Revision: 264555 URL: http://svnweb.freebsd.org/changeset/base/264555 Log: Model. Modified: user/des/fbp/lib/FBP/Model/FBP.pm user/des/fbp/lib/FBP/Schema.pm user/des/fbp/lib/FBP/Schema/Result/Person.pm user/des/fbp/lib/FBP/Schema/Result/Poll.pm user/des/fbp/lib/FBP/Schema/Result/Question.pm Modified: user/des/fbp/lib/FBP/Model/FBP.pm ============================================================================== --- user/des/fbp/lib/FBP/Model/FBP.pm Wed Apr 16 21:01:44 2014 (r264554) +++ user/des/fbp/lib/FBP/Model/FBP.pm Wed Apr 16 21:09:17 2014 (r264555) @@ -29,7 +29,7 @@ Dag-Erling Smørgrav <des@freebsd.org> =head1 LICENSE -This library is free software, you can redistribute it and/or modify +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Modified: user/des/fbp/lib/FBP/Schema.pm ============================================================================== --- user/des/fbp/lib/FBP/Schema.pm Wed Apr 16 21:01:44 2014 (r264554) +++ user/des/fbp/lib/FBP/Schema.pm Wed Apr 16 21:09:17 2014 (r264555) @@ -25,8 +25,6 @@ it under the same terms as Perl itself. =cut -__PACKAGE__->meta->make_immutable; - 1; # $FreeBSD$ Modified: user/des/fbp/lib/FBP/Schema/Result/Person.pm ============================================================================== --- user/des/fbp/lib/FBP/Schema/Result/Person.pm Wed Apr 16 21:01:44 2014 (r264554) +++ user/des/fbp/lib/FBP/Schema/Result/Person.pm Wed Apr 16 21:09:17 2014 (r264555) @@ -173,6 +173,42 @@ __PACKAGE__->has_many( # Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-04-16 20:57:55 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:19kISwX2Afx2WCQPAB8akw +use Crypt::SaltedHash; + +=head2 set_password + +Set this person's password to the specified string. + +=cut + +sub set_password($$) { + my ($self, $password) = @_; + + if ($password !~ m/^[[:print:]]{8,}$/a || $password !~ m/[0-9]/a || + $password !~ m/[A-Z]/a || $password !~ m/[a-z]/a) { + die("Your password must be at least 8 characters long and contain" . + " at least one upper-case letter, one lower-case letter and" . + " one digit.\n"); + } + my $csh = new Crypt::SaltedHash(algorithm => 'SHA-256'); + $csh->add($password); + $self->set_column(password => $csh->generate()); + $self->update() + if $self->in_storage(); +} + +=head2 check_password + +Verify that the specified string matches the user's password. + +=cut + +sub check_password($$) { + my ($self, $password) = @_; + + return Crypt::SaltedHash->validate($self->password, $password); +} + =head1 AUTHOR Dag-Erling Smørgrav <des@freebsd.org> Modified: user/des/fbp/lib/FBP/Schema/Result/Poll.pm ============================================================================== --- user/des/fbp/lib/FBP/Schema/Result/Poll.pm Wed Apr 16 21:01:44 2014 (r264554) +++ user/des/fbp/lib/FBP/Schema/Result/Poll.pm Wed Apr 16 21:09:17 2014 (r264555) @@ -164,6 +164,57 @@ __PACKAGE__->has_many( # Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-04-16 20:57:55 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:wB2dAarq+nsbZ5Ljfsil7Q +use DateTime; + +=index2 active + +True if the poll was, is or will be active at the specified date and +time. + +=cut + +sub active($;$) { + my ($self, $when) = @_; + + $when //= DateTime->now(); + return DateTime->compare($when, $self->starts) >= 0 && + DateTime->compare($when, $self->ends) <= 0; +} + +=head2 validate_answer + +Validates an answer to this poll and dies if it is not valid. + +=cut + +sub validate_answer($%) { + my ($self, %answers) = @_; + + my %questions = map({ $_->id => $_ } $self->questions); + # Verify that all questions have received valid answers + foreach my $qid (keys %questions) { + if (!defined($answers{$qid})) { + die("Question $qid has not been answered.\n"); + } elsif (ref($answers{$qid}) ne 'ARRAY') { + die("Internal error\n"); + } else { + $questions{$qid}->validate_answer(@{$answers{$qid}}); + } + } + # Verify that there are no answers without a matching question + if (!(keys(%answers) ~~ keys(%questions))) { + die("Too many answers\n"); + } +} + +sub commit_answer($$%) { + my ($self, $voter, %answers) = @_; + + foreach my $question ($self->questions) { + $question->commit_answer($voter, @{$answers{$question->id}}); + } +} + =head1 AUTHOR Dag-Erling Smørgrav <des@freebsd.org> Modified: user/des/fbp/lib/FBP/Schema/Result/Question.pm ============================================================================== --- user/des/fbp/lib/FBP/Schema/Result/Question.pm Wed Apr 16 21:01:44 2014 (r264554) +++ user/des/fbp/lib/FBP/Schema/Result/Question.pm Wed Apr 16 21:09:17 2014 (r264555) @@ -182,6 +182,80 @@ __PACKAGE__->has_many( # Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-04-16 20:57:55 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:I/1G7NpDuffuLD3XnoJLpw +=head2 validate_answer + +Validates an answer to this question and dies if it is not valid. + +=cut + +sub validate_answer($@) { + my ($self, @answer) = @_; + + if (!@answer && $self->min_options > 0) { + die("You did not answer this question.\n"); + } elsif (@answer < $self->min_options) { + die("You must select at least " . $self->min_options . " options\n"); + } elsif (@answer > $self->max_options) { + if ($self->max_options == 1) { + die("You may only select one option.\n"); + } else { + die("You may select at most " . $self->max_options . " options."); + } + } + foreach my $oid (@answer) { + $self->options->find($oid) + or die("Option $oid is not a valid answer to this question\n"); + } +} + +=head2 commit_answer + +Registers a voter's answer to this question. + +=cut + +sub commit_answer($$@) { + my ($self, $voter, @answer) = @_; + + print STDERR "Question ", $self->id, " commit_answer\n"; + $voter->votes->search({ question => $self->id })->delete(); + foreach my $oid (@answer) { + $voter->votes->create({ question => $self->id, option => $oid }); + } +} + +=head2 prev + +Returns the previous question by rank. + +=cut + +sub prev($) { + my ($self) = @_; + + my $questions = $self->poll->questions-> + search({ rank => { '<', $self->rank } }, + { order_by => { -desc => 'id' } }) + or return undef; + return $questions->slice(0, 1)->first; +} + +=head2 prev + +Returns the next question by rank. + +=cut + +sub next($) { + my ($self) = @_; + + my $questions = $self->poll->questions-> + search({ rank => { '>', $self->rank } }, + { order_by => { -asc => 'id' } }) + or return undef; + return $questions->slice(0, 1)->first; +} + =head1 AUTHOR Dag-Erling Smørgrav <des@freebsd.org>
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?201404162109.s3GL9HAe038653>