Added Survey tests for more question types

This commit is contained in:
Patrick Donelan 2009-05-28 07:23:43 +00:00
parent 83497b773e
commit d14cf19e9d
7 changed files with 209 additions and 95 deletions

View file

@ -385,9 +385,7 @@ sub responseJSON {
my $self = shift;
my ($json, $responseId) = validate_pos(@_, { type => SCALAR | UNDEF, optional => 1 }, { type => SCALAR, optional => 1});
if (!defined $responseId) {
$responseId = $self->responseId;
}
$responseId ||= $self->responseId;
if (!$self->{_responseJSON} || $json) {
@ -769,7 +767,7 @@ sub www_submitObjectEdit {
return $self->addType($params->{addtype},\@address);
}
# Update the addressed object
# Update the addressed object (and have it automatically persisted)
$self->surveyJSON_update( \@address, $params );
# Return the updated Survey structure
@ -1853,37 +1851,12 @@ sub persistResponseJSON {
#-------------------------------------------------------------------
=head2 responseIdCookies
Mutator for the responseIdCookies that determines whether cookies are used as
part of the L<"responseId"> lookup process.
Useful for disabling cookie operations during tests, since WebGUI::Test::getPage
currently does not support cookies.
=cut
sub responseIdCookies {
my $self = shift;
my ($x) = validate_pos(@_, {type => SCALAR, optional => 1});
if (defined $x) {
$self->{_responseIdCookies} = $x;
}
# Defaults to true..
return defined $self->{_responseIdCookies} ? $self->{_responseIdCookies} : 1;
}
#-------------------------------------------------------------------
=head2 responseId( [userId] )
Accessor for the responseId property, which is the unique identifier for a single
L<WebGUI::Asset::Wobject::Survey::ResponseJSON> instance. See also L<"responseJSON">.
The responseId of the current user is returned, or created if one does not already exist.
If the user is anonymous, the IP is used. Or an emailed or linked code can be used.
=head3 userId (optional)

View file

@ -536,7 +536,6 @@ sub run {
# (re)Instantiate the survey instance using the responseId
use WebGUI::Asset::Wobject::Survey;
$asset = WebGUI::Asset::Wobject::Survey->newByResponseId( $session, $mostRecentlyCompletedResponseId );
$asset->responseIdCookies(0);
if ( !$asset ) {
$session->log->warn("Unable to instantiate asset by responseId: $mostRecentlyCompletedResponseId");
return;

View file

@ -556,18 +556,22 @@ sub recordResponses {
# Server-side Validation and storing of extra data for special q types goes here
# Any answer that fails validation should be skipped with 'next'
if ( $questionType eq 'Number' ) {
if ( $questionType eq 'Country' ) {
# Must be a valid country
next if !grep { $_ eq $recordedAnswer } WebGUI::Form::Country->getCountries;
}
elsif ( $questionType eq 'Date' ) {
# Must be a valid date (until we get date i18n this is limited to YYYY/MM/DD)
next if $recordedAnswer !~ m|^\d{4}/\d{2}/\d{2}$|;
}
elsif ( $questionType eq 'Number' || $questionType eq 'Slider' ) {
if ( $answer->{max} =~ /\d/ and $recordedAnswer > $answer->{max} ) {
next;
}
elsif ( $answer->{min} =~ /\d/ and $recordedAnswer < $answer->{min} ) {
next;
}
elsif ( $answer->{step} =~ /\d/ and $recordedAnswer % $answer->{step} != 0 ) {
next;
}
}
}
elsif ( $questionType eq 'Year Month' ) {
# store year and month as "YYYY Month"
$recordedAnswer = $responses->{ "$aId-year" } . " " . $responses->{ "$aId-month" };
@ -576,7 +580,7 @@ sub recordResponses {
# In the case of a mc question, only selected answers will have a defined recordedAnswer
# Thus we skip any answers where recordedAnswer is not defined
next if !defined $recordedAnswer || $recordedAnswer !~ /\S/;
}
}
# If we reach here, answer validated ok
$aValid = 1;