Merge in HEAD, up to 9866.
This commit is contained in:
Colin Kuskie
parent
c7a66861a6
commit
2bd7a60a01
107 changed files with 6258 additions and 2436 deletions
|
|
@ -33,7 +33,7 @@ my $session = WebGUI::Test->session;
|
|||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
|
||||
my $tests = 53;
|
||||
my $tests = 55;
|
||||
plan tests => 1 + $tests;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -149,6 +149,7 @@ SKIP: {
|
|||
isa_ok($soda, 'WebGUI::Asset::Sku::Product');
|
||||
is($soda->getTitle(), 'Sweet Soda-bottled in Oregon', 'Title set correctly for soda');
|
||||
is($soda->get('url'), 'sweet-soda-bottled-in-oregon', 'URL for new product from the title');
|
||||
is($soda->get('menuTitle'), $soda->getTitle, 'menuTitle is the same as title');
|
||||
my $sodaCollateral = $soda->getAllCollateral('variantsJSON');
|
||||
cmp_deeply(
|
||||
$sodaCollateral,
|
||||
|
|
@ -317,7 +318,8 @@ SKIP: {
|
|||
is($count, 3, 'still have 3 products, nothing new added');
|
||||
|
||||
$soda = WebGUI::Asset::Sku->newBySku($session, 'soda');
|
||||
is($soda->getTitle(), 'Sweet Soda-totally organic', 'Title updated correctly for soda');
|
||||
is($soda->getTitle(), 'Sweet Soda-totally organic', 'Title updated correctly for soda');
|
||||
is($soda->get('menuTitle'), 'Sweet Soda-totally organic', 'menuTitle updated correctly for soda');
|
||||
is($soda->get('url'), 'sweet-soda-bottled-in-oregon', 'URL for updated product from the original title, not the updated title');
|
||||
$shirt = WebGUI::Asset::Sku->newBySku($session, 't-shirt');
|
||||
$shirtCollateral = $shirt->getAllCollateral('variantsJSON');
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
my $tests = 1;
|
||||
my $tests = 11;
|
||||
plan tests => $tests + 1;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -37,6 +37,61 @@ $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);
|
||||
|
||||
my $responseId = $survey->responseId;
|
||||
my $s = WebGUI::Asset::Wobject::Survey->newByResponseId($session, $responseId);
|
||||
is($s->getId, $survey->getId, 'newByResponseId returns same Survey');
|
||||
|
||||
#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");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -9,7 +9,9 @@ use lib "$FindBin::Bin/../../../lib";
|
|||
use Test::More;
|
||||
use Test::Deep;
|
||||
use Test::MockObject::Extends;
|
||||
use Test::Exception;
|
||||
use Data::Dumper;
|
||||
use List::Util qw/shuffle/;
|
||||
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||
use WebGUI::Session;
|
||||
use WebGUI::Asset::Wobject::Survey::SurveyJSON;
|
||||
|
|
@ -20,7 +22,7 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
my $tests = 52;
|
||||
my $tests = 79;
|
||||
plan tests => $tests + 1;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -40,17 +42,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 +82,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 +102,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 +119,39 @@ 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};
|
||||
srand(42);
|
||||
my @expected_order = shuffle(0,1,2);
|
||||
cmp_deeply(\@question_order, \@expected_order, '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};
|
||||
srand(42); # Make shuffle predictable
|
||||
@expected_order = shuffle(0..6);
|
||||
cmp_deeply(\@answer_order, \@expected_order, 'initSurveyOrder shuffled answers');
|
||||
}
|
||||
|
||||
####################################################
|
||||
|
|
@ -169,51 +171,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 +225,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 +264,7 @@ cmp_deeply(
|
|||
|
||||
$rJSON->lastResponse(1);
|
||||
cmp_deeply(
|
||||
$rJSON->nextQuestions(),
|
||||
[$rJSON->nextQuestions],
|
||||
[
|
||||
superhashof({
|
||||
sid => 0,
|
||||
|
|
@ -286,9 +288,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 +312,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 +405,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 +416,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 +427,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 +435,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 +448,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 +457,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 +516,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 +530,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([]);
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@ is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
|
|||
#----------------------------------------------------------------------------
|
||||
# Test addHtml
|
||||
$mail = WebGUI::Mail::Send->create( $session );
|
||||
my $text = <<'EOF';
|
||||
$text = <<'EOF';
|
||||
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Suspendisse eu lacus ut ligula fringilla elementum. Cras condimentum, velit commodo pretium semper, odio ante accumsan orci, a ultrices risus justo a nulla. Aliquam erat volutpat.
|
||||
EOF
|
||||
|
||||
|
|
@ -97,7 +97,7 @@ $mime = $mail->getMimeEntity;
|
|||
# TODO: Test that addHtml creates a body with the right content type
|
||||
|
||||
# addHtml should add newlines after 78 characters
|
||||
my $newlines = length $text / 78;
|
||||
$newlines = length $text / 78;
|
||||
is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
|
||||
"addHtml should add newlines after 78 characters",
|
||||
);
|
||||
|
|
@ -107,7 +107,7 @@ is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
|
|||
#----------------------------------------------------------------------------
|
||||
# Test addHtmlRaw
|
||||
$mail = WebGUI::Mail::Send->create( $session );
|
||||
my $text = <<'EOF';
|
||||
$text = <<'EOF';
|
||||
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Suspendisse eu lacus ut ligula fringilla elementum. Cras condimentum, velit commodo pretium semper, odio ante accumsan orci, a ultrices risus justo a nulla. Aliquam erat volutpat.
|
||||
EOF
|
||||
|
||||
|
|
@ -117,7 +117,7 @@ $mime = $mail->getMimeEntity;
|
|||
# TODO: Test that addHtmlRaw doesn't add an HTML wrapper
|
||||
|
||||
# addHtmlRaw should add newlines after 78 characters
|
||||
my $newlines = length $text / 78;
|
||||
$newlines = length $text / 78;
|
||||
is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
|
||||
"addHtmlRaw should add newlines after 78 characters",
|
||||
);
|
||||
|
|
|
|||
|
|
@ -234,7 +234,7 @@ my $outputBuffer;
|
|||
open my $outputHandle, '>', \$outputBuffer or die "Unable to create scalar filehandle: $!\n";
|
||||
$newSession->output->setHandle($outputHandle);
|
||||
WEBGUI_FATAL: {
|
||||
$newSession->log->fatal();
|
||||
$newSession->log->fatal('Bad things are happenning');
|
||||
}
|
||||
ok(1, 'fatal: recovered from fatal okay');
|
||||
TODO: {
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ use FindBin;
|
|||
use strict;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
use Scalar::Util qw/refaddr/;
|
||||
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||
use WebGUI::Session;
|
||||
use WebGUI::Asset;
|
||||
|
|
@ -32,7 +33,7 @@ my $i18n = WebGUI::International->new($session, "Shop");
|
|||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
|
||||
plan tests => 21; # Increment this number for each test you create
|
||||
plan tests => 23; # Increment this number for each test you create
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# put your tests here
|
||||
|
|
@ -91,6 +92,23 @@ isa_ok($cart->getAddressBook, "WebGUI::Shop::AddressBook", "can get an address b
|
|||
$cart->empty;
|
||||
is($session->db->quickScalar("select count(*) from cartItem where cartId=?",[$cart->getId]), 0, "Items are removed from cart.");
|
||||
|
||||
my $session2 = WebGUI::Session->open(WebGUI::Test->root, WebGUI::Test->file);
|
||||
$session2->user({userId => 3});
|
||||
my $cart2 = WebGUI::Shop::Cart->newBySession($session2);
|
||||
isnt(
|
||||
refaddr $cart->getAddressBook,
|
||||
refaddr $cart2->getAddressBook,
|
||||
'Different carts with different sessions have different AddressBooks'
|
||||
);
|
||||
$cart2->delete;
|
||||
|
||||
my $cart3 = WebGUI::Shop::Cart->newBySession($session);
|
||||
isnt(
|
||||
refaddr $cart->getAddressBook,
|
||||
refaddr $cart3->getAddressBook,
|
||||
'Different carts with same sessions will each have different AddressBooks since no book has been assigned yet.'
|
||||
);
|
||||
$cart3->delete;
|
||||
|
||||
$cart->delete;
|
||||
is($cart->delete, undef, "Can destroy cart.");
|
||||
|
|
@ -101,5 +119,5 @@ $product->purge;
|
|||
#----------------------------------------------------------------------------
|
||||
# Cleanup
|
||||
END {
|
||||
|
||||
$session2->close;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -287,8 +287,6 @@ my $tempStor = WebGUI::Storage->createTemp($session);
|
|||
|
||||
isa_ok( $tempStor, "WebGUI::Storage", "createTemp creates WebGUI::Storage object");
|
||||
is (substr($tempStor->getPathFrag, 0, 5), 'temp/', 'createTemp puts stuff in the temp directory');
|
||||
use Data::Dumper;
|
||||
diag Dumper $tempStor->getErrors();
|
||||
ok (-e $tempStor->getPath(), 'createTemp: directory was created');
|
||||
|
||||
####################################################
|
||||
|
|
|
|||
5
t/User.t
5
t/User.t
|
|
@ -20,7 +20,7 @@ use WebGUI::Cache;
|
|||
use WebGUI::User;
|
||||
use WebGUI::ProfileField;
|
||||
|
||||
use Test::More tests => 143; # increment this value for each test you create
|
||||
use Test::More tests => 144; # increment this value for each test you create
|
||||
use Test::Deep;
|
||||
|
||||
my $session = WebGUI::Test->session;
|
||||
|
|
@ -577,7 +577,8 @@ undef $neighborClone;
|
|||
################################################################
|
||||
|
||||
$friend->profileField('allowPrivateMessages', 'all');
|
||||
is ($friend->acceptsPrivateMessages(1), 1, 'acceptsPrivateMessages: when allowPrivateMessages=all, anyone can send messages');
|
||||
is ($friend->acceptsPrivateMessages($neighbor->userId), 1, 'acceptsPrivateMessages: when allowPrivateMessages=all, anyone can send messages');
|
||||
is ($friend->acceptsPrivateMessages(1), 0, 'acceptsPrivateMessages: when allowPrivateMessages=all, visitor can\'t send messages');
|
||||
$friend->profileField('allowPrivateMessages', 'none');
|
||||
is ($friend->acceptsPrivateMessages($friend->userId), 0, 'acceptsPrivateMessages: when allowPrivateMessages=none, no one can send messages');
|
||||
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ is_deeply($wf->getCrons, [], 'workflow has no crons');
|
|||
isa_ok(WebGUI::Workflow->getList($session), 'HASH', 'getList returns a hashref');
|
||||
|
||||
ok(!isIn($wfId, keys %{WebGUI::Workflow->getList($session)}), 'workflow not in enabled list');
|
||||
is(scalar keys %{WebGUI::Workflow->getList($session)}, 10, 'There are ten default workflows, of all types, shipped with WebGUI');
|
||||
is(scalar keys %{WebGUI::Workflow->getList($session)}, 11, 'There are eleven default workflows, of all types, shipped with WebGUI');
|
||||
|
||||
$wf->set({enabled => 1});
|
||||
ok($wf->get('enabled'), 'workflow is enabled');
|
||||
|
|
|
|||
101
t/Workflow/Activity/BucketPassiveAnalytics.t
Normal file
101
t/Workflow/Activity/BucketPassiveAnalytics.t
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
|
||||
use FindBin;
|
||||
use strict;
|
||||
use lib "$FindBin::Bin/../../lib";
|
||||
#use DB;
|
||||
|
||||
use WebGUI::Test;
|
||||
use WebGUI::Asset;
|
||||
use WebGUI::PassiveAnalytics::Rule;
|
||||
use WebGUI::Workflow::Activity::BucketPassiveAnalytics;
|
||||
use WebGUI::Text;
|
||||
|
||||
use Test::More;
|
||||
|
||||
plan tests => 1; # increment this value for each test you create
|
||||
|
||||
my $session = WebGUI::Test->session;
|
||||
$session->user({userId => 3});
|
||||
|
||||
my $workflow = WebGUI::Workflow->new($session, 'PassiveAnalytics000001');
|
||||
my $activities = $workflow->getActivities();
|
||||
##Note, they're in order, and the order is known.
|
||||
$activities->[0]->set('deltaInterval', 100);
|
||||
$activities->[1]->set('userId', 0); ##To disable sending emails
|
||||
|
||||
my $instance = WebGUI::Workflow::Instance->create($session,
|
||||
{
|
||||
workflowId => $workflow->getId,
|
||||
skipSpectreNotification => 1,
|
||||
priority => 1,
|
||||
}
|
||||
);
|
||||
##Rule label, url, and regexp
|
||||
my @ruleSets = (
|
||||
['home', '/home', '^\/home' ],
|
||||
['one', '/one', '^\/one$' ],
|
||||
['two', '/two', '^\/two$' ],
|
||||
['three', '/three', '^\/three$' ],
|
||||
['end', '/blah/blah/end', 'end$' ],
|
||||
['casa', '/home/casa', 'casa$' ],
|
||||
['uno', '/one/uno', 'uno$' ],
|
||||
['dos', '/two/dos', 'dos$' ],
|
||||
['tres', '/three/tres', 'tres$' ],
|
||||
['alpha', '/alpha/aee', '.alpha.aee' ],
|
||||
['beta', '/beta/bee', '.beta.bee' ],
|
||||
['gamma', '/gamma/cee', '.gamma.cee' ],
|
||||
['delta', '/delta/dee', '.delta.dee' ],
|
||||
['eee', '/epsilon/eee', 'eee$' ],
|
||||
['thingy1', '/thingy?thingId=1', '^.thingy\?thingId=1' ],
|
||||
['rogerRoger', '/roger/roger', '(?:\/roger){2}' ],
|
||||
['roger', '/roger', '^\/roger' ],
|
||||
['thingy2', '/thingy?thingId=2', '^.thingy\?thingId=2' ],
|
||||
['beet', '/beta/beet', '.beta.beet' ],
|
||||
['zero', '/yelnats', 'yelnats' ],
|
||||
);
|
||||
|
||||
my @url2 = @ruleSets;
|
||||
while (my $spec = shift @url2) {
|
||||
my ($bucket, undef, $regexp) = @{ $spec };
|
||||
WebGUI::PassiveAnalytics::Rule->create($session, { bucketName => $bucket, regexp => $regexp });
|
||||
}
|
||||
|
||||
my @urls = map {$_->[1]} @ruleSets;
|
||||
loadLogData($session, @urls);
|
||||
|
||||
##Build rulesets
|
||||
|
||||
##Now, run it and wait for it to finish
|
||||
my $counter = 0;
|
||||
#DB::enable_profile();
|
||||
PAUSE: while (my $retval = $instance->run()) {
|
||||
last PAUSE if $retval eq 'done';
|
||||
last PAUSE if $counter++ >= 16;
|
||||
}
|
||||
#DB::disable_profile();
|
||||
|
||||
ok(1, 'One test');
|
||||
|
||||
END {
|
||||
$session->db->write('delete from passiveLog');
|
||||
$session->db->write('delete from analyticRule');
|
||||
$instance->delete;
|
||||
}
|
||||
|
||||
sub loadLogData {
|
||||
my ($session, @urls) = @_;
|
||||
$session->db->write('delete from passiveLog');
|
||||
my $insert = $session->db->prepare(
|
||||
q!insert into passiveLog (userId, sessionId, timeStamp, url, assetId) VALUES (?,?,?,?,'assetId')!
|
||||
);
|
||||
my $logCount = 15000;
|
||||
my $counter;
|
||||
my $startTime = 1000;
|
||||
my $numUrls = scalar @urls;
|
||||
while ($counter++ < $logCount) {
|
||||
my $index = int rand($numUrls);
|
||||
my $url = $urls[$index];
|
||||
$insert->execute([2, 25, $startTime, $url]);
|
||||
$startTime += int(rand(10))+1;
|
||||
}
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue