From 9a9e94a0de44d7f2b92e50770445a0c2c5dbf608 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 4 Jun 2008 20:09:00 +0000 Subject: [PATCH] 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 --- sbin/testEnvironment.pl | 122 ++++++++------- t/i18n/critic_labels.t | 35 +++++ t/i18n/label.t | 147 ------------------ t/i18n/perlcriticrc | 2 + .../Policy/WebGUI/NoIllegalI18NLabels.pm | 14 +- 5 files changed, 107 insertions(+), 213 deletions(-) create mode 100644 t/i18n/critic_labels.t delete mode 100644 t/i18n/label.t create mode 100644 t/i18n/perlcriticrc diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 17f385ee0..eb9a4fa7e 100644 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -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 ); ################################### diff --git a/t/i18n/critic_labels.t b/t/i18n/critic_labels.t new file mode 100644 index 000000000..39c7fa9fb --- /dev/null +++ b/t/i18n/critic_labels.t @@ -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); diff --git a/t/i18n/label.t b/t/i18n/label.t deleted file mode 100644 index d1e635f79..000000000 --- a/t/i18n/label.t +++ /dev/null @@ -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', - }; - } - } - } -} - - diff --git a/t/i18n/perlcriticrc b/t/i18n/perlcriticrc new file mode 100644 index 000000000..991856a43 --- /dev/null +++ b/t/i18n/perlcriticrc @@ -0,0 +1,2 @@ +only = 1 +include = NoIllegalI18NLabels diff --git a/t/lib/Perl/Critic/Policy/WebGUI/NoIllegalI18NLabels.pm b/t/lib/Perl/Critic/Policy/WebGUI/NoIllegalI18NLabels.pm index 329bc6a5e..a5f589eb3 100644 --- a/t/lib/Perl/Critic/Policy/WebGUI/NoIllegalI18NLabels.pm +++ b/t/lib/Perl/Critic/Policy/WebGUI/NoIllegalI18NLabels.pm @@ -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;