Documented the heretofore undocumented Deactivate Account Template in the Auth modules.
Broke out code scanning tests into their own tests, and required the CODE_COP environment variable be set before they were run. Fixed two bugs in the Workflow test, wrong number of tests and inverse test logic. More Auth template inheritance work. Almost time to reflect it over to the LDAP module.
This commit is contained in:
Colin Kuskie
parent
860a71bc5d
commit
ee9cae98a8
11 changed files with 385 additions and 201 deletions
|
|
@ -25,6 +25,7 @@ use File::Find;
|
|||
|
||||
use Test::More; # increment this value for each test you create
|
||||
my $numTests = 0;
|
||||
plan skip_all => 'set CODE_COP to enable this test' unless $ENV{CODE_COP};
|
||||
|
||||
my $session = WebGUI::Test->session;
|
||||
my $lib = WebGUI::Test->lib;
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ use WebGUI::Test;
|
|||
use WebGUI::Session;
|
||||
use WebGUI::Workflow;
|
||||
use WebGUI::Utility qw/isIn/;
|
||||
use Test::More tests => 0; # increment this value for each test you create
|
||||
use Test::More tests => 16; # increment this value for each test you create
|
||||
|
||||
my $session = WebGUI::Test->session;
|
||||
my $wf = WebGUI::Workflow->create($session, {title => 'Title', description => 'Description',
|
||||
|
|
@ -40,8 +40,9 @@ ok(!isIn($wfId, keys %{WebGUI::Workflow->getList($session)}), 'workflow not in e
|
|||
$wf->set({enabled => 1});
|
||||
ok($wf->get('enabled'), 'workflow is enabled');
|
||||
ok(isIn($wfId, keys %{WebGUI::Workflow->getList($session)}), 'workflow in enabled list');
|
||||
$session->errorHandler->warn('Interesting');
|
||||
$wf->set({enabled => 0});
|
||||
ok($wf->get('enabled'), 'workflow is disabled again');
|
||||
ok(!$wf->get('enabled'), 'workflow is disabled again');
|
||||
|
||||
$wf->delete;
|
||||
ok(!defined WebGUI::Workflow->new($session, $wfId), 'deleted workflow cannot be retrieved');
|
||||
|
|
|
|||
149
t/i18n/help.t
Normal file
149
t/i18n/help.t
Normal file
|
|
@ -0,0 +1,149 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2006 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
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use FindBin;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib "$FindBin::Bin/../lib"; ##t/lib
|
||||
|
||||
use WebGUI::Test;
|
||||
use WebGUI::Operation::Help;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Session;
|
||||
use Text::Balanced qw(extract_codeblock);
|
||||
use File::Find;
|
||||
use Data::Dumper;
|
||||
|
||||
#The goal of this test is to verify all the i18n labels in
|
||||
#the help files. It used to be glommed into the same test as
|
||||
#the code scanner, but was broken out due to speed issues.
|
||||
|
||||
use Test::More; # increment this value for each test you create
|
||||
my $numTests = 0;
|
||||
|
||||
my $session = WebGUI::Test->session;
|
||||
my $lib = WebGUI::Test->lib;
|
||||
|
||||
# put your tests here
|
||||
|
||||
my %helpTable;
|
||||
|
||||
my @helpFileSet = WebGUI::Operation::Help::_getHelpFilesList($session);
|
||||
|
||||
foreach my $helpSet (@helpFileSet) {
|
||||
my $helpName = $helpSet->[1];
|
||||
my $help = WebGUI::Operation::Help::_load($session, $helpName);
|
||||
$helpTable{ $helpName } = $help;
|
||||
}
|
||||
|
||||
##Scan #1, find all labels in the help system. body, title, @fields
|
||||
|
||||
## Array of hashes
|
||||
## each hash will have:
|
||||
## topic -> which help file it is from
|
||||
## entry -> which entry in the help file
|
||||
## tag -> which tag in the entry in the help file
|
||||
## namespace -> which help file it is form
|
||||
## label -> which help file it is form
|
||||
|
||||
my @helpLabels;
|
||||
my @sqlLabels;
|
||||
my @libLabels;
|
||||
my @objLabels;
|
||||
|
||||
|
||||
@helpLabels = getHelpLabels();
|
||||
|
||||
$numTests = scalar(@helpLabels);
|
||||
|
||||
plan tests => $numTests;
|
||||
|
||||
my $i18n = WebGUI::International->new($session);
|
||||
|
||||
foreach my $label ( @helpLabels ) {
|
||||
ok($i18n->get(@{ $label }{qw(label namespace )} ),
|
||||
sprintf "label: %s->%s inside %s->%s->%s", @{ $label }{'namespace', 'label', 'topic', 'entry', 'tag', });
|
||||
}
|
||||
|
||||
sub getHelpLabels {
|
||||
my @helpLabels = ();
|
||||
foreach my $topic ( keys %helpTable ) {
|
||||
foreach my $entry ( keys %{ $helpTable{$topic} }) {
|
||||
##Check the title and body data
|
||||
push @helpLabels, {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'title',
|
||||
namespace=>$topic, ##default
|
||||
label=>$helpTable{$topic}{$entry}{'title'},
|
||||
};
|
||||
if (ref $helpTable{$topic}{$entry}{'body'} ne 'CODE') {
|
||||
push @helpLabels, {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'body',
|
||||
namespace=>$topic, ##default
|
||||
label=>$helpTable{$topic}{$entry}{'body'},
|
||||
};
|
||||
}
|
||||
|
||||
##Add all labels in the fields array
|
||||
foreach my $field (@{ $helpTable{$topic}{$entry}{fields} }) {
|
||||
push @helpLabels, {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'fields',
|
||||
namespace=>$field->{namespace},
|
||||
label=>$field->{title},
|
||||
},
|
||||
{
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'fields',
|
||||
namespace=>$field->{namespace},
|
||||
label=>$field->{description},
|
||||
},;
|
||||
}
|
||||
my $variableEntries = getHelpVariables($helpTable{$topic}{$entry}{variables});
|
||||
foreach my $variable ( @{ $variableEntries } ) {
|
||||
my $namespace = exists $variable->{namespace} ? $variable->{namespace} : $topic;
|
||||
my $one = {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'variables',
|
||||
namespace=>$namespace,
|
||||
};
|
||||
if ($variable->{description}) {
|
||||
$one->{label} = $variable->{description},
|
||||
}
|
||||
else {
|
||||
$one->{label} = $variable->{name},
|
||||
}
|
||||
push @helpLabels, $one;
|
||||
}
|
||||
}
|
||||
}
|
||||
return @helpLabels;
|
||||
}
|
||||
|
||||
sub getHelpVariables {
|
||||
my ($variables) = @_; ##An arrayref of variables, possibly with nested variables in loops
|
||||
my $tmplVars = [];
|
||||
foreach my $var ( @{ $variables } ) {
|
||||
if ( exists $var->{variables} ) {
|
||||
push @{ $tmplVars }, @{ getHelpVariables($var->{variables}) };
|
||||
delete $var->{variables};
|
||||
}
|
||||
push @{ $tmplVars }, $var;
|
||||
}
|
||||
return $tmplVars;
|
||||
}
|
||||
|
||||
|
||||
121
t/i18n/label.t
121
t/i18n/label.t
|
|
@ -26,6 +26,7 @@ use Data::Dumper;
|
|||
|
||||
use Test::More; # increment this value for each test you create
|
||||
my $numTests = 0;
|
||||
plan skip_all => 'set CODE_COP to enable this test' unless $ENV{CODE_COP};
|
||||
|
||||
my $session = WebGUI::Test->session;
|
||||
my $lib = WebGUI::Test->lib;
|
||||
|
|
@ -65,23 +66,14 @@ foreach my $helpSet (@helpFileSet) {
|
|||
## namespace -> which help file it is form
|
||||
## label -> which help file it is form
|
||||
|
||||
my @helpLabels;
|
||||
my @sqlLabels;
|
||||
my @libLabels;
|
||||
my @objLabels;
|
||||
|
||||
|
||||
@helpLabels = getHelpLabels();
|
||||
|
||||
#@sqlLabels = getSQLLabels();
|
||||
|
||||
find(\&label_finder_pm, $lib);
|
||||
|
||||
find(\&obj_finder_pm, $lib);
|
||||
|
||||
$numTests = scalar(@helpLabels)
|
||||
# + scalar(@sqlLabels)
|
||||
+ scalar(@libLabels)
|
||||
$numTests = scalar(@libLabels)
|
||||
+ scalar(@objLabels)
|
||||
;
|
||||
|
||||
|
|
@ -89,19 +81,6 @@ plan tests => $numTests;
|
|||
|
||||
my $i18n = WebGUI::International->new($session);
|
||||
|
||||
foreach my $label ( @helpLabels ) {
|
||||
ok($i18n->get(@{ $label }{qw(label namespace )} ),
|
||||
sprintf "label: %s->%s inside %s->%s->%s", @{ $label }{'namespace', 'label', 'topic', 'entry', 'tag', });
|
||||
}
|
||||
|
||||
#
|
||||
#foreach my $label ( @sqlLabels ) {
|
||||
# ok($i18n->get(@{ $label }{qw(label namespace )} ),
|
||||
# sprintf "label: %s->%s inside %s", @{ $label }{'namespace', 'label', 'file', });
|
||||
#}
|
||||
#
|
||||
##Subroutine calls are now illegal, everything must be done by object methods.
|
||||
|
||||
foreach my $label ( @libLabels ) {
|
||||
ok(0,
|
||||
sprintf "label: %s->%s inside %s", @{ $label }{'namespace', 'label', 'file', });
|
||||
|
|
@ -164,100 +143,4 @@ sub obj_finder_pm {
|
|||
}
|
||||
}
|
||||
|
||||
sub getHelpLabels {
|
||||
my @helpLabels = ();
|
||||
foreach my $topic ( keys %helpTable ) {
|
||||
foreach my $entry ( keys %{ $helpTable{$topic} }) {
|
||||
##Check the title and body data
|
||||
push @helpLabels, {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'title',
|
||||
namespace=>$topic, ##default
|
||||
label=>$helpTable{$topic}{$entry}{'title'},
|
||||
};
|
||||
if (ref $helpTable{$topic}{$entry}{'body'} ne 'CODE') {
|
||||
push @helpLabels, {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'body',
|
||||
namespace=>$topic, ##default
|
||||
label=>$helpTable{$topic}{$entry}{'body'},
|
||||
};
|
||||
}
|
||||
|
||||
##Add all labels in the fields array
|
||||
foreach my $field (@{ $helpTable{$topic}{$entry}{fields} }) {
|
||||
push @helpLabels, {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'fields',
|
||||
namespace=>$field->{namespace},
|
||||
label=>$field->{title},
|
||||
},
|
||||
{
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'fields',
|
||||
namespace=>$field->{namespace},
|
||||
label=>$field->{description},
|
||||
},;
|
||||
}
|
||||
my $variableEntries = getHelpVariables($helpTable{$topic}{$entry}{variables});
|
||||
foreach my $variable ( @{ $variableEntries } ) {
|
||||
my $namespace = exists $variable->{namespace} ? $variable->{namespace} : $topic;
|
||||
my $one = {
|
||||
topic=>$topic,
|
||||
entry=>$entry,
|
||||
tag=>'variables',
|
||||
namespace=>$namespace,
|
||||
};
|
||||
if ($variable->{description}) {
|
||||
$one->{label} = $variable->{description},
|
||||
}
|
||||
else {
|
||||
$one->{label} = $variable->{name},
|
||||
}
|
||||
push @helpLabels, $one;
|
||||
}
|
||||
}
|
||||
}
|
||||
return @helpLabels;
|
||||
}
|
||||
|
||||
sub getHelpVariables {
|
||||
my ($variables) = @_; ##An arrayref of variables, possibly with nested variables in loops
|
||||
my $tmplVars = [];
|
||||
foreach my $var ( @{ $variables } ) {
|
||||
if ( exists $var->{variables} ) {
|
||||
push @{ $tmplVars }, @{ getHelpVariables($var->{variables}) };
|
||||
delete $var->{variables};
|
||||
}
|
||||
push @{ $tmplVars }, $var;
|
||||
}
|
||||
return $tmplVars;
|
||||
}
|
||||
|
||||
sub getSQLLabels {
|
||||
my @sqlLabels = ();
|
||||
foreach my $file (qw/create.sql previousVersion.sql/) {
|
||||
my $file2 = join '/', '../..', 'docs', $file;
|
||||
open my $fh, $file2 or
|
||||
die "Unable to open $file2: $!\n";
|
||||
local $/;
|
||||
my $sql = <$fh>;
|
||||
while ($sql =~ /WebGUI::International::get\(([^\)]+)\)/gs) {
|
||||
my $args;
|
||||
($args = $1) =~ tr{\\"}{}d;
|
||||
my ($label,$namespace) = split ',', $args;
|
||||
$namespace = "WebGUI" unless $namespace;
|
||||
push @sqlLabels, {
|
||||
label => $label,
|
||||
namespace => $namespace,
|
||||
file => $file,
|
||||
};
|
||||
}
|
||||
close $fh;
|
||||
}
|
||||
return @sqlLabels;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue