diff --git a/docs/upgrades/packages-7.7.6/root_import_survey_default-survey-edit.wgpkg b/docs/upgrades/packages-7.7.6/root_import_survey_default-survey-edit.wgpkg index 9af1c4a42..0a4e0e496 100644 Binary files a/docs/upgrades/packages-7.7.6/root_import_survey_default-survey-edit.wgpkg and b/docs/upgrades/packages-7.7.6/root_import_survey_default-survey-edit.wgpkg differ diff --git a/docs/upgrades/upgrade_7.7.5-7.7.6.pl b/docs/upgrades/upgrade_7.7.5-7.7.6.pl index b60d43041..15c819981 100644 --- a/docs/upgrades/upgrade_7.7.5-7.7.6.pl +++ b/docs/upgrades/upgrade_7.7.5-7.7.6.pl @@ -46,6 +46,7 @@ installSMSSettings($session); upgradeSMSMailQueue($session); addPayDrivers($session); addCollaborationColumns($session); +installSurveyTest($session); installFriendManagerSettings($session); installFriendManagerConfig($session); @@ -235,6 +236,14 @@ sub addPayDrivers { print "DONE!\n" unless $quiet; } +sub installSurveyTest { + my $session = shift; + print "\tInstall Survey test table, via Crud... " unless $quiet; + use WebGUI::Asset::Wobject::Survey::Test; + WebGUI::Asset::Wobject::Survey::Test->crud_createTable($session); + print "DONE!\n" unless $quiet; +} + sub addCollaborationColumns { my $session = shift; print "\tAdding columns to store htmlArea Rich Editor and Filter Code for Replies in Collaboration Table ..." unless $quiet; diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 5b08b1a39..b7a8d66f1 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -650,6 +650,18 @@ sub www_editSurvey { return $self->processTemplate( {}, $self->get('surveyEditTemplateId') ); } +sub getAdminConsole { + my $self = shift; + my $ac = $self->SUPER::getAdminConsole; + my $i18n = WebGUI::International->new($self->session, "Asset_Survey"); + my $edit = WebGUI::International->new($self->session, "WebGUI")->get(575); + $ac->addSubmenuItem($self->session->url->page("func=edit"), $edit); + $ac->addSubmenuItem($self->session->url->page("func=editSurvey"), "$edit Survey"); + $ac->addSubmenuItem($self->session->url->page("func=graph"), $i18n->get('survey visualization')); + $ac->addSubmenuItem($self->session->url->page("func=editTestSuite"), $i18n->get("test suite")); + return $ac; +} + #------------------------------------------------------------------- =head2 www_graph ( ) @@ -668,12 +680,7 @@ sub www_graph { my $i18n = WebGUI::International->new($session, "Asset_Survey"); - use WebGUI::AdminConsole; - my $ac = WebGUI::AdminConsole->new($self->session, $i18n->get('survey visualization')); - $ac->setIcon($session->url->extras('assets/survey.gif')); - my $edit = WebGUI::International->new($session, "WebGUI")->get(575); - $ac->addSubmenuItem($self->session->url->page("func=edit"), $edit); - $ac->addSubmenuItem($self->session->url->page("func=editSurvey"), "$edit Survey"); + my $ac = $self->getAdminConsole; eval 'use GraphViz'; if ($@) { @@ -733,7 +740,7 @@ sub www_submitObjectEdit { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); my $params = $self->session->form->paramsHashRef(); @@ -2334,4 +2341,355 @@ sub www_downloadDefaultQuestionTypes{ return $self->export( "WebGUI-Survey-DefaultQuestionTypes.json", $content ); } + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#------------------------------------------------------------------- + +=head2 www_deleteTest ( ) + +Deletes a test + +=cut + +sub www_deleteTest { + my $self = shift; + my $session = $self->session; + + return $self->session->privilege->insufficient() + unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + + my $test = WebGUI::Asset::Wobject::Survey::Test->new($session, $session->form->get("testId")); + if (defined $test) { + $test->delete; + } + return $self->www_editTestSuite; +} + +#------------------------------------------------------------------ + +=head2 www_demoteTest ( ) + +Moves a Test down one position + +=cut + +sub www_demoteTest { + my $self = shift; + my $session = $self->session; + + return $self->session->privilege->insufficient() + unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + + my $test = WebGUI::Asset::Wobject::Survey::Test->new($session, $session->form->get("testId")); + if (defined $test) { + $test->demote; + } + return $self->www_editTestSuite; +} + +#------------------------------------------------------------------- + +=head2 www_editTestSuite ( $error ) + +Configure a set of tests + +=head3 $error + +Allows another method to pass an error into this method, to display to the user. + +=cut + +sub www_editTestSuite { + my $self = shift; + my $error = shift; + my $session = $self->session; + + return $self->session->privilege->insufficient() + unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + + if ($error) { + $error = qq|
$error
\n|; + } + my $i18n = WebGUI::International->new($session, "Asset_Survey"); + my $addmenu = '
'; + $addmenu .= sprintf '%s', $session->url->page('func=editTest'), $i18n->get('add a test'); + $addmenu .= '
'; + + my $testsFound = 0; + my $tests = ''; + my $getATest = WebGUI::Asset::Wobject::Survey::Test->getAllIterator($session); + my $icon = $session->icon; + while (my $test = $getATest->()) { + $testsFound++; + my $id = $test->getId; + my $name = $test->get('name'); + $tests .= ''; + } + $tests .= '
' . $i18n->get('test name') . '
' + . $icon->delete( 'func=deleteTest;testId='.$id, undef, $i18n->get('confirm delete test')) + . $icon->edit( 'func=editTest;testId='.$id) + . $icon->moveDown('func=demoteTest;testId='.$id) + . $icon->moveUp( 'func=promoteTest;testId='.$id) + . ''.$name.'
'; + + my $out = $error . $addmenu; + $out .= $tests if $testsFound; + + my $ac = $self->getAdminConsole; + return $ac->render($out, 'Survey'); +} + +##------------------------------------------------------------------- +# +#=head2 www_editTestSuiteSave ( ) +# +#Saves the results of www_editTestSuite() +# +#=cut +# +#sub www_editTestSuiteSave { +# my $self = shift; +# my $session = $self->session; +# +# return $self->session->privilege->insufficient() +# unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); +# my $session = shift; +# return $session->privilege->insufficient() unless canView($session); +# my $i18n = WebGUI::International->new($session, 'Survey'); +# return www_editTestSuite($session, $i18n->get('already active')) +# if analysisActive($session); +# my $workflow = WebGUI::Workflow->new($session, 'Survey000001'); +# return www_editTestSuite($session, $i18n->get('workflow deleted')) unless defined $workflow; +# my $delta = $session->form->process('pauseInterval','integer'); +# my $activities = $workflow->getActivities(); +# ##Note, they're in order, and the order is known. +# $activities->[0]->set('deltaInterval', $delta); +# $activities->[1]->set('userId', $session->user->userId); +# my $instance = WebGUI::Workflow::Instance->create($session, { +# workflowId => $workflow->getId, +# priority => 1, +# }); +# if (!defined $instance) { +# return www_editTestSuite($session, $i18n->get('currently running')) if $session->stow->get('singletonWorkflowClash'); +# return www_editTestSuite($session, $i18n->get('error creating workflow')); +# } +# $instance->start('skipRealtime'); +# $session->db->write('update surveyStatus set startDate=NOW(), userId=?, endDate=?, running=1', [$session->user->userId, '']); +# return www_editTestSuite($session); +#} + + +#------------------------------------------------------------------- + +=head2 www_editTest ( ) + +Displays a form to edit the properties test. + +=cut + +sub www_editTest { + my $self = shift; + my $error = shift; + my $session = $self->session; + + return $self->session->privilege->insufficient() + unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + + if ($error) { + $error = qq|
$error
\n|; + } + ##Make a Survey test to use to populate the form. + my $testId = $session->form->get('testId'); + my $test; + if ($testId) { + $test = WebGUI::Asset::Wobject::Survey::Test->new($session, $testId); + } + else { + ##We need a temporary test so that we can call dynamicForm, below + $testId = 'new'; + $test = WebGUI::Asset::Wobject::Survey::Test->create($session, { assetId => $self->getId }); + } + + ##Build the form + my $form = WebGUI::HTMLForm->new($session); + $form->hidden( name=>"func", value=>"editTestSave"); + $form->hidden( name=>"testId", value=>$testId); + $form->hidden( name=>"assetId", value=>$self->getId); + $form->dynamicForm([WebGUI::Asset::Wobject::Survey::Test->crud_definition($session)], 'properties', $test); + $form->submit; + + my $i18n = WebGUI::International->new($session, 'Asset_Survey'); + my $ac = $self->getAdminConsole; + + if ($testId eq 'new') { + $test->delete; + } + return $ac->render($error.$form->print, $i18n->get('Edit Test')); +} + +#------------------------------------------------------------------- + +=head2 www_editTestSave ( ) + +Saves the results of www_editTest(). + +=cut + +sub www_editTestSave { + my $self = shift; + my $session = $self->session; + + return $self->session->privilege->insufficient() + unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + + my $form = $session->form; + +# eval { +# 'fooBarBaz' =~ qr/$regexp/; +# }; +# if ($@) { +# my $error = $@; +# $error =~ s/at \S+?\.pm line \d+.*$//; +# my $i18n = WebGUI::International->new($session, 'Asset_Survey'); +# $error = join ' ', $i18n->get('Regular Expression Error:'), $error; +# return www_editTest($session, $error); +# } + + my $testId = $form->get('testId'); + my $test; + if ($testId eq 'new') { + $test = WebGUI::Asset::Wobject::Survey::Test->create($session, { assetId => $self->getId }); + } + else { + $test = WebGUI::Asset::Wobject::Survey::Test->new($session, $testId); + } + $test->updateFromFormPost if $test; + return $self->www_editTestSuite; +} + + +#------------------------------------------------------------------ + +=head2 www_promoteTest ( ) + +Moves a test up one position + +=head3 session + +A reference to the current session. + +=cut + +sub www_promoteTest { + my $self = shift; + my $session = $self->session; + + return $self->session->privilege->insufficient() + unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + + my $test = WebGUI::Asset::Wobject::Survey::Test->new($session, $session->form->get("testId")); + if (defined $test) { + $test->promote; + } + return $self->www_editTestSuite; +} + +##------------------------------------------------------------------- +# +#=head2 www_settings ( ) +# +#Configure Test Suite settings. +# +#=cut +# +#sub www_settings { +# my $self = shift; +# my $error = shift; +# my $session = $self->session; +# +# return $self->session->privilege->insufficient() +# unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); +# +# if ($error) { +# $error = qq|
$error
\n|; +# } +# my $i18n = WebGUI::International->new($session, "Asset_Survey"); +# my $f = WebGUI::HTMLForm->new($session); +# $f->hidden( +# name=>'func', +# value=>'settingsSave' +# ); +# $f->integer( +# name => 'pauseInterval', +# value => $session->form->get('pauseInterval') || $session->setting->get('surveyInterval') || 300, +# label => $i18n->get('default pause interval'), +# hoverHelp => $i18n->get('default pause interval help'), +# ); +# $f->yesNo( +# name => 'deleteDelta', +# value => $session->form->get('deleteDelta') || $session->setting->get('surveyDeleteDelta') || 0, +# label => $i18n->get('Delete Delta Table?'), +# hoverHelp => $i18n->get('Delete Delta Table? help'), +# ); +# $f->yesNo( +# name => 'enabled', +# value => $session->form->get('enabled') || $session->setting->get('surveyEnabled') || 0, +# label => $i18n->get('Enabled?'), +# hoverHelp => $i18n->get('Enabled? help'), +# ); +# $f->submit(); +# my $ac = WebGUI::AdminConsole->new($session,'survey'); +# $ac->addSubmenuItem($session->url->page('surveyfunc=editTestSuite'), $i18n->get('Test Suite')); +# return $ac->render($error.$f->print, 'Test Suite Settings'); +#} +# +##------------------------------------------------------------------- +# +#=head2 www_settingsSave ( session ) +# +#Save Test Suite settings. +# +#=cut +# +#sub www_settingsSave { +# my $self = shift; +# my $session = $self->session; +# +# return $self->session->privilege->insufficient() +# my $session = shift; +# return $session->privilege->insufficient() unless canView($session); +# my $form = $session->form; +# $session->setting->set('surveyInterval', $form->process('pauseInterval', 'integer')); +# $session->setting->set('surveyDeleteDelta', $form->process('deleteDelta', 'yesNo' )); +# $session->setting->set('surveyEnabled', $form->process('enabled', 'yesNo' )); +# return www_settings($session); +#} + 1; diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm new file mode 100644 index 000000000..8c9f7a6bf --- /dev/null +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -0,0 +1,88 @@ +package WebGUI::Asset::Wobject::Survey::Test; + +use base qw/WebGUI::Crud/; +use WebGUI::International; + +=head1 NAME + +Package WebGUI::Asset::Wobject::Survey::Test; + +=head1 DESCRIPTION + +Base class for Survey tests + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +=head2 crud_definition ( ) + +WebGUI::Crud definition for this class. + +=head3 tableName + +Survey_test + +=head3 tableKey + +testId + +=head3 assetId + +testId + +=head3 sequenceKey + +assetId, e.g. each Survey instance has its own sequence of tests. + +=head3 properties + +=head4 assetId + +Identifies the Survey instance. + +=head4 name + +A name for the test + +=head4 test + +The test code + +=cut + +sub crud_definition { + my ( $class, $session ) = @_; + my $definition = $class->SUPER::crud_definition($session); + $definition->{tableName} = 'Survey_test'; + $definition->{tableKey} = 'testId'; + $definition->{sequenceKey} = 'assetId'; + my $properties = $definition->{properties}; + my $i18n = WebGUI::International->new($session); + $properties->{assetId} = { + fieldType => 'hidden', + defaultValue => undef, + }; + $properties->{name} = { + fieldType => 'text', + label => $i18n->get( 'test name', 'Asset_Survey' ), + hoverHelp => $i18n->get( 'test name help', 'Asset_Survey' ), + defaultValue => '', + }; + $properties->{test} = { + fieldType => 'codearea', + label => $i18n->get( 'test code', 'Asset_Survey' ), + hoverHelp => $i18n->get( 'test code help', 'Asset_Survey' ), + syntax => 'perl', + defaultValue => 'test()', + }; + return $definition; +} + +1; + +#vim:ft=perl diff --git a/lib/WebGUI/i18n/English/Asset_Survey.pm b/lib/WebGUI/i18n/English/Asset_Survey.pm index 9d21057ed..d5bc883ce 100644 --- a/lib/WebGUI/i18n/English/Asset_Survey.pm +++ b/lib/WebGUI/i18n/English/Asset_Survey.pm @@ -1528,6 +1528,46 @@ section/answer.|, context => q|Finish button label on Take Survey page|, lastUpdated => 0, }, + + 'add a test' => { + message => q{Add a test}, + lastUpdated => 0, + }, + + 'confirm delete test' => { + message => q{Are you sure you want to delete this test?}, + lastUpdated => 0, + }, + + 'test suite' => { + message => q{Test Suite}, + lastUpdated => 0, + }, + + 'edit test' => { + message => q{Edit Test}, + lastUpdated => 0, + }, + + 'test name' => { + message => q{Test Name}, + lastUpdated => 0, + }, + + 'test name help' => { + message => q{A descriptive name for this test}, + lastUpdated => 0, + }, + + 'test code' => { + message => q{Test Code}, + lastUpdated => 0, + }, + + 'test code help' => { + message => q{The test code}, + lastUpdated => 0, + }, };