Fixed naff Survey::takenCount bug, added explicit test for it

This commit is contained in:
Patrick Donelan 2009-06-02 02:42:37 +00:00
parent 42060bdec4
commit 084a0c3105
2 changed files with 43 additions and 10 deletions

View file

@ -1920,25 +1920,41 @@ sub responseId {
return $self->{responseId};
}
=head2 takenCount
=head2 takenCount ( $options )
Counts the number of existing responses
N.B. only counts responses with completeCode of 1
(others codes indicate abnormal completion such as restart
and thus should not count towards tally)
=head3 options
The following options are supported
=head4 userId
The userId to count responses for (required)
=head4 ipAddress
An IP address to filter responses by (optional)
=head4 isComplete
A complete code to use to filter responses by (optional, defaults to 1)
=cut
sub takenCount {
my $self = shift;
my %opts = validate(@_, { userId => 0, anonId => 0, ipAddress => 0, isComplete => 0 });
my %opts = validate(@_, { userId => 1, ipAddress => 0, isComplete => 0 });
my $isComplete = defined $opts{isComplete} ? $opts{isComplete} : 1;
my $sql = 'select count(*) from Survey_response where';
$sql .= ' assetId = ' . $self->session->db->quote($self->getId);
$sql .= ' and isComplete = ' . $self->session->db->quote($isComplete);
for my $o qw(userId anonId ipAddress) {
if (my $o_value = $opts{o}) {
for my $o qw(userId ipAddress) {
if (my $o_value = $opts{$o}) {
$sql .= " and $o = " . $self->session->db->quote($o_value);
}
}

View file

@ -18,21 +18,21 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 25;
my $tests = 29;
plan tests => $tests + 1;
#----------------------------------------------------------------------------
# put your tests here
my $usedOk = use_ok('WebGUI::Asset::Wobject::Survey');
my ($user, $import_node, $survey);
my ($survey);
SKIP: {
skip $tests, "Unable to load Survey" unless $usedOk;
$user = WebGUI::User->new( $session, 'new' );
my $user = WebGUI::User->new( $session, 'new' );
WebGUI::Test->usersToDelete($user);
$import_node = WebGUI::Asset->getImportNode($session);
my $import_node = WebGUI::Asset->getImportNode($session);
# Create a Survey
$survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
@ -61,8 +61,8 @@ $sJSON->update([1,1], { variable => 'S1Q1' });
$survey->persistSurveyJSON;
# Now start a response as admin user
$session->user( { userId =>3 } );
# Now start a response as the test user
$session->user( { user => $user } );
my $responseId = $survey->responseId;
my $s = WebGUI::Asset::Wobject::Survey->newByResponseId($session, $responseId);
@ -92,6 +92,22 @@ delete $s->{responseId};
ok($s->canTakeSurvey, '..and also when maxResponsesPerUser set to 0 (unlimited)');
ok($s->responseId, '..(and similarly for responseId)');
# Start a new response as another user
$s->update({maxResponsesPerUser => 1});
is($s->takenCount( { userId => 1 } ), 0, 'Visitor has no responses');
my $u = WebGUI::User->new( $session, 'new' );
WebGUI::Test->usersToDelete($u);
is($s->takenCount( { userId => $u->userId } ), 0, 'New user has no responses');
delete $s->{canTake};
delete $s->{responseId};
$session->user( { userId => $u->userId } );
ok($s->canTakeSurvey, 'Separate counts for separate users');
ok($s->responseId, '..(and similarly for responseId)');
# Put things back to normal..
delete $s->{canTake};
delete $s->{responseId};
$session->user( { user => $user } );
# Restart the survey
$s->submitQuestions({
'0-0-0' => 'this text ignored',
@ -136,6 +152,7 @@ cmp_deeply(from_json($surveyEnd), { type => 'forward', url => '/getting_started'
# www_jumpTo
{
# Check a simple www_jumpTo request
$session->user( { userId => 3 } );
WebGUI::Test->getPage( $survey, 'www_jumpTo', { formParams => {id => '0'} } );
is( $session->http->getStatus, '201', 'Page request ok' ); # why is "201 - created" status used??
is($survey->responseJSON->nextResponse, 0, 'S0 is the first response');