diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 387085911..4e0e2a486 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -7,6 +7,10 @@ upgrading from one version to the next, or even between multiple versions. Be sure to heed the warnings contained herein as they will save you many hours of grief. +7.7.0 +-------------------------------------------------------------------- + * WebGUI now requires Params::Validate version 0.81 or greater. + 7.6.11 -------------------------------------------------------------------- * If upgrading from WebGUI 7.5, you should upgrade to 7.5.40 first, diff --git a/docs/upgrades/packages-7.7.0/root_import_expireincompletesurveyresponses.wgpkg b/docs/upgrades/packages-7.7.0/root_import_expireincompletesurveyresponses.wgpkg new file mode 100644 index 000000000..eadd26f7f Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_expireincompletesurveyresponses.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-answer-edit.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-answer-edit.wgpkg new file mode 100644 index 000000000..763d5e2e3 Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-answer-edit.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-gradebook-report.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-gradebook-report.wgpkg new file mode 100644 index 000000000..140db79be Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-gradebook-report.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-overview-report.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-overview-report.wgpkg new file mode 100644 index 000000000..d152cf52d Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-overview-report.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-question-edit.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-question-edit.wgpkg new file mode 100644 index 000000000..ccc7491ec Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-question-edit.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-questions.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-questions.wgpkg new file mode 100644 index 000000000..0465335bf Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-questions.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-section-edit.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-section-edit.wgpkg new file mode 100644 index 000000000..77df06f71 Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-section-edit.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-survey-edit.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-survey-edit.wgpkg new file mode 100644 index 000000000..1b2f5d2be Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-survey-edit.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-survey-take.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-survey-take.wgpkg new file mode 100644 index 000000000..a31b0c6f6 Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-survey-take.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/root_import_survey_default-survey.wgpkg b/docs/upgrades/packages-7.7.0/root_import_survey_default-survey.wgpkg new file mode 100644 index 000000000..e3aee292b Binary files /dev/null and b/docs/upgrades/packages-7.7.0/root_import_survey_default-survey.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/survey-root_import_prop-style.wgpkg b/docs/upgrades/packages-7.7.0/survey-root_import_prop-style.wgpkg new file mode 100644 index 000000000..fea9f43c0 Binary files /dev/null and b/docs/upgrades/packages-7.7.0/survey-root_import_prop-style.wgpkg differ diff --git a/docs/upgrades/packages-7.7.0/survey.css.wgpkg b/docs/upgrades/packages-7.7.0/survey.css.wgpkg new file mode 100644 index 000000000..51101a54b Binary files /dev/null and b/docs/upgrades/packages-7.7.0/survey.css.wgpkg differ diff --git a/docs/upgrades/upgrade_7.6.14-7.7.0.pl b/docs/upgrades/upgrade_7.6.14-7.7.0.pl index 65e25aa6c..c915b2fe1 100644 --- a/docs/upgrades/upgrade_7.6.14-7.7.0.pl +++ b/docs/upgrades/upgrade_7.6.14-7.7.0.pl @@ -34,6 +34,8 @@ my $session = start(); # this line required addGroupToAddToMatrix( $session ); addScreenshotTemplatesToMatrix( $session ); +surveyDoAfterTimeLimit($session); +surveyRemoveResponseTemplate($session); finish($session); # this line required @@ -61,6 +63,26 @@ sub addScreenshotTemplatesToMatrix { print "Done.\n" unless $quiet; } +#---------------------------------------------------------------------------- +sub surveyDoAfterTimeLimit { + my $session = shift; + print "\tAdding column doAfterTimeLimit to Survey table... " unless $quiet; + $session->db->write('alter table Survey add doAfterTimeLimit char(22)'); + print "DONE!\n" unless $quiet; +} + +#---------------------------------------------------------------------------- +sub surveyRemoveResponseTemplate { + my $session = shift; + print "\tRemoving responseTemplate... " unless $quiet; + $session->db->write('alter table Survey drop responseTemplateId'); + if (my $template = WebGUI::Asset->new($session, 'PBtmpl0000000000000064')) { + $template->purge(); + } + print "DONE!\n" unless $quiet; +} + + #---------------------------------------------------------------------------- # Describe what our function does #sub exampleFunction { diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index de1463b34..ae65c3f5a 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -19,8 +19,8 @@ use WebGUI::Utility; use base 'WebGUI::Asset::Wobject'; use WebGUI::Asset::Wobject::Survey::SurveyJSON; use WebGUI::Asset::Wobject::Survey::ResponseJSON; - -use Data::Dumper; +use Params::Validate qw(:all); +Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); #------------------------------------------------------------------- @@ -40,7 +40,7 @@ sub definition { my $definition = shift; my $i18n = WebGUI::International->new( $session, 'Asset_Survey' ); my %properties; - tie %properties, 'Tie::IxHash'; + tie %properties, 'Tie::IxHash'; ## no critic %properties = ( templateId => { fieldType => 'template', @@ -71,6 +71,17 @@ sub definition { label => $i18n->get('timelimit'), hoverHelp => $i18n->get('timelimit hoverHelp'), }, + doAfterTimeLimit => { + fieldType => 'selectBox', + defaultValue => 'exitUrl', + tab => 'properties', + hoverHelp => $i18n->get('do after timelimit hoverHelp'), + label => $i18n->get('do after timelimit label'), + options => { + 'exitUrl' => $i18n->get('exit url label'), + 'restartSurvey' => $i18n->get('restart survey label'), + }, + }, groupToEditSurvey => { fieldType => 'group', defaultValue => 4, @@ -101,195 +112,255 @@ sub definition { label => $i18n->get('Max user responses'), hoverHelp => $i18n->get('Max user responses help'), }, - overviewTemplateId => { - tab => 'display', - fieldType => 'template', - defaultValue => 'PBtmpl0000000000000063', - namespace => 'Survey/Overview', - label => $i18n->get('Survey Overview Template'), - hoverHelp => $i18n->get('Survey Overview Template help'), - }, - gradebookTemplateId => { - tab => 'display', - fieldType => 'template', - defaultValue => 'PBtmpl0000000000000062', - namespace => 'Survey/Gradebook', - label => $i18n->get('Gradebook Template'), - hoverHelp => $i18n->get('Gradebook Template help'), - }, - responseTemplateId => { - tab => 'display', - fieldType => 'template', - defaultValue => 'PBtmpl0000000000000064', - namespace => 'Survey/Response', - label => $i18n->get('Response Template'), - hoverHelp => $i18n->get('Response Template help'), - }, - surveyEditTemplateId => { - tab => 'display', - fieldType => 'template', - defaultValue => 'GRUNFctldUgop-qRLuo_DA', - namespace => 'Survey/Edit', - label => $i18n->get('Edit Survey Template'), - hoverHelp => $i18n->get('Edit Survey Template help'), - }, surveyTakeTemplateId => { tab => 'display', fieldType => 'template', - defaultValue => 'd8jMMMRddSQ7twP4l1ZSIw', - namespace => 'Survey/Take', label => $i18n->get('Take Survey Template'), hoverHelp => $i18n->get('Take Survey Template help'), + defaultValue => 'd8jMMMRddSQ7twP4l1ZSIw', + namespace => 'Survey/Take', }, surveyQuestionsId => { tab => 'display', fieldType => 'template', - defaultValue => 'CxMpE_UPauZA3p8jdrOABw', - namespace => 'Survey/Take', label => $i18n->get('Questions Template'), hoverHelp => $i18n->get('Questions Template help'), + defaultValue => 'CxMpE_UPauZA3p8jdrOABw', + namespace => 'Survey/Take', + }, + surveyEditTemplateId => { + tab => 'display', + fieldType => 'template', + label => $i18n->get('Survey Edit Template'), + hoverHelp => $i18n->get('Survey Edit Template help'), + defaultValue => 'GRUNFctldUgop-qRLuo_DA', + namespace => 'Survey/Edit', }, sectionEditTemplateId => { tab => 'display', fieldType => 'template', - defaultValue => '1oBRscNIcFOI-pETrCOspA', - namespace => 'Survey/Edit', label => $i18n->get('Section Edit Template'), hoverHelp => $i18n->get('Section Edit Template help'), + defaultValue => '1oBRscNIcFOI-pETrCOspA', + namespace => 'Survey/Edit', }, questionEditTemplateId => { tab => 'display', fieldType => 'template', - defaultValue => 'wAc4azJViVTpo-2NYOXWvg', - namespace => 'Survey/Edit', label => $i18n->get('Question Edit Template'), hoverHelp => $i18n->get('Question Edit Template help'), + defaultValue => 'wAc4azJViVTpo-2NYOXWvg', + namespace => 'Survey/Edit', }, answerEditTemplateId => { tab => 'display', fieldType => 'template', - defaultValue => 'AjhlNO3wZvN5k4i4qioWcg', - namespace => 'Survey/Edit', label => $i18n->get('Answer Edit Template'), hoverHelp => $i18n->get('Answer Edit Template help'), + defaultValue => 'AjhlNO3wZvN5k4i4qioWcg', + namespace => 'Survey/Edit', + }, + overviewTemplateId => { + tab => 'display', + fieldType => 'template', + defaultValue => 'PBtmpl0000000000000063', + label => $i18n->get('Overview Report Template'), + hoverHelp => $i18n->get('Overview Report Template help'), + namespace => 'Survey/Overview', + }, + gradebookTemplateId => { + tab => 'display', + fieldType => 'template', + label => $i18n->get('Grabebook Report Template'), + hoverHelp => $i18n->get('Grabebook Report Template help'), + defaultValue => 'PBtmpl0000000000000062', + namespace => 'Survey/Gradebook', + }, + surveyJSON => { + fieldType => 'text', + defaultValue => '', + autoGenerate => 0, + noFormPost => 1, }, ); - push( - @{$definition}, { + push @{$definition}, { assetName => $i18n->get('assetName'), icon => 'survey.gif', autoGenerateForms => 1, tableName => 'Survey', className => 'WebGUI::Asset::Wobject::Survey', properties => \%properties - } - ); + }; + return $class->SUPER::definition( $session, $definition ); -} ## end sub definition +} #------------------------------------------------------------------- -=head2 exportAssetData ( ) +=head2 surveyJSON_update ( ) -Override exportAssetData so that surveyJSON is included in package exports etc.. +Convenience method that delegates to L +and automatically calls L<"persistSurveyJSON"> afterwards. =cut -sub exportAssetData { +sub surveyJSON_update { my $self = shift; - my $hash = $self->SUPER::exportAssetData(); - $self->loadSurveyJSON(); - $hash->{properties}{surveyJSON} = $self->survey->freeze; - return $hash; + my $ret = $self->surveyJSON->update(@_); + $self->persistSurveyJSON(); + return $ret; } #------------------------------------------------------------------- -=head2 importAssetData ( hashRef ) +=head2 surveyJSON_copy ( ) -Override importAssetCollateralData so that surveyJSON gets imported from packages +Convenience method that delegates to L +and automatically calls L<"persistSurveyJSON"> afterwards. =cut -sub importAssetCollateralData { - my ( $self, $data ) = @_; - my $surveyJSON = $data->{properties}{surveyJSON}; - $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $surveyJSON, $self->getId ] ); -} - -#------------------------------------------------------------------- - -=head2 duplicate ( ) - -Override duplicate so that surveyJSON gets duplicated too - -=cut - -sub duplicate { - my $self = shift; - my $options = shift; - my $newAsset = $self->SUPER::duplicate($options); - $self->loadSurveyJSON(); - $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", - [ $self->survey->freeze, $newAsset->getId ] ); - return $newAsset; -} - -#------------------------------------------------------------------- - -=head2 loadSurveyJSON ( ) - -Loads the survey collateral into memory so that the survey objects can be created - -=cut - -sub loadSurveyJSON { - my $self = shift; - my $jsonHash = shift; - if ( defined $self->survey ) { return; } #already loaded - - $jsonHash = $self->session->db->quickScalar( "select surveyJSON from Survey where assetId = ?", [ $self->getId ] ) - if ( !defined $jsonHash ); - - $self->{survey} = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $jsonHash, $self->session->errorHandler ); -} - -#------------------------------------------------------------------- - -=head2 saveSurveyJSON ( ) - -Saves the survey collateral to the DB - -=cut - - -sub saveSurveyJSON { +sub surveyJSON_copy { my $self = shift; - - my $data = $self->survey->freeze(); - - $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $data, $self->getId ] ); + my $ret =$self->surveyJSON->copy(@_); + $self->persistSurveyJSON(); + return $ret; } #------------------------------------------------------------------- -=head2 survey ( ) +=head2 surveyJSON_remove ( ) -Helper to access the survey object. +Convenience method that delegates L +and automatically calls L<"persistSurveyJSON"> afterwards. =cut -sub survey { return shift->{survey}; } -sub littleBuddy { return shift->{survey}; } -sub allyourbases { return shift->{survey}; } -sub helpmehelpme { return shift->{survey}; } +sub surveyJSON_remove { + my $self = shift; + my $ret = $self->surveyJSON->remove(@_); + $self->persistSurveyJSON(); + return $ret; +} + +#------------------------------------------------------------------- + +=head2 surveyJSON_newObject ( ) + +Convenience method that delegates L +and automatically calls L<"persistSurveyJSON"> afterwards. + +=cut + +sub surveyJSON_newObject { + my $self = shift; + my $ret = $self->surveyJSON->newObject(@_); + $self->persistSurveyJSON(); + return $ret; +} + +#------------------------------------------------------------------- + +=head2 recordResponses ( ) + +Convenience method that delegates to L +and automatically calls L<"persistSurveyJSON"> afterwards. + +=cut + +sub recordResponses { + my $self = shift; + my $ret = $self->responseJSON->recordResponses(@_); + $self->persistResponseJSON(); + return $ret; +} + +#------------------------------------------------------------------- + +=head2 surveyJSON ( [json] ) + +Lazy-loading mutator for the L property. + +It is stored in the database as a serialized JSON-encoded string in the surveyJSON db field. + +If you access and change surveyJSON you will need to manually call L<"persistSurveyJSON"> +to have your changes persisted to the database. + +=head3 json (optional) + +A serialized JSON-encoded string representing a SurveyJSON object. If provided, +will be used to instantiate the SurveyJSON instance rather than querying the database. + +=cut + +sub surveyJSON { + my $self = shift; + my ($json) = validate_pos(@_, { type => SCALAR, optional => 1 }); + + if (!$self->{_surveyJSON} || $json) { + + # See if we need to load surveyJSON from the database + if ( !defined $json ) { + $json = $self->get("surveyJSON"); + } + + # Instantiate the SurveyJSON instance, and store it + $self->{_surveyJSON} = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $self->session, $json ); + } + + return $self->{_surveyJSON}; +} + +#------------------------------------------------------------------- + +=head2 responseJSON ( [json], [responseId] ) + +Lazy-loading mutator for the L property. + +It is stored in the database as a serialized JSON-encoded string in the responseJSON db field. + +If you access and change responseJSON you will need to manually call L<"persistResponseJSON"> +to have your changes persisted to the database. + +=head3 json (optional) + +A serialized JSON-encoded string representing a ResponseJSON object. If provided, +will be used to instantiate the ResponseJSON instance rather than querying the database. + +=head3 responseId (optional) + +A responseId to use when retrieving ResponseJSON from the database (defaults to the value returned by L<"responseId">) + +=cut + +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; + } + + if (!$self->{_responseJSON} || $json) { + + # See if we need to load responseJSON from the database + if (!defined $json) { + $json = $self->session->db->quickScalar( 'select responseJSON from Survey_response where assetId = ? and Survey_responseId = ?', [ $self->getId, $responseId ] ); + } + + # Instantiate the ResponseJSON instance, and store it + $self->{_responseJSON} = WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $self->surveyJSON, $json ); + } + + return $self->{_responseJSON}; +} #------------------------------------------------------------------- =head2 www_editSurvey ( ) -Loads the initial edit survey page. All other edit actions are JSON calls from this page. +Loads the initial edit survey page. All other edit actions are ajax calls from this page. =cut @@ -297,20 +368,20 @@ sub www_editSurvey { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) ); + if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); - my %var; - my $out = $self->processTemplate( \%var, $self->get("surveyEditTemplateId") ); - - return $out; + return $self->processTemplate( {}, $self->get('surveyEditTemplateId') ); } #------------------------------------------------------------------- =head2 www_submitObjectEdit ( ) -This is called when an edit is submitted to a survey object. The POST should contain the id and updated params -of the object, and also if the object is being deleted or copied. +This is called when an edit is submitted to a survey object. The POST should contain the id and updated params +of the object, and also if the object is being deleted or copied. + +In general, the id contains a section index, question index, and answer index, separated by dashes. +See L. =cut @@ -318,28 +389,97 @@ sub www_submitObjectEdit { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) ); + if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); - # my $ref = @{from_json($self->session->form->process("data"))}; - my $responses = $self->session->form->paramsHashRef(); + my $params = $self->session->form->paramsHashRef(); - my @address = split /-/, $responses->{id}; + # Id is made up of at most: sectionIndex-questionIndex-answerIndex + my @address = split /-/, $params->{id}; - $self->loadSurveyJSON(); - if ( $responses->{delete} ) { + # See if any special actions were requested.. + if ( $params->{delete} ) { return $self->deleteObject( \@address ); } - elsif ( $responses->{copy} ) { + elsif ( $params->{copy} ) { return $self->copyObject( \@address ); } - # each object checks the ref and then either updates or passes it to the correct child. New objects will have an index of -1. - my $message = $self->survey->update( \@address, $responses ); - - $self->saveSurveyJSON(); + # Update the addressed object + $self->surveyJSON_update( \@address, $params ); + # Return the updated Survey structure return $self->www_loadSurvey( { address => \@address } ); -} ## end sub www_submitObjectEdit +} + +#------------------------------------------------------------------- + +=head2 www_jumpTo + +Allow survey editors to jump to a particular section or question in a +Survey by tricking Survey into thinking they've completed the survey up to that +point. This is useful for user-testing large Survey instances where you don't want +to waste your time clicking through all of the initial questions to get to the one +you want to look at. + +Note that calling this method will delete any existing survey responses for the +current user (although only survey builders can call this method so that shouldn't be +a problem). + +=cut + +sub www_jumpTo { + my $self = shift; + + return $self->session->privilege->insufficient() + if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + + my $id = $self->session->form->param('id'); + + # When the Edit Survey screen first loads the first section will have an id of 'undefined' + # In this case, treat it the same as '0' + $id = $id eq 'undefined' ? 0 : $id; + + $self->session->log->debug("www_jumpTo: $id"); + + # Remove existing responses for current user + $self->session->db->write( 'delete from Survey_response where assetId = ? and userId = ?', + [ $self->getId, $self->session->user->userId() ] ); + + # Break the $id down into sIndex and qIndex + my ($sIndex, $qIndex) = split /-/, $id; + + # Go through items in surveyOrder until we find the item corresponding to $id + my $currentIndex = 0; + for my $address (@{ $self->responseJSON->surveyOrder }) { + my ($order_sIndex, $order_qIndex) = @{$address}[0,1]; + + # For starters, check that we're on the right Section + if ($sIndex ne $order_sIndex) { + + # Bad luck, try the next one.. + $currentIndex++; + next; + } + + # For a match, either qIndex must be empty (target is a Section), or + # the qIndices must match + if (!defined $qIndex || $qIndex eq $order_qIndex) { + + # Set the nextResponse to be the index we're up to + $self->session->log->debug("Found id: $id at index: $currentIndex in surveyOrder"); + $self->responseJSON->nextResponse( $currentIndex ); + $self->persistResponseJSON(); # Manually persist ResponseJSON to the database + return $self->www_takeSurvey; + } + + # Keep looking.. + $currentIndex++; + } + + # Search failed, so return the Edit Survey page instead. + $self->session->log->debug("Unable to find id: $id"); + return $self->www_editSurvey; +} #------------------------------------------------------------------- @@ -349,18 +489,20 @@ Takes the address of a survey object and creates a copy. The copy is placed at Returns the address to the new object. +=head3 $address + +See L + =cut sub copyObject { my ( $self, $address ) = @_; - $self->loadSurveyJSON(); - - #each object checks the ref and then either updates or passes it to the correct child. New objects will have an index of -1. - $address = $self->survey->copy($address); - - $self->saveSurveyJSON(); + # Each object checks the ref and then either updates or passes it to the correct child. + # New objects will have an index of -1. + $address = $self->surveyJSON_copy($address); + # The parent address of the deleted object is returned. return $self->www_loadSurvey( { address => $address } ); } @@ -374,38 +516,33 @@ Returns the address to the parent object, or the very first section. =head3 $address -An array ref. The first element of the array ref is the index of -the section. The second element is the index of the question in -that section. The third element is the index of the answer. +See L =cut sub deleteObject { my ( $self, $address ) = @_; - $self->loadSurveyJSON(); + # Each object checks the ref and then either updates or passes it to the correct child. + # New objects will have an index of -1. + my $message = $self->surveyJSON_remove($address); - #each object checks the ref and then either updates or passes it to the correct child. New objects will have an index of -1. - my $message = $self->survey->remove($address); - - $self->saveSurveyJSON(); - - #The parent address of the deleted object is returned. - if ( @$address == 1 ) { - $$address[0] = 0; + # The parent address of the deleted object is returned. + if ( @{$address} == 1 ) { + $address->[0] = 0; } else { - pop( @{$address} ); # unless @$address == 1 and $$address[0] == 0; + pop @{$address}; } return $self->www_loadSurvey( { address => $address, message => $message } ); -} ## end sub deleteObject +} #------------------------------------------------------------------- =head2 www_newObject() -Creates a new object from a POST param containing the new objects id concat'd on hyphens. +Creates a new object from a POST param containing the new objects id concatenated on hyphens. =cut @@ -413,30 +550,28 @@ sub www_newObject { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) ); + if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); my $ref; - my $ids = $self->session->form->process("data"); + my $ids = $self->session->form->process('data'); my @inAddress = split /-/, $ids; - $self->loadSurveyJSON(); - - #Don't save after this as the new object should not stay in the survey - my $address = $self->survey->newObject( \@inAddress ); - - #The new temp object has an address of NEW, which means it is not a real final address. + # Don't save after this as the new object should not stay in the survey + my $address = $self->surveyJSON->newObject( \@inAddress ); + # The new temp object has an address of NEW, which means it is not a real final address. return $self->www_loadSurvey( { address => $address, message => undef } ); -} ## end sub www_newObject +} #------------------------------------------------------------------- =head2 www_dragDrop -Takes two ids from a form POST. The "target" is the object being moved, the "before" is the object directly preceding the "target". +Takes two ids from a form POST. +The "target" is the object being moved, the "before" is the object directly preceding the "target". =cut @@ -444,23 +579,26 @@ sub www_dragDrop { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) ); + if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); - my $p = from_json( $self->session->form->process("data") ); + my $p = from_json( $self->session->form->process('data') ); my @tid = split /-/, $p->{target}->{id}; my @bid = split /-/, $p->{before}->{id}; - $self->loadSurveyJSON(); - my $target = $self->survey->getObject( \@tid ); - $self->survey->remove( \@tid, 1 ); + my $target = $self->surveyJSON->getObject( \@tid ); + $self->surveyJSON_remove( \@tid, 1 ); my $address = [0]; if ( @tid == 1 ) { #sections can only be inserted after another section so chop off the question and answer portion of $#bid = 0; $bid[0] = -1 if ( !defined $bid[0] ); - $self->survey->insertObject( $target, [ $bid[0] ] ); + + #If target is being moved down, then before has just moved up do to the target being deleted + $bid[0]-- if($tid[0] < $bid[0]); + + $self->surveyJSON->insertObject( $target, [ $bid[0] ] ); } elsif ( @tid == 2 ) { #questions can be moved to any section, but a pushed to the end of a new section. if ( $bid[0] !~ /\d/ ) { @@ -473,43 +611,47 @@ sub www_dragDrop { $bid[1] = $tid[1]; } if ( $bid[0] == $tid[0] ) { - #moved to top of current section $bid[1] = -1; } else { - #else move to the end of the selected section - $bid[1] = $#{ $self->survey->questions( [ $bid[0] ] ) }; + $bid[1] = $#{ $self->surveyJSON->questions( [ $bid[0] ] ) }; } } ## end elsif ( @bid == 1 ) - $self->survey->insertObject( $target, [ $bid[0], $bid[1] ] ); + else{ #Moved within the same section + $bid[1]-- if($tid[1] < $bid[1]); + } + $self->surveyJSON->insertObject( $target, [ $bid[0], $bid[1] ] ); } ## end elsif ( @tid == 2 ) elsif ( @tid == 3 ) { #answers can only be rearranged in the same question - if ( @bid == 2 and $bid[1] == $tid[1] ) { + if ( @bid == 2 and $bid[1] == $tid[1] ) {#moved to the top of the question $bid[2] = -1; - $self->survey->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); + $self->surveyJSON->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); } elsif ( @bid == 3 ) { - $self->survey->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); + #If target is being moved down, then before has just moved up do to the target being deleted + $bid[2]-- if($tid[2] < $bid[2]); + $self->surveyJSON->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); } else { - #else put it back where it was - $self->survey->insertObject( $target, \@tid ); + $self->surveyJSON->insertObject( $target, \@tid ); } } - $self->saveSurveyJSON(); + # Manually persist SuveryJSON since we have directly modified it + $self->persistSurveyJSON(); return $self->www_loadSurvey( { address => $address } ); -} ## end sub www_dragDrop +} #------------------------------------------------------------------- -=head2 www_loadSurvey([options]) +=head2 www_loadSurvey( [options] ) -For loading the survey during editing. Returns the survey meta list and the html data for editing a particular survey object. +For loading the survey during editing. +Returns the survey meta list and the html data for editing a particular survey object. =head3 options @@ -522,17 +664,16 @@ sub www_loadSurvey { my ( $self, $options ) = @_; my $editflag = 1; - $self->loadSurveyJSON(); - my $address = defined $options->{address} ? $options->{address} : undef; if ( !defined $address ) { - if ( my $inAddress = $self->session->form->process("data") ) { - if( $inAddress eq '-' ) { - $editflag = 0; - $address = [ 0 ]; - } else { - $address = [ split /-/, $inAddress ]; - } + if ( my $inAddress = $self->session->form->process('data') ) { + if ( $inAddress eq q{-} ) { + $editflag = 0; + $address = [0]; + } + else { + $address = [ split /-/, $inAddress ]; + } } else { $address = [0]; @@ -541,26 +682,29 @@ sub www_loadSurvey { my $var = defined $options->{var} ? $options->{var} - : $self->survey->getEditVars($address); + : $self->surveyJSON->getEditVars($address); my $editHtml; if ( $var->{type} eq 'section' ) { - $editHtml = $self->processTemplate( $var, $self->get("sectionEditTemplateId") ); + $editHtml = $self->processTemplate( $var, $self->get('sectionEditTemplateId') ); } elsif ( $var->{type} eq 'question' ) { - $editHtml = $self->processTemplate( $var, $self->get("questionEditTemplateId") ); + $editHtml = $self->processTemplate( $var, $self->get('questionEditTemplateId') ); } elsif ( $var->{type} eq 'answer' ) { - $editHtml = $self->processTemplate( $var, $self->get("answerEditTemplateId") ); + $editHtml = $self->processTemplate( $var, $self->get('answerEditTemplateId') ); } + # Generate the list of valid goto targets + my @gotoTargets = $self->surveyJSON->getGotoTargets; + my %buttons; - $buttons{question} = $$address[0]; - if ( @$address == 2 or @$address == 3 ) { - $buttons{answer} = "$$address[0]-$$address[1]"; + $buttons{question} = $address->[0]; + if ( @{$address} == 2 or @{$address} == 3 ) { + $buttons{answer} = "$address->[0]-$address->[1]"; } - my $data = $self->survey->getDragDropList($address); + my $data = $self->surveyJSON->getDragDropList($address); my $html; my ( $scount, $qcount, $acount ) = ( -1, -1, -1 ); my $lastType; @@ -568,7 +712,7 @@ sub www_loadSurvey { my @ids; my ( $s, $q, $a ) = ( 0, 0, 0 ); #bools on if a button has already been created - foreach (@$data) { + foreach (@{$data}) { if ( $_->{type} eq 'section' ) { $lastId{section} = ++$scount; if ( $lastType eq 'answer' ) { @@ -586,33 +730,35 @@ sub www_loadSurvey { $a = 1; } $html .= "
  • Q" . ( $qcount + 1 ) . ": $_->{text}<\/li>
    \n"; - push( @ids, "$scount-$qcount" ); + push @ids, "$scount-$qcount"; $lastType = 'question'; $acount = -1; } elsif ( $_->{type} eq 'answer' ) { $lastId{answer} = ++$acount; - $html .= "
  • A" . ( $acount + 1 ) . ": $_->{text}<\/li>
    \n"; - push( @ids, "$scount-$qcount-$acount" ); + $html + .= "
  • A" + . ( $acount + 1 ) + . ": $_->{text}<\/li>
    \n"; + push @ids, "$scount-$qcount-$acount"; $lastType = 'answer'; } - } ## end foreach (@$data) + } - #address is the address of the focused object - #buttons are the data to create the Add buttons - #edithtml is the html edit the object - #ddhtml is the html to create the draggable html divs - #ids is a list of all ids passed in which are draggable (for adding events) - #type is the object type my $return = { - "address", $address, "buttons", \%buttons, - "edithtml", $editflag ? $editHtml : '', - "ddhtml", $html, "ids", \@ids, "type", $var->{type} + address => $address, # the address of the focused object + buttons => \%buttons, # the data to create the Add buttons + edithtml => $editflag ? $editHtml : q{}, # the html edit the object + ddhtml => $html, # the html to create the draggable html divs + ids => \@ids, # list of all ids passed in which are draggable (for adding events) + type => $var->{type}, # the object type + gotoTargets => \@gotoTargets, }; - #$self->session->http->setMimeType('application/json'); -# $self->session->http->setMimeType('application/json'); + + $self->session->http->setMimeType('application/json'); + return to_json($return); -} ## end sub www_loadSurvey +} #------------------------------------------------------------------- @@ -625,13 +771,14 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $templateId = $self->get("templateId"); - if ( $self->session->form->process("overrideTemplateId") ne "" ) { - $templateId = $self->session->form->process("overrideTemplateId"); + my $templateId = $self->get('templateId'); + if ( $self->session->form->process('overrideTemplateId') ne q{} ) { + $templateId = $self->session->form->process('overrideTemplateId'); } my $template = WebGUI::Asset::Template->new( $self->session, $templateId ); $template->prepare; $self->{_viewTemplate} = $template; + return; } #------------------------------------------------------------------- @@ -644,9 +791,9 @@ Completely remove from WebGUI. sub purge { my $self = shift; - $self->session->db->write( "delete from Survey_response where assetId = ?", [ $self->getId() ] ); - $self->session->db->write( "delete from Survey_tempReport where assetId = ?", [ $self->getId() ] ); - $self->session->db->write( "delete from Survey where assetId = ?", [ $self->getId() ] ); + $self->session->db->write( 'delete from Survey_response where assetId = ?', [ $self->getId() ] ); + $self->session->db->write( 'delete from Survey_tempReport where assetId = ?', [ $self->getId() ] ); + $self->session->db->write( 'delete from Survey where assetId = ?', [ $self->getId() ] ); return $self->SUPER::purge; } @@ -660,14 +807,8 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new( $self->session, "view_" . $self->getId )->delete; - $self->SUPER::purgeCache; -} - -#------------------------------------------------------------------- -sub purgeRevision { - my $self = shift; - return $self->SUPER::purgeRevision; + WebGUI::Cache->new( $self->session, 'view_' . $self->getId )->delete; + return $self->SUPER::purgeCache; } #------------------------------------------------------------------- @@ -684,13 +825,15 @@ sub view { my $var = $self->getMenuVars; my ( $code, $overTakeLimit ) = $self->getResponseInfoForView(); - $var->{'lastResponseCompleted'} = $code; - $var->{'lastResponseTimedOut'} = $code > 1 ? 1 : 0; - $var->{'maxResponsesSubmitted'} = $overTakeLimit; + + $var->{lastResponseCompleted} = $code; + $var->{lastResponseTimedOut} = $code > 1 ? 1 : 0; + $var->{maxResponsesSubmitted} = $overTakeLimit; + my $out = $self->processTemplate( $var, undef, $self->{_viewTemplate} ); return $out; -} ## end sub view +} #------------------------------------------------------------------- @@ -702,19 +845,19 @@ Returns the top menu template variables as a hashref. sub getMenuVars { my $self = shift; - my %var; - - $var{'edit_survey_url'} = $self->getUrl('func=editSurvey'); - $var{'take_survey_url'} = $self->getUrl('func=takeSurvey'); - $var{'view_simple_results_url'} = $self->getUrl('func=exportSimpleResults'); - $var{'view_transposed_results_url'} = $self->getUrl('func=exportTransposedResults'); - $var{'view_statistical_overview_url'} = $self->getUrl('func=viewStatisticalOverview'); - $var{'view_grade_book_url'} = $self->getUrl('func=viewGradeBook'); - $var{'user_canTakeSurvey'} = $self->session->user->isInGroup( $self->get("groupToTakeSurvey") ); - $var{'user_canViewReports'} = $self->session->user->isInGroup( $self->get("groupToViewReports") ); - $var{'user_canEditSurvey'} = $self->session->user->isInGroup( $self->get("groupToEditSurvey") ); - return \%var; + return { + edit_survey_url => $self->getUrl('func=editSurvey'), + take_survey_url => $self->getUrl('func=takeSurvey'), + delete_responses_url => $self->getUrl('func=deleteResponses'), + view_simple_results_url => $self->getUrl('func=exportSimpleResults'), + view_transposed_results_url => $self->getUrl('func=exportTransposedResults'), + view_statistical_overview_url => $self->getUrl('func=viewStatisticalOverview'), + view_grade_book_url => $self->getUrl('func=viewGradeBook'), + user_canTakeSurvey => $self->session->user->isInGroup( $self->get('groupToTakeSurvey') ), + user_canViewReports => $self->session->user->isInGroup( $self->get('groupToViewReports') ), + user_canEditSurvey => $self->session->user->isInGroup( $self->get('groupToEditSurvey') ), + }; } #------------------------------------------------------------------- @@ -731,13 +874,13 @@ sub getResponseInfoForView { my ( $code, $taken ); - my $maxTakes = $self->getValue("maxResponsesPerUser"); + my $maxTakes = $self->getValue('maxResponsesPerUser'); my $id = $self->session->user->userId(); my $anonId - = $self->session->form->process("userid") - || $self->session->http->getCookies->{"Survey2AnonId"} + = $self->session->form->process('userid') + || $self->session->http->getCookies->{Survey2AnonId} || undef; - $self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId); + $anonId && $self->session->http->setCookie( Survey2AnonId => $anonId ); my $ip = $self->session->env->getIp; my $string; @@ -763,91 +906,48 @@ sub getResponseInfoForView { "select count(*) from Survey_response where $string = ? and assetId = ? and isComplete > 0", [ $id, $self->getId() ] ); - } ## end if ( $anonId or $id !=... + } elsif ( $id == 1 ) { my $responseId = $self->session->db->quickScalar( - "select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0", + 'select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0', [ $id, $ip, $self->getId() ] ); if ( !$responseId ) { $code = $self->session->db->quickScalar( - "select isComplete from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete > 0 order by endDate desc limit 1", + 'select isComplete from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete > 0 order by endDate desc limit 1', [ $id, $ip, $self->getId() ] ); } $taken = $self->session->db->quickScalar( - "select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete > 0", + 'select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete > 0', [ $id, $ip, $self->getId() ] ); - } ## end elsif ( $id == 1 ) + } return ( $code, $taken >= $maxTakes ); -} ## end sub getResponseInfoForView - -#------------------------------------------------------------------- - -=head2 www_view ( ) - -See WebGUI::Asset::Wobject::www_view() for details. - -=cut - -sub www_view { - my $self = shift; - $self->SUPER::www_view(@_); } #------------------------------------------------------------------- =head2 www_takeSurvey -Returns the template needed to take the survey. This template dynamically loads the survey via async requests. +The take survey page does very little. It is a simple shell (controlled by surveyTakeTemplateId). + +Survey questions are loaded asynchronously via javascript calls to L<"www_loadQuestions">. =cut sub www_takeSurvey { my $self = shift; - my %var; - - eval { - my $responseId = $self->getResponseId(); - if ( !$responseId ) { - $self->session->log->debug('No responseId, surveyEnd'); - - # return $self->surveyEnd(); # disabled. let the js handle the exitUrl redirection - } - else { - $self->session->log->debug("ResponseId: $responseId"); - } - }; - - $self->session->style->setScript($self->session->url->extras('yui/build/utilities/utilities.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/container/container-min.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/menu/menu-min.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/button/button-min.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/calendar/calendar-min.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/json/json-min.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/logger/logger-min.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/resize/resize-min.js'), {type => - 'text/javascript'}); - $self->session->style->setScript($self->session->url->extras('yui/build/slider/slider-min.js'), {type => - 'text/javascript'}); - - my $out = $self->processTemplate( \%var, $self->get("surveyTakeTemplateId") ); - return $self->session->style->process( $out, $self->get("styleTemplateId") ); -} ## end sub www_takeSurvey + + my $out = $self->processTemplate( {}, $self->get('surveyTakeTemplateId') ); + return $self->session->style->process( $out, $self->get('styleTemplateId') ); +} #------------------------------------------------------------------- =head2 www_deleteResponses -Deletes all the responses from the survey. +Deletes all responses from this survey instance. =cut @@ -855,7 +955,7 @@ sub www_deleteResponses { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) ); + if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); $self->session->db->write( 'delete from Survey_response where assetId = ?', [ $self->getId ] ); @@ -878,22 +978,18 @@ sub www_submitQuestions { return $self->surveyEnd(); } - my $responseId = $self->getResponseId(); + my $responseId = $self->responseId(); if ( !$responseId ) { $self->session->log->debug('No response id, surveyEnd'); return $self->surveyEnd(); } my $responses = $self->session->form->paramsHashRef(); - delete $$responses{'func'}; + delete $responses->{func}; - my @goodResponses = keys %$responses; #load everything. + my @goodResponses = keys %{$responses}; #load everything. - $self->loadBothJSON(); - - my $termInfo = $self->response->recordResponses( $self->session, $responses ); - - $self->saveResponseJSON(); + my $termInfo = $self->recordResponses( $responses ); if ( $termInfo->[0] ) { $self->session->log->debug('Terminal, surveyEnd'); @@ -902,37 +998,38 @@ sub www_submitQuestions { return $self->www_loadQuestions(); - my $files = 0; +# my $files = 0; +# +# for my $id(@$orderOf){ +# if a file upload, write to disk +# my $path; +# if($id->{'questionType'} eq 'File Upload'){ +# $files = 1; +# my $storage = WebGUI::Storage->create($self->session); +# my $filename = $storage->addFileFromFormPost( $id->{'Survey_answerId'} ); +# $path = $storage->getPath($filename); +# } +# $self->session->errorHandler->error("Inserting a response ".$id->{'Survey_answerId'}." $responseId, $path, ".$$responses{$id->{'Survey_answerId'}}); +# $self->session->db->write("insert into Survey_questionResponse +# select ?, Survey_sectionId, Survey_questionId, Survey_answerId, ?, ?, ?, now(), ?, ? from Survey_answer where Survey_answerId = ?", +# [$self->getId(), $responseId, $$responses{ $id->{'Survey_answerId'} }, '', $path, ++$lastOrder, $id->{'Survey_answerId'}]); +# } +# if ($files) { +# ##special case, need to check for more questions in section, if not, more current up one +# my $lastA = $self->getLastAnswerInfo($responseId); +# my $questionId = $self->getNextQuestionId( $lastA->{'Survey_questionId'} ); +# if ( !$questionId ) { +# my $currentSection = $self->getCurrentSection($responseId); +# $currentSection = $self->getNextSection($currentSection); +# if ($currentSection) { +# $self->setCurrentSection( $responseId, $currentSection ); +# } +# } +# return; +# } +# return $self->www_loadQuestions($responseId); - # for my $id(@$orderOf){ - #if a file upload, write to disk - # my $path; - # if($id->{'questionType'} eq 'File Upload'){ - # $files = 1; - # my $storage = WebGUI::Storage->create($self->session); - # my $filename = $storage->addFileFromFormPost( $id->{'Survey_answerId'} ); - # $path = $storage->getPath($filename); - # } - #$self->session->errorHandler->error("Inserting a response ".$id->{'Survey_answerId'}." $responseId, $path, ".$$responses{$id->{'Survey_answerId'}}); - # $self->session->db->write("insert into Survey_questionResponse - # select ?, Survey_sectionId, Survey_questionId, Survey_answerId, ?, ?, ?, now(), ?, ? from Survey_answer where Survey_answerId = ?", - # [$self->getId(), $responseId, $$responses{ $id->{'Survey_answerId'} }, '', $path, ++$lastOrder, $id->{'Survey_answerId'}]); - # } - if ($files) { - ##special case, need to check for more questions in section, if not, more current up one - my $lastA = $self->getLastAnswerInfo($responseId); - my $questionId = $self->getNextQuestionId( $lastA->{'Survey_questionId'} ); - if ( !$questionId ) { - my $currentSection = $self->getCurrentSection($responseId); - $currentSection = $self->getNextSection($currentSection); - if ($currentSection) { - $self->setCurrentSection( $responseId, $currentSection ); - } - } - return; - } - return $self->www_loadQuestions($responseId); -} ## end sub www_submitQuestions +} #------------------------------------------------------------------- @@ -943,43 +1040,45 @@ Determines which questions to display to the survey taker next, loads and return =cut sub www_loadQuestions { - my $self = shift; + my $self = shift; + my $wasRestarted = shift; if ( !$self->canTakeSurvey() ) { $self->session->log->debug('canTakeSurvey false, surveyEnd'); return $self->surveyEnd(); } - my $responseId = $self->getResponseId(); #also loads the survey and response + my $responseId = $self->responseId(); if ( !$responseId ) { $self->session->log->debug('No responseId, surveyEnd'); return $self->surveyEnd(); } - if ( $self->response->hasTimedOut( $self->get('timeLimit') ) ) { + if ( $self->responseJSON->hasTimedOut( $self->get('timeLimit') ) ) { $self->session->log->debug('Response hasTimedOut, surveyEnd'); return $self->surveyEnd( undef, 2 ); } - if ( $self->response->surveyEnd() ) { + if ( $self->responseJSON->surveyEnd() ) { $self->session->log->debug('Response surveyEnd, so calling surveyEnd'); return $self->surveyEnd(); } - my $questions; - eval { $questions = $self->response->nextQuestions(); }; - - my $section = $self->response->nextSection(); + my @questions; + eval { @questions = $self->responseJSON->nextQuestions(); }; + + my $section = $self->responseJSON->nextResponseSection(); #return $self->prepareShowSurveyTemplate($section,$questions); - $section->{id} = $self->response->nextSectionId(); - my $text = $self->prepareShowSurveyTemplate( $section, $questions ); + $section->{id} = $self->responseJSON->nextResponseSectionIndex(); + $section->{wasRestarted} = $wasRestarted; + + my $text = $self->prepareShowSurveyTemplate( $section, \@questions ); + return $text; -} ## end sub www_loadQuestions +} #------------------------------------------------------------------- -#called when the survey is over. - =head2 surveyEnd ( [ $url ], [ $completeCode ] ) Marks the survey completed with either 1 or the $completeCode and then sends the url to the site home or if defined, $url. @@ -1004,35 +1103,38 @@ sub surveyEnd { $completeCode = defined $completeCode ? $completeCode : 1; - if ( my $responseId = $self->getResponseId() ) { #also loads the survey and response + if ( my $responseId = $self->responseId ) { # $self->session->db->write("update Survey_response set endDate = ? and isComplete > 0 where Survey_responseId = ?",[WebGUI::DateTime->now->toDatabase,$responseId]); $self->session->db->setRow( - "Survey_response", - "Survey_responseId", { + 'Survey_response', + 'Survey_responseId', { Survey_responseId => $responseId, - endDate => time(), #WebGUI::DateTime->now->toDatabase, + endDate => scalar time, #WebGUI::DateTime->now->toDatabase, isComplete => $completeCode } ); } - if ( $url !~ /\w/ ) { $url = 0; } - if ( $url eq "undefined" ) { $url = 0; } - if ( !$url ) { - $url - = $self->session->db->quickScalar( - "select exitURL from Survey where assetId = ? order by revisionDate desc limit 1", - [ $self->getId() ] ); + if ($self->get('doAfterTimeLimit') eq 'restartSurvey' && $completeCode == 2){ + $self->responseJSON->startTime(scalar time); + undef $self->{_responseJSON}; + undef $self->{responseId}; + return $self->www_loadQuestions('1'); + } else { + if ( $url !~ /\w/ ) { $url = 0; } + if ( $url eq 'undefined' ) { $url = 0; } if ( !$url ) { - $url = "/"; + $url = $self->get('exitURL'); + if ( !$url ) { + $url = q{/}; + } } } $url = $self->session->url->gateway($url); - #$self->session->http->setRedirect($url); #$self->session->http->setMimeType('application/json'); - my $json = to_json( { "type", "forward", "url", $url } ); + my $json = to_json( { type => 'forward', url => $url } ); return $json; -} ## end sub surveyEnd +} #------------------------------------------------------------------- @@ -1051,236 +1153,241 @@ sub prepareShowSurveyTemplate { 'Confidence', 1, 'Effectiveness', 1, 'Concern', 1, 'Risk', 1, 'Threat', 1, 'Security', 1 ); - my %text = ( 'Text', 1, 'Email', 1, 'Phone Number', 1, 'Text Date', 1, 'Currency', 1 ); - my %slider = ( 'Slider', 1, 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1 ); - my %dateType = ( 'Date', 1, 'Date Range', 1 ); - my %fileUpload = ( 'File Upload', 1 ); - my %hidden = ( 'Hidden', 1 ); + my %textArea = ( 'TextArea', 1 ); + my %text = ( 'Text', 1, 'Email', 1, 'Phone Number', 1, 'Text Date', 1, 'Currency', 1 ); + my %slider = ( 'Slider', 1, 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1 ); + my %dateType = ( 'Date', 1, 'Date Range', 1 ); + my %fileUpload = ( 'File Upload', 1 ); + my %hidden = ( 'Hidden', 1 ); foreach my $q (@$questions) { - if ( $fileUpload{ $$q{'questionType'} } ) { $q->{'fileLoader'} = 1; } - elsif ( $text{ $$q{'questionType'} } ) { $q->{'textType'} = 1; } - elsif ( $hidden{ $$q{'questionType'} } ) { $q->{'hidden'} = 1; } - elsif ( $multipleChoice{ $$q{'questionType'} } ) { - $q->{'multipleChoice'} = 1; - if ( $$q{'maxAnswers'} > 1 ) { - $q->{'maxMoreOne'} = 1; + if ( $fileUpload{ $q->{questionType} } ) { $q->{fileLoader} = 1; } + elsif ( $text{ $q->{questionType} } ) { $q->{textType} = 1; } + elsif ( $textArea{ $q->{questionType} } ) { $q->{textAreaType} = 1; } + elsif ( $hidden{ $q->{questionType} } ) { $q->{hidden} = 1; } + elsif ( $multipleChoice{ $q->{questionType} } ) { + $q->{multipleChoice} = 1; + if ( $q->{maxAnswers} > 1 ) { + $q->{maxMoreOne} = 1; } } - elsif ( $dateType{ $$q{'questionType'} } ) { - $q->{'dateType'} = 1; + elsif ( $dateType{ $q->{questionType} } ) { + $q->{dateType} = 1; } - elsif ( $slider{ $$q{'questionType'} } ) { - $q->{'slider'} = 1; - if ( $$q{'questionType'} eq 'Dual Slider - Range' ) { - $q->{'dualSlider'} = 1; - $q->{'a1'} = [ $q->{'answers'}->[0] ]; - $q->{'a2'} = [ $q->{'answers'}->[1] ]; + elsif ( $slider{ $q->{questionType} } ) { + $q->{slider} = 1; + if ( $q->{questionType} eq 'Dual Slider - Range' ) { + $q->{dualSlider} = 1; + $q->{a1} = [ $q->{answers}->[0] ]; + $q->{a2} = [ $q->{answers}->[1] ]; } } - if ( $$q{'verticalDisplay'} ) { - $$q{'verts'} = "

    "; - $$q{'verte'} = "

    "; + if ( $q->{verticalDisplay} ) { + $q->{verts} = '

    '; + $q->{verte} = '

    '; } - } ## end foreach my $q (@$questions) - $section->{'questions'} = $questions; - $section->{'questionsAnswered'} = $self->response->{questionsAnswered}; - $section->{'totalQuestions'} = @{ $self->response->surveyOrder }; - $section->{'showProgress'} = $self->get('showProgress'); - $section->{'showTimeLimit'} = $self->get('showTimeLimit'); - $section->{'minutesLeft'} - = int( ( ( $self->response->startTime() + ( 60 * $self->get('timeLimit') ) ) - time() ) / 60 ); + } + $section->{questions} = $questions; + $section->{questionsAnswered} = $self->responseJSON->{questionsAnswered}; + $section->{totalQuestions} = @{ $self->responseJSON->surveyOrder }; + $section->{showProgress} = $self->get('showProgress'); + $section->{showTimeLimit} = $self->get('showTimeLimit'); + $section->{minutesLeft} + = int( ( ( $self->responseJSON->startTime() + ( 60 * $self->get('timeLimit') ) ) - time() ) / 60 ); - my $out = $self->processTemplate( $section, $self->get("surveyQuestionsId") ); + if(scalar @{$questions} == ($section->{totalQuestions} - $section->{questionsAnswered})){ + $section->{isLastPage} = 1 + } -# $self->session->http->setMimeType('application/json'); - return to_json( { "type", "displayquestions", "section", $section, "questions", $questions, "html", $out } ); -} ## end sub prepareShowSurveyTemplate + my $out = $self->processTemplate( $section, $self->get('surveyQuestionsId') ); + + $self->session->http->setMimeType('application/json'); + return to_json( { type => 'displayquestions', section => $section, questions => $questions, html => $out } ); +} + +##------------------------------------------------------------------- +# +#=head2 loadBothJSON($rId) +# +#Loads both the Survey and the appropriate response objects from JSON. +# +#=head3 $rId +# +#The reponse id to load. +# +#=cut +# +#sub loadBothJSON { +# my $self = shift; +# my $rId = shift; +## if ( defined $self->surveyJSON and defined $self->responseJSON ) { return; } +# my $ref = $self->session->db->buildArrayRefOfHashRefs( " +# select s.surveyJSON,r.responseJSON +# from Survey s, Survey_response r +# where s.assetId = ? and r.Survey_responseId = ?", +# [ $self->getId, $rId ] ); +# $self->surveyJSON( $ref->[0]->{surveyJSON} ); +# $self->responseJSON( $ref->[0]->{responseJSON}, $rId ); +#} #------------------------------------------------------------------- -=head2 loadBothJSON($rId) +=head2 persistSurveyJSON ( ) -Loads both the Survey and the appropriate response objects from JSON. +Serializes the SurveyJSON instance and persists it to the database. -=head3 $rId - -The reponse id to load. +Calling this method is only required if you have directly accessed and modified +the L<"surveyJSON"> object. =cut -sub loadBothJSON { +sub persistSurveyJSON { my $self = shift; - my $rId = shift; - if ( defined $self->survey and defined $self->response ) { return; } - my $ref = $self->session->db->buildArrayRefOfHashRefs( " - select s.surveyJSON,r.responseJSON - from Survey s, Survey_response r - where s.assetId = ? and r.Survey_responseId = ?", - [ $self->getId, $rId ] ); - $self->loadSurveyJSON( $ref->[0]->{surveyJSON} ); - $self->loadResponseJSON( $ref->[0]->{responseJSON}, $rId ); + + my $data = $self->surveyJSON->freeze(); + $self->update({surveyJSON=>$data}); +# $self->session->db->write( 'update Survey set surveyJSON = ? where assetId = ?', [ $data, $self->getId ] ); + + return; } #------------------------------------------------------------------- -=head2 loadResponseJSON([$jsonHash],[$rId]) - -Loads the response object from JSON. - -=head3 $jsonHash - -Optional, but if the hash has been pulled from the DB before, there is no need to pull it again. - -=head3 $rId - -Optional, but if not passed in, it is grabbed. - -=cut - -sub loadResponseJSON { - my $self = shift; - my $jsonHash = shift; - my $rId = shift; - $rId = defined $rId ? $rId : $self->{responseId}; - if ( defined $self->response and !defined $rId ) { return; } - - $jsonHash - = $self->session->db->quickScalar( - "select responseJSON from Survey_response where assetId = ? and Survey_responseId = ?", - [ $self->getId, $rId ] ) - if ( !defined $jsonHash ); - - $self->{response} - = WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $jsonHash, $self->session->errorHandler, $self->survey ); -} ## end sub loadResponseJSON - -#------------------------------------------------------------------- - -=head3 saveResponseJSON +=head3 persistResponseJSON Turns the response object into JSON and saves it to the DB. =cut -sub saveResponseJSON { +sub persistResponseJSON { my $self = shift; - - my $data = $self->response->freeze(); - - $self->session->db->write( "update Survey_response set responseJSON = ? where Survey_responseId = ?", - - [ $data, $self->{responseId} ] ); + my $data = $self->responseJSON->freeze(); + $self->session->db->write( 'update Survey_response set responseJSON = ? where Survey_responseId = ?', [ $data, $self->responseId ] ); + return; } #------------------------------------------------------------------- -=head2 response +=head2 responseId -Helper to easily grab the response object and prevent typos. +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 response { +sub responseIdCookies { my $self = shift; - return $self->{response}; + 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 getResponseId +=head2 responseId -Determines the response id of the current user. If there is not a response for the user, a new one is created. -If the user is anonymous, the IP is used. Or an email'd or linked code can be used. +Accessor for the responseId property, which is the unique identifier for a single +L 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. =cut -sub getResponseId { +sub responseId { my $self = shift; - return $self->{responseId} if ( defined $self->{responseId} ); - my $ip = $self->session->env->getIp; - my $id = $self->session->user->userId(); - my $anonId - = $self->session->form->process("userid") - || $self->session->http->getCookies->{"Survey2AnonId"} - || undef; - $self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId); - - my $responseId; - - my $string; - - #if there is an anonid or id is for a WG user - if ( $anonId or $id != 1 ) { - $string = 'userId'; - if ($anonId) { - $string = 'anonId'; - $id = $anonId; + if (!defined $self->{responseId}) { + + my $ip = $self->session->env->getIp; + my $id = $self->session->user->userId; + my $anonId = $self->session->form->process('userid'); + if ($self->responseIdCookies) { + $anonId ||= $self->session->http->getCookies->{Survey2AnonId}; ## no critic } - $responseId - = $self->session->db->quickScalar( - "select Survey_responseId from Survey_response where $string = ? and assetId = ? and isComplete = 0", - [ $id, $self->getId() ] ); - - } - elsif ( $id == 1 ) { - $responseId = $self->session->db->quickScalar( - "select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0", - [ $id, $ip, $self->getId() ] - ); - } - - if ( !$responseId ) { - my $allowedTakes - = $self->session->db->quickScalar( - "select maxResponsesPerUser from Survey where assetId = ? order by revisionDate desc limit 1", - [ $self->getId() ] ); - my $haveTaken; - - if ( $id == 1 ) { - $haveTaken - = $self->session->db->quickScalar( - "select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ?", - [ $id, $ip, $self->getId() ] ); + $anonId ||= undef; + + if ($self->responseIdCookies) { + $anonId && $self->session->http->setCookie( Survey2AnonId => $anonId ); } - else { - $haveTaken + + my ($responseId, $string); + + # if there is an anonid or id is for a WG user + if ( $anonId or $id != 1 ) { + $string = 'userId'; + if ($anonId) { + $string = 'anonId'; + $id = $anonId; + } + $responseId = $self->session->db->quickScalar( - "select count(*) from Survey_response where $string = ? and assetId = ?", + "select Survey_responseId from Survey_response where $string = ? and assetId = ? and isComplete = 0", [ $id, $self->getId() ] ); + } - - if ( $haveTaken < $allowedTakes ) { - my $time = time(); - $responseId = $self->session->db->setRow( - "Survey_response", - "Survey_responseId", { - Survey_responseId => "new", - userId => $id, - ipAddress => $ip, - username => $self->session->user->username, - startDate => $time, #WebGUI::DateTime->now->toDatabase, - endDate => 0, #WebGUI::DateTime->now->toDatabase, - assetId => $self->getId(), - anonId => $anonId - } + elsif ( $id == 1 ) { + $responseId = $self->session->db->quickScalar( + 'select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0', + [ $id, $ip, $self->getId() ] ); - $self->loadBothJSON($responseId); - $self->response->createSurveyOrder(); - $self->{responseId} = $responseId; - $self->saveResponseJSON(); - - } ## end if ( $haveTaken < $allowedTakes) - else { - $self->session->log->debug("haveTaken ($haveTaken) >= allowedTakes ($allowedTakes)"); } - } ## end if ( !$responseId ) - $self->{responseId} = $responseId; - $self->loadBothJSON($responseId); - return $responseId; -} ## end sub getResponseId + + if ( !$responseId ) { + my $allowedTakes = $self->get('maxResponsesPerUser'); + my $haveTaken; + + if ( $id == 1 ) { + $haveTaken + = $self->session->db->quickScalar( + 'select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ?', + [ $id, $ip, $self->getId() ] ); + } + else { + $haveTaken + = $self->session->db->quickScalar( + "select count(*) from Survey_response where $string = ? and assetId = ?", + [ $id, $self->getId() ] ); + } + + if ( $haveTaken < $allowedTakes ) { + $responseId = $self->session->db->setRow( + 'Survey_response', + 'Survey_responseId', { + Survey_responseId => 'new', + userId => $id, + ipAddress => $ip, + username => $self->session->user->username, + startDate => scalar time, #WebGUI::DateTime->now->toDatabase, + endDate => 0, #WebGUI::DateTime->now->toDatabase, + assetId => $self->getId(), + anonId => $anonId + } + ); + + # Store the newly created responseId + $self->{responseId} = $responseId; + + # Manually persist ResponseJSON since we have changed $self->responseId + $self->persistResponseJSON(); + } + else { + $self->session->log->debug("haveTaken ($haveTaken) >= allowedTakes ($allowedTakes)"); + } + } + $self->{responseId} = $responseId; + } + return $self->{responseId}; +} #------------------------------------------------------------------- @@ -1295,26 +1402,25 @@ sub canTakeSurvey { return $self->{canTake} if ( defined $self->{canTake} ); - if ( !$self->session->user->isInGroup( $self->get("groupToTakeSurvey") ) ) { + if ( !$self->session->user->isInGroup( $self->get('groupToTakeSurvey') ) ) { return 0; } - #Does user have too many finished survey responses - my $maxTakes = $self->getValue("maxResponsesPerUser"); + my $maxTakes = $self->getValue('maxResponsesPerUser'); my $ip = $self->session->env->getIp; my $id = $self->session->user->userId(); my $takenCount = 0; if ( $id == 1 ) { $takenCount = $self->session->db->quickScalar( - "select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ? - and isComplete > ?", [ $id, $ip, $self->getId(), 0 ] + 'select count(*) from Survey_response where userId = ? and ipAddress = ? ' + . 'and assetId = ? and isComplete > ?', [ $id, $ip, $self->getId(), 0 ] ); } else { $takenCount = $self->session->db->quickScalar( - "select count(*) from Survey_response where userId = ? and assetId = ? and isComplete > ?", + 'select count(*) from Survey_response where userId = ? and assetId = ? and isComplete > ?', [ $id, $self->getId(), 0 ] ); } @@ -1326,7 +1432,7 @@ sub canTakeSurvey { } return $self->{canTake}; -} ## end sub canTakeSurvey +} #------------------------------------------------------------------- @@ -1341,41 +1447,40 @@ sub www_viewGradeBook { my $db = $self->session->db; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get("groupToViewReports") ) ); + if !$self->session->user->isInGroup( $self->get('groupToViewReports') ); my $var = $self->getMenuVars; $self->loadTempReportTable(); my $paginator = WebGUI::Paginator->new($self->session,$self->getUrl('func=viewGradebook')); - $paginator->setDataByQuery("select userId,username,ipAddress,Survey_responseId,startDate,endDate - from Survey_response - where assetId=".$db->quote($self->getId)." order by username,ipAddress,startDate"); + $paginator->setDataByQuery('select userId,username,ipAddress,Survey_responseId,startDate,endDate' + . ' from Survey_response where assetId=' + . $db->quote($self->getId) + . ' order by username,ipAddress,startDate'); my $users = $paginator->getPageData; - $self->loadSurveyJSON(); - $var->{question_count} = $self->survey->questionCount; + $var->{question_count} = $self->surveyJSON->questionCount; my @responseloop; - foreach my $user (@$users) { - my ($correctCount) = $db->quickArray("select count(*) from Survey_tempReport - where Survey_responseId=? and isCorrect=1",[$user->{Survey_responseId}]); - push(@responseloop, { + foreach my $user (@{$users}) { + my ($correctCount) = $db->quickArray('select count(*) from Survey_tempReport' + . ' where Survey_responseId=? and isCorrect=1',[$user->{Survey_responseId}]); + push @responseloop, { # response_url is left out because it looks like Survey doesn't have a viewIndividualSurvey feature # yet. #'response_url'=>$self->getUrl('func=viewIndividualSurvey;responseId='.$user->{Survey_responseId}), 'response_user_name'=>($user->{userId} eq '1') ? $user->{ipAddress} : $user->{username}, 'response_count_correct' => $correctCount, 'response_percent' => round(($correctCount/$var->{question_count})*100) - }); + }; } $var->{response_loop} = \@responseloop; $paginator->appendTemplateVars($var); - my $out = $self->processTemplate( $var, $self->get("gradebookTemplateId") ); - return $self->session->style->process( $out, $self->get("styleTemplateId") ); - -} ## end sub www_viewGradeBook + my $out = $self->processTemplate( $var, $self->get('gradebookTemplateId') ); + return $self->session->style->process( $out, $self->get('styleTemplateId') ); +} #------------------------------------------------------------------- @@ -1390,11 +1495,10 @@ sub www_viewStatisticalOverview { my $db = $self->session->db; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get("groupToViewReports") ) ); + if !$self->session->user->isInGroup( $self->get('groupToViewReports') ); $self->loadTempReportTable(); - $self->loadSurveyJSON(); - my $survey = $self->survey; + my $survey = $self->surveyJSON; my $var = $self->getMenuVars; my $paginator = WebGUI::Paginator->new($self->session,$self->getUrl('func=viewStatisticalOverview')); @@ -1405,13 +1509,13 @@ sub www_viewStatisticalOverview { my $questionType = $question->{questionType}; my (@answerloop, $totalResponses);; - if ($questionType eq "Multiple Choice"){ - $totalResponses = $db->quickScalar("select count(*) from Survey_tempReport - where sectionNumber=? and questionNumber=?",[$sectionIndex,$questionIndex]); + if ($questionType eq 'Multiple Choice'){ + $totalResponses = $db->quickScalar('select count(*) from Survey_tempReport' + . ' where sectionNumber=? and questionNumber=?',[$sectionIndex,$questionIndex]); for ( my $answerIndex = 0; $answerIndex <= $#{ $survey->answers([$sectionIndex,$questionIndex]) }; $answerIndex++ ) { - my $numResponses = $db->quickScalar("select count(*) from Survey_tempReport - where sectionNumber=? and questionNumber=? and answerNumber=?", + my $numResponses = $db->quickScalar('select count(*) from Survey_tempReport' + . ' where sectionNumber=? and questionNumber=? and answerNumber=?', [$sectionIndex,$questionIndex,$answerIndex]); my $responsePercent; if ($totalResponses) { @@ -1420,43 +1524,43 @@ sub www_viewStatisticalOverview { $responsePercent = 0; } my @commentloop; - my $comments = $db->read("select answerComment from Survey_tempReport - where sectionNumber=? and questionNumber=? and answerNumber=?", + my $comments = $db->read('select answerComment from Survey_tempReport' + . ' where sectionNumber=? and questionNumber=? and answerNumber=?', [$sectionIndex,$questionIndex,$answerIndex]); while (my ($comment) = $comments->array) { - push(@commentloop,{ + push @commentloop,{ 'answer_comment'=>$comment - }); + }; } - push(@answerloop,{ + push @answerloop,{ 'answer_isCorrect'=>$survey->answer( [ $sectionIndex, $questionIndex, $answerIndex ] )->{isCorrect}, 'answer' => $survey->answer( [ $sectionIndex, $questionIndex, $answerIndex ] )->{text}, 'answer_response_count' =>$numResponses, 'answer_response_percent' =>$responsePercent, 'comment_loop'=>\@commentloop - }); + }; } } else{ - my $responses = $db->read("select value,answerComment from Survey_tempReport - where sectionNumber=? and questionNumber=?", - [$sectionIndex,$questionIndex]); + my $responses = $db->read('select value,answerComment from Survey_tempReport' + . ' where sectionNumber=? and questionNumber=?', + [$sectionIndex,$questionIndex]); while (my $response = $responses->hashRef) { - push(@answerloop,{ + push @answerloop,{ 'answer_value' =>$response->{value}, 'answer_comment' =>$response->{answerComment} - }); + }; } } - push(@questionloop,{ - 'question' => $question->{text}, - 'question_id' => $sectionIndex.'_'.$questionIndex, - 'question_isMultipleChoice' => ($questionType eq "Multiple Choice"), - 'question_response_total' => $totalResponses, - 'answer_loop' => \@answerloop, - 'questionallowComment' => $question->{allowComment} - }); - } ## end for ( my $questionIndex = 0; $questionIndex <= ... + push @questionloop, { + question => $question->{text}, + question_id => "${sectionIndex}_$questionIndex", + question_isMultipleChoice => ($questionType eq 'Multiple Choice'), + question_response_total => $totalResponses, + answer_loop => \@answerloop, + questionallowComment => $question->{allowComment} + }; + } } $paginator->setDataByArrayRef(\@questionloop); @questionloop = @{$paginator->getPageData}; @@ -1464,8 +1568,8 @@ sub www_viewStatisticalOverview { $var->{question_loop} = \@questionloop; $paginator->appendTemplateVars($var); - my $out = $self->processTemplate( $var, $self->get("overviewTemplateId") ); - return $self->session->style->process( $out, $self->get("styleTemplateId") ); + my $out = $self->processTemplate( $var, $self->get('overviewTemplateId') ); + return $self->session->style->process( $out, $self->get('styleTemplateId') ); } #------------------------------------------------------------------- @@ -1473,14 +1577,14 @@ sub www_exportSimpleResults { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get("groupToViewReports") ) ); + if !$self->session->user->isInGroup( $self->get('groupToViewReports')); $self->loadTempReportTable(); - my $filename = $self->session->url->escape( $self->get("title") . "_results.tab" ); + my $filename = $self->session->url->escape( $self->get('title') . '_results.tab' ); my $content = $self->session->db->quickTab( - "select * from Survey_tempReport t where t.assetId=? order by t.Survey_responseId, t.order", + 'select * from Survey_tempReport t where t.assetId=? order by t.Survey_responseId, t.order', [ $self->getId() ] ); return $self->export( $filename, $content ); } @@ -1496,18 +1600,18 @@ Returns transposed results as a tabbed file. sub www_exportTransposedResults { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get("groupToViewReports") ) ); + if !$self->session->user->isInGroup( $self->get('groupToViewReports') ); $self->loadTempReportTable(); - my $filename = $self->session->url->escape( $self->get("title") . "_transposedResults.tab" ); + my $filename = $self->session->url->escape( $self->get('title') . '_transposedResults.tab' ); my $content = $self->session->db->quickTab( - "select r.userId, r.username, r.ipAddress, r.startDate, r.endDate, r.isComplete, t.* - from Survey_tempReport t - left join Survey_response r using(Survey_responseId) - where t.assetId=? - order by r.userId, r.Survey_responseId, t.order", + 'select r.userId, r.username, r.ipAddress, r.startDate, r.endDate, r.isComplete, t.*' + . ' from Survey_tempReport t' + . ' left join Survey_response r using(Survey_responseId)' + . ' where t.assetId=?' + . ' order by r.userId, r.Survey_responseId, t.order', [ $self->getId() ] ); return $self->export( $filename, $content ); } @@ -1534,12 +1638,12 @@ sub export { $filename =~ s/[^\w\d\.]/_/g; my $content = shift; - #Create a temporary directory to store files if it doesn't already exist + # Create a temporary directory to store files if it doesn't already exist my $store = WebGUI::Storage->createTemp( $self->session ); my $tmpDir = $store->getPath(); my $filepath = $store->getPath($filename); - unless ( open TEMP, ">$filepath" ) { - return "Error - Could not open temporary file for writing. Please use the back button and try again"; + if ( !open TEMP, ">$filepath" ) { + return 'Error - Could not open temporary file for writing. Please use the back button and try again'; } print TEMP $content; close TEMP; @@ -1548,9 +1652,7 @@ sub export { $self->session->http->setRedirect($fileurl); return undef; -} ## end sub export - - +} #------------------------------------------------------------------- @@ -1563,17 +1665,16 @@ Loads the responses from the survey into the Survey_tempReport table, so that ot sub loadTempReportTable { my $self = shift; - $self->loadSurveyJSON(); - my $refs = $self->session->db->buildArrayRefOfHashRefs( "select * from Survey_response where assetId = ?", + my $refs = $self->session->db->buildArrayRefOfHashRefs( 'select * from Survey_response where assetId = ?', [ $self->getId() ] ); - $self->session->db->write( "delete from Survey_tempReport where assetId = ?", [ $self->getId() ] ); - for my $ref (@$refs) { - $self->loadResponseJSON( undef, $ref->{Survey_responseId} ); + $self->session->db->write( 'delete from Survey_tempReport where assetId = ?', [ $self->getId() ] ); + for my $ref (@{$refs}) { + $self->responseJSON( undef, $ref->{Survey_responseId} ); my $count = 1; - for my $q ( @{ $self->response->returnResponseForReporting() } ) { + for my $q ( @{ $self->responseJSON->returnResponseForReporting() } ) { if ( @{ $q->{answers} } == 0 and $q->{comment} =~ /\w/ ) { $self->session->db->write( - "insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", [ + 'insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)', [ $self->getId(), $ref->{Survey_responseId}, $count++, $q->{section}, $q->{sectionName}, $q->{question}, $q->{questionName}, $q->{questionComment}, undef, undef, undef, undef, @@ -1584,7 +1685,7 @@ sub loadTempReportTable { } for my $a ( @{ $q->{answers} } ) { $self->session->db->write( - "insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", [ + 'insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)', [ $self->getId(), $ref->{Survey_responseId}, $count++, $q->{section}, $q->{sectionName}, $q->{question}, $q->{questionName}, $q->{questionComment}, $a->{id}, $a->{value}, $a->{comment}, $a->{time}, @@ -1592,14 +1693,36 @@ sub loadTempReportTable { ] ); } - } ## end for my $q ( @{ $self->response... - } ## end for my $ref (@$refs) + } + } return 1; -} ## end sub loadTempReportTable +} -sub log { +#------------------------------------------------------------------- + +=head2 www_editDefaultQuestions + +Allows a user to edit the *site wide* default multiple choice questions displayed when adding questions to a survey. + +=cut + +sub www_editDefaultQuestions{ my $self = shift; - $self->session->log->debug(shift); + my $warning = shift; + my $session = $self->session; + my ($output); + my $bundleId = $session->form->process("bundleId"); + + if($bundleId eq 'new'){ + + + + } + + if($warning){$output .= "$warning";} +# $output .= $tabForm->print; + + } 1; diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index a8bbb3b35..fa0de8c4a 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm @@ -18,152 +18,222 @@ Package WebGUI::Asset::Wobject::Survey::ResponseJSON =head1 DESCRIPTION -Helper class for WebGUI::Asset::Wobject::Survey. It manages data -from the user, sets the order of questions and answers in the survey, -based on forks, and gotos, and also handles expiring the survey -due to time limits. +Helper class for WebGUI::Asset::Wobject::Survey. The class deals with both a +"reponse" in the sense of an overall Survey response, and also "response" in +the sense of a single Question response (which is closely related to an Answer but +not quite the same). + +As a whole, this class represents the complete state of a user's response to a Survey instance. + +At the heart of this class is a perl hash that can be serialized +as JSON to the database to allow for storage and retrieval of the complete state +of a survey response. + +Survey instances that allow users to record multiple responses will persist multiple +instances of this class to the database (one per distinct user response). + +Data stored in this object include the order in which questions and answers are +presented to the user (L<"surveyOrder">), a snapshot of all completed questions +from the user (L<"responses">), the most recently answered question (L<"lastResponse">), the +number of questions answered (L<"questionsAnswered">) and the Survey start time (L<"startTime">). This package is not intended to be used by any other Asset in WebGUI. -=cut +=head2 surveyOrder + +This data strucutre is an array (reference) of Survey addresses (see +L), stored in the order +in which items are presented to the user. +By making use of L methods which expect address params as +arguments, you can access Section/Question/Answer items in order by iterating over surveyOrder. + +For example: + + # Access sections in order.. + for my $address (@{ $self->surveyOrder }) { + my $section = $self->survey->section( $address ); + # etc.. + } + +In general, the surveyOrder data structure looks like: + + [ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....] + +There is one array element for every section and address in the survey. If there are +no questions, or no addresses, those array elements will not be present. + +=head2 responses + +This data structure stores a snapshot of all question responses. Both question data and answer data +is stored in this hash reference. + +Questions keys are constructed by hypenating the relevant L<"sIndex"> and L<"qIndex">. +Answer keys are constructed by hypenating the relevant L<"sIndex">, L<"qIndex"> and L<"aIndex">. + +Question entries only contain a comment field: + { + ... + questionId => { + comment => "question comment", + } + ... + } + +Answers entries contain: value (the recorded value), time and comment fields. + + { + ... + answerId => { + value => "answer value", + time => time(), + comment => "answer comment", + }, + ... + } + +=cut use strict; use JSON; -use Data::Dumper; +use Params::Validate qw(:all); +use List::Util qw(shuffle); +Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); #------------------------------------------------------------------- -=head2 new ( $json, $log, $survey ) +=head2 new ( $survey, $json ) Object constructor. -=head3 $json - -Pass in some JSON to be serialized into a data structure. Useful JSON would -contain a hash with "startTime", "surveyOrder", "responses", "lastReponse" -and "questionsAnswered" keys, with appropriate values. - -=head3 $log - -The session logger, from $session->log. The class needs nothing else from the -session object. - =head3 $survey -A WebGUI::Asset::Wobject::Survey::SurveyJSON object that represents the current +A L object that represents the current survey. +=head3 $json + +A JSON string used to construct a new Perl object. The string should represent +a JSON hash made up of L<"startTime">, L<"surveyOrder">, L<"responses">, L<"lastReponse"> +and L<"questionsAnswered"> keys, with appropriate values. + =cut sub new { my $class = shift; - my $json = shift; - my $log = shift; - my $survey = shift; - my $temp = from_json($json) if defined $json; - my $self = defined $temp ? $temp : {}; - $self->{survey} = $survey; - $self->{log} = $log; - $self->{responses} = defined $temp->{responses} ? $temp->{responses} : {}; - $self->{lastResponse} = defined $temp->{lastResponse} ? $temp->{lastResponse} : -1; - $self->{questionsAnswered} = defined $temp->{questionsAnswered} ? $temp->{questionsAnswered} : 0; - $self->{startTime} = defined $temp->{startTime} ? $temp->{startTime} : time(); - #an array of question addresses, with the third member being an array of answers - $self->{surveyOrder} = defined $temp->{surveyOrder} ? $temp->{surveyOrder} : []; - bless( $self, $class ); - return $self; -} ## end sub new + my ($survey, $json) = validate_pos(@_, {isa => 'WebGUI::Asset::Wobject::Survey::SurveyJSON' }, { type => SCALAR | UNDEF, optional => 1}); + + # Load json object if given.. + my $jsonData = $json ? from_json($json) : {}; + + # Create skeleton object.. + my $self = { + # First define core members.. + _survey => $survey, + _session => $survey->session, + + # Store all properties that are (de)serialized to/from JSON in a private variable + _response => { + + # Response hash defaults.. + responses => {}, + lastResponse => -1, + questionsAnswered => 0, + startTime => time(), + surveyOrder => undef, + + # And then allow jsonData to override defaults and/or add other members + %{$jsonData}, + }, + }; + + return bless $self, $class; +} #---------------------------------------------------------------------------- -=head2 createSurveyOrder ( SurveyJSON, [address,address] ) +=head2 initSurveyOrder -This creates the order for the survey which will change after every fork. The survey -order is to precreate random questions and answers, which also leaves a record or what -the user was presented with. Forks are passed in to show where to branch the new order. +Computes and stores the order of Sections, Questions and Aswers for this Survey. +See L<"surveyOrder">. You normally don't need to call this, as L<"surveyOrder"> will +call it for you the first time it is used. -If questions and/or answers were set to be randomized, it is handled in here. +Questions and Answers that are set to be randomized are shuffled into a random order. =cut -sub createSurveyOrder { +sub initSurveyOrder { my $self = shift; - my $order; - my $qstarting = 0; - for ( my $s = 0; $s <= $#{ $self->survey->sections() }; $s++ ) { - #create question order for section - my @qorder; - if ( $self->survey->section( [$s] )->{randomizeQuestions} ) { - @qorder = shuffle( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); + # Order Questions in each Section + my @surveyOrder; + for my $sIndex ( 0 .. $self->survey->lastSectionIndex ) { + + # Randomize Questions if required.. + my @qOrder; + if ( $self->survey->section( [$sIndex] )->{randomizeQuestions} ) { + @qOrder = shuffle 0 .. $self->survey->lastQuestionIndex( [$sIndex] ); } else { - @qorder = ( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); + @qOrder = ( 0 .. $self->survey->lastQuestionIndex( [$sIndex] ) ); } - #if this is an empty section, make sure it is still on the list to be seen - if ( @qorder == 0 ) { - push( @$order, [$s] ); - } - $qstarting = 0; + # Order Answers in each Question + for my $q (@qOrder) { - #create answer order for question - for (@qorder) { - my @aorder; - if ( $self->survey->question( [ $s, $_ ] )->{randomizeAnswers} ) { - @aorder = shuffle( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) ); + # Randomize Answers if required.. + my @aOrder; + if ( $self->survey->question( [ $sIndex, $q ] )->{randomizeAnswers} ) { + @aOrder = shuffle 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] ); } else { - @aorder = ( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) ); + @aOrder = ( 0 .. $self->survey->lastAnswerIndex( [ $sIndex, $q ] ) ); } - push( @$order, [ $s, $_, \@aorder ] ); + push @surveyOrder, [ $sIndex, $q, \@aOrder ]; } - } ## end for ( my $s = 0; $s <= ... - $self->{surveyOrder} = $order; -} ## end sub createSurveyOrder + + # If Section had no Questions, make sure it is still added to @surveyOrder + if ( !@qOrder ) { + push @surveyOrder, [$sIndex]; + } + } + $self->response->{surveyOrder} = \@surveyOrder; + + return; +} #------------------------------------------------------------------- -=head2 shuffle ( @array ) +=head2 session -Returns the contents of @array in a random order. +Accessor method for the WebGUI::Session reference =cut -sub shuffle { - my @a = splice @_; - for my $i ( 0 .. $#a ) { - my $j = int rand @a; - @a[ $i, $j ] = @a[ $j, $i ]; - } - return @a; +sub session { + my $self = shift; + return $self->{_session}; } #------------------------------------------------------------------- =head2 freeze -Serializes the object to JSON, after deleting the log and survey objects stored in it. +Serializes the internal perl hash representing the Response to a JSON string =cut sub freeze { my $self = shift; - my %temp = %{$self}; - delete $temp{log}; - delete $temp{survey}; - return to_json( \%temp ); + return to_json($self->response); } #------------------------------------------------------------------- -#Has the survey timed out? - =head2 hasTimedOut ( $limit ) Checks to see whether this survey has timed out, based on the internally stored starting -time, and $limit. +time, and the suppied $limit value. =head3 $limit @@ -172,418 +242,780 @@ How long the user has to take the survey, in minutes. =cut sub hasTimedOut{ - my $self=shift; - my $limit = shift; - return 1 if($self->startTime() + ($limit * 60) < time() and $limit > 0); - return 0; + my $self = shift; + my ($limit) = validate_pos(@_, {type => SCALAR}); + return $limit > 0 && $self->startTime + $limit * 60 < time; } #------------------------------------------------------------------- -#the index of the last surveyOrder entry shown - =head2 lastResponse ([ $responseIndex ]) -Mutator for the index of the last surveyOrder entry shown. With no arguments, -returns the lastResponse index. +Mutator. The lastResponse property represents the index of the most recent surveyOrder entry shown. -=head3 $responseIndex +This method returns (and optionally sets) the value of lastResponse. -If defined, sets the lastResponse to $responseIndex. +=head3 $responseIndex (optional) + +If defined, lastResponse is set to $responseIndex. =cut sub lastResponse { my $self = shift; - my $res = shift; - if ( defined $res ) { - $self->{lastResponse} = $res; - } - else { - return $self->{lastResponse}; + my ($responseIndex) = validate_pos(@_, {type => SCALAR, optional => 1}); + + if ( defined $responseIndex ) { + $self->response->{lastResponse} = $responseIndex; } + + return $self->response->{lastResponse}; } #------------------------------------------------------------------- =head2 questionsAnswered ([ $questionsAnswered ]) -Mutator for the number of questions answered. With no arguments, -does a set. +Mutator for the number of questions answered. +Returns (and optionally sets) the value of questionsAnswered. -=head3 $questionsAnswered. +=head3 $questionsAnswered (optional) If defined, increments the number of questions by $questionsAnswered =cut sub questionsAnswered { - my $self = shift; - my $answered = shift; - if ( defined $answered ) { - $self->{questionsAnswered} += $answered; - } - else { - return $self->{questionsAnswered}; + my $self = shift; + my ($questionsAnswered) = validate_pos(@_, {type => SCALAR, optional => 1}); + + if ( defined $questionsAnswered ) { + $self->response->{questionsAnswered} += $questionsAnswered; } + + return $self->response->{questionsAnswered}; } #------------------------------------------------------------------- -=head2 startTime ([ $newStartTime ]) +=head2 startTime ([ $startTime ]) -Mutator for the time the user began the survey. With no arguments, -returns the startTime. +Mutator for the time the user began the survey. +Returns (and optionally sets) the value of startTime. -=head3 $newStarttime +=head3 $startTime (optional) -If defined, sets the starting time to $newStartTime. +If defined, sets the starting time to $startTime. =cut sub startTime { my $self = shift; - my $newTime = shift; - if ( defined $newTime ) { - $self->{startTime} = $newTime; - } - else { - return $self->{startTime}; + my ($startTime) = validate_pos(@_, {type => SCALAR, optional => 1}); + + if ( defined $startTime ) { + $self->response->{startTime} = $startTime; } + + return $self->response->{startTime}; } #------------------------------------------------------------------- -#array of addresses in which the survey should be presented - =head2 surveyOrder -Accessor for the survey order data structure. It is a deep set of arrays, similar in -structure to a WebGUI::Asset::Wobject::Survey::SurveyJSON address. - - [ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....] - -There is one array element for every section and address in the survey. - -If there are no questions, or no addresses, those array elements will not be present. +Accessor for surveyOrder (see L<"surveyOrder">). +Initialized on first access via L<"initSurveyOrder">. =cut sub surveyOrder { my $self = shift; - return $self->{surveyOrder}; + + if (!defined $self->response->{surveyOrder}) { + $self->initSurveyOrder(); + } + + return $self->response->{surveyOrder}; } #------------------------------------------------------------------- -=head2 nextSectionId +=head2 nextResponse ([ $responseIndex ]) -Relative to the surveyOrder and the lastResponse index, get the index of the -next section. Note, based on the number of questions in an section, this can -be the same as the current section index. +Mutator. The index of the next item that should be shown to the user, +that is, the index of the next item in the L<"surveyOrder"> array, +e.g. L<"lastResponse"> + 1. + +=head3 $responseIndex (optional) + +If defined, nextResponse is set to $responseIndex. =cut -sub nextSectionId { +sub nextResponse { + my $self = shift; + my ($responseIndex) = validate_pos(@_, {type => SCALAR, optional => 1}); + + if ( defined $responseIndex ) { + $self->lastResponse($responseIndex - 1); + } + + return $self->lastResponse() + 1 +} + +#------------------------------------------------------------------- + +=head2 nextResponseSectionIndex + +Returns the Section index of the next item that should be +shown to the user, that is, the next item in the L<"surveyOrder"> array +relative to L<"lastResponse">. + +We go to the effort of calling this property "nextResponseSectionIndex" +rather than just "nextSectionIndex" to emphasize that this property is +distinct from the "next" section index in the Survey. For example, in +a Section with multiple Questions, the value of nextResponseSectionIndex +will be the same value (the current section index) for all Questions +except the last Question. + +=cut + +sub nextResponseSectionIndex { my $self = shift; return undef if $self->surveyEnd(); - return $self->surveyOrder->[ $self->lastResponse + 1 ]->[0]; + return $self->surveyOrder->[ $self->nextResponse ]->[0]; } #------------------------------------------------------------------- -=head2 nextSection +=head2 nextResponseSection -Relative to the surveyOrder and the lastResponse index, gets the next section. -Note, based on the number of questions in a section, this can be the same as -the current section. +Returns the Section corresponding to the next item that should be +shown to the user, that is, the next item in the L<"surveyOrder"> array +relative to L<"lastResponse">. + +As with L<"nextResponseSectionIndex">, we go to the effort of calling this property "nextResponseSection" +rather than just "nextSection" to emphasize that this property is +distinct from the "next" section in the Survey. =cut -sub nextSection { +sub nextResponseSection { my $self = shift; + return {} if $self->surveyEnd(); - return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] ); + return $self->survey->section( [ $self->nextResponseSectionIndex ] ); } #------------------------------------------------------------------- -=head2 currentSection +=head2 lastResponseSectionIndex -Relative to the surveyOrder and the lastResponse index, get the current section. +Returns the Section index of the last item that was shown to the user, +based on the L<"surveyOrder"> array and L<"lastResponse">. =cut -sub currentSection { +sub lastResponseSectionIndex { my $self = shift; - return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse ]->[0] ] ); + return $self->surveyOrder->[ $self->lastResponse ]->[0]; } #------------------------------------------------------------------- -=head2 recordResponses ($session, $responses) +=head2 recordResponses ($responses) -Takes survey responses and puts them into the response hash of this object. Does terminal -handling for sections and questions, and goto processing. Advances the survey page if -all required questions have been answered. - -=head3 $session - -A WebGUI session object +Processes and records submitted survey responses in the L<"responses"> data structure. +Does terminal handling, and branch processing, and advances the L<"lastResponse"> index +if all required questions have been answered. =head3 $responses -A hash ref of form param data. Each element will look like: +A hash ref of form param data. Each element should look like: { - "__qid__comment" => "question comment", - "__aid__" => "answer", - "__aid__comment" => "answer comment", + "questionId-comment" => "question comment", + "answerId" => "answer", + "answerId-comment" => "answer comment", } -where __qid__ is a question id, as described in L, and __aid__ is an -answer id, also described there. +See L<"questionId"> and L<"answerId">. -=head3 terminal processing +=head3 Terminal processing Terminal processing for a section and its questions and answers are handled in order. The terminalUrl setting in a question overrides the terminalUrl setting for its section. Similarly, with questions and answers, the last terminalUrl setting of the set of questions is what is returned for the page, with the questions -and answers being answered in surveyOrder. +and answers being answered in L<"surveyOrder">. -=head3 goto processing +=head3 Branch processing -gotos are handled similarly as with terminalUrls. The last goto in the set of questions -wins. - -=head3 responses data structure - -This method also builds an internal data structure with the users' responses. It -is set up like this: - - responses => { - __qid__ => { - comment => "question comment", - }, - __aid__ => { - time => time(), - comment => "answer comment", - value => "answer value", - }, - } +gotos and gotoExpressions are handled similarly as with terminalUrls. The last goto or +gotoExpression in the set of questions wins. =cut sub recordResponses { - my $self = shift; - my $session = shift; - my $responses = shift; - - my %mcTypes = ( - 'Agree/Disagree', 1, 'Certainty', 1, 'Concern', 1, 'Confidence', 1, 'Education', 1, - 'Effectiveness', 1, 'Gender', 1, 'Ideology', 1, 'Importance', 1, 'Likelihood', 1, - 'Party', 1, 'Multiple Choice', 1, 'Oppose/Support', 1, 'Race', 1, 'Risk', 1, - 'Satisfaction', 1, 'Scale', 1, 'Security', 1, 'Threat', 1, 'True/False', 1, - 'Yes/No', 1 - ); - my %sliderTypes = ( 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1, 'Slider', 1 ); - my %textTypes = ( 'Currency', 'Email', 1, 'Phone Number', 1, 'Text', 1, 'Text Date', 1 ); - my %fileTypes = ( 'File Upload', 1 ); - my %dateTypes = ( 'Date', 'Date Range', 1 ); - my %hiddenTypes = ( 'Hidden', 1 ); + my $self = shift; + my ($responses) = validate_pos( @_, { type => HASHREF } ); - #These were just submitted from the user, so we need to see what and how they were (un)answered. - my $questions = $self->nextQuestions(); - my $qAnswered = 1; - my $sterminal = 0; - my $terminal = 0; + # Build a lookup table of non-multiple choice question types + my %knownTypes = map {$_ => 1} $self->survey->specialQuestionTypes; + + # We want to record responses against the "next" response section and questions, since these are + # the items that have just been displayed to the user. + my $section = $self->nextResponseSection(); + my @questions = $self->nextQuestions(); + + #GOTO jumps in the Survey. Order of precedence is Answer, Question, then Section. + my ($goto, $gotoExpression); + + # Handle terminal Section.. my $terminalUrl; - my $goto; - - my $section = $self->nextSection();#which gets the current section for the just submitted questions. IE, current response pointer has not moved forward for these questions - + my $sTerminal = 0; if ( $section->{terminal} ) { - $sterminal = 1; + $sTerminal = 1; $terminalUrl = $section->{terminalUrl}; } - - #There were no questions in the section just displayed, so increment the lastResponse by one - if ( ref $questions ne 'ARRAY' ) { - $self->lastResponse( $self->lastResponse + 1 ); - return [ $sterminal, $terminalUrl ]; + # ..and also gotos.. + elsif ( $section->{goto} =~ /\w/ ) { + $goto = $section->{goto}; + } + # .. and also gotoExpressions.. + elsif ( $section->{gotoExpression} =~ /\w/ ) { + $gotoExpression = $section->{gotoExpression}; } - for my $question (@$questions) { + + # Handle empty Section.. + if ( !@questions ) { + # No questions to process, so increment lastResponse and return + $self->lastResponse( $self->nextResponse ); + return [ $sTerminal, $terminalUrl ]; + } + + # Process Questions in Section.. + my $terminal = 0; + my $allRequiredQsAnswered = 1; + for my $question (@questions) { my $aAnswered = 0; + + # Handle terminal Questions.. if ( $question->{terminal} ) { $terminal = 1; $terminalUrl = $question->{terminalUrl}; } - $self->responses->{ $question->{id} }->{comment} = $responses->{ $question->{id} . "comment" }; + # ..and also gotos.. + elsif ( $question->{goto} =~ /\w/ ) { + $goto = $question->{goto}; + } + # .. and also gotoExpressions.. + elsif ( $question->{gotoExpression} =~ /\w/ ) { + $gotoExpression = $question->{gotoExpression}; + } + + # Record Question comment + $self->responses->{ $question->{id} }->{comment} = $responses->{ $question->{id} . 'comment' }; + + # Process Answers in Question.. for my $answer ( @{ $question->{answers} } ) { - if ( defined( $responses->{ $answer->{id} } ) - and $responses->{ $answer->{id} } =~ /\S/ ) - { + # Pluck the values out of the responses hash that we want to record.. + my $answerValue = $responses->{ $answer->{id} }; + my $answerComment = $responses->{ $answer->{id} . 'comment' }; + # Proceed if we're satisfied that response is valid.. + if ( defined $answerValue && $answerValue =~ /\S/ ) { $aAnswered = 1; - if ( exists $mcTypes{ $question->{questionType} } ) { + if ($knownTypes{$question->{questionType}}) { + $self->responses->{ $answer->{id} }->{value} = $answerValue; + } else { + # Unknown type, must be a multi-choice bundle + # For Multi-choice, use recordedAnswer instead of answerValue $self->responses->{ $answer->{id} }->{value} = $answer->{recordedAnswer}; } - else { - $self->responses->{ $answer->{id} }->{value} = $responses->{ $answer->{id} }; - } - $self->responses->{ $answer->{id} }->{'time'} = time(); - $self->responses->{ $answer->{id} }->{comment} = $responses->{ $answer->{id} . "comment" }; + $self->responses->{ $answer->{id} }->{time} = time; + $self->responses->{ $answer->{id} }->{comment} = $answerComment; + # Handle terminal Answers.. if ( $answer->{terminal} ) { $terminal = 1; $terminalUrl = $answer->{terminalUrl}; } + # ..and also gotos.. elsif ( $answer->{goto} =~ /\w/ ) { $goto = $answer->{goto}; } - } ## end if ( defined( $responses... - } ## end for my $answer ( @{ $question... - $qAnswered = 0 if ( !$aAnswered and $question->{required} ); - if ($aAnswered) { - $self->questionsAnswered( +1 ); - } - } ## end for my $question (@$questions) - - #if all responses completed, move the lastResponse index to the last question shown - if ($qAnswered) { - $self->lastResponse( $self->lastResponse + @$questions ); - $self->goto($goto) if ( defined $goto ); - } - else { - $terminal = 0; - } - - if($sterminal and $self->nextSection != $self->currentSection){ - $terminal = 1; - } - - return [ $terminal, $terminalUrl ]; -} ## end sub recordResponses - -#------------------------------------------------------------------- - -=head2 goto ( $variable ) - -Looks through all sections and questions for their variable key, in order. If the requested -$variable matches a variable, then the lastResponse is set so that that section or question -is the next displayed. If more than one section or question matches, then the first is used. - -=head3 $variable - -The variable to look for in all sections and questions. - -=cut - -sub goto { - my $self = shift; - my $goto = shift; - for ( my $i = 0; $i <= $#{ $self->surveyOrder() }; $i++ ) { - my $section = $self->survey->section( $self->surveyOrder()->[$i] ); - my $question = $self->survey->question( $self->surveyOrder()->[$i] ); - if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) { - $self->lastResponse( $i - 1 ); - last; - } - if ( ref $question eq 'HASH' and $question->{variable} eq $goto ) { - $self->lastResponse( $i - 1 ); - last; - } - } -} ## end sub goto - -#------------------------------------------------------------------- - -=head2 getPreviousAnswer - -To resolve previous answers which are inserted into question or section text. - -Goes through the previous questions and returns the first recorded response for that question, if it exists. - -=cut - -sub getPreviousAnswer { - my $self = shift; - my $questionParam = shift; - for my $q ( @{ $self->surveyOrder } ) { - my $question = $self->survey->question( [ $$q[0], $$q[1] ] ); - if ( $question->{variable} eq $questionParam ) { - for ( 0 .. @{ $self->survey->answers( [ $$q[0], $$q[1] ] ) } ) { - if ( exists $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ } ) { - return $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ }->{value}; + # .. and also gotoExpressions.. + elsif ( $answer->{gotoExpression} =~ /\w/ ) { + $gotoExpression = $answer->{gotoExpression}; } } } + + # Check if a required Question was skipped + if ( $question->{required} && !$aAnswered ) { + $allRequiredQsAnswered = 0; + } + + # If question was answered, increment the questionsAnswered count.. + if ($aAnswered) { + $self->questionsAnswered(+1); + } } + + # If all required responses were given, proceed onwards! + if ($allRequiredQsAnswered) { + + # Move the lastResponse index to the last question answered + $self->lastResponse( $self->lastResponse + @questions ); + + # Do any requested branching.. + $self->processGoto($goto) if ( defined $goto ); ## no critic + $self->processGotoExpression($gotoExpression) if ( defined $gotoExpression ); ## no critic + } + else { + # Required responses were missing, so we don't let the Survey terminate + $terminal = 0; + } + + if ( $sTerminal && $self->nextResponseSectionIndex != $self->lastResponseSectionIndex ) { + $terminal = 1; + } + + return [ $terminal, $terminalUrl ]; +} + +#------------------------------------------------------------------- + +=head2 processGoto ( $variable ) + +Looks through all sections and questions for their variable key, in order. If the requested +$variable matches a variable, then the lastResponse is set so that that section or question +is the next displayed. If more than one variable name matches, then the first is used. + +=head3 $variable + +A variable name to match against all section and question variable names. + +=cut + +sub processGoto { + my $self = shift; + my ($goto) = validate_pos(@_, {type => SCALAR}); + + # Iterate over items in order.. + my $itemIndex = 0; + for my $address (@{ $self->surveyOrder }) { + + # Retreive the section and question for this address.. + my $section = $self->survey->section( $address ); + my $question = $self->survey->question( $address ); + + # See if our goto variable matches the section variable.. + if ( ref $section eq 'HASH' && $section->{variable} eq $goto ) { + + # Fudge lastReponse so that the next response item will be our matching item + $self->lastResponse( $itemIndex - 1 ); + last; + } + + # See if our goto variable matches the question variable.. + if ( ref $question eq 'HASH' && $question->{variable} eq $goto ) { + + # Fudge lastReponse so that the next response item will be our matching item + $self->lastResponse( $itemIndex - 1 ); + last; + } + + # Increment the item index counter + $itemIndex++; + } + return; +} + +#------------------------------------------------------------------- + +=head2 processGotoExpression ( $gotoExpression ) + +Processes the given gotoExpression, and triggers a call to L<"processGoto"> if the expression +indicates that we should branch. + +=head3 $gotoExpression + +The gotoExpression. + +A gotoExpression is a string representing a list of expressions (one per line) of the form: + target: expression + target: expression + ... + +This subroutine iterates through the list, processing each line and, all things being +well, evaluates the expression. The first expression to evaluate to true triggers a +call to goto($target). + +The expression is a simple subset of the formula language used in spreadsheet programs +such as Excel, OpenOffice, Google Docs etc.. + +Here is an example using section variables S1 and S2 as jump targets and question +variables Q1-3 in the expression. It jumps to S1 if the user's answer to Q1 has a value +of 3, jumps to S2 if Q2 + Q3 < 10, and otherwise doesn't branch at all (the default). +S1: Q1 = 3 +S2: Q2 + Q3 < 10 + +Arguments are evaluated as follows: + +Numeric arguments evaluate as numbers + +=over 4 + +=item * No support for strings (and hence no string matching) + +=item * Question variable names (e.g. Q1) evaluate to the numeric value associated with +user's answer to that question, or undefined if the user has not answered that question + +=back + +Binary comparisons operators: = != < <= >= > + +=over 4 + +=item * return boolean values based on perl's equivalent numeric comparison operators + +=back + +Simple math operators: + - * / + +=over 4 + +=item * return numeric values + +=back + +Later we may add Boolean operators: AND( x; y; z; ... ), OR( x; y; z; ... ), NOT( x ), with args separated by +semicolons (presumably because spreadsheet formulas use commas to indicate cell ranges) + +Later still you may be able to say AVG(section1) or SUM(section3) and have those functions automatically +compute their result over the set of all questions in the given section. +But for now those things can be done manually using the limited subset defined. + +=cut + +sub processGotoExpression { + my $self = shift; + my ($expression) = validate_pos(@_, {type => SCALAR}); + + my $responses = $self->recordedResponses(); + + # Parse gotoExpressions one after the other (first one that's true wins) + foreach my $line (split /\n/, $expression) { + my $processed = $self->parseGotoExpression($line, $responses); + + next if !$processed; + + # (ab)use perl's eval to evaluate the processed expression + my $result = eval "$processed->{expression}"; ## no critic + $self->session->log->warn($@) if $@; ## no critic + + if ($result) { + $self->session->log->debug("Truthy, goto [$processed->{target}]"); + $self->processGoto($processed->{target}); + return $processed; + } else { + $self->session->log->debug('Falsy, not branching'); + next; + } + } + return; +} + +#------------------------------------------------------------------- + +=head2 recordedResponses + +Returns a hash (reference) of question responses. The hash keys are +question variable names. The hash values are the corresponding answer +values selected by the user. + +=cut + +sub recordedResponses { + my $self = shift; + + my $responses= { + # questionName => response answer value + }; + + # Populate %responses with the user's data.. + for my $address ( @{ $self->surveyOrder } ) { + my $question = $self->survey->question( $address ); + my ($sIndex, $qIndex) = (sIndex($address), qIndex($address)); + for my $aIndex (aIndexes($address)) { + my $answerId = $self->answerId($sIndex, $qIndex, $aIndex); + if ( defined $self->responses->{$answerId} ) { + my $answer = $self->survey->answer( [ $sIndex, $qIndex, $aIndex ] ); + $responses->{$question->{variable}} + = $answer->{value} =~ /\w/ ? $answer->{value} + : $question->{value} + ; + } + } + } + return $responses; +} + +#------------------------------------------------------------------- + +=head2 parseGotoExpression( ( $expression, $responses) + +Parses a single gotoExpression. Returns undef if processing fails, or the following hashref +if things work out well: + { target => $target, expression => $expression } + +=head3 $expression + +The expression to process + +=head3 $responses + +Hashref that maps questionNames to response values + +=head3 Explanation: + +Uses the following simple strategy: + +First, parse the expression as: + target: expression + +Replace each questionName with its response value (from the $responses hashref) + +Massage the expression into valid perl + +Check that only valid tokens remain. This last step ensures that any invalid questionNames in +the expression generate an error because our list of valid tokens doesn't include a-z + +=cut + +sub parseGotoExpression { + my $self = shift; + my ($expression, $responses) = validate_pos(@_, { type => SCALAR }, { type => HASHREF, default => {} }); + + $self->session->log->debug("Parsing gotoExpression: $expression"); + + # Valid gotoExpression tokens are.. + my $tokens = qr{\s|[-0-9=!<>+*/.()]}; + + my ( $target, $rest ) = $expression =~ /\s* ([^:]+?) \s* : \s* (.*)/x; + + $self->session->log->debug("Parsed as Target: [$target], Expression: [$rest]"); + + if ( !defined $target ) { + $self->session->log->warn('Target undefined'); + return; + } + + if ( !defined $rest || $rest eq q{} ) { + $self->session->log->warn('Expression undefined'); + return; + } + + # Replace each questionName with its response value + while ( my ( $questionName, $response ) = each %{$responses} ) { + $rest =~ s/$questionName/$response/g; + } + + # convert '=' to '==' but don't touch '!=', '<=' or '>=' + $rest =~ s/(?])=(?!=)/==/g; + + if ( $rest !~ /^$tokens+$/ ) { + $self->session->log->warn("Contains invalid tokens: $rest"); + return; + } + + $self->session->log->debug("Processed as: $rest"); + + return { + target => $target, + expression => $rest, + }; +} + +#------------------------------------------------------------------- + +=head2 getTemplatedText ($text, $responses) + +Scans a string of text for instances of "[[var]]". Looks up each match in the given hash reference +and replaces the string with the associated hash value. + +This method is used to enable simple templating in Survey Section/Question/Answer text. $responses will +usually be a hash of all of the users responses so that their previous responses can be displayed in +the text of later questions. + +=head3 text + +A string of text. e.g. + + Your chose the value [[Q2]] in Question 2 + +=head3 params + +A hash reference. Each matching key in the string will be replaced with its associated value. + +=cut + +sub getTemplatedText { + my $self = shift; + my ($text, $params) = validate_pos(@_, { type => SCALAR }, { type => HASHREF }); + + # Replace all instances of [[var]] with the value from the $params hash reference + $text =~ s/\[\[([^\%]*?)\]\]/$params->{$1}/eg; + + return $text; } #------------------------------------------------------------------- =head2 nextQuestions -Returns an array ref of the next questions in the survey. The number of questions -returned is set by the questionsPerPage property of the next section, as determined -by nextSectionId rather than logical section ordering. +Returns a list (array ref) of the Questions that should be shwon on the next page of the Survey. +Each Question also contains a list (array ref) of associated Answers. -If no questions are available, then it returns an empty array ref. +N.B. These are safe copies of the Survey data. -Each element of the array ref is a question data structure, from the -WebGUI::Asset::Wobject::Survey::SurveyJSON class, with a section sid field (index of -the containing section) and question id (section and question id concatenated with a -'-') added. The answers array of the question contains answer data structures, also -from WebGUI::Asset::Wobject::Survey::SurveyJSON, with an id field which is the section, -question and answer indexes concatentated together with dashes. +The number of questions is determined by the questionsPerPage property of the 'next' section +in L<"surveyOrder">. -Section and question [[var]] replacements in text fields. +Each element of the array ref returned is a question data structure (see +L), with some additional fields: -All questions and answers are safe copies of the survey data. +=over 4 + +=item sid Section Id field (see L<"sectionId">) + +=item id Question id (see L<"questionId">. + +=item answers An array of Answers (see L), with +each answer in the array containing an Answer Id (see L<"answerId">) + +=back + +Survey, Question and Answer template text is processed here (see L<"getTemplatedText">) =cut sub nextQuestions { my $self = shift; - return [] if $self->surveyEnd; + # See if we've reached the end of the Survey + return if $self->surveyEnd; - my $nextSectionId = $self->nextSectionId; + # Get some information about the Section that the next response belongs to.. + my $section = $self->nextResponseSection(); + my $sectionIndex = $self->nextResponseSectionIndex; + my $questionsPerPage = $self->survey->section( [ $self->nextResponseSectionIndex ] )->{questionsPerPage}; + # Get all of the existing question responses (so that we can do Section and Question [[var]] replacements + my $recordedResponses = $self->recordedResponses(); - my $qPerPage = $self->survey->section( [ $self->nextSectionId ] )->{questionsPerPage}; + # Do text replacement + $section->{text} = $self->getTemplatedText($section->{text}, $recordedResponses); - #load Previous answer text - my $section = $self->nextSection(); - $section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; + # Collect all the questions to be shown on the next page.. + my @questions; + for my $i (1 .. $questionsPerPage ) { + my $address = $self->surveyOrder->[ $self->lastResponse + $i ]; + last if(! defined $address); + my ($sIndex, $qIndex) = (sIndex($address), qIndex($address)); - my $questions; - for ( my $i = 1; $i <= $qPerPage; $i++ ) { - my $qAddy = $self->surveyOrder->[ $self->lastResponse + $i ]; - next - if ( !exists $$qAddy[1] ); #skip this if it doesn't have a question (for sections with no questions) + # Skip if this is a Section without a Question + if ( !defined $qIndex ) { + next; + } - if ( $$qAddy[0] != $nextSectionId ) { + # Stop if we have left the Section + if ( $sIndex != $sectionIndex ) { last; } - my %question = %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) }; - $question{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; - delete $question{answers}; - $question{id} = "$$qAddy[0]-$$qAddy[1]"; - $question{sid} = "$$qAddy[0]"; - for ( @{ $$qAddy[2] } ) { - my %ans = %{ $self->survey->answer( [ $$qAddy[0], $$qAddy[1], $_ ] ) }; - $ans{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; - $ans{id} = "$$qAddy[0]-$$qAddy[1]-$_"; - push( @{ $question{answers} }, \%ans ); + + # Make a safe copy of the question + my %questionCopy = %{$self->survey->question( $address )}; + + # Do text replacement + $questionCopy{text} = $self->getTemplatedText($questionCopy{text}, $recordedResponses); + + # Add any extra fields we want.. + $questionCopy{id} = $self->questionId($sIndex, $qIndex); + $questionCopy{sid} = $self->sectionId($sIndex); + + # Rebuild the list of anwers with a safe copy + delete $questionCopy{answers}; + for my $aIndex ( aIndexes($address) ) { + my %answerCopy = %{ $self->survey->answer( [ $sIndex, $qIndex, $aIndex ] ) }; + + # Do text replacement + $answerCopy{text} = $self->getTemplatedText($answerCopy{text}, $recordedResponses); + + # Add any extra fields we want.. + $answerCopy{id} = $self->answerId($sIndex, $qIndex, $aIndex); + + push @{ $questionCopy{answers} }, \%answerCopy; } - push( @$questions, \%question ); - } ## end for ( my $i = 1; $i <= ... - return $questions; -} ## end sub nextQuestions + push @questions, \%questionCopy; + } + return @questions; +} + +=head2 sectionId + +Convenience method to construct a Section Id from the given Section index. + +A Section Id is identical to a Section index. This method is only present for consistency with questionId and answerId. + +=cut + +sub sectionId { + my $self = shift; + my ($sIndex) = validate_pos(@_, { type => SCALAR | UNDEF } ); + + return if !defined $sIndex; + + return $sIndex; +} + +=head2 questionId + +Convenience method to construct a Question Id from the given Section index and Question index. + +The id is constructed by hyphenating the Section index and Question index. + +=cut + +sub questionId { + my $self = shift; + my ($sIndex, $qIndex) = validate_pos(@_, { type => SCALAR | UNDEF }, { type => SCALAR | UNDEF } ); + + return if !defined $sIndex || !defined $qIndex; + + return "$sIndex-$qIndex"; +} + +=head2 answerId + +Convenience method to construct an Answer Id from the given Section index, Question index and Answer index. + +The id is constructed by hyphenating all three indices. + +=cut + +sub answerId { + my $self = shift; + my ($sIndex, $qIndex, $aIndex) = validate_pos(@_, { type => SCALAR | UNDEF }, { type => SCALAR | UNDEF }, { type => SCALAR | UNDEF } ); + + return if !defined $sIndex || !defined $qIndex || !defined $aIndex; + + return "$sIndex-$qIndex-$aIndex"; +} #------------------------------------------------------------------- @@ -596,12 +1028,64 @@ equal to the number of sections in the survey order. sub surveyEnd { my $self = shift; + return 1 if ( $self->lastResponse >= $#{ $self->surveyOrder } ); return 0; } #------------------------------------------------------------------- +=head2 sIndex ($address) + +Convenience sub to extract the section index from an address in the L<"surveyOrder"> array. +This method exists purely to improve code readability. +This method is identical to L. + +=cut + +sub sIndex { + my ($address) = validate_pos(@_, { type => ARRAYREF}); + return $address->[0]; +} + +#------------------------------------------------------------------- + +=head2 qIndex ($address) + +Convenience sub to extract the question index from an address in the L<"surveyOrder"> array. +This method exists purely to improve code readability. +This method is identical to L. + +=cut + +sub qIndex { + my ($address) = validate_pos(@_, { type => ARRAYREF}); + return $address->[1]; +} + +#------------------------------------------------------------------- + +=head2 aIndexes ($address) + +Convenience sub to extract the array of answer indices from an address in the L<"surveyOrder"> array. +This method exists purely to improve code readability. +Unlike sIndex and qIndex, this method is different to L. +This is because the third element of the L<"surveyOrder"> address array ref in is an array of answer indices. + +=cut + +sub aIndexes { + my ($address) = validate_pos(@_, { type => ARRAYREF}); + + if (my $indexes = $address->[2]) { + return @{ $indexes }; + } + + return; +} + +#------------------------------------------------------------------- + =head2 returnResponsesForReporting Used to extract JSON responses for use in reporting results. @@ -612,57 +1096,74 @@ recorded value, and the id of the answer. =cut +# TODO: This sub should make use of recordedResponses + sub returnResponseForReporting { my $self = shift; - my @responses = (); - for my $entry ( @{ $self->surveyOrder } ) { - if ( @$entry == 1 ) { + my @report = (); + for my $address ( @{ $self->surveyOrder } ) { + my ($sIndex, $qIndex) = (sIndex($address), qIndex($address)); + my $section = $self->survey->section( $address ); + my $question = $self->survey->question( [ $sIndex, $qIndex ] ); + my $questionId = $self->questionId($sIndex, $qIndex); + + # Skip if this is a Section without a Question + if ( !defined $qIndex ) { next; } - my @answers; - for ( @{ $$entry[2] } ) { - if ( defined $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) { - $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{id} = $_; - if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{isCorrect} ) { - my $value; - if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value} =~ /\w/ ) { - $value = $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value}; - } - else { - $value = $self->survey->question( [ $$entry[0], $$entry[1] ] )->{value}; - } - $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{value} = $value; - $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 1; + + my @responses; + for my $aIndex (aIndexes($address)) { + my $answerId = $self->answerId($sIndex, $qIndex, $aIndex); + + if ( $self->responses->{$answerId} ) { + + # Make a safe copy of the response + my %response = %{$self->responses->{$answerId}}; + $response{id} = $aIndex; + + my $answer = $self->survey->answer( [ $sIndex, $qIndex, $aIndex ] ); + if ( $answer->{isCorrect} ) { + $response{value} + = $answer->{value} =~ /\w/ ? $answer->{value} + : $question->{value} + ; + $response{isCorrect} = 1; } else { - $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 0; + $response{isCorrect} = 0; } - push( @answers, ( $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) ); - } ## end if ( defined $self->responses... - } ## end for ( @{ $$entry[2] } ) - push( - @responses, ( { - 'section', $$entry[0], - 'question', $$entry[1], - 'sectionName', $self->survey->section( [ $$entry[0] ] )->{variable}, - 'questionName', $self->survey->question( [ $$entry[0], $$entry[1] ] )->{variable}, - 'questionComment', $self->responses->{"$$entry[0]-$$entry[1]"}->{comment}, - 'answers', \@answers - } - ) - ); - } ## end for my $entry ( @{ $self... - return \@responses; -} ## end sub returnResponseForReporting + push @responses, \%response; + } + } + push @report, { + section => $sIndex, + question => $qIndex, + sectionName => $section->{variable}, + questionName => $question->{variable}, + questionComment => $self->responses->{$questionId}->{comment}, + answers => \@responses + }; + } + return \@report; +} #------------------------------------------------------------------- +=head2 response + +Accessor for the Perl hash containing Response data + +=cut + +sub response { + my $self = shift; + return $self->{_response}; +} + =head2 responses -Returns a reference to the actual responses to the survey. A response is for a question and -is accessed by the exact same address as a survey member. Questions only contain the comment -and an array of answer Responses. Answers only contain, entered text, entered verbatim, -their index in the Survey Question Answer array, and the assetId to the uploaded file. +Mutator for the L<"responses"> property. Note, this is an unsafe reference. @@ -670,12 +1171,16 @@ Note, this is an unsafe reference. sub responses { my $self = shift; - return $self->{responses}; + my $responses = shift; + if ( defined $responses ) { + $self->response->{responses} = $responses; + } + return $self->response->{responses}; } #------------------------------------------------------------------- -=head2 responses +=head2 survey Returns a referece to the SurveyJSON object that this object was created with. @@ -685,21 +1190,7 @@ Note, this is an unsafe reference. sub survey { my $self = shift; - return $self->{survey}; + return $self->{_survey}; } -#------------------------------------------------------------------- - -=head2 log - -Logs an error to the webgui log file, using the session logger. - -=cut - -sub log { - my ( $self, $message ) = @_; - if ( defined $self->{log} ) { - $self->{log}->debug($message); - } -} 1; diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index 9bf42d006..701327de6 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -25,90 +25,183 @@ serializing and deserializing JSON data, and manages the data for the Survey. This package is not intended to be used by any other Asset in WebGUI. +=head2 Address Parameter + +Most subroutines in this module accept an $address param. This param is an array ref that +serves as a multidimensional index into the section/question/answer structure. + +In general, the first element of the array is the section index, the second element is +the question index, and the third element is the answer index. E.g. in its most general +form the array looks like: + + [section index, question index, answer index] + +Most subroutines will not expect or require all three elements to be present. Often, the +subroutine will alter its behaviour based on how many elements you provide. Typically, +the subroutine will operate on the most specific element it can based on the amount of +information you provide. For example if you provide two elements, the subroutine will most +likely operate on the question indexed by: + + [section index, question index] + =cut use strict; use JSON; +use Params::Validate qw(:all); +Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); +# N.B. We're currently using Storable::dclone instead of Clone::clone +# because Colin uncovered some Clone bugs in Perl 5.10 #use Clone qw/clone/; use Storable qw/dclone/; -=head2 new ( $json, $log ) +# The maximum value of questionsPerPage is currently hardcoded here +my $MAX_QUESTIONS_PER_PAGE = 20; + +my %MULTI_CHOICE_BUNDLES = ( + 'Agree/Disagree' => [ 'Strongly disagree', (q{}) x 5, 'Strongly agree' ], + Certainty => [ 'Not at all certain', (q{}) x 9, 'Extremely certain' ], + Concern => [ 'Not at all concerned', (q{}) x 9, 'Extremely concerned' ], + Confidence => [ 'Not at all confident', (q{}) x 9, 'Extremely confident' ], + Education => [ + 'Elementary or some high school', + 'High school/GED', + 'Some college/vocational school', + 'College graduate', + 'Some graduate work', + 'Master\'s degree', + 'Doctorate (of any type)', + 'Other degree (verbatim)', + ], + Effectiveness => [ 'Not at all effective', (q{}) x 9, 'Extremely effective' ], + Gender => [qw( Male Female )], + Ideology => [ + 'Strongly liberal', + 'Liberal', + 'Somewhat liberal', + 'Middle of the road', + 'Slightly conservative', + 'Conservative', + 'Strongly conservative' + ], + Importance => [ 'Not at all important', (q{}) x 9, 'Extremely important' ], + Likelihood => [ 'Not at all likely', (q{}) x 9, 'Extremely likely' ], + 'Oppose/Support' => [ 'Strongly oppose', (q{}) x 5, 'Strongly support' ], + Party => + [ 'Democratic party', 'Republican party (or GOP)', 'Independent party', 'Other party (verbatim)' ], + Race => + [ 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic', 'Something else (verbatim)' ], + Risk => [ 'No risk', (q{}) x 9, 'Extreme risk' ], + Satisfaction => [ 'Not at all satisfied', (q{}) x 9, 'Extremely satisfied' ], + Security => [ 'Not at all secure', (q{}) x 9, 'Extremely secure' ], + Threat => [ 'No threat', (q{}) x 9, 'Extreme threat' ], + 'True/False' => [qw( True False )], + 'Yes/No' => [qw( Yes No )], + Scale => [q{}], + 'Multiple Choice' => [q{}], +); + +my @SPECIAL_QUESTION_TYPES = ( + 'Dual Slider - Range', + 'Multi Slider - Allocate', + 'Slider', + 'Currency', + 'Email', + 'Phone Number', + 'Text', + 'Text Date', + 'TextArea', + 'File Upload', + 'Date', + 'Date Range', + 'Hidden', +); + +sub specialQuestionTypes { + return @SPECIAL_QUESTION_TYPES; +} + +=head2 new ( $session, json ) Object constructor. -=head3 $json +=head3 $session -Pass in some JSON to be serialized into a data structure. Useful JSON would -be a hash with "survey" and "sections" keys with appropriate values. +WebGUI::Session object -=head3 $log +=head3 $json (optional) -The session logger, from $session->log. The class needs nothing else from the -session object. +A JSON string used to construct a new Perl object. The string should represent +a JSON hash made up of "survey" and "sections" keys. =cut sub new { my $class = shift; - my $json = shift; - my $log = shift; - my $self = {}; - $self->{log} = $log; - my $temp = from_json($json) if defined $json; - $self->{sections} = defined $temp->{sections} ? $temp->{sections} : []; - $self->{survey} = defined $temp->{survey} ? $temp->{survey} : {}; - bless( $self, $class ); + my ($session, $json) = validate_pos(@_, {isa => 'WebGUI::Session' }, { type => SCALAR | UNDEF, optional => 1}); - if ( @{ $self->sections } == 0 ) { + # Load json object if given.. + my $jsonData = $json ? from_json($json) : {}; + + # Create skeleton object.. + my $self = { + _session => $session, + _sections => $jsonData->{sections} || [], + _survey => $jsonData->{survey} || {}, + }; + + bless $self, $class; + + # Initialise the survey data structure if empty.. + if ( $self->totalSections == 0 ) { $self->newObject( [] ); } return $self; -} ## end sub new +} =head2 freeze -Serializes the survey and sections data into JSON and returns the JSON. +Serialize this Perl object into a JSON string. The serialized object is made up of the survey and sections +components of this object. =cut sub freeze { my $self = shift; - my %temp; - $temp{sections} = $self->{sections}; - $temp{survey} = $self->{survey}; - return to_json( \%temp ); + return to_json( + { sections => $self->sections, + survey => $self->{_survey}, + } + ); } =head2 newObject ( $address ) -Add new, empty elements to the survey data structure. It returns $address, -modified to show what was added. +Add a new, empty Section, Question or Answer to the survey data structure. + +Updates $address to point at the newly added object. Returns $address. =head3 $address -An array ref. The number of elements array set what is added, and -where. +See L<"Address Parameter">. New objects are always added (pushed) onto the end of the list of similar objects at the +given address. -This method modifies $address. It also returns $address. +The number of elements in $address determines the behaviour: =over 4 -=item empty +=item * 0 elements -If the array ref is empty, a new section is added. +Add a new section. -=item 1 element +=item * 1 element -If there's just 1 element, then that element is used as an index into -the array of sections, and a new question is added to that section. +Add a new question to the indexed section. -=item 2 elements +=item * 2 elements -If there are 2 elements, then the first element is an index into -section array, and the second element is an index into the questions -in that section. A new answer is added to the specified question in -the specified section. +Add a new answer to the indexed question inside the indexed section. =back @@ -116,24 +209,35 @@ the specified section. sub newObject { my $self = shift; - my $address = shift; - if ( @$address == 0 ) { - push( @{ $self->sections }, $self->newSection() ); - $address->[0] = $#{ $self->sections }; - } - elsif ( @$address == 1 ) { - push( @{ $self->questions($address) }, $self->newQuestion($address) ); - $$address[1] = $#{ $self->questions($address) }; - } - elsif ( @$address == 2 ) { - push( @{ $self->answers($address) }, $self->newAnswer($address) ); - $$address[2] = $#{ $self->answers($address) }; - } - return $address; -} ## end sub newObject + my ($address) = validate_pos(@_, { type => ARRAYREF }); -#address is the array of objects currently selected in the edit screen -#data is the array of hash items for displaying + # Figure out what to do by counting the number of elements in the $address array ref + my $count = @{$address}; + + if ( $count == 0 ) { + # Add a new section to the end of the list of sections.. + push @{ $self->sections }, $self->newSection(); + + # Update $address with the index of the newly created section + $address->[0] = $self->lastSectionIndex; + } + elsif ( $count == 1 ) { + # Add a new question to the end of the list of questions in section located at $address + push @{ $self->questions($address) }, $self->newQuestion($address); + + # Update $address with the index of the newly created question + $address->[1] = $self->lastQuestionIndex($address); + } + elsif ( $count == 2 ) { + # Add a new answer to the end of the list of answers in section/question located at $address + push @{ $self->answers($address) }, $self->newAnswer($address); + + # Update $address with the index of the newly created answer + $address->[2] = $self->lastAnswerIndex($address); + } + # Return the (modified) $address + return $address; +} =head2 getDragDropList ( $address ) @@ -164,45 +268,44 @@ All answers for the referenced question will also be in the array reference: The sections, question and answer will be in depth-first order: -section, section, section, question, answer, answer, answer, section, section + section, section, section, question, answer, answer, answer, section, section =head3 $address -An array ref. Sets which question from a section will be listed, along with all -its answers. $address should ALWAYS have two elements. +See L<"Address Parameter">. Determines which question from a section will be listed, along with all +its answers. Should ALWAYS have two elements since we want to address a question. =cut sub getDragDropList { my $self = shift; - my $address = shift; + my ($address) = validate_pos(@_, { type => ARRAYREF }); + my @data; - for ( my $i = 0; $i <= $#{ $self->sections }; $i++ ) { - push( @data, { text => $self->section( [$i] )->{title}, type => 'section' } ); - if ( $address->[0] == $i ) { + for my $sIndex (0 .. $self->lastSectionIndex) { + push @data, { text => $self->section( [$sIndex] )->{title}, type => 'section' }; + if ( sIndex($address) == $sIndex ) { - for ( my $x = 0; $x <= $#{ $self->questions($address) }; $x++ ) { - push( - @data, - { text => $self->question( [ $i, $x ] )->{text}, + for my $qIndex (0 .. $self->lastQuestionIndex($address)) { + push @data, + { text => $self->question( [ $sIndex, $qIndex ] )->{text}, type => 'question' } - ); - if ( $address->[1] == $x ) { - for ( my $y = 0; $y <= $#{ $self->answers($address) }; $y++ ) { - push( - @data, - { text => $self->answer( [ $i, $x, $y ] )->{text}, + ; + if ( qIndex($address) == $qIndex ) { + for my $aIndex (0 .. $self->lastAnswerIndex($address)) { + push @data, + { text => $self->answer( [ $sIndex, $qIndex, $aIndex ] )->{text}, type => 'answer' } - ); + ; } } - } ## end for ( my $x = 0; $x <= ... - } ## end if ( $address->[0] == ... - } ## end for ( my $i = 0; $i <= ... + } + } + } return \@data; -} ## end sub getDragDropList +} =head2 getObject ( $address ) @@ -210,44 +313,51 @@ Retrieve objects from the sections data structure by address. =head3 $address -An array ref. The number of elements array set what is fetched. +See L<"Address Parameter">. + +The number of elements in $address determines the behaviour: =over 4 -=item empty +=item * 0 elements -If the array ref is empty, nothing is done. +Do Nothing -=item 1 element +=item * 1 element -If there's just 1 element, returns the section with that index. +One element is enough to reference a section. Returns that section. -=item 2 elements +=item * 2 elements -If there are 2 elements, then the first element is an index into -section array, and the second element is an index into the questions -in that section. Returns that question. +Two elements are enough to reference a question inside a section. Returns that question. -=item 3 elements +=item * 3 elements -Three elements are enough to reference an answer, inside of a particular -question in a section. Returns that answer. +Three elements are enough to reference an answer, inside of a particular question in a section. +Returns that answer. =back =cut sub getObject { - my ( $self, $address ) = @_; - if ( @$address == 1 ) { - return dclone $self->{sections}->[ $address->[0] ]; + my $self = shift; + my ($address) = validate_pos(@_, { type => ARRAYREF }); + + # Figure out what to do by counting the number of elements in the $address array ref + my $count = @{$address}; + + return if !$count; + + if ( $count == 1 ) { + return dclone $self->sections->[ sIndex($address) ]; } - elsif ( @$address == 2 ) { - return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]; + elsif ( $count == 2 ) { + return dclone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ]; } else { - return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers} - ->[ $address->[2] ]; + return dclone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ]->{answers} + ->[ aIndex($address) ]; } } @@ -259,31 +369,66 @@ from it. =head3 $address -An array ref. The number of elements determines whether edit vars are fetched for +See L<"Address Parameter">. The number of elements determines whether edit vars are fetched for sections, questions, or answers. =cut sub getEditVars { - my ( $self, $address ) = @_; + my $self = shift; + my ($address) = validate_pos(@_, { type => ARRAYREF }); - if ( @$address == 1 ) { + # Figure out what to do by counting the number of elements in the $address array ref + my $count = @{$address}; + + if ( $count == 1 ) { return $self->getSectionEditVars($address); } - elsif ( @$address == 2 ) { + elsif ( $count == 2 ) { return $self->getQuestionEditVars($address); } - elsif ( @$address == 3 ) { + elsif ( $count == 3 ) { return $self->getAnswerEditVars($address); } } +=head2 getGotoTargets + +Generates the list of valid goto targets + +=cut + +sub getGotoTargets { + my $self = shift; + + # Valid goto targets are all of the section variable names.. + my @section_vars = map {$_->{variable}} @{$self->sections}; + + # ..and all of the question variable names.. + my @question_vars = map {$_->{variable}} @{$self->questions}; + + # ..excluding the ones that are empty + return grep { $_ ne q{} } (@section_vars, @question_vars); +} + =head2 getSectionEditVars ( $address ) Get a safe copy of the variables for this section, to use for editing -purposes. Adds two variables, id, which is the index of this section, -and displayed_id, which is this question's index in a 1-based array -(versus the default, perl style, 0-based array). +purposes. + +Adds two variables: + +=over 4 + +=item * id + +the index of this section + +=item * displayed_id + +this question's index in a 1-based array (versus the default, perl style, 0-based array) + +=back It removes the questions array ref, and changes questionsPerPage from a single element, into an array of hashrefs, which list the available questions per page and which one is currently @@ -291,39 +436,54 @@ selected for this section. =head3 $address -An array reference, specifying which question to fetch variables for. +See L<"Address Parameter">. Specifies which question to fetch variables for. =cut sub getSectionEditVars { my $self = shift; - my $address = shift; - my $object = $self->section($address); - my %var = %{$object}; - $var{id} = $address->[0]; - $var{displayed_id} = $address->[0] + 1; + my ($address) = validate_pos(@_, { type => ARRAYREF }); + + my $section = $self->section($address); + my %var = %{$section}; + + # Add the extra fields.. + $var{id} = sIndex($address); + $var{displayed_id} = sIndex($address) + 1; + + # Remove the fields we don't want.. delete $var{questions}; delete $var{questionsPerPage}; - for ( 1 .. 20 ) { - - # if($_ == $self->section($address)->{questionsPerPage}){ - if ( $_ == $object->{questionsPerPage} ) { - push( @{ $var{questionsPerPage} }, { 'index', $_, 'selected', 1 } ); - } - else { - push( @{ $var{questionsPerPage} }, { 'index', $_, 'selected', 0 } ); - } + # Change questionsPerPage from a single element, into an array of hashrefs, which list the + # available questions per page and which one is currently selected for this section.. + for my $index ( 1 .. $MAX_QUESTIONS_PER_PAGE ) { + push @{ $var{questionsPerPage} }, { + index => $index, + selected => $index == $section->{questionsPerPage} ? 1 : 0 + }; } return \%var; -} ## end sub getSectionEditVars +} =head2 getQuestionEditVars ( $address ) -Get a safe copy of the variables for this question, to use for editing purposes. Adds -two variables, id, which is the indeces of the question's position in its parent's -section array joined by dashes '-', and displayed_id, which is this question's index -in a 1-based array (versus the default, perl style, 0-based array). +Get a safe copy of the variables for this question, to use for editing purposes. + +Adds two variables: + +=over 4 + +=item * id + +the index of the question's position in its parent's section array joined by dashes '-' +See L. + +=item * displayed_id + +this question's index in a 1-based array (versus the default, perl style, 0-based array). + +=back It removes the answers array ref, and changes questionType from a single element, into an array of hashrefs, which list the available question types and which one is currently @@ -331,314 +491,346 @@ selected for this question. =head3 $address -An array reference, specifying which question to fetch variables for. +See L<"Address Parameter">. Specifies which question to fetch variables for. =cut sub getQuestionEditVars { my $self = shift; - my $address = shift; - my $object = $self->question($address); - my %var = %{$object}; - $var{id} = $address->[0] . "-" . $address->[1]; - $var{displayed_id} = $address->[1] + 1; + my ($address) = validate_pos(@_, { type => ARRAYREF }); + + my $question = $self->question($address); + my %var = %{$question}; + + # Add the extra fields.. + $var{id} = sIndex($address) . q{-} . qIndex($address); + $var{displayed_id} = qIndex($address) + 1; + + # Remove the fields we don't want delete $var{answers}; delete $var{questionType}; - my @types = $self->getValidQuestionTypes(); - for (@types) { - if ( $_ eq $object->{questionType} ) { - push( @{ $var{questionType} }, { 'text', $_, 'selected', 1 } ); - } - else { - push( @{ $var{questionType} }, { 'text', $_, 'selected', 0 } ); - } + # Change questionType from a single element into an array of hashrefs which list the available + # question types and which one is currently selected for this question.. + + for my $qType ($self->getValidQuestionTypes) { + push @{ $var{questionType} }, { + text => $qType, + selected => $qType eq $question->{questionType} ? 1 : 0 + }; } return \%var; -} ## end sub getQuestionEditVars +} =head2 getValidQuestionTypes -A convenience method. Returns a list of question types. If you add a question -type to the Survey, you must handle it here, and also in updateQuestionAnswers +A convenience method. Returns a list of question types. =cut sub getValidQuestionTypes { - return ( - 'Agree/Disagree', 'Certainty', 'Concern', 'Confidence', - 'Currency', 'Date', 'Date Range', 'Dual Slider - Range', - 'Education', 'Effectiveness', 'Email', 'File Upload', - 'Gender', 'Hidden', 'Ideology', 'Importance', - 'Likelihood', 'Multi Slider - Allocate', 'Multiple Choice', 'Oppose/Support', - 'Party', 'Phone Number', 'Race', 'Risk', - 'Satisfaction', 'Scale', 'Security', 'Slider', - 'Text', 'Text Date', 'Threat', 'True/False', - 'Yes/No' - ); + return sort (@SPECIAL_QUESTION_TYPES, keys %MULTI_CHOICE_BUNDLES); } =head2 getAnswerEditVars ( $address ) -Get a safe copy of the variables for this answer, to use for editing purposes. Adds -two variables, id, which is the indeces of the answer's position in its parent's question -and section arrays joined by dashes '-', and displayed_id, which is this answer's index -in a 1-based array (versus the default, perl style, 0-based array). +Get a safe copy of the variables for this answer, to use for editing purposes. + +Adds two variables: + +=over 4 + +=item * id + +The index of the answer's position in its parent's question and section arrays joined by dashes '-' +See L. + +=item * displayed_id + +This answer's index in a 1-based array (versus the default, perl style, 0-based array). + +=back =head3 $address -An array reference, specifying which answer to fetch variables for. +See L<"Address Parameter">. Specifies which answer to fetch variables for. =cut sub getAnswerEditVars { my $self = shift; - my $address = shift; + my ($address) = validate_pos(@_, { type => ARRAYREF }); + my $object = $self->answer($address); my %var = %{$object}; - $var{id} = $address->[0] . "-" . $address->[1] . "-" . $address->[2]; - $var{displayed_id} = $address->[2] + 1; + + # Add the extra fields.. + $var{id} = sIndex($address) . q{-} . qIndex($address) . q{-} . aIndex($address); + $var{displayed_id} = aIndex($address) + 1; + return \%var; } -=head2 update ( $address, $object ) +=head2 update ( $address, $properties ) -Update new "objects" into the current data structure, or add new ones. It does not -return anything significant. +Update a section/question/answer with $properties, or add new ones. +Does not return anything significant. =head3 $address -An array ref. The number of elements array set what is updated. +See L<"Address Parameter">. + +The number of elements in $address determines the behaviour: =over 4 -=item empty +=item * 0 elements -If the array ref is empty, nothing is done. +Do Nothing -=item 1 element +=item * 1 element -If there's just 1 element, then that element is used as an index into -the array of sections, and information from $object is used to replace -the properties of that section. If the select section does not exist, such +Update the addressed section with $properties. If the section does not exist, such as by using an out of bounds array index, then a new section is appended to the list of sections. -=item 2 elements +=item * 2 elements -If there are 2 elements, then the first element is an index into -section array, and the second element is an index into the questions -in that section. +Update the addressed question with $properties. -=item 3 elements +=item * 3 elements -Three elements are enough to reference an answer, for a particular -question in a section. +Update the addressed answer with $properties. =back -=head3 $object +=head3 $properties -A perl data structure. Note, that it is not checked for type, so it is -possible to add a "question" object into the list of section objects. -$object should never be a partial object, but contain all properties. +A perl hash reference. Note, that it is not checked for type, so it is +possible to add a "question" object into the list of sections. +$properties should never be a partial object, but contain all properties. =cut sub update { - my ( $self, $address, $ref ) = @_; - my $object; + my $self = shift; + my ($address, $properties) = validate_pos(@_, { type => ARRAYREF }, {type => HASHREF}); + + # Keep track of whether a new question is created along the way.. my $newQuestion = 0; - if ( @$address == 1 ) { + + # Figure out what to do by counting the number of elements in the $address array ref + my $count = @{$address}; + + # First retrieve the addressed object, or, if necessary, create it + my $object; + if ( $count == 1 ) { $object = $self->section($address); if ( !defined $object ) { $object = $self->newSection(); - push( @{ $self->sections }, $object ); + push @{ $self->sections }, $object; } } - elsif ( @$address == 2 ) { + elsif ( $count == 2 ) { $object = $self->question($address); if ( !defined $object ) { - my $newQuestion = 1; $object = $self->newQuestion(); - push( @{ $self->questions($address) }, $object ); + $newQuestion = 1; # make note that a new question was created + push @{ $self->questions($address) }, $object; + } + # We need to update all of the answers to reflect the new questionType + if ( $properties->{questionType} ne $object->{questionType} ) { + $self->updateQuestionAnswers( $address, $properties->{questionType} ); } } - elsif ( @$address == 3 ) { + elsif ( $count == 3 ) { $object = $self->answer($address); if ( !defined $object ) { $object = $self->newAnswer(); - push( @{ $self->answers($address) }, $object ); + push @{ $self->answers($address) }, $object; } } - if ( @$address == 2 and !$newQuestion ) { - if ( $ref->{questionType} ne $self->question($address)->{questionType} ) { - $self->updateQuestionAnswers( $address, $ref->{questionType} ); - } - } - for my $key ( keys %$ref ) { - $object->{$key} = $ref->{$key} if ( defined $$ref{$key} ); - } -} ## end sub update -#determine what to add and add it. -# ref should contain all the information for the new + # Update $object with all of the data in $properties + while (my ($key, $value) = each %{$properties}) { + if (defined $value) { + $object->{$key} = $value; + } + } + + return; +} =head2 insertObject ( $object, $address ) -Used to move existing objects in the current data structure. It does not -return anything significant. +Rearrange existing objects in the current data structure. +Does not return anything significant. =head3 $object -A perl data structure. Note, that it is not checked for homegeneity, +A perl hash reference. Note, that it is not checked for homegeneity, so it is possible to add a "question" object into the list of section objects. =head3 $address -An array ref. The number of elements array set what is added, and -where. +See L<"Address Parameter">. + +The number of elements in $address determines the behaviour: =over 4 -=item empty +=item * 0 elements -If the array ref is empty, nothing is done. +Do Nothing -=item 1 element +=item * 1 element -If there's just 1 element, then that element is used as an index into -the array of sections, and $object is spliced into place right after -that index. +Reposition $object immediately after the indexed section -=item 2 elements +=item * 2 elements -If there are 2 elements, then the first element is an index into -section array, and the second element is an index into the questions -in that section. $object is added right after that question. +Reposition $object immediately after the indexed question -=item 3 elements +=item * 3 elements -Three elements are enough to reference an answer, inside of a particular -question in a section. $object is spliced in right after that answer. +Reposition $object immediately after the indexed answer =back =cut sub insertObject { - my ( $self, $object, $address ) = @_; - if ( @$address == 1 ) { - splice( @{ $self->sections($address) }, $$address[0] + 1, 0, $object ); - } - elsif ( @$address == 2 ) { - splice( @{ $self->questions($address) }, $$address[1] + 1, 0, $object ); - } - elsif ( @$address == 3 ) { - splice( @{ $self->answers($address) }, $$address[2] + 1, 0, $object ); - } + my $self = shift; + my ($object, $address) = validate_pos(@_, {type => HASHREF}, { type => ARRAYREF }); + # Figure out what to do by counting the number of elements in the $address array ref + my $count = @{$address}; + return if !$count; + + # Use splice to rearrange the relevant array of objects.. + if ( $count == 1 ) { + splice @{ $self->sections($address) }, sIndex($address) +1, 0, $object; + } + elsif ( $count == 2 ) { + splice @{ $self->questions($address) }, qIndex($address) + 1, 0, $object; + } + elsif ( $count == 3 ) { + splice @{ $self->answers($address) }, aIndex($address) + 1, 0, $object; + } + + return; } =head2 copy ( $address ) -Duplicate the structure pointed to by $address, and add it to the end of the list of -similar structures. copy returns $address with the last element changed to the highest -index in that array. +Duplicate the indexed section or question, and push the copy onto the end of the +list of existing items. Modifies $address. Returns $address with the last element changed +to the highest index in that array. =head3 $address -An array ref. The number of elements array set what is added, and -where. +See L<"Address Parameter">. -This method modifies $address. +The number of elements in $address determines the behaviour: =over 4 -=item 1 element +=item * 1 element -If there's just 1 element, then the section with that index is duplicated -at the end of the array of sections. +Duplice the indexed section onto the end of the array of sections. -=item 2 elements +=item * 2 elements -If there are 2 elements, the question in the section that is indexed -will be duplicated and added to the end of the array of questions -in that section. +Duplice the indexed question onto the end of the array of questions. -=item 3 elements, or more +=item * 3 elements, or more -Nothing happens. It is not allowed to duplicate answers. +Nothing happens. It is not allowed to duplicate answers. =back =cut sub copy { - my ( $self, $address ) = @_; - if ( @$address == 1 ) { - my $newSection = dclone $self->section($address); - push( @{ $self->sections }, $newSection ); - $address->[0] = $#{ $self->sections }; - return $address; + my $self = shift; + my ($address) = validate_pos(@_, { type => ARRAYREF }); + + # Figure out what to do by counting the number of elements in the $address array ref + my $count = @{$address}; + + if ( $count == 1 ) { + # Clone the indexed section onto the end of the list of sections.. + push @{ $self->sections }, dclone $self->section($address); + + # Update $address with the index of the newly created section + $address->[0] = $self->lastSectionIndex; } - elsif ( @$address == 2 ) { - my $newQuestion = dclone $self->question($address); - push( @{ $self->questions($address) }, $newQuestion ); - $address->[1] = $#{ $self->questions($address) }; - return $address; + elsif ( $count == 2 ) { + # Clone the indexed question onto the end of the list of questions.. + push @{ $self->questions($address) }, dclone $self->question($address); + + # Update $address with the index of the newly created question + $address->[1] = $self->lastQuestionIndex($address); } + # Return the (modified) $address + return $address; } =head2 remove ( $address, $movingOverride ) -Delete the structure pointed to by $address. +Delete the section/question/answer indexed by $address. Modifies $address if it has 1 or more elements. =head3 $address -An array ref. The number of elements array set what is added, and -where. +See L<"Address Parameter">. -This method modifies $address if it has 1 or more elements. +The number of elements in $address determines the behaviour: =over 4 -=item 1 element +=item * 1 element -If there's just 1 element, then the section with that index is removed. Normally, -the first section, index 0, cannot be removed. See $movingOverride below. +Remove the indexed section. Normally, the first section, index 0, cannot be removed. See $movingOverride below. -=item 2 elements +=item * 2 elements -If there are 2 elements, the question in the section is removed. -in that section. +Remove the indexed question =item 3 elements -Removes the answer in the specified question and section. +Remove the indexed answer =back =head3 $movingOverride -If $movingOverride is defined (meaning including 0 and ''), then the first section -is allowed to be removed. +If $movingOverride is defined (meaning including 0 and ''), then the first section is allowed to be removed. =cut sub remove { - my ( $self, $address, $movingOverride ) = @_; - if ( @$address == 1 ) { - splice( @{ $self->{sections} }, $$address[0], 1 ) - if ( $$address[0] != 0 or defined $movingOverride ); #can't delete the first section + my $self = shift; + my ($address, $movingOverride) = validate_pos(@_, { type => ARRAYREF }, 0); + + # Figure out what to do by counting the number of elements in the $address array ref + my $count = @{$address}; + + # Use splice to remove the indexed section/question/answer.. + if ( $count == 1 ) { + # Make sure the first section isn't removed unless we REALLY want to + if ( sIndex($address) != 0 || defined $movingOverride ) { + splice @{ $self->sections }, sIndex($address), 1; + } } - elsif ( @$address == 2 ) { - splice( @{ $self->questions($address) }, $$address[1], 1 ); + elsif ( $count == 2 ) { + splice @{ $self->questions($address) }, qIndex($address), 1; } - elsif ( @$address == 3 ) { - splice( @{ $self->answers($address) }, $$address[2], 1 ); + elsif ( $count == 3 ) { + splice @{ $self->answers($address) }, aIndex($address), 1; } + + return; } =head2 newSection @@ -649,17 +841,18 @@ Returns a reference to a new, empty section. sub newSection { return { - text => '', + text => q{}, title => 'NEW SECTION', ##i18n - variable => '', + variable => q{}, questionsPerPage => 5, questionsOnSectionPage => 1, randomizeQuestions => 0, everyPageTitle => 1, everyPageText => 1, terminal => 0, - terminalUrl => '', - goto => '', + terminalUrl => q{}, + goto => q{}, + gotoExpression => q{}, timeLimit => 0, type => 'section', questions => [], @@ -674,23 +867,23 @@ Returns a reference to a new, empty question. sub newQuestion { return { - text => '', - variable => '', + text => q{}, + variable => q{}, allowComment => 0, commentCols => 10, commentRows => 5, randomizeAnswers => 0, questionType => 'Multiple Choice', - randomWords => '', + randomWords => q{}, verticalDisplay => 0, required => 0, maxAnswers => 1, value => 1, textInButton => 0, -# terminal => 0, -# terminalUrl => '', type => 'question', answers => [], + goto => q{}, + gotoExpression => q{}, }; } @@ -702,173 +895,115 @@ Returns a reference to a new, empty answer. sub newAnswer { return { - text => '', + text => q{}, verbatim => 0, textCols => 10, textRows => 5, - goto => '', - recordedAnswer => '', + goto => q{}, + gotoExpression => q{}, + recordedAnswer => q{}, isCorrect => 1, min => 1, max => 10, step => 1, value => 1, terminal => 0, - terminalUrl => '', + terminalUrl => q{}, type => 'answer' }; } =head2 updateQuestionAnswers ($address, $type); -Add answers to a question, based on the requested type. +Remove all existing answers and add a default set of answers to a question, based on question type. =head3 $address -Which question to add answers to. +See L<"Address Parameter">. Determines question to add answers to. =head3 $type -The question type to use to determine how many and what kind of answers -to add to the question. +The question type determines how many answers to add and what answer text (if any) to use =cut sub updateQuestionAnswers { my $self = shift; - my $address = shift; - my $type = shift; + my ($address, $type) = validate_pos(@_, { type => ARRAYREF }, { type => SCALAR | UNDEF, optional => 1}); - my @addy = @{$address}; + # Make a private copy of the $address arrayref that we can use locally + # when updating answer text without causing side-effects for the caller's $address + my @address_copy = @{$address}; + + # Get the indexed question, and remove all of its existing answers my $question = $self->question($address); $question->{answers} = []; + # Add the default set of answers. The question type determines both the number + # of answers added and the answer text to use. When updating answer text + # first update $address_copy to point to the answer + if ( $type eq 'Date Range' or $type eq 'Multi Slider - Allocate' or $type eq 'Dual Slider - Range' ) { - push( @{ $question->{answers} }, $self->newAnswer() ); - push( @{ $question->{answers} }, $self->newAnswer() ); + push @{ $question->{answers} }, $self->newAnswer(); + push @{ $question->{answers} }, $self->newAnswer(); } elsif ( $type eq 'Currency' ) { - push( @{ $question->{answers} }, $self->newAnswer() ); - $addy[2] = 0; - $self->update( \@addy, { 'text', 'Currency Amount:' } ); + push @{ $question->{answers} }, $self->newAnswer(); + $address_copy[2] = 0; + $self->update( \@address_copy, { 'text', 'Currency Amount:' } ); } elsif ( $type eq 'Text Date' ) { - push( @{ $question->{answers} }, $self->newAnswer() ); - $addy[2] = 0; - $self->update( \@addy, { 'text', 'Date:' } ); + push @{ $question->{answers} }, $self->newAnswer(); + $address_copy[2] = 0; + $self->update( \@address_copy, { 'text', 'Date:' } ); } elsif ( $type eq 'Phone Number' ) { - push( @{ $question->{answers} }, $self->newAnswer() ); - $addy[2] = 0; - $self->update( \@addy, { 'text', 'Phone Number:' } ); + push @{ $question->{answers} }, $self->newAnswer(); + $address_copy[2] = 0; + $self->update( \@address_copy, { 'text', 'Phone Number:' } ); } elsif ( $type eq 'Email' ) { - push( @{ $question->{answers} }, $self->newAnswer() ); - $addy[2] = 0; - $self->update( \@addy, { 'text', 'Email:' } ); + push @{ $question->{answers} }, $self->newAnswer(); + $address_copy[2] = 0; + $self->update( \@address_copy, { 'text', 'Email:' } ); } - elsif ( $type eq 'Education' ) { - my @ans = ( - 'Elementary or some high school', - 'High school/GED', - 'Some college/vocational school', - 'College graduate', - 'Some graduate work', - 'Master\'s degree', - 'Doctorate (of any type)', - 'Other degree (verbatim)' - ); - $self->addAnswersToQuestion( \@addy, \@ans, { 7, 1 } ); + elsif ( my $answerBundle = $self->getMultiChoiceBundle($type) ) { + # We found a known multi-choice bundle. + + # Mark any answer containing the string "verbatim" as verbatim + my $verbatims = {}; + for my $answerIndex (0 .. $#$answerBundle) { + if ($answerBundle->[$answerIndex] =~ /\(verbatim\)/) { + $verbatims->{$answerIndex} = 1; + } + } + # Add the bundle of multi-choice answers, along with the verbatims hash + $self->addAnswersToQuestion( \@address_copy, $answerBundle, $verbatims ); + } else { + # Default action is to add a single, default answer to the question + push @{ $question->{answers} }, $self->newAnswer(); } - elsif ( $type eq 'Party' ) { - my @ans - = ( 'Democratic party', 'Republican party (or GOP)', 'Independent party', 'Other party (verbatim)' ); - $self->addAnswersToQuestion( \@addy, \@ans, { 3, 1 } ); - } - elsif ( $type eq 'Race' ) { - my @ans = ( 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic', - 'Something else (verbatim)' ); - $self->addAnswersToQuestion( \@addy, \@ans, { 5, 1 } ); - } - elsif ( $type eq 'Ideology' ) { - my @ans = ( - 'Strongly liberal', - 'Liberal', - 'Somewhat liberal', - 'Middle of the road', - 'Slightly conservative', - 'Conservative', - 'Strongly conservative' - ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Security' ) { - my @ans = ( 'Not at all secure', '', '', '', '', '', '', '', '', '', 'Extremely secure' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Threat' ) { - my @ans = ( 'No threat', '', '', '', '', '', '', '', '', '', 'Extreme threat' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Risk' ) { - my @ans = ( 'No risk', '', '', '', '', '', '', '', '', '', 'Extreme risk' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Concern' ) { - my @ans = ( 'Not at all concerned', '', '', '', '', '', '', '', '', '', 'Extremely concerned' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Effectiveness' ) { - my @ans = ( 'Not at all effective', '', '', '', '', '', '', '', '', '', 'Extremely effective' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Confidence' ) { - my @ans = ( 'Not at all confident', '', '', '', '', '', '', '', '', '', 'Extremely confident' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Satisfaction' ) { - my @ans = ( 'Not at all satisfied', '', '', '', '', '', '', '', '', '', 'Extremely satisfied' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Certainty' ) { - my @ans = ( 'Not at all certain', '', '', '', '', '', '', '', '', '', 'Extremely certain' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Likelihood' ) { - my @ans = ( 'Not at all likely', '', '', '', '', '', '', '', '', '', 'Extremely likely' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Importance' ) { - my @ans = ( 'Not at all important', '', '', '', '', '', '', '', '', '', 'Extremely important' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Oppose/Support' ) { - my @ans = ( 'Strongly oppose', '', '', '', '', '', 'Strongly support' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Agree/Disagree' ) { - my @ans = ( 'Strongly disagree', '', '', '', '', '', 'Strongly agree' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'True/False' ) { - my @ans = ( 'True', 'False' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Yes/No' ) { - my @ans = ( 'Yes', 'No' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - elsif ( $type eq 'Gender' ) { - my @ans = ( 'Male', 'Female' ); - $self->addAnswersToQuestion( \@addy, \@ans, {} ); - } - else { - push( @{ $question->{answers} }, $self->newAnswer() ); - } -} ## end sub updateQuestionAnswers + + return; +} + +=head2 getMultiChoiceBundle + +Returns a list of answers for each multi-choice bundle. + +Currently these are hard-coded but soon they will live in the database. + +=cut + +sub getMultiChoiceBundle { + my $self = shift; + my ($type) = validate_pos( @_, { type => SCALAR | UNDEF } ); + + return $MULTI_CHOICE_BUNDLES{$type}; +} =head2 addAnswersToQuestion ($address, $answers, $verbatims) @@ -876,7 +1011,7 @@ Helper routine for updateQuestionAnswers. Adds an array of answers to a questio =head3 $address -The address of the question to add answers to. +See L<"Address Parameter">. The address of the question to add answers to. =head3 $answers @@ -892,25 +1027,34 @@ set to true. =cut sub addAnswersToQuestion { - my $self = shift; - my $addy = shift; - my $ans = shift; - my $verbs = shift; - for ( 0 .. $#$ans ) { - push( @{ $self->question($addy)->{answers} }, $self->newAnswer() ); - $$addy[2] = $_; - if ( exists $$verbs{$_} and $verbs->{$_} ) { - $self->update( $addy, { 'text', $$ans[$_], 'recordedAnswer', $_ + 1, 'verbatim', 1 } ); - } - else { - $self->update( $addy, { 'text', $$ans[$_], 'recordedAnswer', $_ + 1 } ); - } - } -} ## end sub addAnswersToQuestion + my $self = shift; + my ( $address, $answers, $verbatims ) + = validate_pos( @_, { type => ARRAYREF }, { type => ARRAYREF }, { type => HASHREF } ); -#------------------------------ -#accessors and helpers -#------------------------------ + # Make a private copy of the $address arrayref that we can use locally + # when updating answer text without causing side-effects for the caller's $address + my @address_copy = @{$address}; + + for my $answer_index ( 0 .. $#{$answers} ) { + + # Add a new answer to question + push @{ $self->question( \@address_copy )->{answers} }, $self->newAnswer(); + + # Update address to point at newly created answer (so that we can update it) + $address_copy[2] = $answer_index; + + # Update the answer appropriately + $self->update( + \@address_copy, + { text => $answers->[$answer_index], + recordedAnswer => $answer_index + 1, + verbatim => $verbatims->{$answer_index}, + } + ); + } + + return; +} =head2 sections @@ -920,7 +1064,116 @@ Returns a reference to all the sections in this object. sub sections { my $self = shift; - return $self->{sections}; + return $self->{_sections}; +} + +=head2 lastSectionIndex + +Convenience method to return the index of the last Section. Frequently used to +iterate over all Sections. e.g. ( 0 .. lastSectionIndex ) + +=cut + +sub lastSectionIndex { + my $self = shift; + return $self->totalSections(@_) - 1; +} + +=head2 lastQuestionIndex + +Convenience method to return the index of the last Question, overall, or in the +given Section if $address given. Frequently used to +iterate over all Questions. e.g. ( 0 .. lastQuestionIndex ) + +=head3 $address (optional) + +See L<"Address Parameter">. + +=cut + +sub lastQuestionIndex { + my $self = shift; + return $self->totalQuestions(@_) - 1; +} + +=head2 lastQuestionIndex + +Convenience method to return the index of the last Answer, overall, or in the +given Question if $address given. Frequently used to +iterate over all Answers. e.g. ( 0 .. lastAnswerIndex ) + +=head3 $address (optional) + +See L<"Address Parameter">. + +=cut + +sub lastAnswerIndex { + my $self = shift; + return $self->totalAnswers(@_) - 1; +} + +=head2 totalSections + +Returns the total number of Sections + +=cut + +sub totalSections { + my $self = shift; + return scalar @{ $self->sections || [] }; +} + +=head2 totalQuestions ($address) + +Returns the total number of Questions, overall, or in the given Section if $address given + +=head3 $address (optional) + +See L<"Address Parameter">. + +=cut + +sub totalQuestions { + my $self = shift; + my ($address) = validate_pos(@_, { type => ARRAYREF, optional => 1 }); + + if ($address) { + return scalar @{ $self->questions($address) || [] }; + } else { + my $count = 0; + for my $sIndex (0 .. $self->lastSectionIndex) { + $count += $self->totalQuestions([$sIndex]); + } + return $count; + } +} + +=head2 totalAnswers ($address) + +Returns the total number of Answers overall, or in the given Question if $address given + +=head3 $address (optional) + +See L<"Address Parameter">. + +=cut + +sub totalAnswers { + my $self = shift; + my ($address) = validate_pos(@_, { type => ARRAYREF, optional => 1 }); + + if ($address) { + return scalar @{ $self->answers($address) || [] }; + } else { + my $count = 0; + for my $sIndex (0 .. $self->lastSectionIndex) { + for my $qIndex (0 .. $self->lastQuestionIndex([$sIndex])) { + $count += $self->totalAnswers([$sIndex, $qIndex]); + } + } + return $count; + } } =head2 section ($address) @@ -929,15 +1182,26 @@ Returns a reference to one section. =head3 $address -An array ref. The first element of the array ref is the index of -the section whose questions will be returned. +See L<"Address Parameter">. =cut sub section { my $self = shift; - my $address = shift; - return $self->{sections}->[ $$address[0] ]; + my ($address) = validate_pos(@_, { type => ARRAYREF}); + + return $self->sections->[ $address->[0] ]; +} + +=head2 session + +Accessor method for the local WebGUI::Session reference + +=cut + +sub session { + my $self = shift; + return $self->{_session}; } =head2 questions ($address) @@ -946,15 +1210,15 @@ Returns a reference to all the questions from a particular section. =head3 $address -An array ref. The first element of the array ref is the index of -the section whose questions will be returned. +See L<"Address Parameter">. =cut sub questions { my $self = shift; - my $address = shift; - return $self->{sections}->[ $$address[0] ]->{questions}; + my ($address) = validate_pos(@_, { type => ARRAYREF, optional => 1}); + + return $self->sections->[ $address->[0] ]->{questions}; } =head2 question ($address) @@ -963,16 +1227,15 @@ Return a reference to one question from a particular section. =head3 $address -An array ref. The first element of the array ref is the index of -the section. The second element is the index of the question in -that section. +See L<"Address Parameter">. =cut sub question { my $self = shift; - my $address = shift; - return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]; + my ($address) = validate_pos(@_, { type => ARRAYREF}); + + return $self->sections->[ $address->[0] ]->{questions}->[ $address->[1] ]; } #------------------------------------------------------------------- @@ -1000,17 +1263,15 @@ Return a reference to all answers from a particular question. =head3 $address -An array ref. The first element of the array ref is the index of -the section. The second element is the index of the question in -that section. An array ref of anwers from that question will be -returned. +See L<"Address Parameter">. =cut sub answers { my $self = shift; - my $address = shift; - return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]->{answers}; + my ($address) = validate_pos(@_, { type => ARRAYREF}); + + return $self->sections->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}; } =head2 answer ($address) @@ -1019,32 +1280,51 @@ Return a reference to one answer from a particular question and section. =head3 $address -An array ref. The first element of the array ref is the index of -the section. The second element is the index of the question in -that section. The third element is the index of the answer. +See L<"Address Parameter">. =cut sub answer { my $self = shift; - my $address = shift; - return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]->{answers}->[ $$address[2] ]; + my ($address) = validate_pos(@_, { type => ARRAYREF}); + + return $self->sections->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ]; } -=head2 log ($message) +=head2 sIndex ($address) -Logs an error message using the session logger. - -=head3 $message - -The message to log. It will be logged as type "error". +Convenience sub to extract the section index from a standard $address parameter. See L<"Address Parameter">. +This method exists purely to improve code readability. =cut -sub log { - my ( $self, $message ) = @_; - if ( defined $self->{log} ) { - $self->{log}->error($message); - } +sub sIndex { + my ($address) = validate_pos(@_, { type => ARRAYREF}); + return $address->[0]; } + +=head2 qIndex ($address) + +Convenience sub to extract the question index from a standard $address parameter. See L<"Address Parameter">. +This method exists purely to improve code readability. + +=cut + +sub qIndex { + my ($address) = validate_pos(@_, { type => ARRAYREF}); + return $address->[1]; +} + +=head2 aIndex ($address) + +Convenience sub to extract the answer index from a standard $address parameter. See L<"Address Parameter">. +This method exists purely to improve code readability. + +=cut + +sub aIndex { + my ($address) = validate_pos(@_, { type => ARRAYREF}); + return $address->[2]; +} + 1; diff --git a/lib/WebGUI/Workflow/Activity/ExpireIncompleteSurveyResponses.pm b/lib/WebGUI/Workflow/Activity/ExpireIncompleteSurveyResponses.pm new file mode 100644 index 000000000..25f5e2ea8 --- /dev/null +++ b/lib/WebGUI/Workflow/Activity/ExpireIncompleteSurveyResponses.pm @@ -0,0 +1,152 @@ +package WebGUI::Workflow::Activity::ExpireIncompleteSurveyResponses; + + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2008 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=cut + +use strict; +use base 'WebGUI::Workflow::Activity'; +use WebGUI::Asset; +use WebGUI::DateTime; +use DateTime::Duration; + +=head1 NAME + +Package WebGUI::Workflow::Activity::ExpireIncompleteSurveyResponses + +=head1 DESCRIPTION + +This activity deletes the survey responses for which the allowed time has expired and emails the survey user. + +=head1 SYNOPSIS + +See WebGUI::Workflow::Activity for details on how to use any activity. + +=head1 METHODS + +These methods are available from this class: + +=cut + + +#------------------------------------------------------------------- + +=head2 definition ( session, definition ) + +See WebGUI::Workflow::Activity::defintion() for details. + +=cut + +sub definition { + my $class = shift; + my $session = shift; + my $definition = shift; + my $i18n = WebGUI::International->new($session, "Workflow_Activity_ExpireIncompleteSurveyResponses"); + push(@{$definition}, { + name => $i18n->get("name"), + properties => { + deleteExpired=>{ + fieldType=>"yesNo", + defaultValue=>0, + label=>$i18n->get("Delete expired survey responses"), + hoverHelp=>$i18n->get("delete expired") + }, + emailUsers=>{ + fieldType=>"yesNo", + defaultValue=>0, + label=>$i18n->get("Email users that responses were deleted"), + hoverHelp=>$i18n->get("email users") + }, + emailTemplateId => { + fieldType => "template", + defaultValue => 'ExpireIncResptmpl00001', + namespace => "ExpireIncompleteSurveyResponses", + label => $i18n->get('Email template sent to user'), + hoverHelp => $i18n->get('email template'), + }, + from => { + fieldType=>"text", + label=>$i18n->get("from"), + defaultValue=>$session->setting->get("companyEmail"), + hoverHelp=>$i18n->get("from mouse over"), + }, + subject => { + fieldType=>"text", + label=>$i18n->get("subject", 'WebGUI'), + defaultValue=>"Expired Survey", + hoverHelp=>$i18n->get("subject mouse over"), + }, + } + }); + return $class->SUPER::definition($session,$definition); +} + + +#------------------------------------------------------------------- + +=head2 execute ( [ object ] ) + +Finds all the expired Survey Responses on the system. If delete is selected, they are removed. Then if +email is selected, the users are emailed the template. + +=cut + +sub execute { + my $self = shift; + my $session = $self->session; + + my $sql = "select r.Survey_responseId, r.username, r.userId, upd.email,upd.firstName,upd.lastName, r.startDate, s.timeLimit, ad.title, ad.url + from Survey s, Survey_response r, assetData ad, userProfileData upd + where r.isComplete = 0 and s.timeLimit > 0 and (unix_timestamp() - r.startDate) > (s.timeLimit * 60) + and r.assetId = s.assetId and s.revisionDate = (select max(revisionDate) from Survey where assetId = s.assetId) + and ad.assetId = s.assetId and ad.revisionDate = s.revisionDate and upd.userId = r.userId"; + my $refs = $self->session->db->buildArrayRefOfHashRefs($sql); + for my $ref (@{$refs}) { + if($self->get("deleteExpired") == 1){ + $self->session->db->write("delete from Survey_response where Survey_responseId = ?",[$ref->{Survey_responseId}]); + }else{#else sent to expired but not deleted + $self->session->db->write("update Survey_response set isComplete = 99 where Survey_responseId = ?",[$ref->{Survey_responseId}]); + } + if($self->get("emailUsers") == 1 && $ref->{email} =~ /\@/){ + + my $var = { + to => $ref->{email}, + from => $self->get("from"), + firstName => $ref->{firstName}, + lastName => $ref->{lastName}, + surveyTitle => $ref->{title}, + surveyUrl => $ref->{url}, + responseId => $ref->{Survey_responseId}, + deleted => $self->get("deleteExpired"), + companyName => $self->session->setting->get("companyName"), + }; + my $template = WebGUI::Asset->newByDynamicClass($self->session,$self->get('emailTemplateId')); + my $message = $template->processTemplate($var, $self->get("emailTemplateId")); + WebGUI::Macro::process($self->session,\$message); + my $mail = WebGUI::Mail::Send->create($self->session,{ + to => $ref->{email}, + subject => $self->get("subject"), + from => $self->get('from'), + }); + $mail->addHtml($message); + $mail->addFooter; + $mail->queue; + } + } + return $self->COMPLETE; +} + +1; + + diff --git a/lib/WebGUI/i18n/English/Asset_Survey.pm b/lib/WebGUI/i18n/English/Asset_Survey.pm index 1a29968b7..7229209ff 100644 --- a/lib/WebGUI/i18n/English/Asset_Survey.pm +++ b/lib/WebGUI/i18n/English/Asset_Survey.pm @@ -31,6 +31,10 @@ our $I18N = { message => q|View Grade Book|, lastUpdated => 1224686319 }, + 'delete responses' => { + message => q|Delete Responses|, + lastUpdated => 0 + }, 'continue button' => { message => q|Continue|, lastUpdated => 1224686319 @@ -83,7 +87,7 @@ our $I18N = { }, 'section name' => { - message => q|Section name:|, + message => q|Section title:|, lastUpdated => 1224686319 }, 'section name description' => { @@ -101,7 +105,7 @@ our $I18N = { lastUpdated => 0 }, 'section custom variable name' => { - message => q|Section custom variable name:|, + message => q|Section variable name:|, lastUpdated => 1224686319 }, 'section custom variable name description' => { @@ -110,7 +114,7 @@ our $I18N = { lastUpdated => 0 }, 'section branch goto variable name' => { - message => q|Section branch goto variable name:|, + message => q|Jump to:|, lastUpdated => 1224686319 }, 'section branch goto variable name description' => { @@ -222,6 +226,10 @@ our $I18N = { message => q|Question type:|, lastUpdated => 1224686319 }, + 'randomized words' => { + message => q|Randomized words:|, + lastUpdated => 1224686319 + }, 'question type description' => { message => q|Select this question's field type.|, context => q|Description of the 'question type' field, used as hoverhelp in the edit question dialog.|, @@ -256,21 +264,21 @@ our $I18N = { context => q|Description of the 'allow comment' field, used as hoverhelp in the edit question dialog.|, lastUpdated => 0 }, - 'cols' => { - message => q|Cols:|, + 'comment cols' => { + message => q|Comment Cols:|, lastUpdated => 1224686319 }, 'cols description' => { - message => q|The number of columns of the textarea input.|, + message => q|The number of columns used for the comment TextArea input field.|, context => q|Description of the 'cols' field, used as hoverhelp in the edit question dialog.|, lastUpdated => 0 }, - 'rows' => { - message => q|Rows:|, + 'comment rows' => { + message => q|Comment Rows:|, lastUpdated => 1224686319 }, 'rows description' => { - message => q|The number of rows of the textarea input.|, + message => q|The number of rows shown for the comment TextArea input field.|, context => q|Description of the 'rows' field, used as hoverhelp in the edit question dialog.|, lastUpdated => 0 }, @@ -325,11 +333,11 @@ our $I18N = { lastUpdated => 0 }, 'recorded answer' => { - message => q|Recorded answer:|, + message => q|Answer title:|, lastUpdated => 1224686319 }, 'recorded answer description' => { - message => q|The answer that will be recorded in the database. The recorded answer will be displayed in a multiple choice question's buttons, only if the question's 'Show text in button' property is set to yes. Otherwise the multiple choice buttons will be empty. |, + message => q|Text to display inside multiple-choice answer buttons (only if 'Show text in button' is enabled for this question).|, context => q|Description of the 'recorded answer' field, used as hoverhelp in the edit answer dialog.|, lastUpdated => 0 }, @@ -337,13 +345,22 @@ our $I18N = { message => q|Jump to:|, lastUpdated => 1224686319 }, + 'jump expression' => { + message => q|Jump expression:|, + lastUpdated => 1229318805 + }, 'jump to description' => { message => q|The section or question with this variable name will be the next to be displayed after this answer.|, context => q|Description of the 'jump to' field, used as hoverhelp in the edit answer dialog.|, lastUpdated => 0 + }, + 'jump expression description' => { + message => q|An expression used to control complex branching based user responses to previous questions. A branch expression is made up of a list of rules, one per line, along with a branch target for each rule. |, + context => q|Description of the 'jump expression' field, used as hoverhelp in the edit answer dialog.|, + lastUpdated => 0 }, 'text answer' => { - message => q|Text answer|, + message => q|TextArea|, lastUpdated => 1224686319 }, 'is this the correct answer' => { @@ -363,30 +380,30 @@ our $I18N = { message => q|No|, lastUpdated => 1224686319 }, - 'min' => { - message => q|Min|, + 'min label' => { + message => q|Slider Min|, lastUpdated => 1224686319 }, 'min description' => { - message => q|Set the min value of this answer for slider type questions.|, + message => q|The minimum value of this answer for slider type questions.|, context => q|Description of the 'min' field, used as hoverhelp in the edit answer dialog.|, lastUpdated => 0 }, 'max label' => { - message => q|Max|, + message => q|Slider Max|, lastUpdated => 1224686319 }, 'max description' => { - message => q|Set the max value of this answer for slider type questions.|, + message => q|The maximum value of this answer for slider type questions.|, context => q|Description of the 'max' field, used as hoverhelp in the edit answer dialog.|, lastUpdated => 0 }, 'step label' => { - message => q|Step|, + message => q|Slider Step|, lastUpdated => 1224686319 }, 'step description' => { - message => q|Set the step value of this answer for slider type questions.|, + message => q|The step value of this answer for slider type questions.|, context => q|Description of the 'step' field, used as hoverhelp in the edit answer dialog.|, lastUpdated => 0 }, @@ -395,7 +412,7 @@ our $I18N = { lastUpdated => 1224686319 }, 'verbatim description' => { - message => q|Set to yes to add an extra text input to the answer, where the user can enter a single line of text.|, + message => q|Set to yes to add an extra text input to the answer, where the user can enter a single line of text. Typically used to permit a free-text 'other' response.|, context => q|Description of the 'verbatim' field, used as hoverhelp in the edit answer dialog.|, lastUpdated => 0 }, @@ -404,7 +421,7 @@ our $I18N = { lastUpdated => 1224686319 }, 'answer value description' => { - message => q|Enter a value for this answer.|, + message => q|Assign a numeric scores to this answers. Used in question scoring and jump expressions.|, context => q|Description of the 'answer value' field, used as hoverhelp in the edit answer dialog.|, lastUpdated => 0 }, @@ -429,7 +446,35 @@ our $I18N = { message => q|The template to display the main page of the survey.|, lastUpdated => 0, }, - + 'do after timelimit label' => { + message => q|Do After Time Limit:|, + lastUpdated => 1224686319, + context => q|label for the 'do after timelimit' field on the Properties tab of the Survey's edit screen.|, + }, + 'do after timelimit hoverHelp' => { + message => q|Select what happens after the time limit for finishing the survey has expired.|, + lastUpdated => 1231193335, + context => q|description of the 'do after timelimit' field on the Properties tab of the Survey's edit +screen|, + }, + 'exit url label' =>{ + message => q|Exit URL|, + lastUpdated => 0, + context => q|Label for the 'exit url' option of the 'do after timelimit' field on the Properties tab of the +Survey's edit screen|, + }, + 'restart survey label' =>{ + message => q|Restart Survey|, + lastUpdated => 0, + context => q|Label for the 'restart survey' option of the 'do after timelimit' field on the Properties tab of the +Survey's edit screen|, + }, + 'restart message' =>{ + message => q|The survey was restarted because the time limit for completing the survey was reached.|, + lastUpdated => 0, + context => q|The message shown to the user taking the survey when the survey is restarted after reaching +the time limit for completing the survey. This message is in the 'take survey' template.|, + }, 'Show user their progress' => { message => q|Show user their progress?|, lastUpdated => 0, @@ -489,6 +534,36 @@ our $I18N = { message => q|When the user finishes the surevey, they will be sent to this URL. Leave blank if no special forwarding is required. The gateway setting from the config file will be automatically added to the URL for you.|, lastUpdated => 1233714385, }, + + 'Overview Report Template' => { + message => q|Overview Report Template|, + lastUpdated => 0, + }, + + 'Overview Report Template help' => { + message => q|The template used to display the Overview Report.|, + lastUpdated => 0, + }, + + 'Grabebook Report Template' => { + message => q|Grabebook Report Template|, + lastUpdated => 0, + }, + + 'Grabebook Report Template help' => { + message => q|The template used to display the Gradebook Report|, + lastUpdated => 0, + }, + + 'Survey Edit Template' => { + message => q|Survey Edit Template|, + lastUpdated => 0, + }, + + 'Survey Edit Template help' => { + message => q|The template used to display the Survey Edit screen.|, + lastUpdated => 0, + }, 'Max user responses' => { message => q|Max user responses|, @@ -523,17 +598,6 @@ our $I18N = { lastUpdated => 0 }, - 'Response Template' => { - message => q|Response Template|, - context => q|The template for displaying responses to the survey.|, - lastUpdated => 0 - }, - - 'Response Template help' => { - message => q|The template for displaying responses to the survey.|, - lastUpdated => 0 - }, - 'Edit Survey Template' => { message => q|Edit Survey Template|, context => q|The template for displaying the screen for editing the survey.|, @@ -552,7 +616,7 @@ our $I18N = { }, 'Take Survey Template help' => { - message => q|The template for displaying the screen where a user takes the survey.|, + message => q|The template used to control the initial Take Survey screen, from which responses are dynamically loaded into.|, lastUpdated => 0 }, @@ -563,7 +627,7 @@ our $I18N = { }, 'Questions Template help' => { - message => q|The template for rendering questions in the survey.|, + message => q|The template used to display individual questions, which are dynamically loaded into the Take Survey page.|, lastUpdated => 0 }, @@ -574,7 +638,7 @@ our $I18N = { }, 'Section Edit Template help' => { - message => q|The template for adding or editing sections.|, + message => q|The template used to display the Section Edit dialog on the Edit Survey page.|, lastUpdated => 0 }, @@ -585,7 +649,7 @@ our $I18N = { }, 'Question Edit Template help' => { - message => q|The template for adding or editing questions.|, + message => q|The template used to display the Question Edit dialog on the Edit Survey page.|, lastUpdated => 0 }, @@ -596,7 +660,7 @@ our $I18N = { }, 'Answer Edit Template help' => { - message => q|The template for adding or editing answers.|, + message => q|The template used to display the Answer Edit dialog on the Edit Survey page.|, lastUpdated => 0 }, @@ -859,12 +923,6 @@ directly inside the answer_loop for other types of questions.|, lastUpdated => 0, }, - 'templateId' => { - message => q|The ID of the template to show the Survey.|, - context => q|Description of a template variable for a template Help page.|, - lastUpdated => 1168639537, - }, - 'groupToTakeSurvey' => { message => q|The ID of the group that is allowed to take the Survey.|, context => q|Description of a template variable for a template Help page.|, @@ -883,24 +941,6 @@ directly inside the answer_loop for other types of questions.|, lastUpdated => 1168643566, }, - 'overviewTemplateId' => { - message => q|The ID of the template used to show the overview screen.|, - context => q|Description of a template variable for a template Help page.|, - lastUpdated => 1168643669, - }, - - 'gradebookTemplateId' => { - message => q|The ID of the template used to show the gradebook screen.|, - context => q|Description of a template variable for a template Help page.|, - lastUpdated => 1168643669, - }, - - 'responseTemplateId' => { - message => q|The ID of the template used to show the Survey Response screen.|, - context => q|Description of a template variable for a template Help page.|, - lastUpdated => 1168643669, - }, - 'survey questions template title' => { message => q|Survey Questions Template|, context => q|The title of a template Help page.|, @@ -1227,18 +1267,6 @@ section/answer.|, lastUpdated => 0, }, - 'min' => { - message => q|The min value of this answer for slider type questions.|, - context => q|Description of a template variable for a template Help page.|, - lastUpdated => 0, - }, - - 'max' => { - message => q|The max value of this answer for slider type questions..|, - context => q|Description of a template variable for a template Help page.|, - lastUpdated => 0, - }, - 'step' => { message => q|The step value of this answer for slider type questions..|, context => q|Description of a template variable for a template Help page.|, @@ -1252,13 +1280,13 @@ section/answer.|, }, 'textCols' => { - message => q|The number of columns for textarea answers.|, + message => q|The number of columns for TextArea questions.|, context => q|Description of a template variable for a template Help page.|, lastUpdated => 0, }, 'textRows' => { - message => q|The number of rows for textarea answers.|, + message => q|The number of rows for TextArea questions.|, context => q|Description of a template variable for a template Help page.|, lastUpdated => 0, }, diff --git a/lib/WebGUI/i18n/English/Workflow_Activity_ExpireIncompleteSurveyResponses.pm b/lib/WebGUI/i18n/English/Workflow_Activity_ExpireIncompleteSurveyResponses.pm new file mode 100644 index 000000000..fc3bb8e85 --- /dev/null +++ b/lib/WebGUI/i18n/English/Workflow_Activity_ExpireIncompleteSurveyResponses.pm @@ -0,0 +1,67 @@ +package WebGUI::i18n::English::Workflow_Activity_ExpireIncompleteSurveyResponses; +use strict; + +our $I18N = { + 'name' => { + message => q|ExpireIncompleteSurveyResponses|, + lastUpdated => 0, + }, + 'Delete expired survey responses' => { + message => q|Delete expired survey responses|, + context => q|the hover help for the delete responses field|, + lastUpdated => 0, + }, + 'delete expired' => { + message => q|When ran, every survey response which is expired will be completely removed from the database.|, + context => q|the hover help for the delete responses field|, + lastUpdated => 0, + }, + 'Email users that responses were deleted' => { + message => q|Email users that responses were deleted|, + context => q|the hover help for the email users field|, + lastUpdated => 0, + }, + 'email users' => { + message => q|When a survey response is deleted, should the user be informed of this via email?|, + context => q|the hover help for the email users field|, + lastUpdated => 0, + }, + 'email template' => { + message => q|When an email is sent updating the user that their response has been deleted, this is the text that is sent to them.|, + context => q|the hover help for the email template field|, + lastUpdated => 0, + }, + 'from' => { + message => q|Email from field|, + context => q||, + lastUpdated => 0, + }, + 'from mouse over' => { + message => q|This is the from field that will show up in the sent email.|, + context => q||, + lastUpdated => 0, + }, + 'subject' => { + message => q|Email subject field|, + context => q||, + lastUpdated => 0, + }, + 'subject mouse over' => { + message => q|This is the subject field that will show up in the sent email.|, + context => q||, + lastUpdated => 0, + }, + 'Email template sent to user' => { + message => q|The template for the email|, + context => q||, + lastUpdated => 0, + }, + 'email template' => { + message => q|This is the email template that will be sent to the user|, + context => q||, + lastUpdated => 0, + }, + +}; + +1; diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 91587fb37..ced824337 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -120,6 +120,7 @@ checkModule("List::MoreUtils", "0.22" ); checkModule("File::Path", "2.04" ); checkModule("Module::Find", "0.06" ); checkModule("Class::C3", "0.19" ); +checkModule("Params::Validate", "0.81" ); failAndExit("Required modules are missing, running no more checks.") if $missingModule; diff --git a/t/Asset/Wobject/Survey.t b/t/Asset/Wobject/Survey.t index a4612c555..9d8a1ea36 100644 --- a/t/Asset/Wobject/Survey.t +++ b/t/Asset/Wobject/Survey.t @@ -18,7 +18,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 1; +my $tests = 10; plan tests => $tests + 1; #---------------------------------------------------------------------------- @@ -37,6 +37,56 @@ $import_node = WebGUI::Asset->getImportNode($session); $survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } ); isa_ok($survey, 'WebGUI::Asset::Wobject::Survey'); +# Load bare-bones survey, containing a single section (S0) +$survey->surveyJSON_update([0], { variable => 'S0' }); + +# Add 2 questions to S0 +$survey->surveyJSON_newObject([0]); # S0Q0 +$survey->surveyJSON_update([0,0], { variable => 'S0Q0' }); +$survey->surveyJSON_newObject([0]); # S0Q1 +$survey->surveyJSON_update([0,1], { variable => 'S0Q1' }); + +# Add a new section (S1) +$survey->surveyJSON_newObject([]); # S1 +$survey->surveyJSON_update([1], { variable => 'S1' }); + +# Add 2 questions to S1 +$survey->surveyJSON_newObject([1]); # S1Q0 +$survey->surveyJSON_update([1,0], { variable => 'S1Q0' }); +$survey->surveyJSON_newObject([1]); # S1Q1 +$survey->surveyJSON_update([1,1], { variable => 'S1Q1' }); + +# Now start a response as admin user +$session->user( { userId =>3 } ); +$survey->responseIdCookies(0); + +#for my $address (@{ $survey->responseJSON->surveyOrder }) { +# diag (Dumper $address); +#} + +# www_jumpTo +{ + # Check a simple www_jumpTo request + 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'); + + tie my %expectedSurveyOrder, 'Tie::IxHash'; + %expectedSurveyOrder = ( + 'undefined' => 0, + '0' => 0, + '0-0' => 0, + '0-1' => 1, + '1' => 2, + '1-0' => 2, + '1-1' => 3, + ); + while (my ($id, $index) = each %expectedSurveyOrder) { + WebGUI::Test->getPage( $survey, 'www_jumpTo', { formParams => {id => $id} } ); + is($survey->responseJSON->nextResponse, $index, "jumpTo($id) sets nextResponse to $index"); + } +} + } #---------------------------------------------------------------------------- diff --git a/t/Asset/Wobject/Survey/ResponseJSON.t b/t/Asset/Wobject/Survey/ResponseJSON.t index f8f424d52..d278dd9d3 100644 --- a/t/Asset/Wobject/Survey/ResponseJSON.t +++ b/t/Asset/Wobject/Survey/ResponseJSON.t @@ -9,6 +9,7 @@ use lib "$FindBin::Bin/../../../lib"; use Test::More; use Test::Deep; use Test::MockObject::Extends; +use Test::Exception; use Data::Dumper; use WebGUI::Test; # Must use this before any other WebGUI modules use WebGUI::Session; @@ -20,7 +21,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 52; +my $tests = 79; plan tests => $tests + 1; #---------------------------------------------------------------------------- @@ -40,17 +41,16 @@ skip $tests, "Unable to load ResponseJSON" unless $usedOk; #################################################### my $newTime = time(); -$responseJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new('{}', $session->log); +$responseJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), '{}'); isa_ok($responseJSON , 'WebGUI::Asset::Wobject::Survey::ResponseJSON'); is($responseJSON->lastResponse(), -1, 'new: default lastResponse is -1'); -is($responseJSON->{questionsAnswered}, 0, 'new: questionsAnswered is 0 by default'); -cmp_ok((abs$responseJSON->{startTime} - $newTime), '<=', 2, 'new: by default startTime set to time'); +is($responseJSON->questionsAnswered, 0, 'new: questionsAnswered is 0 by default'); +cmp_ok((abs$responseJSON->startTime - $newTime), '<=', 2, 'new: by default startTime set to time'); is_deeply( $responseJSON->responses, {}, 'new: by default, responses is an empty hashref'); -is_deeply( $responseJSON->surveyOrder, [], 'new: by default, responses is an empty arrayref'); my $now = time(); -my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(qq!{ "startTime": $now }!, $session->log); +my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), qq!{ "startTime": $now }!); cmp_ok(abs($rJSON->startTime() - $now), '<=', 2, 'new: startTime set using JSON'); #################################################### @@ -81,13 +81,13 @@ ok( ! $rJSON->hasTimedOut(4*60), 'hasTimedOut, limit check'); #################################################### # -# createSurveyOrder +# initSurveyOrder # #################################################### -$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session)); +$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!); -$rJSON->createSurveyOrder(); +#$rJSON->initSurveyOrder(); cmp_deeply( $rJSON->surveyOrder, [ @@ -101,7 +101,7 @@ cmp_deeply( [ 3, 1, [0, 1, 2, 3, 4, 5, 6] ], [ 3, 2, [0] ], ], - 'createSurveyOrder, enumerated all sections, questions and answers' + 'initSurveyOrder, enumerated all sections, questions and answers' ); #################################################### @@ -118,38 +118,35 @@ cmp_deeply( #################################################### # -# createSurveyOrder, part 2 +# initSurveyOrder, part 2 # #################################################### { - no strict "refs"; - no warnings; - my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session)); - $rJSON->survey->section([0])->{randomizeQuestions} = 0; - my $shuffleName = "WebGUI::Asset::Wobject::Survey::ResponseJSON::shuffle"; - my $shuffleCalled = 0; - my $shuffleRef = \&$shuffleName; - *$shuffleName = sub { - $shuffleCalled = 1; - goto &$shuffleRef; - }; - $rJSON->createSurveyOrder(); - is($shuffleCalled, 0, 'createSurveyOrder did not call shuffle on a section'); + my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!); + + $rJSON->survey->section([0])->{randomizeQuestions} = 0; + $rJSON->initSurveyOrder(); + my @question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder}; + cmp_deeply(\@question_order, [0,1,2], 'initSurveyOrder did not shuffle questions'); - $shuffleCalled = 0; $rJSON->survey->section([0])->{randomizeQuestions} = 1; - $rJSON->createSurveyOrder(); - is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a section'); + srand(42); # Make shuffle predictable + $rJSON->initSurveyOrder(); + @question_order = map {$_->[1]} grep {$_->[0] == 0} @{$rJSON->surveyOrder}; + cmp_deeply(\@question_order, [2,0,1], 'initSurveyOrder shuffled questions in first section'); - $shuffleCalled = 0; $rJSON->survey->section([0])->{randomizeQuestions} = 0; - $rJSON->survey->question([0,0])->{randomizeAnswers} = 1; - $rJSON->createSurveyOrder(); - is($shuffleCalled, 1, 'createSurveyOrder called shuffle on a question'); - - ##Restore the subroutine to the original - *$shuffleName = &$shuffleRef; + $rJSON->survey->question([0,0])->{randomizeAnswers} = 0; + $rJSON->initSurveyOrder(); + my @answer_order = map {@{$_->[2]}} grep {$_->[0] == 3 && $_->[1] == 1} @{$rJSON->surveyOrder}; + cmp_deeply(\@answer_order, [0,1,2,3,4,5,6], 'initSurveyOrder did not shuffle answers'); + + $rJSON->survey->question([3,1])->{randomizeAnswers} = 1; + srand(42); # Make shuffle predictable + $rJSON->initSurveyOrder(); + @answer_order = map {@{$_->[2]}} grep {$_->[0] == 3 && $_->[1] == 1} @{$rJSON->surveyOrder}; + cmp_deeply(\@answer_order, [1,3,4,5,6,0,2], 'initSurveyOrder shuffled answers'); } #################################################### @@ -169,51 +166,51 @@ ok( $rJSON->surveyEnd(), 'surveyEnd, with 9 elements, 20 >= end of survey'); #################################################### # -# nextSectionId, nextSection, currentSection +# nextResponseSectionIndex, nextResponseSection, lastResponseSectionIndex # #################################################### $rJSON->lastResponse(0); -is($rJSON->nextSectionId(), 0, 'nextSectionId, lastResponse=0, nextSectionId=0'); +is($rJSON->nextResponseSectionIndex, 0, 'nextResponseSectionIndex, lastResponse=0, nextResponseSectionIndex=0'); cmp_deeply( - $rJSON->nextSection, + $rJSON->nextResponseSection, $rJSON->survey->section([0]), - 'lastResponse=0, nextSection = section 0' + 'lastResponse=0, nextResponseSection = section 0' ); -cmp_deeply( - $rJSON->currentSection, - $rJSON->survey->section([0]), - 'lastResponse=0, currentSection = section 0' +is( + $rJSON->lastResponseSectionIndex, + 0, + 'lastResponse=0, lastResponseSectionIndex = 0' ); $rJSON->lastResponse(2); -is($rJSON->nextSectionId(), 1, 'nextSectionId, lastResponse=2, nextSectionId=1'); +is($rJSON->nextResponseSectionIndex(), 1, 'nextResponseSectionIndex, lastResponse=2, nextResponseSectionIndex=1'); cmp_deeply( - $rJSON->nextSection, + $rJSON->nextResponseSection, $rJSON->survey->section([1]), - 'lastResponse=2, nextSection = section 1' + 'lastResponse=2, nextResponseSection = section 1' ); -cmp_deeply( - $rJSON->currentSection, - $rJSON->survey->section([0]), - 'lastResponse=2, currentSection = section 0' +is( + $rJSON->lastResponseSectionIndex, + 0, + 'lastResponse=2, lastResponseSectionIndex = 0' ); $rJSON->lastResponse(6); -is($rJSON->nextSectionId(), 3, 'nextSectionId, lastResponse=6, nextSectionId=3'); +is($rJSON->nextResponseSectionIndex(), 3, 'nextResponseSectionIndex, lastResponse=6, nextResponseSectionIndex=3'); cmp_deeply( - $rJSON->nextSection, + $rJSON->nextResponseSection, $rJSON->survey->section([3]), - 'lastResponse=0, nextSection = section 3' + 'lastResponse=0, nextResponseSection = section 3' ); cmp_deeply( - $rJSON->currentSection, - $rJSON->survey->section([3]), - 'lastResponse=6, currentSection = section 3' + $rJSON->lastResponseSectionIndex, + 3, + 'lastResponse=6, lastResponseSectionIndex = 3' ); $rJSON->lastResponse(20); -is($rJSON->nextSectionId(), undef, 'nextSectionId, lastResponse > surveyEnd, nextSectionId=undef'); +is($rJSON->nextResponseSectionIndex(), undef, 'nextResponseSectionIndex, lastResponse > surveyEnd, nextResponseSectionIndex=undef'); #################################################### # @@ -223,14 +220,14 @@ is($rJSON->nextSectionId(), undef, 'nextSectionId, lastResponse > surveyEnd, nex $rJSON->lastResponse(20); ok($rJSON->surveyEnd, 'nextQuestions: lastResponse indicates end of survey'); -is_deeply($rJSON->nextQuestions, [], 'nextQuestions returns an empty array ref if there are no questions available'); +is_deeply([$rJSON->nextQuestions], [], 'nextQuestions returns an empty array if there are no questions available'); $rJSON->survey->section([0])->{questionsPerPage} = 2; $rJSON->survey->section([1])->{questionsPerPage} = 2; $rJSON->survey->section([2])->{questionsPerPage} = 2; $rJSON->survey->section([3])->{questionsPerPage} = 2; $rJSON->lastResponse(-1); cmp_deeply( - $rJSON->nextQuestions(), + [$rJSON->nextQuestions], [ superhashof({ sid => 0, @@ -262,7 +259,7 @@ cmp_deeply( $rJSON->lastResponse(1); cmp_deeply( - $rJSON->nextQuestions(), + [$rJSON->nextQuestions], [ superhashof({ sid => 0, @@ -286,9 +283,9 @@ cmp_deeply( $rJSON->lastResponse(4); cmp_deeply( - $rJSON->nextQuestions(), - undef, - 'nextQuestions: returns undef if the next section is empty' + [$rJSON->nextQuestions], + [], + 'nextQuestions: returns an empty array if the next section is empty' ); #################################################### @@ -310,15 +307,90 @@ $rJSON->survey->question([3,1])->{variable} = 'goto 3-0'; ##Intentional duplica $rJSON->survey->question([3,2])->{variable} = 'goto 3-2'; $rJSON->lastResponse(0); -$rJSON->goto('goto 80'); +$rJSON->processGoto('goto 80'); is($rJSON->lastResponse(), 0, 'goto: no change in lastResponse if the variable cannot be found'); -$rJSON->goto('goto 1'); +$rJSON->processGoto('goto 1'); is($rJSON->lastResponse(), 2, 'goto: works on existing section'); -$rJSON->goto('goto 0-1'); +$rJSON->processGoto('goto 0-1'); is($rJSON->lastResponse(), 0, 'goto: works on existing question'); -$rJSON->goto('goto 3-0'); +$rJSON->processGoto('goto 3-0'); is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates'); +#################################################### +# +# processGotoExpression +# +#################################################### +throws_ok { $rJSON->parseGotoExpression() } 'WebGUI::Error::InvalidParam', 'processGotoExpression takes exception to empty arguments'; +is($rJSON->parseGotoExpression(q{}), + undef, '.. and undef with empty expression'); +is($rJSON->parseGotoExpression('blah-dee-blah-blah'), + undef, '.. and undef with duff expression'); +is($rJSON->parseGotoExpression(':'), + undef, '.. and undef with missing target'); +is($rJSON->parseGotoExpression('t1:'), + undef, '.. and undef with missing expression'); +cmp_deeply($rJSON->parseGotoExpression('t1: 1'), + { target => 't1', expression => '1'}, 'works for simple numeric expression'); +cmp_deeply($rJSON->parseGotoExpression('t1: 1 - 23 + 456 * (78 / 9.0)'), + { target => 't1', expression => '1 - 23 + 456 * (78 / 9.0)'}, 'works for expression using all algebraic tokens'); +is($rJSON->parseGotoExpression('t1: 1 + &'), undef, '.. but disallows expression containing non-whitelisted token'); +cmp_deeply($rJSON->parseGotoExpression('t1: 1 = 3'), + { target => 't1', expression => '1 == 3'}, 'converts single = to =='); +cmp_deeply($rJSON->parseGotoExpression('t1: 1 != 3 <= 4 >= 5'), + { target => 't1', expression => '1 != 3 <= 4 >= 5'}, q{..but doesn't mess with other ops containing =}); +cmp_deeply($rJSON->parseGotoExpression('t1: q1 + q2 * q3 - 4', { q1 => 11, q2 => 22, q3 => 33}), + { target => 't1', expression => '11 + 22 * 33 - 4'}, 'substitues q for value'); +cmp_deeply($rJSON->parseGotoExpression('t1: a silly var name * 10 + another var name', { 'a silly var name' => 345, 'another var name' => 456}), + { target => 't1', expression => '345 * 10 + 456'}, '..it even works for vars with spaces in their names'); +is($rJSON->parseGotoExpression('t1: qX + 3', { q1 => '7'}), + undef, q{..but doesn't like invalid var names}); + +#################################################### +# +# gotoExpression +# +#################################################### + +$rJSON->survey->section([0])->{variable} = 's0'; +$rJSON->survey->section([2])->{variable} = 's2'; +$rJSON->survey->question([1,0])->{variable} = 's1q0'; +$rJSON->survey->answer([1,0,0])->{value} = 3; + +$rJSON->lastResponse(2); +$rJSON->recordResponses({ + '1-0comment' => 'Section 1, question 0 comment', + '1-0-0' => 'First answer', + '1-0-0comment' => 'Section 1, question 0, answer 0 comment', +}); +is($rJSON->processGotoExpression('blah-dee-blah-blah'), undef, 'invalid gotoExpression is false'); +ok($rJSON->processGotoExpression('s0: s1q0 = 3'), '3 == 3 is true'); +ok(!$rJSON->processGotoExpression('s0: s1q0 = 4'), '3 == 4 is false'); +ok($rJSON->processGotoExpression('s0: s1q0 != 2'), '3 != 2 is true'); +ok(!$rJSON->processGotoExpression('s0: s1q0 != 3'), '3 != 3 is false'); +ok($rJSON->processGotoExpression('s0: s1q0 > 2'), '3 > 2 is true'); +ok($rJSON->processGotoExpression('s0: s1q0 < 4'), '3 < 2 is true'); +ok(!$rJSON->processGotoExpression('s0: s1q0 >= 4'), '3 >= 4 is false'); +ok(!$rJSON->processGotoExpression('s0: s1q0 <= 2'), '3 >= 4 is false'); + +cmp_deeply($rJSON->processGotoExpression(<<"END_EXPRESSION"), {target => 's2', expression => '3 == 3'}, 'first true expression wins'); +s0: s1q0 <= 2 +s2: s1q0 = 3 +END_EXPRESSION + +ok(!$rJSON->processGotoExpression(<<"END_EXPRESSION"), 'but multiple false expressions still false'); +s0: s1q0 <= 2 +s2: s1q0 = 345 +END_EXPRESSION + +$rJSON->processGotoExpression('s0: s1q0 = 3'); +is($rJSON->lastResponse(), -1, '.. lastResponse changed to -1 due to processGoto(s0)'); +$rJSON->processGotoExpression('s2: s1q0 = 3'); +is($rJSON->lastResponse(), 4, '.. lastResponse changed to 4 due to processGoto(s2)'); + +$rJSON->responses({}); +$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered); + #################################################### # # recordResponses @@ -328,7 +400,7 @@ is($rJSON->lastResponse(), 5, 'goto: finds first if there are duplicates'); $rJSON->lastResponse(4); my $terminals; cmp_deeply( - $rJSON->recordResponses($session, {}), + $rJSON->recordResponses({}), [ 0, undef ], 'recordResponses, if section has no questions, returns terminal info in the section. With no terminal info, returns [0, undef]', ); @@ -339,7 +411,7 @@ $rJSON->survey->section([2])->{terminalUrl} = '/terminal'; $rJSON->lastResponse(4); cmp_deeply( - $rJSON->recordResponses($session, {}), + $rJSON->recordResponses({}), [ 1, '/terminal' ], 'recordResponses, if section has no questions, returns terminal info in the section.', ); @@ -350,7 +422,7 @@ $rJSON->survey->question([1,0])->{terminalUrl} = 'question 1-0 terminal'; $rJSON->lastResponse(2); cmp_deeply( - $rJSON->recordResponses($session, { + $rJSON->recordResponses({ '1-0comment' => 'Section 1, question 0 comment', '1-0-0' => 'First answer', '1-0-0comment' => 'Section 1, question 0, answer 0 comment', @@ -358,6 +430,7 @@ cmp_deeply( [ 1, 'question 1-0 terminal' ], 'recordResponses: question terminal overrides section terminal', ); + is($rJSON->lastResponse(), 4, 'lastResponse advanced to next page of questions'); is($rJSON->questionsAnswered, 1, 'questionsAnswered=1, answered one question'); @@ -370,7 +443,7 @@ cmp_deeply( '1-0-0' => { comment => 'Section 1, question 0, answer 0 comment', 'time' => num(time(), 3), - value => 1, + value => 1, # 'recordedAnswer' value used because question is multi-choice }, '1-1' => { comment => undef, @@ -379,14 +452,44 @@ cmp_deeply( 'recordResponses: recorded responses correctly, two questions, one answer, comments, values and time' ); + +# Repeat with non multi-choice question, to check that submitted answer value is used +# instead of recordedValue +$rJSON->survey->question([1,0])->{questionType} = 'Text'; +$rJSON->lastResponse(2); +$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered); +$rJSON->recordResponses({ + '1-0comment' => 'Section 1, question 0 comment', + '1-0-0' => 'First answer', + '1-0-0comment' => 'Section 1, question 0, answer 0 comment', +}); +cmp_deeply( + $rJSON->responses, + { + '1-0' => { + comment => 'Section 1, question 0 comment', + }, + '1-0-0' => { + comment => 'Section 1, question 0, answer 0 comment', + 'time' => num(time(), 3), + value => 'First answer', # submitted answer value used this time because non-mc + }, + '1-1' => { + comment => undef, + } + }, + 'recordResponses: recorded responses correctly, two questions, one answer, comments, values and time' +); +$rJSON->survey->question([1,0])->{questionType} = 'Multiple Choice'; # revert change + $rJSON->survey->question([1,0,0])->{terminal} = 1; $rJSON->survey->question([1,0,0])->{terminalUrl} = 'answer 1-0-0 terminal'; -$rJSON->{responses} = {}; +$rJSON->responses({}); $rJSON->lastResponse(2); $rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered); cmp_deeply( - $rJSON->recordResponses($session, { + $rJSON->recordResponses({ '1-0comment' => 'Section 1, question 0 comment', '1-0-0' => "\t\t\t\n\n\n\t\t\t", #SOS in whitespace '1-0-0comment' => 'Section 1, question 0, answer 0 comment', @@ -408,6 +511,9 @@ cmp_deeply( 'recordResponses: if the answer is all whitespace, it is skipped over' ); is($rJSON->questionsAnswered, 0, 'question was all whitespace, not answered'); +#delete $rJSON->{_session}; +#delete $rJSON->survey->{_session}; +#diag(Dumper($rJSON)); } @@ -419,7 +525,7 @@ is($rJSON->questionsAnswered, 0, 'question was all whitespace, not answered'); sub buildSurveyJSON { my $session = shift; - my $sjson = WebGUI::Asset::Wobject::Survey::SurveyJSON->new(undef, $session->log); + my $sjson = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session); ##Build 4 sections. Remembering that one is created by default when you make an empty SurveyJSON object $sjson->newObject([]); $sjson->newObject([]); diff --git a/t/Asset/Wobject/Survey/SurveyJSON.t b/t/Asset/Wobject/Survey/SurveyJSON.t index 306922ccb..42f68a3ef 100644 --- a/t/Asset/Wobject/Survey/SurveyJSON.t +++ b/t/Asset/Wobject/Survey/SurveyJSON.t @@ -22,7 +22,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 96; +my $tests = 132; plan tests => $tests + 1 + 3; #---------------------------------------------------------------------------- @@ -126,10 +126,10 @@ skip $tests, "Unable to load SurveyJSON" unless $usedOk; # #################################################### -$surveyJSON = WebGUI::Asset::Wobject::Survey::SurveyJSON->new('{}', $session->log); +$surveyJSON = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session, '{}'); isa_ok($surveyJSON, 'WebGUI::Asset::Wobject::Survey::SurveyJSON'); -my $sJSON2 = WebGUI::Asset::Wobject::Survey::SurveyJSON->new(undef, $session->log); +my $sJSON2 = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session); isa_ok($sJSON2, 'WebGUI::Asset::Wobject::Survey::SurveyJSON', 'even with absolutely no JSON'); undef $sJSON2; @@ -173,9 +173,8 @@ cmp_deeply( 'new: empty JSON in constructor causes 1 new, default section to be created', ); -$surveyJSON = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( +$surveyJSON = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session, '{ "sections" : [], "survey" : {} }', - $session->log, ); cmp_deeply( @@ -188,16 +187,14 @@ cmp_deeply( lives_ok { - my $foo = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( - qq!{ "survey" : "on 16\x{201d} hand-crocheted Cord" }!, - $session->log + my $foo = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session, + encode_json({survey => "on 16\x{201d}" }), ); } 'new handles wide characters'; -$sJSON2 = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( +$sJSON2 = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session, '{ "sections" : [ { "type" : "section" } ], "survey" : {} }', - $session->log, ); cmp_deeply( @@ -276,7 +273,7 @@ cmp_deeply( # #################################################### -$surveyJSON = WebGUI::Asset::Wobject::Survey::SurveyJSON->new('{}', $session->log); +$surveyJSON = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session, '{}'); { my $section = $surveyJSON->section([0]); $section->{title} = 'Section 0'; @@ -2003,18 +2000,81 @@ cmp_deeply( 'updateQuestionAnswers: Dual Slider - Range' ); +#################################################### +# +# totalSections +# +#################################################### +{ + my $s = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($session, '{}'); + is($s->totalSections, 1, 'a'); + is($s->totalQuestions, 0, 'a'); + is($s->totalAnswers, 0, 'a'); + + # Add a new section + my $address = $s->newObject([]); + is($s->totalSections, 2, 'Now there are 2 sections'); + is($s->totalQuestions, 0, '..but still no questions'); + is($s->totalAnswers, 0, '..and no answers'); + + # Add a question to first section + $address = $s->newObject([0]); + is($s->totalSections, 2, 'Still 2 sections'); + is($s->totalQuestions, 1, '..and now 1 question'); + is($s->totalQuestions([0]), 1, '..in the intended section'); + is($s->totalAnswers, 0, '..but still no answers'); + + # Add a question to second section + $address = $s->newObject([1]); + is($s->totalSections, 2, 'Still 2 sections'); + is($s->totalQuestions, 2, '..and now 2 questions overall'); + is($s->totalQuestions([0]), 1, '..one in the first section'); + is($s->totalQuestions([1]), 1, '..and one in the second section'); + is($s->totalAnswers, 0, '..but still no answers'); + + # Add another question to second section + $address = $s->newObject([1]); + is($s->totalSections, 2, 'Still 2 sections'); + is($s->totalQuestions, 3, '..and now 3 questions overall'); + is($s->totalQuestions([0]), 1, '..one in the first section'); + is($s->totalQuestions([1]), 2, '..and two in the second section'); + is($s->totalAnswers, 0, '..but still no answers'); + + # Add an answer to second section, first question + $address = $s->newObject([1,0]); + is($s->totalSections, 2, 'Still 2 sections'); + is($s->totalQuestions, 3, '..and 3 questions'); + is($s->totalAnswers, 1, '..and now 1 answer overall'); + is($s->totalAnswers([0,0]), 0, '..0 in first question'); + is($s->totalAnswers([1,0]), 1, '..1 in second question'); + is($s->totalAnswers([1,1]), 0, '..0 in third question'); + + # Add an answer to second section, second question + $address = $s->newObject([1,1]); + is($s->totalSections, 2, 'Still 2 sections'); + is($s->totalQuestions, 3, '..and 3 questions'); + is($s->totalAnswers, 2, '..and now 2 answer overall'); + is($s->totalAnswers([0,0]), 0, '..0 in first question'); + is($s->totalAnswers([1,0]), 1, '..1 in second question'); + is($s->totalAnswers([1,1]), 1, '..1 in third question'); + + # Add a second answer to second section, second question + $address = $s->newObject([1,1]); + is($s->totalSections, 2, 'Still 2 sections'); + is($s->totalQuestions, 3, '..and 3 questions'); + is($s->totalAnswers, 3, '..and now 3 answer overall'); + is($s->totalAnswers([0,0]), 0, '..0 in first question'); + is($s->totalAnswers([1,0]), 1, '..1 in second question'); + is($s->totalAnswers([1,1]), 2, '..2 in third question'); +} + #################################################### # # log # #################################################### -WebGUI::Test->interceptLogging; - -my $logger = $surveyJSON->log("Everyone in here is innocent"); -is ($WebGUI::Test::logger_warns, undef, 'Did not log a warn'); -is ($WebGUI::Test::logger_info, undef, 'Did not log an info'); -is ($WebGUI::Test::logger_error, "Everyone in here is innocent", 'Logged an error'); +isa_ok($surveyJSON->session, 'WebGUI::Session', 'session() accessor works'); } @@ -2030,7 +2090,7 @@ is ($WebGUI::Test::logger_error, "Everyone in here is innocent", 'Logged an erro sub summarizeSectionSkeleton { my ($skeleton) = @_; my $summary = []; - foreach my $section (@{ $skeleton->{sections} }) { + foreach my $section (@{ $skeleton->{_sections} }) { my $summarySection = { title => $section->{title}, questions => [], @@ -2091,6 +2151,7 @@ sub getBareSkeletons { terminal => 0, terminalUrl => '', goto => '', + gotoExpression => '', timeLimit => 0, type => 'section', questions => [], @@ -2111,6 +2172,8 @@ sub getBareSkeletons { textInButton => 0, type => 'question', answers => [], + goto => '', + gotoExpression => '', }, { text => '', @@ -2118,6 +2181,7 @@ sub getBareSkeletons { textCols => 10, textRows => 5, goto => '', + gotoExpression => '', recordedAnswer => '', isCorrect => 1, min => 1, diff --git a/www/extras/wobject/Survey/administersurvey.js b/www/extras/wobject/Survey/administersurvey.js index 1d4bf27e2..a91b42696 100644 --- a/www/extras/wobject/Survey/administersurvey.js +++ b/www/extras/wobject/Survey/administersurvey.js @@ -8,49 +8,29 @@ if (typeof Survey === "undefined") { var CLASS_INVALID = 'survey-invalid'; // For elements that fail input validation var CLASS_INVALID_MARKER = 'survey-invalid-marker'; // For default '*' invalid field marker - var multipleChoice = { - 'Multiple Choice': 1, - 'Gender': 1, - 'Yes/No': 1, - 'True/False': 1, - 'Ideology': 1, - 'Race': 1, - 'Party': 1, - 'Education': 1, - 'Scale': 1, - 'Agree/Disagree': 1, - 'Oppose/Support': 1, - 'Importance': 1, - 'Likelihood': 1, - 'Certainty': 1, - 'Satisfaction': 1, - 'Confidence': 1, - 'Effectiveness': 1, - 'Concern': 1, - 'Risk': 1, - 'Threat': 1, - 'Security': 1 - }; - var text = { + // All specially-handled question types are listed here + // (anything else is assumed to be a multi-choice bundle) + var TEXT_TYPES = { 'Text': 1, 'Email': 1, 'Phone Number': 1, 'Text Date': 1, - 'Currency': 1 + 'Currency': 1, + 'TextArea': 1 }; - var slider = { + var SLIDER_TYPES = { 'Slider': 1, 'Dual Slider - Range': 1, 'Multi Slider - Allocate': 1 }; - var dateType = { + var DATE_TYPES = { 'Date': 1, 'Date Range': 1 }; - var fileUpload = { + var UPLOAD_TYPES = { 'File Upload': 1 }; - var hidden = { + var HIDDEN_TYPES = { 'Hidden': 1 }; @@ -353,7 +333,6 @@ if (typeof Survey === "undefined") { if (lastSection !== s.id || s.everyPageText === '1') { document.getElementById('headertext').style.display = 'block'; } - if (lastSection !== s.id && s.questionsOnSectionPage !== '1') { var span = document.createElement("div"); span.innerHTML = ""; @@ -385,11 +364,16 @@ if (typeof Survey === "undefined") { Survey.Form.addWidgets(qs); } }, - + addWidgets: function(qs){ hasFile = false; for (var i = 0; i < qs.length; i++) { var q = qs[i]; + if (!q || !q.answers) { + // gracefully handle q with no answers + continue; + } + var verts = ''; for (var x in q.answers) { if (YAHOO.lang.hasOwnProperty(q.answers, x)) { @@ -411,98 +395,99 @@ if (typeof Survey === "undefined") { } - if (multipleChoice[q.questionType]) { - var butts = []; - verb = 0; - for (var j = 0; j < q.answers.length; j++) { - var a = q.answers[j]; + if (DATE_TYPES[q.questionType]) { + for (var k = 0; k < q.answers.length; k++) { + var ans = q.answers[k]; if (toValidate[q.id]) { - toValidate[q.id].answers[a.id] = 1; + toValidate[q.id].answers[ans.id] = 1; } - var b = document.getElementById(a.id + 'button'); - /* - b = new YAHOO.widget.Button({ type: "checkbox", label: a.answerText, id: a.id+'button', name: a.id+'button', - value: a.id, - container: a.id+"container", checked: false }); - */ - // b.on("click", buttonChanged,[b,a.id,q.maxAnswers,butts,qs.length,a.id]); - // YAHOO.util.Event.addListener(a.id+'button', "click", buttonChanged,[b,a.id,q.maxAnswers,butts,qs.length,a.id]); - if (a.verbatim) { - verb = 1; - } - YAHOO.util.Event.addListener(a.id + 'button', "click", buttonChanged, [b, a.id, q.maxAnswers, butts, qs.length, a.id]); - b.hid = a.id; - butts.push(b); + var calid = ans.id + 'container'; + var c = new YAHOO.widget.Calendar(calid, { + title: 'Choose a date:', + close: true + }); + c.selectEvent.subscribe(selectCalendar, [c, ans.id], true); + c.render(); + c.hide(); + var btn = new YAHOO.widget.Button({ + label: "Select Date", + id: "pushbutton" + ans.id, + container: ans.id + 'button' + }); + btn.on("click", showCalendar, [c]); } + continue; } - else - if (dateType[q.questionType]) { - for (var k = 0; k < q.answers.length; k++) { - var ans = q.answers[k]; - if (toValidate[q.id]) { - toValidate[q.id].answers[ans.id] = 1; + + if (SLIDER_TYPES[q.questionType]) { + //First run through and put up the span placeholders and find the max value for an answer, to know how big the allocation points will be. + var max = 0; + if (q.questionType === 'Dual Slider - Range') { + handleDualSliders(q); + } + else { + for (var s in q.answers) { + if (YAHOO.lang.hasOwnProperty(q.answers, s)) { + var a1 = q.answers[s]; + YAHOO.util.Event.addListener(a1.id, "blur", sliderTextSet); + if (a1.max - a1.min > max) { + max = a1.max - a1.min; + } } - var calid = ans.id + 'container'; - var c = new YAHOO.widget.Calendar(calid, { - title: 'Choose a date:', - close: true - }); - c.selectEvent.subscribe(selectCalendar, [c, ans.id], true); - c.render(); - c.hide(); - var btn = new YAHOO.widget.Button({ - label: "Select Date", - id: "pushbutton" + ans.id, - container: ans.id + 'button' - }); - btn.on("click", showCalendar, [c]); } } + if (q.questionType === 'Multi Slider - Allocate') { + //sliderManagers[sliderManagers.length] = new this.sliderManager(q,max); + for (var x1 = 0; x1 < q.answers.length; x1++) { + if (toValidate[q.id]) { + toValidate[q.id].total = q.answers[x1].max; + toValidate[q.id].answers[q.answers[x1].id] = 1; + } + } + sliderManager(q, max); + } else - if (slider[q.questionType]) { - //First run through and put up the span placeholders and find the max value for an answer, to know how big the allocation points will be. - var max = 0; - if (q.questionType === 'Dual Slider - Range') { - handleDualSliders(q); - } - else { - for (var s in q.answers) { - if (YAHOO.lang.hasOwnProperty(q.answers, s)) { - var a1 = q.answers[s]; - YAHOO.util.Event.addListener(a1.id, "blur", sliderTextSet); - if (a1.max - a1.min > max) { - max = a1.max - a1.min; - } - } - } - } - if (q.questionType === 'Multi Slider - Allocate') { - //sliderManagers[sliderManagers.length] = new this.sliderManager(q,max); - for (var x1 = 0; x1 < q.answers.length; x1++) { - if (toValidate[q.id]) { - toValidate[q.id].total = q.answers[x1].max; - toValidate[q.id].answers[q.answers[x1].id] = 1; - } - } - sliderManager(q, max); - } - else - if (q.questionType === 'Slider') { - handleSliders(q); - } + if (q.questionType === 'Slider') { + handleSliders(q); } - - else - if (fileUpload[q.questionType]) { - hasFile = true; - } - - else - if (text[q.questionType]) { - if (toValidate[q.id]) { - toValidate[q.id].answers[q.answers[x].id] = 1; - } - } + continue; + } + + if (UPLOAD_TYPES[q.questionType]) { + hasFile = true; + continue; + } + + if (TEXT_TYPES[q.questionType]) { + if (toValidate[q.id]) { + toValidate[q.id].answers[q.answers[x].id] = 1; + } + continue; + } + + // Must be a multi-choice bundle + var butts = []; + verb = 0; + for (var j = 0; j < q.answers.length; j++) { + var a = q.answers[j]; + if (toValidate[q.id]) { + toValidate[q.id].answers[a.id] = 1; + } + var b = document.getElementById(a.id + 'button'); + /* + b = new YAHOO.widget.Button({ type: "checkbox", label: a.answerText, id: a.id+'button', name: a.id+'button', + value: a.id, + container: a.id+"container", checked: false }); + */ + // b.on("click", buttonChanged,[b,a.id,q.maxAnswers,butts,qs.length,a.id]); + // YAHOO.util.Event.addListener(a.id+'button', "click", buttonChanged,[b,a.id,q.maxAnswers,butts,qs.length,a.id]); + if (a.verbatim) { + verb = 1; + } + YAHOO.util.Event.addListener(a.id + 'button', "click", buttonChanged, [b, a.id, q.maxAnswers, butts, qs.length, a.id]); + b.hid = a.id; + butts.push(b); + } } YAHOO.util.Event.addListener("submitbutton", "click", formsubmit); } @@ -514,4 +499,4 @@ if (typeof Survey === "undefined") { YAHOO.util.Event.onDOMReady(function(){ // Survey.Comm.setUrl('/' + document.getElementById('assetPath').value); Survey.Comm.callServer('', 'loadQuestions'); -}); \ No newline at end of file +}); diff --git a/www/extras/wobject/Survey/dd.js b/www/extras/wobject/Survey/dd.js index 86559ebba..5c7feacb2 100644 --- a/www/extras/wobject/Survey/dd.js +++ b/www/extras/wobject/Survey/dd.js @@ -5,6 +5,8 @@ var Dom = YAHOO.util.Dom; var Event = YAHOO.util.Event; var DDM = YAHOO.util.DragDropMgr; +var currentDest; + Survey.DDList = function(id, sGroup, config) { Survey.DDList.superclass.constructor.call(this, id, sGroup, config); @@ -61,30 +63,10 @@ YAHOO.extend(Survey.DDList, YAHOO.util.DDProxy, { a.animate(); }, + onInvalidDrop: function(e, id) { + Survey.Data.dragDrop(this.getEl()); + }, onDragDrop: function(e, id) { - - // If there is one drop interaction, the li was dropped either on the list, - // or it was dropped on the current location of the source element. - if (DDM.interactionInfo.drop.length === 1) { - - // The position of the cursor at the time of the drop (YAHOO.util.Point) - var pt = DDM.interactionInfo.point; - - // The region occupied by the source element at the time of the drop - var region = DDM.interactionInfo.sourceRegion; - - // Check to see if we are over the source element's location. We will - // append to the bottom of the list once we are sure it was a drop in - // the negative space (the area of the list without any list items) - if (!region.intersect(pt)) { - var destEl = Dom.get(id); - var destDD = DDM.getDDById(id); - destEl.appendChild(this.getEl()); - destDD.isEmpty = false; - DDM.refreshCache(); - } - - } Survey.Data.dragDrop(this.getEl()); }, @@ -110,6 +92,8 @@ YAHOO.extend(Survey.DDList, YAHOO.util.DDProxy, { // We are only concerned with list items, we ignore the dragover // notifications for the list. if (destEl.nodeName.toLowerCase() == "li") { +currentDest = destEl; +console.log(destEl); var orig_p = srcEl.parentNode; var p = destEl.parentNode; diff --git a/www/extras/wobject/Survey/editsurvey.js b/www/extras/wobject/Survey/editsurvey.js index a668fe708..efb6df3ae 100644 --- a/www/extras/wobject/Survey/editsurvey.js +++ b/www/extras/wobject/Survey/editsurvey.js @@ -1,134 +1,154 @@ -if (typeof Survey == "undefined") { +/*global Survey, YAHOO */ +if (typeof Survey === "undefined") { var Survey = {}; } -Survey.Data = new function(){ +Survey.Data = (function(){ + var lastDataSet = {}; var focus; var lastId = -1; + + // Keep references to widgets here so that we can destory any instances before + // creating new ones (to avoid memory leaks) + var autoComplete; + var sButton, qButton, aButton; - this.dragDrop = function(did){ - var type; -YAHOO.log('In drag drop'); - if(did.className.match("section")){type = 'section';} - else if(did.className.match("question")){type = 'question';} - else{ type = 'answer';} - - var first = {id:did.id,type:type}; - var before = document.getElementById(did.id).previousSibling; - - while(1){ - if( before == undefined || (before.id != undefined && before.id != '') ){ - break; - } - var before = before.previousSibling; - } - - var data = {id:'',type:''}; - - if(before != undefined && before.id != undefined && before.id != ''){ - if(before.className.match("section")){type = 'section';} - else if(before.className.match("question")){type = 'question';} - else{ type = 'answer';} - data = {id:before.id,type:type}; - } -YAHOO.log(first.id+' '+data.id); - Survey.Comm.dragDrop(first,data); - } - - - - this.clicked = function(){ - Survey.Comm.loadSurvey(this.id); - } - - - - this.loadData = function(d){ - focus = d.address;//What is the current highlighted item. - var showEdit = 1; - if(lastId.toString() == d.address.toString()){ - showEdit = 0; - lastId = -1; - }else{ - lastId = d.address; - } - document.getElementById('sections').innerHTML=d.ddhtml; - - //add event handlers for if a tag is clicked - for(var x in d.ids){ -YAHOO.log('adding handler for '+ d.ids[x]); - YAHOO.util.Event.addListener(d.ids[x], "click", this.clicked); - new Survey.DDList(d.ids[x],"sections"); - } - - //add the add object buttons -// if(d.buttons['section']){ - document.getElementById('addSection').innerHTML = ''; - document.getElementById('addQuestion').innerHTML = ''; - document.getElementById('addAnswer').innerHTML = ''; - var button = new YAHOO.widget.Button({ label:"Add Section", id:"addsection", container:"addSection" }); - button.on("click", this.addSection); -// } -// if(d.buttons['question']){ - var button = new YAHOO.widget.Button({ label:"Add Question", id:"addquestion", container:"addQuestion" }); - button.on("click", this.addQuestion,d.buttons['question']); -// } - if(d.buttons['answer']){ - var button = new YAHOO.widget.Button({ label:"Add Answer", id:"addanswer", container:"addAnswer" }); - button.on("click", this.addAnswer,d.buttons['answer']); - } - - if(showEdit == 1){ - this.loadObjectEdit(d.edithtml,d.type); - }else{ - document.getElementById('edit').innerHTML = ""; - } - lastDataSet = d; - } - - this.addSection = function(){ - Survey.Comm.newSection(); - } - - - this.addQuestion = function(e,id){ - Survey.Comm.newQuestion(id); - } - - this.addAnswer = function(e,id){ - Survey.Comm.newAnswer(id); - } - - this.loadObjectEdit = function(edit,type){ - if(edit){ - Survey.ObjectTemplate.loadObject(edit,type); - } - } - - - this.loadLast = function(){ - this.loadData(lastDataSet); - } -}(); - - -//---------------------------------------------------------------- -// -// Initialize survey -// -//---------------------------------------------------------------- -Survey.OnLoad = function() { - var e = YAHOO.util.Event; return { - init: function() { - e.onDOMReady(this.initHandler); - }, - initHandler: function(){ - new YAHOO.util.DDTarget("sections","sections"); - Survey.Comm.loadSurvey(); - }, - } -}(); + dragDrop: function(did){ -Survey.OnLoad.init(); + YAHOO.log('In drag drop'); + var type = did.className.match("section") ? 'section' + : did.className.match("question") ? 'question' + : 'answer'; + + var first = { + id: did.id, // pre-drag index of item + type: type + }; + var before = YAHOO.util.Dom.getPreviousSiblingBy( document.getElementById(did.id), function(node){ + return node.id; // true iff node has a non-empty id + }); + + var data = { + id: '', + type: '' + }; + + if (before) { + type = before.className.match("section") ? 'section' + : before.className.match("question") ? 'question' + : 'answer'; + data = { + id: before.id, + type: type + }; + } + YAHOO.log(first.id + ' ' + data.id); + Survey.Comm.dragDrop(first, data); + }, + + clicked: function(){ + Survey.Comm.loadSurvey(this.id); + }, + + loadData: function(d){ + focus = d.address;//What is the current highlighted item. + var showEdit = 1; + if (lastId.toString() === d.address.toString()) { + showEdit = 0; + lastId = -1; + } + else { + lastId = d.address; + } + + // First purge any event handlers bound to sections node.. + YAHOO.util.Event.purgeElement('sections', true); + + // Now we can re-write its innerHTML without fear of memory leaks + document.getElementById('sections').innerHTML = d.ddhtml; + + //add event handlers for if a tag is clicked + for (var x in d.ids) { + if (YAHOO.lang.hasOwnProperty(d.ids, x)) { + YAHOO.log('adding handler for ' + d.ids[x]); + YAHOO.util.Event.addListener(d.ids[x], "click", this.clicked); + var _s = new Survey.DDList(d.ids[x], "sections"); + } + } + + sButton && sButton.destroy(); + sButton = new YAHOO.widget.Button({ + label: "Add Section", + id: "addsection", + container: "addSection" + }); + sButton.on("click", this.addSection); + + qButton && qButton.destroy(); + qButton = new YAHOO.widget.Button({ + label: "Add Question", + id: "addquestion", + container: "addQuestion" + }); + qButton.on("click", this.addQuestion, d.buttons.question); + + if (d.buttons.answer) { + aButton && aButton.destroy(); + aButton = new YAHOO.widget.Button({ + label: "Add Answer", + id: "addanswer", + container: "addAnswer" + }); + aButton.on("click", this.addAnswer, d.buttons.answer); + } + + if (showEdit == 1) { + this.loadObjectEdit(d.edithtml, d.type); + + // build the goto auto-complete widget + if (d.gotoTargets && document.getElementById('goto')) { + var ds = new YAHOO.util.LocalDataSource(d.gotoTargets); + autoComplete = new YAHOO.widget.AutoComplete('goto', 'goto-yui-ac-container', ds); + } + } + else { + Survey.ObjectTemplate.unloadObject(); + if (autoComplete) { + autoComplete.destroy(); + autoComplete = null; + } + } + lastDataSet = d; + }, + + addSection: function(){ + Survey.Comm.newSection(); + }, + + addQuestion: function(e, id){ + Survey.Comm.newQuestion(id); + }, + + addAnswer: function(e, id){ + Survey.Comm.newAnswer(id); + }, + + loadObjectEdit: function(edit, type){ + if (edit) { + Survey.ObjectTemplate.loadObject(edit, type); + } + }, + + loadLast: function(){ + this.loadData(lastDataSet); + } + }; +})(); + +// Initialize survey +YAHOO.util.Event.onDOMReady(function(){ + var ddTarget = new YAHOO.util.DDTarget("sections", "sections"); + Survey.Comm.loadSurvey(); +}); diff --git a/www/extras/wobject/Survey/editsurvey/answer.js b/www/extras/wobject/Survey/editsurvey/answer.js deleted file mode 100644 index f9fdabac7..000000000 --- a/www/extras/wobject/Survey/editsurvey/answer.js +++ /dev/null @@ -1,69 +0,0 @@ -if (typeof Survey == "undefined") { - var Survey = {}; -} - -Survey.AnswerTemplate = new function(){ - this.params; - this.loadAnswer = function(params){ - for(var p in params){ - if(params[p] == undefined){params[p] = '';} - } - - var html = "\ -
    \ -
    Please enter answer information
    \ -
    \ -\ -
    \ -\ -

    Answer Number: "+params.sequenceNumber + "\ -\ - \ - \ - "; - html = html + "

    Answer Text:\n\n"; - html = html + "

    Recorded Answer\n\n"; - html = html + "

    Jump to:"; - html = html + "

    Text Answer Cols: Rows: \ -

    "; - html = html + "

    Is this the correct answer:\n" + - this.makeRadio('isCorrect',[{text:'Yes',value:1},{text:'No',value:0}],params.isCorrect); - html = html + "

    Min:"; - html = html + "

    Max:"; - html = html + "

    Step:"; - html = html + "

    Verbatim:\n" + - this.makeRadio('verbatim',[{text:'Yes',value:1},{text:'No',value:0}],params.verbatim); - document.getElementById('edit').innerHTML = html; - - var butts = [{ text:"Submit", handler:function(){this.submit();}, isDefault:true },{ text:"Cancel", handler:function(){this.cancel();}} ]; - if(params.Survey_answerId != ''){ - butts[2] = { text:"Delete", handler:function(){Survey.Comm.deleteAnswer(Survey.AnswerTemplate.params.Survey_answerId);}}; - } - - var form = new YAHOO.widget.Dialog("answer", - { width : "500px", - fixedcenter : true, - visible : false, - constraintoviewport : true, - buttons : butts - }); - - form.callback = Survey.Comm.callback; - form.render(); - form.show(); - this.params = params; - }; - - this.makeRadio = function(name,values,checked){ - var html = ''; - for(var i in values){ - if(checked == values[i]['value']){ - html = html+ "" + values[i]['text']; - }else{ - html = html+ "" + values[i]['text']; - } - } - html = html + "\n"; - return html; - } -}(); diff --git a/www/extras/wobject/Survey/editsurvey/object.js b/www/extras/wobject/Survey/editsurvey/object.js index 5ca1181ae..bb049c3a6 100644 --- a/www/extras/wobject/Survey/editsurvey/object.js +++ b/www/extras/wobject/Survey/editsurvey/object.js @@ -1,33 +1,128 @@ -if (typeof Survey == "undefined") { + +/*global Survey, YAHOO */ +if (typeof Survey === "undefined") { var Survey = {}; } -Survey.ObjectTemplate = new function(){ +Survey.ObjectTemplate = (function(){ - this.loadObject = function(html,type){ + // Keep references to widgets here so that we can destory any instances before + // creating new ones (to avoid memory leaks) + var dialog; + var editor; - document.getElementById('edit').innerHTML = html; + return { + + unloadObject: function(){ + // First destory the editor.. + if (editor) { + editor.destroy(); + editor = null; + } + + // And then the Dialog that contains it. + if (dialog) { + dialog.destroy(); + dialog = null; + } + }, - var butts = [ - { text:"Submit", handler:function(){this.submit();}, isDefault:true }, - { text:"Copy", handler:function(){document.getElementById('copy').value = 1; this.submit();}}, - { text:"Cancel", handler:function(){this.cancel(); Survey.Comm.loadSurvey('-');}}, - { text:"Delete", handler:function(){document.getElementById('delete').value = 1; this.submit();}} - ]; + loadObject: function(html, type){ + // Make sure we purge any event listeners before overwrite innerHTML.. + YAHOO.util.Event.purgeElement('edit', true); + document.getElementById('edit').innerHTML = html; + + var btns = [{ + text: "Submit", + handler: function(){ + editor.saveHTML(); + this.submit(); + }, + isDefault: true + }, { + text: "Copy", + handler: function(){ + document.getElementById('copy').value = 1; + this.submit(); + } + }, { + text: "Cancel", + handler: function(){ + this.cancel(); + Survey.Comm.loadSurvey('-'); + } + }, { + text: "Delete", + handler: function(){ + document.getElementById('delete').value = 1; + this.submit(); + } + }, { + text: "Preview", + handler: function(){ + if (type === 'answer') { + alert('Sorry, preview is only supported for Sections and Questions, not Answers'); + } + else { + var msg = 'This will delete any Survey responses you have made under this ' + + 'user account and redirect you to the Take Survey page starting at the selected item. ' + + "\n\nAre you sure you want to continue?"; + if (confirm(msg)) { + window.location.search = 'func=jumpTo;id=' + dialog.getData().id; + } + } + } + }]; + + dialog = new YAHOO.widget.Dialog(type, { + width: "600px", + context: [document.body, 'tr', 'tr'], + visible: false, + constraintoviewport: true, + buttons: btns + }); + + dialog.callback = Survey.Comm.callback; + dialog.render(); - var form = new YAHOO.widget.Dialog(type, - { - width : "500px", - fixedcenter : true, - visible : false, - constraintoviewport : true, - buttons : butts - } ); +// if(type == 'question'){ +// var resize = new YAHOO.util.Resize('resize_randomWords_formId'); +// resize.on('resize', function(ev) { +// YAHOO.util.Dom.setStyle('randomWords_formId', 'width', (ev.width - 6) + "px"); +// YAHOO.util.Dom.setStyle('randomWords_formId', 'height', (ev.height - 6) + "px"); +// }); +// } - form.callback = Survey.Comm.callback; - form.render(); - form.show(); - initHoverHelp(type); - } -}(); + if(type == 'answer'){ + var resize = new YAHOO.util.Resize('resize_gotoExpression_formId'); + resize.on('resize', function(ev) { + YAHOO.util.Dom.setStyle('gotoExpression_formId', 'width', (ev.width - 6) + "px"); + YAHOO.util.Dom.setStyle('gotoExpression_formId', 'height', (ev.height - 6) + "px"); + }); + } + + var textareaId = type + 'Text'; + var textarea = YAHOO.util.Dom.get(textareaId); + + var height = YAHOO.util.Dom.getStyle(textarea, 'height'); + if (!height) { + height = '300px'; + } + // N.B. SimpleEditor has a memory leak so this eats memory on every instantiation + editor = new YAHOO.widget.SimpleEditor(textareaId, { + height: height, + width: '100%', + dompath: false //Turns on the bar at the bottom + }); + + if (editor.get('toolbar')) { + editor.get('toolbar').titlebar = false; + } + editor.render(); + + dialog.show(); + initHoverHelp(type); + } + }; +})(); diff --git a/www/extras/wobject/Survey/editsurvey/question.html b/www/extras/wobject/Survey/editsurvey/question.html deleted file mode 100644 index e63ace0ea..000000000 --- a/www/extras/wobject/Survey/editsurvey/question.html +++ /dev/null @@ -1,40 +0,0 @@ -

    -
    Please enter question information
    -
    - -

    Question Number: - -

    Question Text:\n"; - \n"; -

    Question variable name:

    "; -

    Randomize answers:"; - checked>Yes - checked>No -

    Question type: - -

    Randomized words: - -

    Vertical display: - checked>Yes - checked>No - -

    Show text in button: - checked>Yes - checked>No - -

    Allow comment: - checked>Yes - checked>No -

       Cols: Rows: -

    -

    Maximum number of answers: -

    Required: - checked>Yes - checked>No -

    -
    -
    diff --git a/www/extras/wobject/Survey/editsurvey/question.js b/www/extras/wobject/Survey/editsurvey/question.js deleted file mode 100644 index 214c4b28b..000000000 --- a/www/extras/wobject/Survey/editsurvey/question.js +++ /dev/null @@ -1,112 +0,0 @@ -if (typeof Survey == "undefined") { - var Survey = {}; -} - -Survey.QuestionTemplate = new function(){ - - this.loadQuestion = function(params){ - - for(var p in params){ - if(params[p] == undefined){params[p] = '';} - } - - var html = "\ -
    \ -
    Please enter question information
    \ -
    \ -\ -
    \ -

    Question Number: "+params.sequenceNumber + "\ -\ - \ - \ -

    Question Text:\n"; - if(params.questionText == ''){ - html = html + "\n"; - } - else{ - html = html + "\n"; - } - html = html + "

    Question variable name:

    "; - html = html + "

    Randomize answers:"; - - html = html+ this.makeRadio('randomizeAnswers',[{text:'Yes',value:1},{text:'No',value:0}],params.randomizeAnswers); - html = html + "

    Question type:"; - var questions = ['Agree/Disagree','Certainty','Concern','Confidence','Currency','Date','Date Range','Dual Slider - Range','Education','Effectiveness', - 'Email','File Upload','Gender','Hidden','Ideology','Importance','Likelihood','Multi Slider - Allocate','Multiple Choice','Oppose/Support', - 'Party','Phone Number','Race','Risk','Satisfaction','Scale','Security','Slider','Text','Text Date','Threat','True/False','Yes/No']; -// var questions = ['Multiple Choice','Gender','Yes/No','True/False','Agree/Disagree','Oppose/Support','Importance','Likelihood','Certainty','Satisfaction', -// 'Confidence','Effectiveness','Concern','Risk','Threat','Security','Ideology','Race','Party','Education', -// 'Text', 'Email', 'Phone Number', 'Text Date', 'Currency', -// 'Slider','Dual Slider - Range','Multi Slider - Allocate', 'Date','Date Range', 'File Upload','Hidden']; - - html = html + this.makeMenu('questionType',questions,questions,params.questionType); - - html = html + "\ -

    Randomized words:\ - \ -

    Vertical display:"; - - html = html+ this.makeRadio('verticalDisplay',[{text:'Yes',value:1},{text:'No',value:0}],params.verticalDisplay); - html = html + "

    Show text in button:"; - html = html + this.makeRadio('textInButton',[{text:'Yes',value:1},{text:'No',value:0}],params.textInButton); - html = html + "

    Allow comment:"; - html = html + this.makeRadio('allowComment',[{text:'Yes',value:1},{text:'No',value:0}],params.allowComment); - html = html + "

       Cols: Rows: \ -

    "; - html = html + "

    Maximum number of answers:"; - html = html + "

    Required:"; - html = html+ this.makeRadio('required',[{text:'Yes',value:1},{text:'No',value:0}],params.required); - html = html + "\ -

    \ -
    \ -
    \ - "; - - document.getElementById('edit').innerHTML = html; - - - var butts = [ { text:"Submit", handler:function(){this.submit();}, isDefault:true }, { text:"Cancel", handler:function(){this.cancel();}} ]; - if(params.Survey_questionId != ''){ - butts[2] = {text:"Delete", handler:function(){Survey.Comm.deleteQuestion(params.Survey_questionId);}}; - } - - var form = new YAHOO.widget.Dialog("question", - { width : "500px", - fixedcenter : true, - visible : false, - constraintoviewport : true, - buttons : butts - } ); - - form.callback = Survey.Comm.callback; - form.render(); - form.show(); - - } - this.makeMenu = function(name,values,text,selected){ - var html = "\n"; - return html; - } - this.makeRadio = function(name,values,checked){ - var html = ''; - for(var i in values){ - if(checked == values[i]['value']){ - html = html+ "" + values[i]['text']; - }else{ - html = html+ "" + values[i]['text']; - } - } - html = html + "\n"; - return html; - } - -}(); diff --git a/www/extras/wobject/Survey/editsurvey/section.js b/www/extras/wobject/Survey/editsurvey/section.js deleted file mode 100644 index 91d21a00a..000000000 --- a/www/extras/wobject/Survey/editsurvey/section.js +++ /dev/null @@ -1,28 +0,0 @@ -if (typeof Survey == "undefined") { - var Survey = {}; -} - -Survey.SectionTemplate = new function(){ - - this.loadSection = function(html){ - - document.getElementById('edit').innerHTML = html; - - var butts = [ { text:"Submit", handler:function(){this.submit();}, isDefault:true }, { text:"Cancel", handler:function(){this.cancel();}}, - {text:"Delete", handler:function(){document.getElementById('delete').setValue(1); this.submit();}} - ]; - - var form = new YAHOO.widget.Dialog("section", - { width : "500px", - fixedcenter : true, - visible : false, - constraintoviewport : true, - buttons : butts - } ); - - form.callback = Survey.Comm.callback; - form.render(); - form.show(); - } -}(); - diff --git a/www/extras/wobject/Survey/survey.css b/www/extras/wobject/Survey/survey.css deleted file mode 100644 index 626b9ee58..000000000 --- a/www/extras/wobject/Survey/survey.css +++ /dev/null @@ -1,90 +0,0 @@ -body { - margin: 0; - background-repeat: repeat-y; - background-position: 0px 0px; -} -.survey-header { - width: 80%; - height: 20px; - margin-left: 80px; -} -#survey { - margin-left: 80px; - width: 85%; -} - -div.dateanswer { - min-height: 250px; -} -div.slider-bg { - position: relative; - background:url(/extras/wobject/Survey/bg-fader-500.gif) 5px 0 no-repeat; - height:68px; - width:529px; -} -div.slider-thumb { - cursor:default; - position: absolute; - top: 30px; - left: 4px; -} -div.slider-min-thumb { - cursor:default; - position: absolute; - top: 4px; -} -div.slider-max-thumb { - cursor:default; - position: absolute; - top: 4px; -} -#headertitle { - display: none; -} -#headertext { - display: none; -} -#questions { - display: none; -} -input.mcbutton{ - font-size: 10px; - font-weight: bold; - text-decoration: none; - background-color: #CCCCCC; - background-repeat: repeat-x; - text-align: center; - display: block; - margin: 0.5em; - padding: .8em; - width: 60px; - font-family: Verdana, Arial, Helvetica, sans-serif; - color: #000000; - background-image: url(/extras/wobject/Survey/gradient-glossy.png); -} -input.mcbutton:hover{ - background-color: #B6D2F1; - font-family: Verdana, Arial, Helvetica, sans-serif; - font-size: 10px; - color: #000000; -} -input.mcbutton-selected{ - background-color: #172D9D; - background-repeat: repeat-x; - color: #FFFFFF; - font-family: Verdana, Arial, Helvetica, sans-serif; - font-size: 10px; - margin: 0.5em; - padding: .8em; - width: 60px; - text-align: center; - display: block; - font-weight: bold; - background-image: url(/extras/wobject/Survey/gradient-glossy.png); - background-position: 0px 0px; -} - -/* By default the marker for invalid (required) fields is a red '*' */ -.survey-invalid-marker { - color: #FF0000; -} \ No newline at end of file diff --git a/www/extras/wobject/Survey/surveyedit.css b/www/extras/wobject/Survey/surveyedit.css index 0050e6c20..3ff5260fc 100644 --- a/www/extras/wobject/Survey/surveyedit.css +++ b/www/extras/wobject/Survey/surveyedit.css @@ -92,9 +92,11 @@ li.squestion { min-height: 10px; } li.newQuestion { -# background-color: #D1E6EC; -# border:1px solid #7EA6B2; -# cursor: move; +/* + background-color: #D1E6EC; + border:1px solid #7EA6B2; + cursor: move; +*/ padding-left:25px; } @@ -119,14 +121,19 @@ li.sanswer { background-color: #CC6600; border:1px solid #7EA6B2; cursor: move; - padding-left:50px; + padding-left:50px; width:60%; min-height: 10px; } li.newAnswer { -# background-color: #D1E6EC; -# border:1px solid #7EA6B2; - padding-left:50px; -# cursor: move; +/* + background-color: #D1E6EC; + border:1px solid #7EA6B2; + cursor: move; +*/ + padding-left:50px; +} +#goto-yui-ac { + width:15em; + margin-top:0.5em; } -