Merge commit 'v7.10.24' into WebGUI8

This commit is contained in:
Colin Kuskie 2012-01-17 15:03:45 -08:00
commit 3b418ede3c
139 changed files with 699 additions and 32133 deletions

View file

@ -391,6 +391,8 @@ sub www_editSubmission {
$fields->{$fieldId}{fieldType} = $metaField->{dataType};
$fields->{$fieldId}{name} = $fieldId;
$fields->{$fieldId}{value} = $self->get($fieldId) if $self;
$fields->{$fieldId}{options} = $metaField->{possibleValues};
$fields->{$fieldId}{defaultValue} = $metaField->{defaultValues};
}
}

View file

@ -731,9 +731,10 @@ sub process {
my $output;
eval { $output = $parser->process($template, $self->param); };
if (my $e = Exception::Class->caught) {
$session->log->error(sprintf "Error processing template: %s, %s, %s", $self->getUrl, $self->getId, $e->error);
my $message = ref $e ? $e->error : $e;
$session->log->error(sprintf "Error processing template: %s, %s, %s", $self->getUrl, $self->getId, $message);
my $i18n = WebGUI::International->new($session, 'Asset_Template');
$output = sprintf $i18n->get('template error').$e->error, $self->getUrl, $self->getId;
$output = sprintf $i18n->get('template error').$message, $self->getUrl, $self->getId;
}
# Process the style template

View file

@ -1126,7 +1126,7 @@ sub viewList {
);
### Build the event vars
my $dtLast = $dtStart; # The DateTime of the last event
my $dtLast = WebGUI::DateTime->new(0); # The DateTime of the last event
EVENT: for my $event (@events) {
next EVENT unless $event && $event->canView();
my ( %eventVar, %eventDate )
@ -1135,12 +1135,15 @@ sub viewList {
# Add the change flags
my $dt = $event->getDateTimeStart;
if ( $dt->year > $dtLast->year ) {
$eventVar{ new_year } = 1;
}
if ( $dt->month > $dtLast->month ) {
$eventVar{ new_year } = 1;
$eventVar{ new_month } = 1;
$eventVar{ new_day } = 1;
}
if ( $dt->day > $dtLast->day ) {
elsif ( $dt->month > $dtLast->month ) {
$eventVar{ new_month } = 1;
$eventVar{ new_day } = 1;
}
elsif ( $dt->day > $dtLast->day ) {
$eventVar{ new_day } = 1;
}

View file

@ -2430,6 +2430,53 @@ sub export {
#-------------------------------------------------------------------
=head2 exportAssetData ()
Extend the base method to include custom question types added to this Survey.
=cut
sub exportAssetData {
my $self = shift;
my $asset_data = $self->SUPER::exportAssetData();
my $questions = $self->surveyJSON->questions();
my $multiple_choice = $self->surveyJSON->multipleChoiceTypes();
my %question_types = ();
my $get_question = $self->session->db->prepare('select answers from Survey_questionTypes where questionType=?');
foreach my $question (@{ $questions }) {
my $type = $question->{questionType};
next unless $multiple_choice->{$type};
next if $question_types{$type};
$get_question->execute([$type]);
my ($answers) = $get_question->array();
$question_types{$type} = $answers;
}
#my $question_types = $self->db->buildArrayRefOfHashRefs('select * from Survey_questionTypes');
$get_question->finish;
$asset_data->{question_types} = \%question_types;
return $asset_data;
}
#-------------------------------------------------------------------
=head2 importAssetCollateralData ($data)
Extend the base method to include custom question types added to this Survey.
=cut
sub importAssetCollateralData {
my $self = shift;
my $data = shift;
$self->SUPER::importAssetCollateralData($data);
my $custom_types = $data->{question_types};
while (my ($question, $answer) = each %{ $custom_types }) {
$self->session->db->write("INSERT INTO Survey_questionTypes VALUES(?,?) ON DUPLICATE KEY UPDATE answers = ?",[$question,$answer,$answer]);
}
}
#-------------------------------------------------------------------
=head2 www_exportSimpleResults ()
Exports transposed results as CSV (or tabbed depending on the C<format> form param)

View file

@ -169,7 +169,7 @@ sub addType {
my $questionType = shift;
my $address = shift;
my $question = $self->question($address);
my $ansString = $question->{answers} ? to_json $question->{answers} : {};
my $ansString = $question->{answers} ? to_json $question->{answers} : '{}';
$self->session->db->write("INSERT INTO Survey_questionTypes VALUES(?,?) ON DUPLICATE KEY UPDATE answers = ?",[$questionType,$ansString,$ansString]);
$question->{questionType} = $questionType;
}

View file

@ -157,6 +157,10 @@ This scratch variable is used by the Widget Macro.
Takes a hashref of arguments, containing the following keys:
=head3 depth
How many levels deep to export.
=head3 quiet
Boolean. To be or not to be quiet with our output. Defaults to false.

View file

@ -1169,8 +1169,10 @@ sub www_displayLogin {
$vars->{title} = $i18n->get(66);
my $action;
if ($self->session->setting->get("encryptLogin")) {
$action = $self->session->url->page(undef,1);
$action =~ s/http:/https:/;
my $uri = URI->new($self->session->url->page(undef,1));
$uri->scheme('https');
$uri->host_port($uri->host);
$action = $uri->as_string;
}
use WebGUI::Form::Password;
use WebGUI::Form::Hidden;
@ -1241,9 +1243,10 @@ sub www_login {
$self->session->scratch->delete("redirectAfterLogin");
}
elsif ($self->session->setting->get('encryptLogin')) {
my $currentUrl = $self->session->url->page(undef,1);
$currentUrl =~ s/^https:/http:/;
$self->session->response->setRedirect($currentUrl);
my $currentUrl = URI->new($self->session->url->page(undef,1));
$currentUrl->scheme('http');
$currentUrl->port($self->session->config->get('webServerPort') || 80);
$self->session->response->setRedirect($currentUrl->canonical->as_string);
}
# Get open version tag. This is needed if we want

View file

@ -293,6 +293,7 @@ sub finish {
$props{latch} = 0;
}
$props{endTime} = time();
$props{redirect} = $self->{redirect};
$self->set( \%props );
}
@ -529,6 +530,20 @@ sub setGroup {
#-----------------------------------------------------------------
=head2 setRedirect($url)
Allows a redirect to be set for the process after the initial fork. This happens
in the case when a file is to be downloaded after the fork finishes.
=cut
sub setRedirect {
my ( $self, $url ) = @_;
$self->{redirect} = $url;
}
#-----------------------------------------------------------------
=head2 request ($module, $subname, $data)
Internal method. Generates a hashref suitable for passing to runRequest.

View file

@ -98,7 +98,7 @@ my $template = <<'TEMPLATE';
url : params.statusUrl,
draw : function (data) {
var status = YAHOO.lang.JSON.parse(data.status);
bar.update(status.finished, status.total);
bar.update(status.current, status.total);
document.getElementById('message').innerHTML = status.message;
document.getElementById('elapsed').innerHTML = data.elapsed;
},
@ -106,8 +106,8 @@ my $template = <<'TEMPLATE';
document.getElementById('loading').style.display = 'none';
document.getElementById('ui').style.display = 'block';
},
finish : function() {
YAHOO.WebGUI.Fork.redirect(params);
finish : function(data) {
YAHOO.WebGUI.Fork.redirect(data.redirect || params.redirect);
},
error : function (msg) {
alert(msg);

View file

@ -67,7 +67,7 @@ See the synopsis for what kind of response this generates.
sub handler {
my $process = shift;
my $status = $process->getStatus;
my ( $finished, $startTime, $endTime, $error ) = $process->get( 'finished', 'startTime', 'endTime', 'error' );
my ( $finished, $startTime, $endTime, $error, $redirect ) = $process->get( qw/finished startTime endTime error redirect/ );
$endTime = time() unless $finished;
@ -76,7 +76,8 @@ sub handler {
elapsed => ( $endTime - $startTime ),
finished => ( $finished ? \1 : \0 ),
);
$status{error} = $error if $finished;
$status{error} = $error if $finished;
$status{redirect} = $redirect if $finished;
$process->session->response->content_type('text/plain');
JSON::encode_json( \%status );
} ## end sub handler

View file

@ -265,6 +265,7 @@ sub toHtml {
$style->setRawHeadTags(qq|<script type="text/javascript">var classValues = $jsonStr; </script>|);
my $jsonData = $self->get("value") || q|{ "isNew" : "true" }|;
$style->setRawHeadTags(qq|<script type="text/javascript">var dataValues = $jsonData; var first_row_error_msg = '$first_row_error_msg';</script>|);
$self->headTags();
#Decode JSON data for filling in some of the fields
my $jsonDataHash = JSON->new->decode($jsonData);

View file

@ -241,15 +241,15 @@ our $HELP = {
],
variables => [
{
name => 'newYear',
name => 'new_year',
description => 'helpvar newYear',
},
{
name => 'newMonth',
name => 'new_month',
description => 'helpvar newMonth',
},
{
name => 'newDay',
name => 'new_day',
description => 'helpvar newDay',
},
{

View file

@ -35,8 +35,8 @@ This package contains utility methods for WebGUI's ldap link system.
%ldapLink = WebGUI::LDAPLink->new($self->session,$ldapLinkId)->get;
$ldapLink = WebGUI::LDAPLink->new($self->session,$ldapLinkId);
$connection = $ldapLink->authenticate();
$ldapLink->disconnect;
$connection = $ldapLink->connectToLDAP();
$ldapLink->unbind;
=head1 METHODS

View file

@ -14,6 +14,7 @@ use strict;
use WebGUI::Form;
use WebGUI::International;
use WebGUI::Asset::Template;
use URI;
=head1 NAME
@ -97,8 +98,10 @@ sub process {
my $action;
if ($session->setting->get("encryptLogin")) {
$action = $session->url->page(undef,1);
$action =~ s/http:/https:/;
my $uri = URI->new($session->url->page(undef,1));
$uri->scheme('https');
$uri->host_port($uri->host);
$action = $uri->canonical->as_string;
}
use WebGUI::Form::Text;
use WebGUI::Form::Password;

View file

@ -154,7 +154,7 @@ sub rollbackInFork {
my $session = $process->session;
my $tag = WebGUI::VersionTag->new( $session, $tagId );
my %status = (
finished => 0,
current => 0,
total => $process->session->db->quickScalar( 'SELECT count(*) FROM assetData WHERE tagId = ?', [$tagId] ),
message => '',
);
@ -168,7 +168,7 @@ sub rollbackInFork {
my $purgeRevision = shift;
my $self = shift;
$self->$purgeRevision(@_);
$status{finished}++;
$status{current}++;
$update->();
}
);

View file

@ -11,6 +11,7 @@ use WebGUI::Workflow;
use WebGUI::Workflow::Instance;
use WebGUI::User;
use WebGUI::Text;
use WebGUI::Fork;
=head1 NAME
@ -57,7 +58,7 @@ sub canView {
#----------------------------------------------------------------------------
=head2 exportSomething ( session, sth, filename )
=head2 exportSomething ( $process, $data )
Generates CSV data from the supplied statement handle and generates
a temporary WebGUI::Storage object containing that data in the requested
@ -66,31 +67,53 @@ filename.
This subroutine also does a setRedirect to the URL of the file in
the storage object.
=head3 session
=head3 $process
Session variable, to set the http redirect correctly.
A WebGUI::Fork object, to let the user know what's going on.
=head3 sth
=head3 $data
Statement handle for reading data and getting column names
Hash ref of data.
=head3 tableName
The name of the table where data will be pulled and translated into CSV.
=head3 filename
The name of the file to create inside the storage object.
The name of the file to generate
=cut
sub exportSomething {
my ($session, $sth, $filename) = @_;
my ($process, $data) = @_;
my $session = $process->session;
my $i18n = WebGUI::International->new($session, 'Asset_Thingy');
my $storage = WebGUI::Storage->createTemp($session);
open my $CSV, '>', $storage->getPath($data->{filename});
my $sth = $session->db->read('select SQL_CALC_FOUND_ROWS * from '.$data->{tableName});
my %status = (
current => 0,
message => '',
total => $session->db->quickScalar('select found_rows()') + 0,
);
my $update = sub {
$process->update( sub { JSON::to_json(\%status) } );
};
$update->();
my @columns = $sth->getColumnNames;
my $csvData = WebGUI::Text::joinCSV( @columns ). "\n";
print $CSV WebGUI::Text::joinCSV( @columns ). "\n";
my $rowCounter = 0;
$status{message} = $i18n->get('Writing data');
$update->();
while (my $row = $sth->hashRef()) {
my @row = @{ $row }{@columns};
$csvData .= WebGUI::Text::joinCSV(@row) . "\n";
print $CSV WebGUI::Text::joinCSV(@row) . "\n";
++$status{current };
$update->();
}
$storage->addFileFromScalar($filename, $csvData);
$session->response->setRedirect($storage->getUrl($filename));
close $CSV;
$sth->finish;
}
#-------------------------------------------------------------------
@ -334,8 +357,24 @@ Dump the contents of the bucket log.
sub www_exportBucketData {
my ($session) = @_;
my $bucket = $session->db->read('select * from bucketLog order by userId, Bucket, timeStamp');
exportSomething($session, $bucket, 'bucketData.csv');
my $process = WebGUI::Fork->start(
$session,
__PACKAGE__, 'exportSomething',
{ tableName => 'bucketLog', filename => 'bucketData.csv', },
);
my $i18n = WebGUI::International->new($session, 'PassiveAnalytics');
$session->http->setRedirect(
$session->url->page(
$process->contentPairs(
'ProgressBar', {
icon => 'passiveAnalytics',
title => $i18n->get('Export bucket data'),
proceed => $session->url->page('op=passiveAnalytics;func=editRuleflow'),
},
),
),
);
return "redirect";
}
@ -349,8 +388,23 @@ Dump the contents of the delta log.
sub www_exportDeltaData {
my ($session) = @_;
my $delta = $session->db->read('select * from deltaLog order by userId, timeStamp');
exportSomething($session, $delta, 'deltaData.csv');
my $process = WebGUI::Fork->start(
$session,
__PACKAGE__, 'exportSomething',
{ tableName => 'deltaLog', filename => 'deltaData.csv', },
);
my $i18n = WebGUI::International->new($session, 'PassiveAnalytics');
$session->http->setRedirect(
$session->url->page(
$process->contentPairs(
'ProgressBar', {
icon => 'passiveAnalytics',
title => $i18n->get('Export delta data'),
proceed => $session->url->page('op=passiveAnalytics;func=editRuleflow'),
},
),
),
);
return "redirect";
}
@ -364,8 +418,23 @@ Dump the contents of the raw log.
sub www_exportLogs {
my ($session) = @_;
my $raw = $session->db->read('select * from passiveLog order by userId, timeStamp');
exportSomething($session, $raw, 'passiveData.csv');
my $process = WebGUI::Fork->start(
$session,
__PACKAGE__, 'exportSomething',
{ tableName => 'passiveLog', filename => 'passiveData.csv', },
);
my $i18n = WebGUI::International->new($session, 'PassiveAnalytics');
$session->http->setRedirect(
$session->url->page(
$process->contentPairs(
'ProgressBar', {
icon => 'passiveAnalytics',
title => $i18n->get('Export raw logs'),
proceed => $session->url->page('op=passiveAnalytics;func=editRuleflow'),
},
),
),
);
return "redirect";
}

View file

@ -51,6 +51,20 @@ sub definition {
return $class->SUPER::definition($session,$definition);
}
#-------------------------------------------------------------------
=head2 get_statement( session, counter )
Return a statement handle at the desired offset.
=cut
sub get_statement {
my ($session, $logIndex) = @_;
my $deltaSql = q{select SQL_CALC_FOUND_ROWS userId, assetId, url, delta, from_unixtime(timeStamp) as stamp from deltaLog limit ?, 500000};
my $sth = $session->db->read($deltaSql, [$logIndex+0]);
return $sth;
}
#-------------------------------------------------------------------
@ -85,47 +99,49 @@ sub execute {
my %bucketCache = ();
##Configure all the SQL
my $deltaSql = <<"EOSQL1";
select userId, assetId, url, delta, from_unixtime(timeStamp) as stamp
from deltaLog order by timestamp limit $logIndex, 1234567890
EOSQL1
my $deltaSth = $session->db->read($deltaSql);
my $bucketSth = $session->db->prepare('insert into bucketLog (userId, Bucket, duration, timeStamp) VALUES (?,?,?,?)');
my $deltaSth = get_statement($session, $logIndex);
my $total_rows = $session->db->quickScalar('select found_rows()');
my $bucketSth = $session->db->prepare('insert into bucketLog (userId, Bucket, duration, timeStamp) VALUES (?,?,?,?)');
##Walk through the log file entries, one by one. Run each entry against
##all the rules until 1 matches. If it doesn't match any rule, then bin it
##into the "Other" bucket.
DELTA_ENTRY: while (my $entry = $deltaSth->hashRef()) {
++$logIndex;
my $bucketFound = 0;
my $url = $entry->{url};
if (exists $bucketCache{$url}) {
$bucketSth->execute([$entry->{userId}, $bucketCache{$url}, $entry->{delta}, $entry->{stamp}]);
}
else {
RULE: foreach my $rule (@rules) {
next RULE unless $url =~ $rule->[1];
# Into the bucket she goes..
$bucketCache{$url} = $rule->[0];
$bucketSth->execute([$entry->{userId}, $rule->[0], $entry->{delta}, $entry->{stamp}]);
$bucketFound = 1;
last RULE;
DELTA_CHUNK: while (1) {
DELTA_ENTRY: while (my $entry = $deltaSth->hashRef()) {
++$logIndex;
my $bucketFound = 0;
my $url = $entry->{url};
if (exists $bucketCache{$url}) {
$bucketSth->execute([$entry->{userId}, $bucketCache{$url}, $entry->{delta}, $entry->{stamp}]);
}
if (!$bucketFound) {
$bucketCache{$url} = 'Other';
$bucketSth->execute([$entry->{userId}, 'Other', $entry->{delta}, $entry->{stamp}]);
}
}
if (time() > $endTime) {
$expired = 1;
last DELTA_ENTRY;
}
}
else {
RULE: foreach my $rule (@rules) {
next RULE unless $url =~ $rule->[1];
if ($expired) {
$instance->setScratch('logIndex', $logIndex);
return $self->WAITING(1);
# Into the bucket she goes..
$bucketCache{$url} = $rule->[0];
$bucketSth->execute([$entry->{userId}, $rule->[0], $entry->{delta}, $entry->{stamp}]);
$bucketFound = 1;
last RULE;
}
if (!$bucketFound) {
$bucketCache{$url} = 'Other';
$bucketSth->execute([$entry->{userId}, 'Other', $entry->{delta}, $entry->{stamp}]);
}
}
if (time() > $endTime) {
$expired = 1;
last DELTA_ENTRY;
}
}
if ($expired) {
$instance->setScratch('lastPassiveLogIndex', $logIndex);
return $self->WAITING(1);
}
last DELTA_CHUNK if $logIndex >= $total_rows;
$deltaSth = get_statement($session, $logIndex);
}
my $message = 'Passive analytics is done.';
if ($session->setting->get('passiveAnalyticsDeleteDelta')) {

View file

@ -49,6 +49,20 @@ sub definition {
return $class->SUPER::definition($session,$definition);
}
#-------------------------------------------------------------------
=head2 get_statement( session, counter )
Return a statement handle at the desired offset.
=cut
sub get_statement {
my ($session, $counter) = @_;
my $passive = q{select SQL_CALC_FOUND_ROWS * from passiveLog where userId <> '1' limit ?, 500000};
my $sth = $session->db->read($passive, [$counter+0]);
return $sth;
}
#-------------------------------------------------------------------
@ -72,72 +86,61 @@ sub execute {
my $endTime = time() + $self->getTTL;
my $deltaInterval = $self->get('deltaInterval');
my $passive = q{select * from passiveLog where userId <> '1' order by userId, sessionId, timeStamp};
my $sth;
my $lastUserId;
my $lastSessionId;
my $lastTimeStamp;
my $lastAssetId;
my $lastUrl;
my $counter = $instance->getScratch('counter');
if ($counter) {
$passive .= ' limit '. $counter .', 1234567890';
$sth = $session->db->read($passive);
$lastUserId = $instance->getScratch('lastUserId');
$lastSessionId = $instance->getScratch('lastSessionId');
$lastTimeStamp = $instance->getScratch('lastTimeStamp');
$lastAssetId = $instance->getScratch('lastAssetId');
$lastUrl = $instance->getScratch('lastUrl');
}
else {
$sth = $session->db->read($passive);
my $logLine = $sth->hashRef();
$lastUserId = $logLine->{userId};
$lastSessionId = $logLine->{sessionId};
$lastTimeStamp = $logLine->{timeStamp};
$lastAssetId = $logLine->{assetId};
$lastUrl = $logLine->{url};
my $sth = get_statement($session, $counter);
if (! $counter) { #Clean up from last time, just in case
$session->db->write('delete from deltaLog');
$session->db->write('delete from PA_lastLog');
}
$session->db->write('delete from deltaLog'); ##Only if we're starting out
my $deltaLog = $session->db->prepare('insert into deltaLog (userId, assetId, delta, timeStamp, url) VALUES (?,?,?,?,?)');
my $total_rows = $session->db->quickScalar('select found_rows()');
my $deltaLog = $session->db->prepare('insert into deltaLog (userId, assetId, timeStamp, url, delta) VALUES (?,?,?,?,?)');
my $recordLast = $session->db->prepare('REPLACE INTO PA_lastLog (userId, sessionId, timeStamp, url) VALUES (?,?,?,?)');
my $fetchLast = $session->db->prepare('select * from PA_lastLog where sessionId=? and userId=?');
my $expired = 0;
LOG_ENTRY: while (my $logLine = $sth->hashRef()) {
$counter++;
my $delta = $logLine->{timeStamp} - $lastTimeStamp;
if ( $logLine->{userId} eq $lastUserId
&& $logLine->{sessionId} eq $lastSessionId
&& $delta < $deltaInterval ) {
$deltaLog->execute([$lastUserId, $lastAssetId, $delta, $lastTimeStamp, $lastUrl]);
LOG_CHUNK: while (1) {
LOG_ENTRY: while (my $logLine = $sth->hashRef()) {
$counter++;
$fetchLast->execute([@{$logLine}{qw/sessionId userId/}]);
my $lastLine = $fetchLast->hashRef();
$recordLast->execute([ (@{ $logLine }{qw/userId sessionId timeStamp url/}) ]);
if ($lastLine->{timeStamp}) {
my $delta = $logLine->{timeStamp} - $lastLine->{timeStamp};
if ($delta <= $deltaInterval) {
$deltaLog->execute([ (@{ $lastLine }{qw/userId assetId timeStamp url/}), $delta]);
}
}
if (time() > $endTime) {
$expired = 1;
last LOG_ENTRY;
}
}
$lastUserId = $logLine->{userId};
$lastSessionId = $logLine->{sessionId};
$lastTimeStamp = $logLine->{timeStamp};
$lastAssetId = $logLine->{assetId};
$lastUrl = $logLine->{url};
if (time() > $endTime) {
$instance->setScratch('lastUserId', $lastUserId);
$instance->setScratch('lastSessionId', $lastSessionId);
$instance->setScratch('lastTimeStamp', $lastTimeStamp);
$instance->setScratch('lastAssetId', $lastAssetId);
$instance->setScratch('lastUrl', $lastUrl);
$instance->setScratch('counter', $counter);
$expired = 1;
last LOG_ENTRY;
if ($expired) {
$deltaLog->finish;
$recordLast->finish;
$fetchLast->finish;
$sth->finish;
$instance->setScratch('counter', $counter);
return $self->WAITING(1);
}
}
if ($expired) {
return $self->WAITING(1);
last LOG_CHUNK if $counter >= $total_rows;
$sth = get_statement($session, $counter);
}
$instance->deleteScratch('lastUserId');
$instance->deleteScratch('lastSessionId');
$instance->deleteScratch('lastTimeStamp');
$instance->deleteScratch('lastAssetId');
$instance->deleteScratch('lastUrl');
$instance->deleteScratch('counter');
$deltaLog->finish;
$recordLast->finish;
$fetchLast->finish;
$sth->finish;
$session->db->write('delete from PA_lastLog');
return $self->COMPLETE;
}

View file

@ -0,0 +1,15 @@
package WebGUI::i18n::English::Form_TimeField;
use strict;
our $I18N = {
'invalid time' => {
message => q|Invalid time|,
lastUpdated => 0,
context => q|Flag for when a time cannot be parsed.|
},
};
1;

View file

@ -201,6 +201,12 @@ home\?func=match<br />
context => q|Error message|,
},
'error creating workflow' => {
message => q|Error creating the workflow instance.|,
lastUpdated => 0,
context => q|Error message|,
},
};
1;