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:
Colin Kuskie 2008-06-04 20:09:00 +00:00
parent 614b37e31d
commit 9a9e94a0de
5 changed files with 107 additions and 213 deletions

View file

@ -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
View 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);

View file

@ -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
View file

@ -0,0 +1,2 @@
only = 1
include = NoIllegalI18NLabels

View file

@ -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;