replace the old, buggy label.t with the new, slow critic_labels.t. Add Perl::Critic and Test::Perl::Critic as optional requirements to sbin/testEnvironment.pl
This commit is contained in:
parent
614b37e31d
commit
9a9e94a0de
5 changed files with 107 additions and 213 deletions
|
|
@ -67,66 +67,68 @@ if ($] >= 5.006) {
|
|||
}
|
||||
|
||||
|
||||
checkModule("LWP",5.80);
|
||||
checkModule("HTTP::Request",1.40);
|
||||
checkModule("HTTP::Headers",1.61);
|
||||
checkModule("Test::More",0.61,1);
|
||||
checkModule("Test::MockObject",1.02,1);
|
||||
checkModule("Test::Deep",0.095,1);
|
||||
checkModule("Pod::Coverage",0.17,2);
|
||||
checkModule("Text::Balanced",1.95,1);
|
||||
checkModule("Digest::MD5",2.20);
|
||||
checkModule("DBI",1.40);
|
||||
checkModule("DBD::mysql",3.0002);
|
||||
checkModule("HTML::Parser",3.36);
|
||||
checkModule("Archive::Tar",1.05);
|
||||
checkModule("Archive::Zip",1.16);
|
||||
checkModule("IO::Zlib",1.01);
|
||||
checkModule("Compress::Zlib",1.34);
|
||||
checkModule("Net::SMTP",2.24);
|
||||
checkModule("MIME::Tools",5.419);
|
||||
checkModule("Net::POP3",2.28);
|
||||
checkModule("Tie::IxHash",1.21);
|
||||
checkModule("Tie::CPHash",1.001);
|
||||
checkModule("XML::Simple",2.09);
|
||||
checkModule("SOAP::Lite",0.60);
|
||||
checkModule("DateTime",0.2901);
|
||||
checkModule("Time::HiRes",1.38);
|
||||
checkModule("DateTime::Format::Strptime",1.0601);
|
||||
checkModule("DateTime::Format::Mail",0.2901);
|
||||
checkModule("Image::Magick","6.0",2);
|
||||
checkModule("Graphics::Magick","1.1.7",2);
|
||||
checkModule("Log::Log4perl",0.51);
|
||||
checkModule("Net::LDAP",0.25);
|
||||
checkModule("HTML::Highlight",0.20);
|
||||
checkModule("HTML::TagFilter",0.07);
|
||||
checkModule("HTML::Template",2.9);
|
||||
checkModule("HTML::Template::Expr",0.05,2);
|
||||
checkModule("XML::RSSLite",0.11);
|
||||
checkModule("JSON",2.04);
|
||||
checkModule("Config::JSON","1.1.2");
|
||||
checkModule("Text::CSV_XS","0.26");
|
||||
checkModule("Net::Subnets",0.21);
|
||||
checkModule("Finance::Quote",1.08);
|
||||
checkModule("POE",0.3202);
|
||||
checkModule("POE::Component::IKC::Server",0.18);
|
||||
checkModule("POE::Component::Client::HTTP", 0.77);
|
||||
checkModule("Data::Structure::Util",0.11);
|
||||
checkModule("Apache2::Request",2.06);
|
||||
checkModule("URI::Escape","3.28");
|
||||
checkModule("POSIX");
|
||||
checkModule("List::Util");
|
||||
checkModule("Color::Calc");
|
||||
checkModule("Text::Aspell",0.01,2);
|
||||
checkModule("Locale::US");
|
||||
checkModule("Weather::Com::Finder","0.5.1");
|
||||
checkModule("Class::InsideOut","1.06");
|
||||
checkModule("HTML::TagCloud","0.34");
|
||||
checkModule("Image::ExifTool","7.00");
|
||||
checkModule("Archive::Any","0.093");
|
||||
checkModule("Path::Class", '0.16');
|
||||
checkModule("Exception::Class","1.23");
|
||||
checkModule("List::MoreUtils","0.22");
|
||||
checkModule("LWP", 5.80 );
|
||||
checkModule("HTTP::Request", 1.40 );
|
||||
checkModule("HTTP::Headers", 1.61 );
|
||||
checkModule("Test::More", 0.61, 1 );
|
||||
checkModule("Test::MockObject", 1.02, 1 );
|
||||
checkModule("Test::Deep", 0.095, 1 );
|
||||
checkModule("Pod::Coverage", 0.17, 2 );
|
||||
checkModule("Text::Balanced", 1.95, 1 );
|
||||
checkModule("Digest::MD5", 2.20 );
|
||||
checkModule("DBI", 1.40 );
|
||||
checkModule("DBD::mysql", 3.0002 );
|
||||
checkModule("HTML::Parser", 3.36 );
|
||||
checkModule("Archive::Tar", 1.05 );
|
||||
checkModule("Archive::Zip", 1.16 );
|
||||
checkModule("IO::Zlib", 1.01 );
|
||||
checkModule("Compress::Zlib", 1.34 );
|
||||
checkModule("Net::SMTP", 2.24 );
|
||||
checkModule("MIME::Tools", 5.419 );
|
||||
checkModule("Net::POP3", 2.28 );
|
||||
checkModule("Tie::IxHash", 1.21 );
|
||||
checkModule("Tie::CPHash", 1.001 );
|
||||
checkModule("XML::Simple", 2.09 );
|
||||
checkModule("SOAP::Lite", 0.60 );
|
||||
checkModule("DateTime", 0.2901 );
|
||||
checkModule("Time::HiRes", 1.38 );
|
||||
checkModule("DateTime::Format::Strptime", 1.0601 );
|
||||
checkModule("DateTime::Format::Mail", 0.2901 );
|
||||
checkModule("Image::Magick", "6.0", 2 );
|
||||
checkModule("Graphics::Magick", "1.1.7", 2 );
|
||||
checkModule("Log::Log4perl", 0.51 );
|
||||
checkModule("Net::LDAP", 0.25 );
|
||||
checkModule("HTML::Highlight", 0.20 );
|
||||
checkModule("HTML::TagFilter", 0.07 );
|
||||
checkModule("HTML::Template", 2.9 );
|
||||
checkModule("HTML::Template::Expr", 0.05, 2 );
|
||||
checkModule("XML::RSSLite", 0.11 );
|
||||
checkModule("JSON", 2.04 );
|
||||
checkModule("Config::JSON", "1.1.2" );
|
||||
checkModule("Text::CSV_XS", "0.26" );
|
||||
checkModule("Net::Subnets", 0.21 );
|
||||
checkModule("Finance::Quote", 1.08 );
|
||||
checkModule("POE", 0.3202 );
|
||||
checkModule("POE::Component::IKC::Server", 0.18 );
|
||||
checkModule("POE::Component::Client::HTTP", 0.77 );
|
||||
checkModule("Data::Structure::Util", 0.11 );
|
||||
checkModule("Apache2::Request", 2.06 );
|
||||
checkModule("URI::Escape", "3.28" );
|
||||
checkModule("POSIX" );
|
||||
checkModule("List::Util" );
|
||||
checkModule("Color::Calc" );
|
||||
checkModule("Text::Aspell", 0.01,2 );
|
||||
checkModule("Locale::US" );
|
||||
checkModule("Weather::Com::Finder", "0.5.1" );
|
||||
checkModule("Class::InsideOut", "1.06" );
|
||||
checkModule("HTML::TagCloud", "0.34" );
|
||||
checkModule("Image::ExifTool", "7.00" );
|
||||
checkModule("Archive::Any", "0.093" );
|
||||
checkModule("Path::Class", '0.16' );
|
||||
checkModule("Exception::Class", "1.23" );
|
||||
checkModule("List::MoreUtils", "0.22" );
|
||||
checkModule("Perl::Critic", "1.080", 1 );
|
||||
checkModule("Test::Perl::Critic", "1.01", 1 );
|
||||
|
||||
|
||||
###################################
|
||||
|
|
|
|||
35
t/i18n/critic_labels.t
Normal file
35
t/i18n/critic_labels.t
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
# vim:syntax=perl
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2008 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#------------------------------------------------------------------
|
||||
|
||||
# Write a little about what this script tests.
|
||||
#
|
||||
#
|
||||
|
||||
use Path::Class;
|
||||
use FindBin;
|
||||
use strict;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
plan skip_all => 'set CODE_COP to enable this test' unless $ENV{CODE_COP};
|
||||
|
||||
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||
use WebGUI::Session;
|
||||
|
||||
##Delay this so that the skip_all can work the way it should
|
||||
eval { require Test::Perl::Critic; };
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Init
|
||||
my $session = WebGUI::Test->session;
|
||||
|
||||
my $label_profile = Path::Class::File->new( WebGUI::Test->root , 't', 'i18n', 'perlcriticrc');
|
||||
Test::Perl::Critic->import(-profile => $label_profile->stringify);
|
||||
all_critic_ok(WebGUI::Test->lib);
|
||||
147
t/i18n/label.t
147
t/i18n/label.t
|
|
@ -1,147 +0,0 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2008 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
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 locate all of the international labels that it
|
||||
#can and verify that they exist in all loaded language models
|
||||
|
||||
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;
|
||||
|
||||
# put your tests here
|
||||
|
||||
my $digits = qr/(\d+)/;
|
||||
my $bareword = qr/(\w+)/;
|
||||
#my $quotelike = qr/((['"])([^'"\s$]+\s*)+(['"]))/;
|
||||
my $quotelike = qr/((['"])([^'"\s\$]+\s*)+(['"]))/;
|
||||
my $sub_args = qr/(($quotelike|$digits)(,\s*)?)+/;
|
||||
my $sess_arg = qr/(?:\$session|\$self->session)/;
|
||||
my $subroutine = qr/
|
||||
WebGUI::International::get
|
||||
\( ##Opening paren for optional arguments
|
||||
($sub_args)
|
||||
\) ##Closing paren
|
||||
/x;
|
||||
|
||||
|
||||
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 @libLabels;
|
||||
my @objLabels;
|
||||
|
||||
find(\&label_finder_pm, $lib);
|
||||
|
||||
find(\&obj_finder_pm, $lib);
|
||||
|
||||
$numTests = scalar(@libLabels)
|
||||
+ scalar(@objLabels)
|
||||
;
|
||||
|
||||
plan tests => $numTests;
|
||||
|
||||
my $i18n = WebGUI::International->new($session);
|
||||
|
||||
foreach my $label ( @libLabels ) {
|
||||
ok(0,
|
||||
sprintf "sub label: %s->%s inside %s", @{ $label }{'namespace', 'label', 'file', });
|
||||
}
|
||||
|
||||
foreach my $label ( @objLabels ) {
|
||||
ok($i18n->get(@{ $label }{qw(label namespace )} ),
|
||||
sprintf "obj label: %s->%s inside %s", @{ $label }{'namespace', 'label', 'file', });
|
||||
}
|
||||
|
||||
sub label_finder_pm {
|
||||
return unless /\.pm$/;
|
||||
open my $pmf, $_
|
||||
or die "unable to open file $File::Find::name: $!\n";
|
||||
my $libFile = '';
|
||||
{
|
||||
local $/;
|
||||
$libFile = <$pmf>;
|
||||
}
|
||||
close $pmf;
|
||||
while ($libFile =~ m/$subroutine/gc) {
|
||||
my ($label, $namespace) = split /,\s*/, $1;
|
||||
push @libLabels, {
|
||||
file=>$File::Find::name,
|
||||
label=>$label,
|
||||
namespace=>$namespace || 'WebGUI',
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
sub obj_finder_pm {
|
||||
return unless /\.pm$/;
|
||||
if ($File::Find::name =~ m#/(?:Help|i18n)/?$#) {
|
||||
diag "Pruned $File::Find::name\n";
|
||||
$File::Find::prune=1;
|
||||
return;
|
||||
}
|
||||
open my $pmf, $_
|
||||
or die "unable to open file $File::Find::name: $!\n";
|
||||
my $libFile = '';
|
||||
{
|
||||
local $/;
|
||||
$libFile = <$pmf>;
|
||||
}
|
||||
close $pmf;
|
||||
##Advance pos to first subroutine
|
||||
while ( my $subBody = extract_codeblock($libFile, '{}', qr/(?ms).*?^sub (\w+)\s*/) ) {
|
||||
while ( $subBody =~ /(\w+)\s*=\s*WebGUI::International->new\($sess_arg(?:,\s*($quotelike))?\)/msgc) {
|
||||
my $objBody = $subBody;
|
||||
my ($obj, $namespace) = ($1,$2);
|
||||
while ( $objBody =~ /$obj\->get\(($sub_args)\)/msgc ) {
|
||||
my ($label, $local_name) = split /,\s*/, $1;
|
||||
push @objLabels, {
|
||||
file=>$File::Find::name,
|
||||
label=>$label,
|
||||
namespace=>$local_name || $namespace || 'WebGUI',
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
2
t/i18n/perlcriticrc
Normal file
2
t/i18n/perlcriticrc
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
only = 1
|
||||
include = NoIllegalI18NLabels
|
||||
|
|
@ -13,18 +13,19 @@ use base 'Perl::Critic::Policy';
|
|||
|
||||
=head1 Perl::Critic::Policy::WebGUI::NoIllegalI18NLabels
|
||||
|
||||
Scan WebGUI modules for i18n calls and make sure that each
|
||||
call has a corresponding i18n table entry.
|
||||
Scan WebGUI modules for i18n calls and make sure that each call has a
|
||||
corresponding i18n table entry. It will not check i18n calls that have
|
||||
variables for either the namespace or the label to look up.
|
||||
|
||||
Running this policy requires setting up some environmental
|
||||
variables to that it can get a proper WebGUI session, and access
|
||||
the test library.
|
||||
Running this policy from the command line requires setting up some
|
||||
environmental variables to that it can get a proper WebGUI session,
|
||||
and access the test library.
|
||||
|
||||
env WEBGUI_CONFIG=/data/WebGUI/etc/my.conf PERL5LIB=/data/WebGUI/t/lib perlcritic -single-policy NoIllegalI18N
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.1';
|
||||
our $VERSION = '0.2';
|
||||
|
||||
Readonly::Scalar my $DESC => q{i18n calls that do not have corresponding i18n table entries};
|
||||
|
||||
|
|
@ -78,6 +79,7 @@ sub violates {
|
|||
return unless ref $arg_list eq 'PPI::Structure::List';
|
||||
my @arguments = _get_args($arg_list);
|
||||
my $namespace = $arguments[1]->[0];
|
||||
return unless $namespace; ##This can be a namespace in a variable.
|
||||
$namespace = $namespace->string || 'WebGUI';
|
||||
$self->{_i18n_objects}->{$symbol_name} = $namespace;
|
||||
return;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue