aboutsummaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorPerl Tidy <perltidy@bugzilla.org>2019-01-30 20:00:43 -0500
committerDylan William Hardison <dylan@hardison.net>2019-01-30 20:31:44 -0500
commit7f3a749d7bd78a3e4aee163f562d7e95b0954b44 (patch)
treef86271c0b1f3ece6d55d8fa44767d41bb890f1f6 /t
parentBug 1226123 - Email addresses with an apostrophe in them break the "Send Mail... (diff)
downloadbugzilla-7f3a749d7bd78a3e4aee163f562d7e95b0954b44.tar.gz
bugzilla-7f3a749d7bd78a3e4aee163f562d7e95b0954b44.tar.bz2
bugzilla-7f3a749d7bd78a3e4aee163f562d7e95b0954b44.zip
no bug - reformat all the code using the new perltidy rules
Diffstat (limited to 't')
-rw-r--r--t/001compile.t116
-rw-r--r--t/002goodperl.t269
-rw-r--r--t/003safesys.t61
-rw-r--r--t/004template.t180
-rw-r--r--t/005whitespace.t66
-rw-r--r--t/006spellcheck.t104
-rw-r--r--t/007util.t68
-rw-r--r--t/008filter.t310
-rw-r--r--t/009bugwords.t84
-rw-r--r--t/010dependencies.t76
-rw-r--r--t/011pod.t154
-rw-r--r--t/012throwables.t280
-rw-r--r--t/013dbschema.t80
-rw-r--r--t/Support/Files.pm40
-rw-r--r--t/Support/Templates.pm91
15 files changed, 1048 insertions, 931 deletions
diff --git a/t/001compile.t b/t/001compile.t
index 7097ad361..bfd065dc0 100644
--- a/t/001compile.t
+++ b/t/001compile.t
@@ -18,48 +18,48 @@ use lib qw(. lib t);
use Config;
use Support::Files;
use Test::More tests => scalar(@Support::Files::testitems)
- + scalar(@Support::Files::test_files);
+ + scalar(@Support::Files::test_files);
-BEGIN {
- use_ok('Bugzilla::Constants');
- use_ok('Bugzilla::Install::Requirements');
- use_ok('Bugzilla');
+BEGIN {
+ use_ok('Bugzilla::Constants');
+ use_ok('Bugzilla::Install::Requirements');
+ use_ok('Bugzilla');
}
sub compile_file {
- my ($file) = @_;
+ my ($file) = @_;
- # Don't allow CPAN.pm to modify the global @INC, which the version
- # shipped with Perl 5.8.8 does. (It gets loaded by
- # Bugzilla::Install::CPAN.)
- local @INC = @INC;
+ # Don't allow CPAN.pm to modify the global @INC, which the version
+ # shipped with Perl 5.8.8 does. (It gets loaded by
+ # Bugzilla::Install::CPAN.)
+ local @INC = @INC;
- if ($file =~ s/\.pm$//) {
- $file =~ s{/}{::}g;
- use_ok($file);
- return;
- }
+ if ($file =~ s/\.pm$//) {
+ $file =~ s{/}{::}g;
+ use_ok($file);
+ return;
+ }
- open(my $fh, $file);
- my $bang = <$fh>;
- close $fh;
+ open(my $fh, $file);
+ my $bang = <$fh>;
+ close $fh;
- my $T = "";
- if ($bang =~ m/#!\S*perl\s+-.*T/) {
- $T = "T";
- }
+ my $T = "";
+ if ($bang =~ m/#!\S*perl\s+-.*T/) {
+ $T = "T";
+ }
- my $libs = '';
- if ($ENV{PERL5LIB}) {
- $libs = join " ", map { "-I\"$_\"" } split /$Config{path_sep}/, $ENV{PERL5LIB};
- }
- my $perl = qq{"$^X"};
- my $output = `$perl $libs -c$T $file 2>&1`;
- chomp($output);
- my $return_val = $?;
- $output =~ s/^\Q$file\E syntax OK$//ms;
- diag($output) if $output;
- ok(!$return_val, $file) or diag('--ERROR');
+ my $libs = '';
+ if ($ENV{PERL5LIB}) {
+ $libs = join " ", map {"-I\"$_\""} split /$Config{path_sep}/, $ENV{PERL5LIB};
+ }
+ my $perl = qq{"$^X"};
+ my $output = `$perl $libs -c$T $file 2>&1`;
+ chomp($output);
+ my $return_val = $?;
+ $output =~ s/^\Q$file\E syntax OK$//ms;
+ diag($output) if $output;
+ ok(!$return_val, $file) or diag('--ERROR');
}
my @testitems = (@Support::Files::testitems, @Support::Files::test_files);
@@ -67,29 +67,29 @@ my $file_features = map_files_to_features();
# Test the scripts by compiling them
foreach my $file (@testitems) {
- # These were already compiled, above.
- next if ($file eq 'Bugzilla.pm'
- or $file eq 'Bugzilla/Constants.pm'
- or $file eq 'Bugzilla/Install/Requirements.pm');
- SKIP: {
- if ($file eq 'mod_perl.pl') {
- skip 'mod_perl.pl cannot be compiled from the command line', 1;
- }
- my $feature = $file_features->{$file};
- if ($feature and !Bugzilla->feature($feature)) {
- skip "$file: $feature not enabled", 1;
- }
-
- # Check that we have a DBI module to support the DB, if this
- # is a database module (but not Schema)
- if ($file =~ m{Bugzilla/DB/([^/]+)\.pm$}
- and $file ne "Bugzilla/DB/Schema.pm")
- {
- my $module = lc($1);
- my $dbd = DB_MODULE->{$module}->{dbd}->{module};
- eval("use $dbd; 1") or skip "$file: $dbd not installed", 1;
- }
-
- compile_file($file);
+
+ # These were already compiled, above.
+ next
+ if ($file eq 'Bugzilla.pm'
+ or $file eq 'Bugzilla/Constants.pm'
+ or $file eq 'Bugzilla/Install/Requirements.pm');
+SKIP: {
+ if ($file eq 'mod_perl.pl') {
+ skip 'mod_perl.pl cannot be compiled from the command line', 1;
+ }
+ my $feature = $file_features->{$file};
+ if ($feature and !Bugzilla->feature($feature)) {
+ skip "$file: $feature not enabled", 1;
}
-}
+
+ # Check that we have a DBI module to support the DB, if this
+ # is a database module (but not Schema)
+ if ($file =~ m{Bugzilla/DB/([^/]+)\.pm$} and $file ne "Bugzilla/DB/Schema.pm") {
+ my $module = lc($1);
+ my $dbd = DB_MODULE->{$module}->{dbd}->{module};
+ eval("use $dbd; 1") or skip "$file: $dbd not installed", 1;
+ }
+
+ compile_file($file);
+ }
+}
diff --git a/t/002goodperl.t b/t/002goodperl.t
index d1858361f..c59692229 100644
--- a/t/002goodperl.t
+++ b/t/002goodperl.t
@@ -18,156 +18,171 @@ use lib 't';
use Support::Files;
-use Test::More tests => (scalar(@Support::Files::testitems)
- + scalar(@Support::Files::test_files)) * 6;
+use Test::More tests =>
+ (scalar(@Support::Files::testitems) + scalar(@Support::Files::test_files))
+ * 6;
my @testitems = (@Support::Files::test_files, @Support::Files::testitems);
my @require_taint = qw(email_in.pl importxml.pl mod_perl.pl whine.pl);
foreach my $file (@testitems) {
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
- if (! open (FILE, $file)) {
- ok(0,"could not open $file --WARNING");
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next if (!$file); # skip null entries
+ if (!open(FILE, $file)) {
+ ok(0, "could not open $file --WARNING");
+ }
+ my $file_line1 = <FILE>;
+ close(FILE);
+
+ $file =~ m/.*\.(.*)/;
+ my $ext = $1;
+
+ if ($file_line1 !~ m/^#\!/) {
+ ok(1, "$file does not have a shebang");
+ }
+ else {
+ my $flags;
+ if (!defined $ext || $ext eq "pl") {
+
+ # standalone programs aren't taint checked yet
+ if (grep { $file eq $_ } @require_taint) {
+ $flags = 'T';
+ }
+ else {
+ $flags = '';
+ }
}
- my $file_line1 = <FILE>;
- close (FILE);
-
- $file =~ m/.*\.(.*)/;
- my $ext = $1;
-
- if ($file_line1 !~ m/^#\!/) {
- ok(1,"$file does not have a shebang");
- } else {
- my $flags;
- if (!defined $ext || $ext eq "pl") {
- # standalone programs aren't taint checked yet
- if (grep { $file eq $_ } @require_taint) {
- $flags = 'T';
- }
- else {
- $flags = '';
- }
- } elsif ($ext eq "pm") {
- ok(0, "$file is a module, but has a shebang");
- next;
- } elsif ($ext eq "cgi") {
- # cgi files must be taint checked
- $flags = 'T';
- } else {
- ok(0, "$file has shebang but unknown extension");
- next;
- }
-
- if ($file_line1 =~ m#^\#\!/usr/bin/perl(?:\s-(\w+))?$#) {
- my $file_flags = $1 || '';
- if ($flags eq $file_flags) {
- ok(1, "$file uses standard perl location" . ($flags ? " and -$flags flag" : ""));
- }
- elsif ($flags) {
- ok(0, "$file is MISSING -$flags flag --WARNING");
- }
- else {
- ok(0, "$file has unexpected -$file_flags flag --WARNING");
- }
- } else {
- ok(0,"$file uses non-standard perl location");
- }
+ elsif ($ext eq "pm") {
+ ok(0, "$file is a module, but has a shebang");
+ next;
}
-}
+ elsif ($ext eq "cgi") {
-foreach my $file (@testitems) {
- my $found_use_perl = 0;
- my $found_use_strict = 0;
- my $found_use_warnings = 0;
-
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
- if (! open (FILE, $file)) {
- ok(0,"could not open $file --WARNING");
- next;
- }
- while (my $file_line = <FILE>) {
- $found_use_perl = 1 if $file_line =~ m/^\s*use 5.10.1/;
- $found_use_strict = 1 if $file_line =~ m/^\s*use strict/;
- $found_use_warnings = 1 if $file_line =~ m/^\s*use warnings/;
- last if ($found_use_perl && $found_use_strict && $found_use_warnings);
+ # cgi files must be taint checked
+ $flags = 'T';
}
- close (FILE);
- if ($found_use_perl) {
- ok(1,"$file requires Perl 5.10.1");
- } else {
- ok(0,"$file DOES NOT require Perl 5.10.1 --WARNING");
+ else {
+ ok(0, "$file has shebang but unknown extension");
+ next;
}
- if ($found_use_strict) {
- ok(1,"$file uses strict");
- } else {
- ok(0,"$file DOES NOT use strict --WARNING");
+ if ($file_line1 =~ m#^\#\!/usr/bin/perl(?:\s-(\w+))?$#) {
+ my $file_flags = $1 || '';
+ if ($flags eq $file_flags) {
+ ok(1,
+ "$file uses standard perl location" . ($flags ? " and -$flags flag" : ""));
+ }
+ elsif ($flags) {
+ ok(0, "$file is MISSING -$flags flag --WARNING");
+ }
+ else {
+ ok(0, "$file has unexpected -$file_flags flag --WARNING");
+ }
}
-
- if ($found_use_warnings) {
- ok(1,"$file uses warnings");
- } else {
- ok(0,"$file DOES NOT use warnings --WARNING");
+ else {
+ ok(0, "$file uses non-standard perl location");
}
+ }
+}
+
+foreach my $file (@testitems) {
+ my $found_use_perl = 0;
+ my $found_use_strict = 0;
+ my $found_use_warnings = 0;
+
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next if (!$file); # skip null entries
+ if (!open(FILE, $file)) {
+ ok(0, "could not open $file --WARNING");
+ next;
+ }
+ while (my $file_line = <FILE>) {
+ $found_use_perl = 1 if $file_line =~ m/^\s*use 5.10.1/;
+ $found_use_strict = 1 if $file_line =~ m/^\s*use strict/;
+ $found_use_warnings = 1 if $file_line =~ m/^\s*use warnings/;
+ last if ($found_use_perl && $found_use_strict && $found_use_warnings);
+ }
+ close(FILE);
+ if ($found_use_perl) {
+ ok(1, "$file requires Perl 5.10.1");
+ }
+ else {
+ ok(0, "$file DOES NOT require Perl 5.10.1 --WARNING");
+ }
+
+ if ($found_use_strict) {
+ ok(1, "$file uses strict");
+ }
+ else {
+ ok(0, "$file DOES NOT use strict --WARNING");
+ }
+
+ if ($found_use_warnings) {
+ ok(1, "$file uses warnings");
+ }
+ else {
+ ok(0, "$file DOES NOT use warnings --WARNING");
+ }
}
# Check to see that all error messages use tags (for l10n reasons.)
foreach my $file (@testitems) {
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
- if (! open (FILE, $file)) {
- ok(0,"could not open $file --WARNING");
- next;
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next if (!$file); # skip null entries
+ if (!open(FILE, $file)) {
+ ok(0, "could not open $file --WARNING");
+ next;
+ }
+ my $lineno = 0;
+ my $error = 0;
+
+ while (!$error && (my $file_line = <FILE>)) {
+ $lineno++;
+ if ($file_line =~ /Throw.*Error\("(.*?)"/) {
+ if ($1 =~ /\s/) {
+ ok(
+ 0, "$file has a Throw*Error call on line $lineno
+ which doesn't use a tag --ERROR"
+ );
+ $error = 1;
+ }
}
- my $lineno = 0;
- my $error = 0;
-
- while (!$error && (my $file_line = <FILE>)) {
- $lineno++;
- if ($file_line =~ /Throw.*Error\("(.*?)"/) {
- if ($1 =~ /\s/) {
- ok(0,"$file has a Throw*Error call on line $lineno
- which doesn't use a tag --ERROR");
- $error = 1;
- }
- }
- }
-
- ok(1,"$file uses Throw*Error calls correctly") if !$error;
-
- close(FILE);
+ }
+
+ ok(1, "$file uses Throw*Error calls correctly") if !$error;
+
+ close(FILE);
}
# Forbird the { foo => $cgi->param() } syntax, for security reasons.
foreach my $file (@testitems) {
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next unless $file; # skip null entries
- if (!open(FILE, $file)) {
- ok(0, "could not open $file --WARNING");
- next;
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next unless $file; # skip null entries
+ if (!open(FILE, $file)) {
+ ok(0, "could not open $file --WARNING");
+ next;
+ }
+ my $lineno = 0;
+ my @unsafe_args;
+
+ while (my $file_line = <FILE>) {
+ $lineno++;
+ $file_line =~ s/^\s*(.+)\s*$/$1/; # Remove leading and trailing whitespaces.
+ if ($file_line =~ /^[^#]+=> \$cgi\->param/) {
+ push(@unsafe_args, "$file_line on line $lineno");
}
- my $lineno = 0;
- my @unsafe_args;
-
- while (my $file_line = <FILE>) {
- $lineno++;
- $file_line =~ s/^\s*(.+)\s*$/$1/; # Remove leading and trailing whitespaces.
- if ($file_line =~ /^[^#]+=> \$cgi\->param/) {
- push(@unsafe_args, "$file_line on line $lineno");
- }
- }
-
- if (@unsafe_args) {
- ok(0, "$file incorrectly passes a CGI argument to a hash --ERROR\n" .
- join("\n", @unsafe_args));
- }
- else {
- ok(1, "$file has no vulnerable hash syntax");
- }
-
- close(FILE);
+ }
+
+ if (@unsafe_args) {
+ ok(0,
+ "$file incorrectly passes a CGI argument to a hash --ERROR\n"
+ . join("\n", @unsafe_args));
+ }
+ else {
+ ok(1, "$file has no vulnerable hash syntax");
+ }
+
+ close(FILE);
}
exit 0;
diff --git a/t/003safesys.t b/t/003safesys.t
index 443f96415..3cc55f835 100644
--- a/t/003safesys.t
+++ b/t/003safesys.t
@@ -24,39 +24,42 @@ use Test::More tests => scalar(@Support::Files::testitems);
# This will handle verbosity for us automatically.
my $fh;
{
- no warnings qw(unopened); # Don't complain about non-existent filehandles
- if (-e \*Test::More::TESTOUT) {
- $fh = \*Test::More::TESTOUT;
- } elsif (-e \*Test::Builder::TESTOUT) {
- $fh = \*Test::Builder::TESTOUT;
- } else {
- $fh = \*STDOUT;
- }
+ no warnings qw(unopened); # Don't complain about non-existent filehandles
+ if (-e \*Test::More::TESTOUT) {
+ $fh = \*Test::More::TESTOUT;
+ }
+ elsif (-e \*Test::Builder::TESTOUT) {
+ $fh = \*Test::Builder::TESTOUT;
+ }
+ else {
+ $fh = \*STDOUT;
+ }
}
-my @testitems = @Support::Files::testitems;
-my $perlapp = "\"$^X\"";
+my @testitems = @Support::Files::testitems;
+my $perlapp = "\"$^X\"";
foreach my $file (@testitems) {
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
-
- open(my $fh2, '<', $file);
- my $bang = <$fh2>;
- close $fh2;
-
- my $T = "";
- if ($bang =~ m/#!\S*perl\s+-.*T/) {
- $T = "T";
- }
- my $command = "$perlapp -c$T -It -MSupport::Systemexec $file 2>&1";
- my $loginfo=`$command`;
- if ($loginfo =~ /arguments for Support::Systemexec::(system|exec)/im) {
- ok(0,"$file DOES NOT use proper system or exec calls");
- print $fh $loginfo;
- } else {
- ok(1,"$file uses proper system and exec calls");
- }
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next if (!$file); # skip null entries
+
+ open(my $fh2, '<', $file);
+ my $bang = <$fh2>;
+ close $fh2;
+
+ my $T = "";
+ if ($bang =~ m/#!\S*perl\s+-.*T/) {
+ $T = "T";
+ }
+ my $command = "$perlapp -c$T -It -MSupport::Systemexec $file 2>&1";
+ my $loginfo = `$command`;
+ if ($loginfo =~ /arguments for Support::Systemexec::(system|exec)/im) {
+ ok(0, "$file DOES NOT use proper system or exec calls");
+ print $fh $loginfo;
+ }
+ else {
+ ok(1, "$file uses proper system and exec calls");
+ }
}
exit 0;
diff --git a/t/004template.t b/t/004template.t
index 0a6f0e0aa..938ee8b18 100644
--- a/t/004template.t
+++ b/t/004template.t
@@ -22,20 +22,22 @@ use CGI qw(-no_debug);
use File::Spec;
use Template;
-use Test::More tests => ( scalar(@referenced_files) + 2 * $num_actual_files );
+use Test::More tests => (scalar(@referenced_files) + 2 * $num_actual_files);
# Capture the TESTOUT from Test::More or Test::Builder for printing errors.
# This will handle verbosity for us automatically.
my $fh;
{
- no warnings qw(unopened); # Don't complain about non-existent filehandles
- if (-e \*Test::More::TESTOUT) {
- $fh = \*Test::More::TESTOUT;
- } elsif (-e \*Test::Builder::TESTOUT) {
- $fh = \*Test::Builder::TESTOUT;
- } else {
- $fh = \*STDOUT;
- }
+ no warnings qw(unopened); # Don't complain about non-existent filehandles
+ if (-e \*Test::More::TESTOUT) {
+ $fh = \*Test::More::TESTOUT;
+ }
+ elsif (-e \*Test::Builder::TESTOUT) {
+ $fh = \*Test::Builder::TESTOUT;
+ }
+ else {
+ $fh = \*STDOUT;
+ }
}
# Check to make sure all templates that are referenced in Bugzilla
@@ -44,82 +46,106 @@ my $fh;
# fall back to English if necessary.
foreach my $file (@referenced_files) {
- my $found = 0;
- foreach my $path (@english_default_include_paths) {
- my $pathfile = File::Spec->catfile($path, $file);
- if (-e $pathfile) {
- $found = 1;
- last;
- }
+ my $found = 0;
+ foreach my $path (@english_default_include_paths) {
+ my $pathfile = File::Spec->catfile($path, $file);
+ if (-e $pathfile) {
+ $found = 1;
+ last;
}
+ }
- ok($found, "$file found");
+ ok($found, "$file found");
}
foreach my $include_path (@include_paths) {
- # Processes all the templates to make sure they have good syntax
- my $provider = Template::Provider->new(
- {
- INCLUDE_PATH => $include_path ,
- # Need to define filters used in the codebase, they don't
- # actually have to function in this test, just be defined.
- # See Template.pm for the actual codebase definitions.
-
- # Initialize templates (f.e. by loading plugins like Hook).
- PRE_PROCESS => "global/variables.none.tmpl",
-
- FILTERS =>
- {
- html_linebreak => sub { return $_; },
- js => sub { return $_ } ,
- base64 => sub { return $_ } ,
- inactive => [ sub { return sub { return $_; } }, 1] ,
- closed => [ sub { return sub { return $_; } }, 1] ,
- obsolete => [ sub { return sub { return $_; } }, 1] ,
- url_quote => sub { return $_ } ,
- css_class_quote => sub { return $_ } ,
- xml => sub { return $_ } ,
- quoteUrls => sub { return $_ } ,
- bug_link => [ sub { return sub { return $_; } }, 1] ,
- csv => sub { return $_ } ,
- unitconvert => sub { return $_ },
- time => sub { return $_ } ,
- wrap_comment => sub { return $_ },
- none => sub { return $_ } ,
- ics => [ sub { return sub { return $_; } }, 1] ,
+
+ # Processes all the templates to make sure they have good syntax
+ my $provider = Template::Provider->new({
+ INCLUDE_PATH => $include_path,
+
+ # Need to define filters used in the codebase, they don't
+ # actually have to function in this test, just be defined.
+ # See Template.pm for the actual codebase definitions.
+
+ # Initialize templates (f.e. by loading plugins like Hook).
+ PRE_PROCESS => "global/variables.none.tmpl",
+
+ FILTERS => {
+ html_linebreak => sub { return $_; },
+ js => sub { return $_ },
+ base64 => sub { return $_ },
+ inactive => [
+ sub {
+ return sub { return $_; }
+ },
+ 1
+ ],
+ closed => [
+ sub {
+ return sub { return $_; }
+ },
+ 1
+ ],
+ obsolete => [
+ sub {
+ return sub { return $_; }
+ },
+ 1
+ ],
+ url_quote => sub { return $_ },
+ css_class_quote => sub { return $_ },
+ xml => sub { return $_ },
+ quoteUrls => sub { return $_ },
+ bug_link => [
+ sub {
+ return sub { return $_; }
+ },
+ 1
+ ],
+ csv => sub { return $_ },
+ unitconvert => sub { return $_ },
+ time => sub { return $_ },
+ wrap_comment => sub { return $_ },
+ none => sub { return $_ },
+ ics => [
+ sub {
+ return sub { return $_; }
},
+ 1
+ ],
+ },
+ });
+
+ foreach my $file (@{$actual_files{$include_path}}) {
+ my $path = File::Spec->catfile($include_path, $file);
+
+ # These are actual files, so there's no need to check for existence.
+
+ my ($data, $err) = $provider->fetch($file);
+
+ if (!$err) {
+ ok(1, "$path syntax ok");
+ }
+ else {
+ ok(0, "$path has bad syntax --ERROR");
+ print $fh $data . "\n";
+ }
+
+ # Make sure no forbidden constructs are present.
+ local $/;
+ open(FILE, '<', $path) or die "Can't open $file: $!\n";
+ $data = <FILE>;
+ close(FILE);
+
+ # Forbid single quotes to delimit URLs, see bug 926085.
+ if ($data =~ /href=\\?'/) {
+ ok(0, "$path contains blacklisted constructs: href='...'");
}
- );
-
- foreach my $file (@{$actual_files{$include_path}}) {
- my $path = File::Spec->catfile($include_path, $file);
-
- # These are actual files, so there's no need to check for existence.
-
- my ($data, $err) = $provider->fetch($file);
-
- if (!$err) {
- ok(1, "$path syntax ok");
- }
- else {
- ok(0, "$path has bad syntax --ERROR");
- print $fh $data . "\n";
- }
-
- # Make sure no forbidden constructs are present.
- local $/;
- open(FILE, '<', $path) or die "Can't open $file: $!\n";
- $data = <FILE>;
- close (FILE);
-
- # Forbid single quotes to delimit URLs, see bug 926085.
- if ($data =~ /href=\\?'/) {
- ok(0, "$path contains blacklisted constructs: href='...'");
- }
- else {
- ok(1, "$path contains no blacklisted constructs");
- }
+ else {
+ ok(1, "$path contains no blacklisted constructs");
}
+ }
}
exit 0;
diff --git a/t/005whitespace.t b/t/005whitespace.t
index b6de8cee3..ef589e693 100644
--- a/t/005whitespace.t
+++ b/t/005whitespace.t
@@ -19,49 +19,57 @@ use Support::Files;
use Support::Templates;
use File::Spec;
-use Test::More tests => (scalar(@Support::Files::testitems)
- + scalar(@Support::Files::test_files)
- + $Support::Templates::num_actual_files) * 3;
+use Test::More tests => (
+ scalar(@Support::Files::testitems)
+ + scalar(@Support::Files::test_files)
+ + $Support::Templates::num_actual_files)
+ * 3;
my @testitems = (@Support::Files::testitems, @Support::Files::test_files);
for my $path (@Support::Templates::include_paths) {
- push(@testitems, map(File::Spec->catfile($path, $_),
- Support::Templates::find_actual_files($path)));
+ push(
+ @testitems,
+ map(File::Spec->catfile($path, $_),
+ Support::Templates::find_actual_files($path))
+ );
}
my %results;
foreach my $file (@testitems) {
- open (FILE, "$file");
- my @contents = <FILE>;
- if (grep /\t/, @contents) {
- ok(0, "$file contains tabs --WARNING");
- } else {
- ok(1, "$file has no tabs");
- }
- close (FILE);
+ open(FILE, "$file");
+ my @contents = <FILE>;
+ if (grep /\t/, @contents) {
+ ok(0, "$file contains tabs --WARNING");
+ }
+ else {
+ ok(1, "$file has no tabs");
+ }
+ close(FILE);
}
foreach my $file (@testitems) {
- open (FILE, "$file");
- my @contents = <FILE>;
- if (grep /\r/, @contents) {
- ok(0, "$file contains non-OS-conformant line endings --WARNING");
- } else {
- ok(1, "All line endings of $file are OS conformant");
- }
- close (FILE);
+ open(FILE, "$file");
+ my @contents = <FILE>;
+ if (grep /\r/, @contents) {
+ ok(0, "$file contains non-OS-conformant line endings --WARNING");
+ }
+ else {
+ ok(1, "All line endings of $file are OS conformant");
+ }
+ close(FILE);
}
foreach my $file (@testitems) {
- open (FILE, "$file");
- my $first_line = <FILE>;
- if ($first_line =~ /\xef\xbb\xbf/) {
- ok(0, "$file contains Byte Order Mark --WARNING");
- } else {
- ok(1, "$file is free of a Byte Order Mark");
- }
- close (FILE);
+ open(FILE, "$file");
+ my $first_line = <FILE>;
+ if ($first_line =~ /\xef\xbb\xbf/) {
+ ok(0, "$file contains Byte Order Mark --WARNING");
+ }
+ else {
+ ok(1, "$file is free of a Byte Order Mark");
+ }
+ close(FILE);
}
exit 0;
diff --git a/t/006spellcheck.t b/t/006spellcheck.t
index 24e00242d..ccbd69932 100644
--- a/t/006spellcheck.t
+++ b/t/006spellcheck.t
@@ -19,72 +19,76 @@ use Support::Files;
# -1 because 006spellcheck.t must not be checked.
use Test::More tests => scalar(@Support::Files::testitems)
- + scalar(@Support::Files::test_files) - 1;
+ + scalar(@Support::Files::test_files) - 1;
# Capture the TESTOUT from Test::More or Test::Builder for printing errors.
# This will handle verbosity for us automatically.
my $fh;
{
- no warnings qw(unopened); # Don't complain about non-existent filehandles
- if (-e \*Test::More::TESTOUT) {
- $fh = \*Test::More::TESTOUT;
- } elsif (-e \*Test::Builder::TESTOUT) {
- $fh = \*Test::Builder::TESTOUT;
- } else {
- $fh = \*STDOUT;
- }
+ no warnings qw(unopened); # Don't complain about non-existent filehandles
+ if (-e \*Test::More::TESTOUT) {
+ $fh = \*Test::More::TESTOUT;
+ }
+ elsif (-e \*Test::Builder::TESTOUT) {
+ $fh = \*Test::Builder::TESTOUT;
+ }
+ else {
+ $fh = \*STDOUT;
+ }
}
my @testitems = (@Support::Files::testitems, @Support::Files::test_files);
#add the words to check here:
my @evilwords = qw(
- anyways
- appearence
- arbitary
- cancelled
- critera
- databasa
- dependan
- existance
- existant
- paramater
- refered
- repsentation
- suported
- varsion
+ anyways
+ appearence
+ arbitary
+ cancelled
+ critera
+ databasa
+ dependan
+ existance
+ existant
+ paramater
+ refered
+ repsentation
+ suported
+ varsion
);
my $evilwordsregexp = join('|', @evilwords);
foreach my $file (@testitems) {
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
- # Do not try to validate this file as it obviously contains a list
- # of wrongly spelled words.
- next if ($file eq 't/006spellcheck.t');
-
- if (open (FILE, $file)) { # open the file for reading
-
- my $found_word = '';
-
- while (my $file_line = <FILE>) { # and go through the file line by line
- if ($file_line =~ /($evilwordsregexp)/i) { # found an evil word
- $found_word = $1;
- last;
- }
- }
-
- close (FILE);
-
- if ($found_word) {
- ok(0,"$file: found SPELLING ERROR $found_word --WARNING");
- } else {
- ok(1,"$file does not contain registered spelling errors");
- }
- } else {
- ok(0,"could not open $file for spellcheck --WARNING");
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next if (!$file); # skip null entries
+ # Do not try to validate this file as it obviously contains a list
+ # of wrongly spelled words.
+ next if ($file eq 't/006spellcheck.t');
+
+ if (open(FILE, $file)) { # open the file for reading
+
+ my $found_word = '';
+
+ while (my $file_line = <FILE>) { # and go through the file line by line
+ if ($file_line =~ /($evilwordsregexp)/i) { # found an evil word
+ $found_word = $1;
+ last;
+ }
}
-}
+
+ close(FILE);
+
+ if ($found_word) {
+ ok(0, "$file: found SPELLING ERROR $found_word --WARNING");
+ }
+ else {
+ ok(1, "$file does not contain registered spelling errors");
+ }
+ }
+ else {
+ ok(0, "could not open $file for spellcheck --WARNING");
+ }
+}
exit 0;
diff --git a/t/007util.t b/t/007util.t
index 66c2df032..94f62dfc1 100644
--- a/t/007util.t
+++ b/t/007util.t
@@ -18,9 +18,9 @@ use Support::Files;
use Test::More tests => 17;
use DateTime;
-BEGIN {
- use_ok('Bugzilla');
- use_ok('Bugzilla::Util');
+BEGIN {
+ use_ok('Bugzilla');
+ use_ok('Bugzilla::Util');
}
# We need to override user preferences so we can get an expected value when
@@ -29,38 +29,57 @@ Bugzilla->user->{'settings'}->{'timezone'}->{'value'} = "local";
# We need to know the local timezone for the date chosen in our tests.
# Below, tests are run against Nov. 24, 2002.
-my $tz = Bugzilla->local_timezone->short_name_for_datetime(DateTime->new(year => 2002, month => 11, day => 24));
+my $tz = Bugzilla->local_timezone->short_name_for_datetime(
+ DateTime->new(year => 2002, month => 11, day => 24));
# we don't test the taint functions since that's going to take some more work.
# XXX: test taint functions
#html_quote():
-is(html_quote("<lala&@>"),"&lt;lala&amp;&#64;&gt;",'html_quote');
+is(html_quote("<lala&@>"), "&lt;lala&amp;&#64;&gt;", 'html_quote');
#url_quote():
-is(url_quote("<lala&>gaa\"'[]{\\"),"%3Clala%26%3Egaa%22%27%5B%5D%7B%5C",'url_quote');
+is(url_quote("<lala&>gaa\"'[]{\\"),
+ "%3Clala%26%3Egaa%22%27%5B%5D%7B%5C", 'url_quote');
#trim():
-is(trim(" fg<*\$%>+=~~ "),'fg<*$%>+=~~','trim()');
+is(trim(" fg<*\$%>+=~~ "), 'fg<*$%>+=~~', 'trim()');
#format_time();
-is(format_time("2002.11.24 00:05"), "2002-11-24 00:05 $tz",'format_time("2002.11.24 00:05") is ' . format_time("2002.11.24 00:05"));
-is(format_time("2002.11.24 00:05:56"), "2002-11-24 00:05:56 $tz",'format_time("2002.11.24 00:05:56")');
-is(format_time("2002.11.24 00:05:56", "%Y-%m-%d %R"), '2002-11-24 00:05', 'format_time("2002.11.24 00:05:56", "%Y-%m-%d %R") (with no timezone)');
-is(format_time("2002.11.24 00:05:56", "%Y-%m-%d %R %Z"), "2002-11-24 00:05 $tz", 'format_time("2002.11.24 00:05:56", "%Y-%m-%d %R %Z") (with timezone)');
+is(
+ format_time("2002.11.24 00:05"),
+ "2002-11-24 00:05 $tz",
+ 'format_time("2002.11.24 00:05") is ' . format_time("2002.11.24 00:05")
+);
+is(
+ format_time("2002.11.24 00:05:56"),
+ "2002-11-24 00:05:56 $tz",
+ 'format_time("2002.11.24 00:05:56")'
+);
+is(
+ format_time("2002.11.24 00:05:56", "%Y-%m-%d %R"),
+ '2002-11-24 00:05',
+ 'format_time("2002.11.24 00:05:56", "%Y-%m-%d %R") (with no timezone)'
+);
+is(
+ format_time("2002.11.24 00:05:56", "%Y-%m-%d %R %Z"),
+ "2002-11-24 00:05 $tz",
+ 'format_time("2002.11.24 00:05:56", "%Y-%m-%d %R %Z") (with timezone)'
+);
# email_filter
my %email_strings = (
- 'somebody@somewhere.com' => 'somebody',
- 'Somebody <somebody@somewhere.com>' => 'Somebody <somebody>',
- 'One Person <one@person.com>, Two Person <two@person.com>'
- => 'One Person <one>, Two Person <two>',
- 'This string contains somebody@somewhere.com and also this@that.com'
- => 'This string contains somebody and also this',
+ 'somebody@somewhere.com' => 'somebody',
+ 'Somebody <somebody@somewhere.com>' => 'Somebody <somebody>',
+ 'One Person <one@person.com>, Two Person <two@person.com>' =>
+ 'One Person <one>, Two Person <two>',
+ 'This string contains somebody@somewhere.com and also this@that.com' =>
+ 'This string contains somebody and also this',
);
+
foreach my $input (keys %email_strings) {
- is(Bugzilla::Util::email_filter($input), $email_strings{$input},
- "email_filter('$input')");
+ is(Bugzilla::Util::email_filter($input),
+ $email_strings{$input}, "email_filter('$input')");
}
# validate_email_syntax. We need to override some parameters.
@@ -68,14 +87,18 @@ my $params = Bugzilla->params;
$params->{emailregexp} = '.*';
$params->{emailsuffix} = '';
my $ascii_email = 'admin@company.com';
+
# U+0430 returns the Cyrillic "а", which looks similar to the ASCII "a".
my $utf8_email = "\N{U+0430}dmin\@company.com";
-ok(validate_email_syntax($ascii_email), 'correctly formatted ASCII-only email address is valid');
-ok(!validate_email_syntax($utf8_email), 'correctly formatted email address with non-ASCII characters is rejected');
+ok(validate_email_syntax($ascii_email),
+ 'correctly formatted ASCII-only email address is valid');
+ok(!validate_email_syntax($utf8_email),
+ 'correctly formatted email address with non-ASCII characters is rejected');
# diff_arrays():
my @old_array = qw(alpha beta alpha gamma gamma beta alpha delta epsilon gamma);
my @new_array = qw(alpha alpha beta gamma epsilon delta beta delta);
+
# The order is not relevant when comparing both arrays for matching items,
# i.e. (foo bar) and (bar foo) are the same arrays (same items).
# But when returning data, we try to respect the initial order.
@@ -83,5 +106,6 @@ my @new_array = qw(alpha alpha beta gamma epsilon delta beta delta);
# Removed (in this order): gamma alpha gamma.
# Added (in this order): delta
my ($removed, $added) = diff_arrays(\@old_array, \@new_array);
-is_deeply($removed, [qw(gamma alpha gamma)], 'diff_array(\@old, \@new) (check removal)');
+is_deeply($removed, [qw(gamma alpha gamma)],
+ 'diff_array(\@old, \@new) (check removal)');
is_deeply($added, [qw(delta)], 'diff_array(\@old, \@new) (check addition)');
diff --git a/t/008filter.t b/t/008filter.t
index f0a26d13f..b60a97579 100644
--- a/t/008filter.t
+++ b/t/008filter.t
@@ -11,7 +11,7 @@
# This test scans all our templates for every directive. Having eliminated
# those which cannot possibly cause XSS problems, it then checks the rest
-# against the safe list stored in the filterexceptions.pl file.
+# against the safe list stored in the filterexceptions.pl file.
# Sample exploit code: '>"><script>alert('Oh dear...')</script>
@@ -29,192 +29,196 @@ use Cwd;
# Undefine the record separator so we can read in whole files at once
my $oldrecsep = $/;
-my $topdir = cwd;
+my $topdir = cwd;
$/ = undef;
our %safe;
foreach my $path (@Support::Templates::include_paths) {
- $path =~ s|\\|/|g if ON_WINDOWS; # convert \ to / in path if on windows
- $path =~ m|template/([^/]+)/([^/]+)|;
- my $lang = $1;
- my $flavor = $2;
-
- chdir $topdir; # absolute path
- my @testitems = Support::Templates::find_actual_files($path);
- chdir $topdir; # absolute path
-
- next unless @testitems;
-
- # Some people require this, others don't. No-one knows why.
- chdir $path; # relative path
-
- # We load a %safe list of acceptable exceptions.
- if (-r "filterexceptions.pl") {
- do "filterexceptions.pl";
- if (ON_WINDOWS) {
- # filterexceptions.pl uses / separated paths, while
- # find_actual_files returns \ separated ones on Windows.
- # Here, we convert the filter exception hash to use \.
- foreach my $file (keys %safe) {
- my $orig_file = $file;
- $file =~ s|/|\\|g;
- if ($file ne $orig_file) {
- $safe{$file} = $safe{$orig_file};
- delete $safe{$orig_file};
- }
- }
+ $path =~ s|\\|/|g if ON_WINDOWS; # convert \ to / in path if on windows
+ $path =~ m|template/([^/]+)/([^/]+)|;
+ my $lang = $1;
+ my $flavor = $2;
+
+ chdir $topdir; # absolute path
+ my @testitems = Support::Templates::find_actual_files($path);
+ chdir $topdir; # absolute path
+
+ next unless @testitems;
+
+ # Some people require this, others don't. No-one knows why.
+ chdir $path; # relative path
+
+ # We load a %safe list of acceptable exceptions.
+ if (-r "filterexceptions.pl") {
+ do "filterexceptions.pl";
+ if (ON_WINDOWS) {
+
+ # filterexceptions.pl uses / separated paths, while
+ # find_actual_files returns \ separated ones on Windows.
+ # Here, we convert the filter exception hash to use \.
+ foreach my $file (keys %safe) {
+ my $orig_file = $file;
+ $file =~ s|/|\\|g;
+ if ($file ne $orig_file) {
+ $safe{$file} = $safe{$orig_file};
+ delete $safe{$orig_file};
}
+ }
}
-
- # We preprocess the %safe hash of lists into a hash of hashes. This allows
- # us to flag which members were not found, and report that as a warning,
- # thereby keeping the lists clean.
- foreach my $file (keys %safe) {
- if (ref $safe{$file} eq 'ARRAY') {
- my $list = $safe{$file};
- $safe{$file} = {};
- foreach my $directive (@$list) {
- $safe{$file}{$directive} = 0;
- }
- }
+ }
+
+ # We preprocess the %safe hash of lists into a hash of hashes. This allows
+ # us to flag which members were not found, and report that as a warning,
+ # thereby keeping the lists clean.
+ foreach my $file (keys %safe) {
+ if (ref $safe{$file} eq 'ARRAY') {
+ my $list = $safe{$file};
+ $safe{$file} = {};
+ foreach my $directive (@$list) {
+ $safe{$file}{$directive} = 0;
+ }
}
+ }
- foreach my $file (@testitems) {
- # There are some files we don't check, because there is no need to
- # filter their contents due to their content-type.
- if ($file =~ /\.(pm|txt|rst|png)\.tmpl$/) {
- ok(1, "($lang/$flavor) $file is filter-safe");
- next;
- }
+ foreach my $file (@testitems) {
- # Read the entire file into a string
- open (FILE, "<$file") || die "Can't open $file: $!\n";
- my $slurp = <FILE>;
- close (FILE);
+ # There are some files we don't check, because there is no need to
+ # filter their contents due to their content-type.
+ if ($file =~ /\.(pm|txt|rst|png)\.tmpl$/) {
+ ok(1, "($lang/$flavor) $file is filter-safe");
+ next;
+ }
- my @unfiltered;
+ # Read the entire file into a string
+ open(FILE, "<$file") || die "Can't open $file: $!\n";
+ my $slurp = <FILE>;
+ close(FILE);
- # /g means we execute this loop for every match
- # /s means we ignore linefeeds in the regexp matches
- while ($slurp =~ /\[%(?:-|\+|~|=)?(.*?)(?:-|\+|~|=)?%\]/gs) {
- my $directive = $1;
+ my @unfiltered;
- my @lineno = ($` =~ m/\n/gs);
- my $lineno = scalar(@lineno) + 1;
+ # /g means we execute this loop for every match
+ # /s means we ignore linefeeds in the regexp matches
+ while ($slurp =~ /\[%(?:-|\+|~|=)?(.*?)(?:-|\+|~|=)?%\]/gs) {
+ my $directive = $1;
- if (!directive_ok($file, $directive)) {
+ my @lineno = ($` =~ m/\n/gs);
+ my $lineno = scalar(@lineno) + 1;
- # This intentionally makes no effort to eliminate duplicates; to do
- # so would merely make it more likely that the user would not
- # escape all instances when attempting to correct an error.
- push(@unfiltered, "$lineno:$directive");
- }
- }
+ if (!directive_ok($file, $directive)) {
- my $fullpath = File::Spec->catfile($path, $file);
-
- if (@unfiltered) {
- my $uflist = join("\n ", @unfiltered);
- ok(0, "($lang/$flavor) $fullpath has unfiltered directives:\n $uflist\n--ERROR");
- }
- else {
- # Find any members of the exclusion list which were not found
- my @notfound;
- foreach my $directive (keys %{$safe{$file}}) {
- push(@notfound, $directive) if ($safe{$file}{$directive} == 0);
- }
-
- if (@notfound) {
- my $nflist = join("\n ", @notfound);
- ok(0, "($lang/$flavor) $fullpath - filterexceptions.pl has extra members:\n $nflist\n" .
- "--WARNING");
- }
- else {
- # Don't use the full path here - it's too long and unwieldy.
- ok(1, "($lang/$flavor) $file is filter-safe");
- }
- }
+ # This intentionally makes no effort to eliminate duplicates; to do
+ # so would merely make it more likely that the user would not
+ # escape all instances when attempting to correct an error.
+ push(@unfiltered, "$lineno:$directive");
+ }
}
+
+ my $fullpath = File::Spec->catfile($path, $file);
+
+ if (@unfiltered) {
+ my $uflist = join("\n ", @unfiltered);
+ ok(0,
+ "($lang/$flavor) $fullpath has unfiltered directives:\n $uflist\n--ERROR");
+ }
+ else {
+ # Find any members of the exclusion list which were not found
+ my @notfound;
+ foreach my $directive (keys %{$safe{$file}}) {
+ push(@notfound, $directive) if ($safe{$file}{$directive} == 0);
+ }
+
+ if (@notfound) {
+ my $nflist = join("\n ", @notfound);
+ ok(0,
+ "($lang/$flavor) $fullpath - filterexceptions.pl has extra members:\n $nflist\n"
+ . "--WARNING");
+ }
+ else {
+ # Don't use the full path here - it's too long and unwieldy.
+ ok(1, "($lang/$flavor) $file is filter-safe");
+ }
+ }
+ }
}
sub directive_ok {
- my ($file, $directive) = @_;
+ my ($file, $directive) = @_;
- # Comments
- return 1 if $directive =~ /^#/;
+ # Comments
+ return 1 if $directive =~ /^#/;
- # Remove any leading/trailing whitespace.
- $directive =~ s/^\s*//;
- $directive =~ s/\s*$//;
+ # Remove any leading/trailing whitespace.
+ $directive =~ s/^\s*//;
+ $directive =~ s/\s*$//;
- # Empty directives are ok; they are usually line break helpers
- return 1 if $directive eq '';
+ # Empty directives are ok; they are usually line break helpers
+ return 1 if $directive eq '';
- # Make sure we're not looking for ./ in the $safe hash
- $file =~ s#^\./##;
+ # Make sure we're not looking for ./ in the $safe hash
+ $file =~ s#^\./##;
- # Exclude those on the nofilter list
- if (defined($safe{$file}{$directive})) {
- $safe{$file}{$directive}++;
- return 1;
- };
+ # Exclude those on the nofilter list
+ if (defined($safe{$file}{$directive})) {
+ $safe{$file}{$directive}++;
+ return 1;
+ }
- # Directives
- return 1 if $directive =~ /^(IF|END|UNLESS|FOREACH|PROCESS|INCLUDE|
+ # Directives
+ return 1 if $directive =~ /^(IF|END|UNLESS|FOREACH|PROCESS|INCLUDE|
BLOCK|USE|ELSE|NEXT|LAST|DEFAULT|
ELSIF|SET|SWITCH|CASE|WHILE|RETURN|STOP|
TRY|CATCH|FINAL|THROW|CLEAR|MACRO|FILTER)/x;
- # ? :
- if ($directive =~ /.+\?(.+):(.+)/) {
- return 1 if directive_ok($file, $1) && directive_ok($file, $2);
- }
+ # ? :
+ if ($directive =~ /.+\?(.+):(.+)/) {
+ return 1 if directive_ok($file, $1) && directive_ok($file, $2);
+ }
+
+ # + - * /
+ return 1 if $directive =~ /[+\-*\/]/;
+
+ # Numbers
+ return 1 if $directive =~ /^[0-9]+$/;
+
+ # Simple assignments
+ return 1 if $directive =~ /^[\w\.\$\{\}]+\s+=\s+/;
+
+ # Conditional literals with either sort of quotes
+ # There must be no $ in the string for it to be a literal
+ return 1 if $directive =~ /^(["'])[^\$]*[^\\]\1/;
+ return 1 if $directive =~ /^(["'])\1/;
+
+ # Special values always used for numbers
+ return 1 if $directive =~ /^[ijkn]$/;
+ return 1 if $directive =~ /^count$/;
+
+ # Params
+ return 1 if $directive =~ /^Param\(/;
+
+ # Hooks
+ return 1 if $directive =~ /^Hook.process\(/;
+
+ # Other functions guaranteed to return OK output
+ return 1 if $directive =~ /^(time2str|url)\(/;
+
+ # Safe Template Toolkit virtual methods
+ return 1 if $directive =~ /\.(length$|size$|push\(|unshift\(|delete\()/;
+
+ # Special Template Toolkit loop variable
+ return 1 if $directive =~ /^loop\.(index|count)$/;
+
+ # Branding terms
+ return 1 if $directive =~ /^terms\./;
- # + - * /
- return 1 if $directive =~ /[+\-*\/]/;
-
- # Numbers
- return 1 if $directive =~ /^[0-9]+$/;
-
- # Simple assignments
- return 1 if $directive =~ /^[\w\.\$\{\}]+\s+=\s+/;
-
- # Conditional literals with either sort of quotes
- # There must be no $ in the string for it to be a literal
- return 1 if $directive =~ /^(["'])[^\$]*[^\\]\1/;
- return 1 if $directive =~ /^(["'])\1/;
-
- # Special values always used for numbers
- return 1 if $directive =~ /^[ijkn]$/;
- return 1 if $directive =~ /^count$/;
-
- # Params
- return 1 if $directive =~ /^Param\(/;
-
- # Hooks
- return 1 if $directive =~ /^Hook.process\(/;
-
- # Other functions guaranteed to return OK output
- return 1 if $directive =~ /^(time2str|url)\(/;
-
- # Safe Template Toolkit virtual methods
- return 1 if $directive =~ /\.(length$|size$|push\(|unshift\(|delete\()/;
-
- # Special Template Toolkit loop variable
- return 1 if $directive =~ /^loop\.(index|count)$/;
-
- # Branding terms
- return 1 if $directive =~ /^terms\./;
-
- # Things which are already filtered
- # Note: If a single directive prints two things, and only one is
- # filtered, we may not catch that case.
- return 1 if $directive =~ /FILTER\ (html|csv|js|base64|css_class_quote|ics|
+ # Things which are already filtered
+ # Note: If a single directive prints two things, and only one is
+ # filtered, we may not catch that case.
+ return 1 if $directive =~ /FILTER\ (html|csv|js|base64|css_class_quote|ics|
quoteUrls|time|uri|xml|lower|html_light|
obsolete|inactive|closed|unitconvert|
txt|html_linebreak|none)\b/x;
- return 0;
+ return 0;
}
$/ = $oldrecsep;
diff --git a/t/009bugwords.t b/t/009bugwords.t
index e36651edb..da432e114 100644
--- a/t/009bugwords.t
+++ b/t/009bugwords.t
@@ -9,9 +9,9 @@
#Bugzilla Test 9#
####bugwords#####
-# Bugzilla has a mechanism for taking various words, including "bug", "bugs",
+# Bugzilla has a mechanism for taking various words, including "bug", "bugs",
# and "a bug" and automatically replacing them in the templates with the local
-# terminology. It does this by using the 'terms' hash, so "bug" becomes
+# terminology. It does this by using the 'terms' hash, so "bug" becomes
# "[% terms.bug %]". This test makes sure the relevant words aren't used
# bare.
@@ -27,53 +27,57 @@ use Bugzilla::Util;
use File::Spec;
-use Test::More tests => ($Support::Templates::num_actual_files);
+use Test::More tests => ($Support::Templates::num_actual_files);
# Find all the templates
my @testitems;
for my $path (@Support::Templates::include_paths) {
- push(@testitems, map(File::Spec->catfile($path, $_),
- Support::Templates::find_actual_files($path)));
+ push(
+ @testitems,
+ map(File::Spec->catfile($path, $_),
+ Support::Templates::find_actual_files($path))
+ );
}
foreach my $file (@testitems) {
- my @errors;
-
- # Read the entire file into a string
- local $/;
- open (FILE, "<$file") || die "Can't open $file: $!\n";
- my $slurp = <FILE>;
- close (FILE);
-
- # /g means we execute this loop for every match
- # /s means we ignore linefeeds in the regexp matches
- # This extracts everything which is _not_ a directive.
- while ($slurp =~ /%\](.*?)(\[%|$)/gs) {
- my $text = $1;
-
- my @lineno = ($` =~ m/\n/gs);
- my $lineno = scalar(@lineno) + 1;
-
- # "a bug", "bug", "bugs"
- if (grep /(a?[\s>]bugs?[\s.:;,<])/i, $text) {
- # Exclude variable assignment.
- unless (grep /bugs =/, $text) {
- push(@errors, [$lineno, $text]);
- next;
- }
- }
- }
-
- if (scalar(@errors)) {
- ok(0, "$file contains invalid bare words (e.g. 'bug') --WARNING");
-
- foreach my $error (@errors) {
- print "$error->[0]: $error->[1]\n";
+ my @errors;
+
+ # Read the entire file into a string
+ local $/;
+ open(FILE, "<$file") || die "Can't open $file: $!\n";
+ my $slurp = <FILE>;
+ close(FILE);
+
+ # /g means we execute this loop for every match
+ # /s means we ignore linefeeds in the regexp matches
+ # This extracts everything which is _not_ a directive.
+ while ($slurp =~ /%\](.*?)(\[%|$)/gs) {
+ my $text = $1;
+
+ my @lineno = ($` =~ m/\n/gs);
+ my $lineno = scalar(@lineno) + 1;
+
+ # "a bug", "bug", "bugs"
+ if (grep /(a?[\s>]bugs?[\s.:;,<])/i, $text) {
+
+ # Exclude variable assignment.
+ unless (grep /bugs =/, $text) {
+ push(@errors, [$lineno, $text]);
+ next;
}
- }
- else {
- ok(1, "$file has no invalid barewords");
}
+ }
+
+ if (scalar(@errors)) {
+ ok(0, "$file contains invalid bare words (e.g. 'bug') --WARNING");
+
+ foreach my $error (@errors) {
+ print "$error->[0]: $error->[1]\n";
+ }
+ }
+ else {
+ ok(1, "$file has no invalid barewords");
+ }
}
exit 0;
diff --git a/t/010dependencies.t b/t/010dependencies.t
index afd29a652..b600766b6 100644
--- a/t/010dependencies.t
+++ b/t/010dependencies.t
@@ -30,7 +30,8 @@ use constant MODULE_REGEX => qr/
['"]?
([\w:\.\\]+)
/x;
-use constant BASE_REGEX => qr/^use (?:base|parent) (?:-norequire, )?qw\(([^\)]+)/;
+use constant BASE_REGEX =>
+ qr/^use (?:base|parent) (?:-norequire, )?qw\(([^\)]+)/;
# Extract all Perl modules.
foreach my $file (@Support::Files::testitems) {
@@ -42,46 +43,47 @@ foreach my $file (@Support::Files::testitems) {
}
foreach my $module (keys %mods) {
- my $reading = 1;
- my @use;
-
- open(SOURCE, $mods{$module});
- while (my $line = <SOURCE>) {
- last if ($line =~ /^__END__/);
- if ($line =~ /^=cut/) {
- $reading = 1;
- next;
- }
- next unless $reading;
- if ($line =~ /^=(head|over|item|back|pod|begin|end|for)/) {
- $reading = 0;
- next;
- }
- if ($line =~ /^package\s+([^;]);/) {
- $module = $1;
- }
- elsif ($line =~ BASE_REGEX or $line =~ MODULE_REGEX) {
- my $used_string = $1;
- # "use base"/"use parent" can have multiple modules
- my @used_array = split(/\s+/, $used_string);
- foreach my $used (@used_array) {
- next if $used !~ /^Bugzilla/;
- $used =~ s#/#::#g;
- $used =~ s#\.pm$##;
- $used =~ s#\$module#[^:]+#;
- $used =~ s#\${[^}]+}#[^:]+#;
- $used =~ s#[" ]##g;
- push(@use, grep(/^\Q$used\E$/, keys %mods));
- }
- }
+ my $reading = 1;
+ my @use;
+
+ open(SOURCE, $mods{$module});
+ while (my $line = <SOURCE>) {
+ last if ($line =~ /^__END__/);
+ if ($line =~ /^=cut/) {
+ $reading = 1;
+ next;
+ }
+ next unless $reading;
+ if ($line =~ /^=(head|over|item|back|pod|begin|end|for)/) {
+ $reading = 0;
+ next;
}
- close (SOURCE);
+ if ($line =~ /^package\s+([^;]);/) {
+ $module = $1;
+ }
+ elsif ($line =~ BASE_REGEX or $line =~ MODULE_REGEX) {
+ my $used_string = $1;
- foreach my $u (@use) {
- if (!grep {$_ eq $u} @{$deps{$module}}) {
- push(@{$deps{$module}}, $u);
+ # "use base"/"use parent" can have multiple modules
+ my @used_array = split(/\s+/, $used_string);
+ foreach my $used (@used_array) {
+ next if $used !~ /^Bugzilla/;
+ $used =~ s#/#::#g;
+ $used =~ s#\.pm$##;
+ $used =~ s#\$module#[^:]+#;
+ $used =~ s#\${[^}]+}#[^:]+#;
+ $used =~ s#[" ]##g;
+ push(@use, grep(/^\Q$used\E$/, keys %mods));
}
}
+ }
+ close(SOURCE);
+
+ foreach my $u (@use) {
+ if (!grep { $_ eq $u } @{$deps{$module}}) {
+ push(@{$deps{$module}}, $u);
+ }
+ }
}
sub creates_loop {
diff --git a/t/011pod.t b/t/011pod.t
index 8a7f374ce..2930ea112 100644
--- a/t/011pod.t
+++ b/t/011pod.t
@@ -21,111 +21,123 @@ use Pod::Checker;
use Pod::Coverage;
use Test::More tests => scalar(@Support::Files::testitems)
- + scalar(@Support::Files::module_files);
+ + scalar(@Support::Files::module_files);
# These methods do not need to be documented by default.
-use constant DEFAULT_WHITELIST => qr/^(?:new|new_from_list|check|run_create_validators)$/;
+use constant DEFAULT_WHITELIST =>
+ qr/^(?:new|new_from_list|check|run_create_validators)$/;
# These subroutines do not need to be documented, generally because
# you shouldn't call them yourself. No need to include subroutines
# of the form _foo(); they are already treated as private.
use constant SUB_WHITELIST => (
- 'Bugzilla::Flag' => qr/^(?:(force_)?retarget|force_cleanup)$/,
- 'Bugzilla::FlagType' => qr/^sqlify_criteria$/,
- 'Bugzilla::JobQueue' => qr/(?:^work_once|work_until_done|subprocess_worker)$/,
- 'Bugzilla::Search' => qr/^SPECIAL_PARSING$/,
- 'Bugzilla::Template' => qr/^field_name$/,
- 'Bugzilla::MIME' => qr/^as_string$/,
+ 'Bugzilla::Flag' => qr/^(?:(force_)?retarget|force_cleanup)$/,
+ 'Bugzilla::FlagType' => qr/^sqlify_criteria$/,
+ 'Bugzilla::JobQueue' => qr/(?:^work_once|work_until_done|subprocess_worker)$/,
+ 'Bugzilla::Search' => qr/^SPECIAL_PARSING$/,
+ 'Bugzilla::Template' => qr/^field_name$/,
+ 'Bugzilla::MIME' => qr/^as_string$/,
);
# These modules do not need to be documented, generally because they
# are subclasses of another module which already has all the relevant
# documentation. Partial names are allowed.
use constant MODULE_WHITELIST => qw(
- Bugzilla::Auth::Login::
- Bugzilla::Auth::Persist::
- Bugzilla::Auth::Verify::
- Bugzilla::BugUrl::
- Bugzilla::Config::
- Bugzilla::Extension::
- Bugzilla::Job::
- Bugzilla::Migrate::
- docs::lib::Pod::Simple::
+ Bugzilla::Auth::Login::
+ Bugzilla::Auth::Persist::
+ Bugzilla::Auth::Verify::
+ Bugzilla::BugUrl::
+ Bugzilla::Config::
+ Bugzilla::Extension::
+ Bugzilla::Job::
+ Bugzilla::Migrate::
+ docs::lib::Pod::Simple::
);
# Capture the TESTOUT from Test::More or Test::Builder for printing errors.
# This will handle verbosity for us automatically.
my $fh;
{
- no warnings qw(unopened); # Don't complain about non-existent filehandles
- if (-e \*Test::More::TESTOUT) {
- $fh = \*Test::More::TESTOUT;
- } elsif (-e \*Test::Builder::TESTOUT) {
- $fh = \*Test::Builder::TESTOUT;
- } else {
- $fh = \*STDOUT;
- }
+ no warnings qw(unopened); # Don't complain about non-existent filehandles
+ if (-e \*Test::More::TESTOUT) {
+ $fh = \*Test::More::TESTOUT;
+ }
+ elsif (-e \*Test::Builder::TESTOUT) {
+ $fh = \*Test::Builder::TESTOUT;
+ }
+ else {
+ $fh = \*STDOUT;
+ }
}
my @testitems = @Support::Files::testitems;
foreach my $file (@testitems) {
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
- my $error_count = podchecker($file, $fh);
- if ($error_count < 0) {
- ok(1,"$file does not contain any POD");
- } elsif ($error_count == 0) {
- ok(1,"$file has correct POD syntax");
- } else {
- ok(0,"$file has incorrect POD syntax --ERROR");
- }
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next if (!$file); # skip null entries
+ my $error_count = podchecker($file, $fh);
+ if ($error_count < 0) {
+ ok(1, "$file does not contain any POD");
+ }
+ elsif ($error_count == 0) {
+ ok(1, "$file has correct POD syntax");
+ }
+ else {
+ ok(0, "$file has incorrect POD syntax --ERROR");
+ }
}
my %sub_whitelist = SUB_WHITELIST;
-my @module_files = sort @Support::Files::module_files;
+my @module_files = sort @Support::Files::module_files;
foreach my $file (@module_files) {
- my $module = $file;
- $module =~ s/\.pm$//;
- $module =~ s#/#::#g;
- $module =~ s/^extensions/Bugzilla::Extension/;
-
- my @whitelist = (DEFAULT_WHITELIST);
- push(@whitelist, $sub_whitelist{$module}) if $sub_whitelist{$module};
-
- # XXX Once all methods are correctly documented, nonwhitespace should
- # be set to 1.
- my $cover = Pod::Coverage->new(package => $module, nonwhitespace => 0,
- trustme => \@whitelist);
- my $coverage = $cover->coverage;
- my $reason = $cover->why_unrated;
-
- if (defined $coverage) {
- if ($coverage == 1) {
- ok(1, "$file has POD for all methods");
- }
- else {
- ok(0, "$file POD coverage is " . sprintf("%u%%", 100 * $coverage) .
- ". Undocumented methods: " . join(', ', $cover->uncovered));
- }
+ my $module = $file;
+ $module =~ s/\.pm$//;
+ $module =~ s#/#::#g;
+ $module =~ s/^extensions/Bugzilla::Extension/;
+
+ my @whitelist = (DEFAULT_WHITELIST);
+ push(@whitelist, $sub_whitelist{$module}) if $sub_whitelist{$module};
+
+ # XXX Once all methods are correctly documented, nonwhitespace should
+ # be set to 1.
+ my $cover = Pod::Coverage->new(
+ package => $module,
+ nonwhitespace => 0,
+ trustme => \@whitelist
+ );
+ my $coverage = $cover->coverage;
+ my $reason = $cover->why_unrated;
+
+ if (defined $coverage) {
+ if ($coverage == 1) {
+ ok(1, "$file has POD for all methods");
}
- # These errors are thrown when the module couldn't be loaded due to
- # a missing dependency.
- elsif ($reason =~ /^(?:no public symbols defined|requiring '[^']+' failed)$/) {
- ok(1, "$file cannot be loaded");
+ else {
+ ok(0,
+ "$file POD coverage is "
+ . sprintf("%u%%", 100 * $coverage)
+ . ". Undocumented methods: "
+ . join(', ', $cover->uncovered));
}
- elsif ($reason eq "couldn't find pod") {
- if (grep { $module =~ /^\Q$_\E/ } MODULE_WHITELIST) {
- ok(1, "$file does not contain any POD (whitelisted)");
- }
- else {
- ok(0, "$file POD coverage is 0%");
- }
+ }
+
+ # These errors are thrown when the module couldn't be loaded due to
+ # a missing dependency.
+ elsif ($reason =~ /^(?:no public symbols defined|requiring '[^']+' failed)$/) {
+ ok(1, "$file cannot be loaded");
+ }
+ elsif ($reason eq "couldn't find pod") {
+ if (grep { $module =~ /^\Q$_\E/ } MODULE_WHITELIST) {
+ ok(1, "$file does not contain any POD (whitelisted)");
}
else {
- ok(0, "$file: $reason");
+ ok(0, "$file POD coverage is 0%");
}
+ }
+ else {
+ ok(0, "$file: $reason");
+ }
}
exit 0;
diff --git a/t/012throwables.t b/t/012throwables.t
index 0ef043fa5..3cfa211dc 100644
--- a/t/012throwables.t
+++ b/t/012throwables.t
@@ -6,7 +6,6 @@
# defined by the Mozilla Public License, v. 2.0.
-
##################
#Bugzilla Test 12#
######Errors######
@@ -32,11 +31,11 @@ push @{$Errors{code}{template_error}{used_in}{'Bugzilla/Error.pm'}}, 0;
# Define files to test. Each file would have a list of error messages, if any.
my %test_templates = ();
-my %test_modules = ();
+my %test_modules = ();
# Find all modules
foreach my $module (@Support::Files::testitems) {
- $test_modules{$module} = ();
+ $test_modules{$module} = ();
}
# Find all error templates
@@ -44,20 +43,19 @@ foreach my $module (@Support::Files::testitems) {
# hairy. But let us do it only once.
foreach my $include_path (@include_paths) {
- foreach my $path (@{$actual_files{$include_path}}) {
- my $file = File::Spec->catfile($include_path, $path);
- $file =~ s/\s.*$//; # nuke everything after the first space
- $file =~ s|\\|/|g if ON_WINDOWS; # convert \ to / in path if on windows
- $test_templates{$file} = ()
- if $file =~ m#global/(code|user)-error\.html\.tmpl#;
-
- # Make sure the extension is not disabled
- if ($file =~ m#^(extensions/[^/]+/)#) {
- $test_templates{$file} = ()
- if ! -e "${1}disabled"
- && $file =~ m#global/(code|user)-error-errors\.html\.tmpl#;
- }
+ foreach my $path (@{$actual_files{$include_path}}) {
+ my $file = File::Spec->catfile($include_path, $path);
+ $file =~ s/\s.*$//; # nuke everything after the first space
+ $file =~ s|\\|/|g if ON_WINDOWS; # convert \ to / in path if on windows
+ $test_templates{$file} = () if $file =~ m#global/(code|user)-error\.html\.tmpl#;
+
+ # Make sure the extension is not disabled
+ if ($file =~ m#^(extensions/[^/]+/)#) {
+ $test_templates{$file} = ()
+ if !-e "${1}disabled"
+ && $file =~ m#global/(code|user)-error-errors\.html\.tmpl#;
}
+ }
}
# Count the tests. The +1 is for checking the WS_ERROR_CODE errors.
@@ -69,112 +67,115 @@ plan tests => $tests;
# Collect all errors defined in templates
foreach my $file (keys %test_templates) {
- $file =~ m|template/([^/]+).*/global/([^/]+)-error(?:-errors)?\.html\.tmpl|;
- my $lang = $1;
- my $errtype = $2;
-
- if (! open (TMPL, $file)) {
- Register(\%test_templates, $file, "could not open file --WARNING");
- next;
+ $file =~ m|template/([^/]+).*/global/([^/]+)-error(?:-errors)?\.html\.tmpl|;
+ my $lang = $1;
+ my $errtype = $2;
+
+ if (!open(TMPL, $file)) {
+ Register(\%test_templates, $file, "could not open file --WARNING");
+ next;
+ }
+
+ my $lineno = 0;
+ while (my $line = <TMPL>) {
+ $lineno++;
+ if ($line =~ /\[%\s[A-Z]+\s*error\s*==\s*"(.+)"\s*%\]/) {
+ my $errtag = $1;
+ if ($errtag =~ /\s/) {
+ Register(\%test_templates, $file,
+ "has an error definition \"$errtag\" at line $lineno with "
+ . "space(s) embedded --ERROR");
+ }
+ else {
+ push @{$Errors{$errtype}{$errtag}{defined_in}{$lang}{$file}}, $lineno;
+ }
}
-
- my $lineno=0;
- while (my $line = <TMPL>) {
- $lineno++;
- if ($line =~ /\[%\s[A-Z]+\s*error\s*==\s*"(.+)"\s*%\]/) {
- my $errtag = $1;
- if ($errtag =~ /\s/) {
- Register(\%test_templates, $file,
- "has an error definition \"$errtag\" at line $lineno with "
- . "space(s) embedded --ERROR");
- }
- else {
- push @{$Errors{$errtype}{$errtag}{defined_in}{$lang}{$file}}, $lineno;
- }
- }
- }
- close(TMPL);
+ }
+ close(TMPL);
}
# Collect all used errors from cgi/pm files
foreach my $file (keys %test_modules) {
- $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
- next if (!$file); # skip null entries
- if (! open (TMPL, $file)) {
- Register(\%test_modules, $file, "could not open file --WARNING");
- next;
+ $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
+ next if (!$file); # skip null entries
+ if (!open(TMPL, $file)) {
+ Register(\%test_modules, $file, "could not open file --WARNING");
+ next;
+ }
+
+ my $lineno = 0;
+ while (my $line = <TMPL>) {
+ last if $line =~ /^__END__/; # skip the POD (at least in
+ # Bugzilla/Error.pm)
+ $lineno++;
+ if ($line
+ =~ /^[^#]*\b(Throw(Code|User)Error|(user_)?error\s+=>)\s*\(?\s*["'](.*?)['"]/)
+ {
+ my $errtype;
+
+ # If it's a normal ThrowCode/UserError
+ if ($2) {
+ $errtype = lc($2);
+ }
+
+ # If it's an AUTH_ERROR tag
+ else {
+ $errtype = $3 ? 'user' : 'code';
+ }
+ my $errtag = $4;
+ push @{$Errors{$errtype}{$errtag}{used_in}{$file}}, $lineno;
}
+ }
- my $lineno = 0;
- while (my $line = <TMPL>) {
- last if $line =~ /^__END__/; # skip the POD (at least in
- # Bugzilla/Error.pm)
- $lineno++;
- if ($line =~
-/^[^#]*\b(Throw(Code|User)Error|(user_)?error\s+=>)\s*\(?\s*["'](.*?)['"]/) {
- my $errtype;
- # If it's a normal ThrowCode/UserError
- if ($2) {
- $errtype = lc($2);
- }
- # If it's an AUTH_ERROR tag
- else {
- $errtype = $3 ? 'user' : 'code';
- }
- my $errtag = $4;
- push @{$Errors{$errtype}{$errtag}{used_in}{$file}}, $lineno;
- }
- }
-
- close(TMPL);
+ close(TMPL);
}
# Now let us start the checks
foreach my $errtype (keys %Errors) {
- foreach my $errtag (keys %{$Errors{$errtype}}) {
- # Check for undefined tags
- if (!defined $Errors{$errtype}{$errtag}{defined_in}) {
- UsedIn($errtype, $errtag, "any");
+ foreach my $errtag (keys %{$Errors{$errtype}}) {
+
+ # Check for undefined tags
+ if (!defined $Errors{$errtype}{$errtag}{defined_in}) {
+ UsedIn($errtype, $errtag, "any");
+ }
+ else {
+ # Check for all languages!!!
+ my @langs = ();
+ foreach my $lang (@languages) {
+ if (!defined $Errors{$errtype}{$errtag}{defined_in}{$lang}) {
+ push @langs, $lang;
}
- else {
- # Check for all languages!!!
- my @langs = ();
- foreach my $lang (@languages) {
- if (!defined $Errors{$errtype}{$errtag}{defined_in}{$lang}) {
- push @langs, $lang;
- }
- }
- if (scalar @langs) {
- UsedIn($errtype, $errtag, join(', ',@langs));
- }
-
- # Now check for tag usage in all DEFINED languages
- foreach my $lang (keys %{$Errors{$errtype}{$errtag}{defined_in}}) {
- if (!defined $Errors{$errtype}{$errtag}{used_in}) {
- DefinedIn($errtype, $errtag, $lang);
- }
- }
+ }
+ if (scalar @langs) {
+ UsedIn($errtype, $errtag, join(', ', @langs));
+ }
+
+ # Now check for tag usage in all DEFINED languages
+ foreach my $lang (keys %{$Errors{$errtype}{$errtag}{defined_in}}) {
+ if (!defined $Errors{$errtype}{$errtag}{used_in}) {
+ DefinedIn($errtype, $errtag, $lang);
}
+ }
}
+ }
}
# And make sure that everything defined in WS_ERROR_CODE
# is actually a valid error.
foreach my $err_name (keys %{WS_ERROR_CODE()}) {
- if (!defined $Errors{'code'}{$err_name}
- && !defined $Errors{'user'}{$err_name})
- {
- Register(\%test_modules, 'WS_ERROR_CODE',
- "Error tag '$err_name' is used in WS_ERROR_CODE in"
- . " Bugzilla/WebService/Constants.pm"
- . " but not defined in any template, and not used in any code.");
- }
+ if (!defined $Errors{'code'}{$err_name} && !defined $Errors{'user'}{$err_name})
+ {
+ Register(\%test_modules, 'WS_ERROR_CODE',
+ "Error tag '$err_name' is used in WS_ERROR_CODE in"
+ . " Bugzilla/WebService/Constants.pm"
+ . " but not defined in any template, and not used in any code.");
+ }
}
# Now report modules results
foreach my $file (sort keys %test_modules) {
- Report($file, @{$test_modules{$file}});
+ Report($file, @{$test_modules{$file}});
}
# And report WS_ERROR_CODE results
@@ -182,56 +183,67 @@ Report('WS_ERROR_CODE', @{$test_modules{'WS_ERROR_CODE'}});
# Now report templates results
foreach my $file (sort keys %test_templates) {
- Report($file, @{$test_templates{$file}});
+ Report($file, @{$test_templates{$file}});
}
sub Register {
- my ($hash, $file, $message, $warning) = @_;
- # If set to 1, $warning will avoid the test to fail.
- $warning ||= 0;
- push(@{$hash->{$file}}, {'message' => $message, 'warning' => $warning});
+ my ($hash, $file, $message, $warning) = @_;
+
+ # If set to 1, $warning will avoid the test to fail.
+ $warning ||= 0;
+ push(@{$hash->{$file}}, {'message' => $message, 'warning' => $warning});
}
sub Report {
- my ($file, @errors) = @_;
- if (scalar @errors) {
- # Do we only have warnings to report or also real errors?
- my @real_errors = grep {$_->{'warning'} == 0} @errors;
- # Extract error messages.
- @errors = map {$_->{'message'}} @errors;
- if (scalar(@real_errors)) {
- ok(0, "$file has ". scalar(@errors) ." error(s):\n" . join("\n", @errors));
- }
- else {
- ok(1, "--WARNING $file has " . scalar(@errors) .
- " unused error tag(s):\n" . join("\n", @errors));
- }
+ my ($file, @errors) = @_;
+ if (scalar @errors) {
+
+ # Do we only have warnings to report or also real errors?
+ my @real_errors = grep { $_->{'warning'} == 0 } @errors;
+
+ # Extract error messages.
+ @errors = map { $_->{'message'} } @errors;
+ if (scalar(@real_errors)) {
+ ok(0, "$file has " . scalar(@errors) . " error(s):\n" . join("\n", @errors));
}
else {
- # This is used for both code and template files, so let's use
- # file-independent phrase
- ok(1, "$file uses error tags correctly");
+ ok(1,
+ "--WARNING $file has "
+ . scalar(@errors)
+ . " unused error tag(s):\n"
+ . join("\n", @errors));
}
+ }
+ else {
+ # This is used for both code and template files, so let's use
+ # file-independent phrase
+ ok(1, "$file uses error tags correctly");
+ }
}
sub UsedIn {
- my ($errtype, $errtag, $lang) = @_;
- $lang = $lang || "any";
- foreach my $file (keys %{$Errors{$errtype}{$errtag}{used_in}}) {
- Register(\%test_modules, $file,
- "$errtype error tag '$errtag' is used at line(s) ("
- . join (',', @{$Errors{$errtype}{$errtag}{used_in}{$file}})
- . ") but not defined for language(s): $lang");
- }
+ my ($errtype, $errtag, $lang) = @_;
+ $lang = $lang || "any";
+ foreach my $file (keys %{$Errors{$errtype}{$errtag}{used_in}}) {
+ Register(\%test_modules, $file,
+ "$errtype error tag '$errtag' is used at line(s) ("
+ . join(',', @{$Errors{$errtype}{$errtag}{used_in}{$file}})
+ . ") but not defined for language(s): $lang");
+ }
}
+
sub DefinedIn {
- my ($errtype, $errtag, $lang) = @_;
- foreach my $file (keys %{$Errors{$errtype}{$errtag}{defined_in}{$lang}}) {
- Register(\%test_templates, $file,
- "$errtype error tag '$errtag' is defined at line(s) ("
- . join (',', @{$Errors{$errtype}{$errtag}{defined_in}{$lang}{$file}})
- . ") but is not used anywhere", 1);
- }
+ my ($errtype, $errtag, $lang) = @_;
+ foreach my $file (keys %{$Errors{$errtype}{$errtag}{defined_in}{$lang}}) {
+ Register(
+ \%test_templates,
+ $file,
+ "$errtype error tag '$errtag' is defined at line(s) ("
+ . join(',', @{$Errors{$errtype}{$errtag}{defined_in}{$lang}{$file}})
+ . ") but is not used anywhere",
+ 1
+ );
+ }
}
exit 0;
diff --git a/t/013dbschema.t b/t/013dbschema.t
index 217176ff2..062a22992 100644
--- a/t/013dbschema.t
+++ b/t/013dbschema.t
@@ -23,30 +23,30 @@ use Bugzilla::DB::Schema;
# SQL reserved words
use constant RESERVED_WORDS => qw(
- ABSOLUTE ACTION ACTOR ADD AFTER ALL ALLOCATE ALTER ANY AND ARE AS ASC ASSERTION ASYNC AT
- ATTRIBUTES BEFORE BEGIN BETWEEN BIT BIT_LENGTH BOOLEAN BOTH BREADTH BY CALL CASCADE
- CASCADED CASE CAST CATALOG CHAR CHARACTER_LENGTH CHAR_LENGTH COLLATE
- COLLATION COLUMN COMPLETION CONNECT CONNECTION CONSTRAINT CONSTRAINTS
- CONVERT CORRESPONDING CREATE CROSS CURRENT_DATE CURRENT_PATH CURRENT_TIME
- CURRENT_TIMESTAMP CURRENT_USER CYCLE DATA DATE DAY DEALLOCATE DECLARE DEFAULT DEFERRABLE
- DEFERRED DELETE DEPTH DESC DESCRIBE DESCRIPTOR DESTROY DIAGNOSTICS DICTIONARY
- DISCONNECT DISTINCT DO DOMAIN DROP EACH ELEMENT ELSE ELSEIF END END-EXEC EQUALS EXCEPT
- EXCEPTION EXECUTE EXTERNAL EXTRACT FACTOR FALSE FIRST FOR FROM FULL GENERAL GET
- GLOBAL GRANT GROUP HAVING HOLD HOUR IDENTITY IF IGNORE IMMEDIATE IN INITIALLY INNER INPUT
- INSENSITIVE INSERT INSTEAD INTERSECT INTERVAL IS ISOLATION JOIN LAST LEADING LEAVE
- LEFT LESS LEVEL LIMIT LIST LOCAL LOOP LOWER MATCH MINUTE MODIFY MONTH NAMES
- NATIONAL NATURAL NCHAR NEW NEW_TABLE NEXT NO NONE NOT NULL NULLIF OBJECT
- OCTET_LENGTH OFF OID OLD OLD_TABLE ONLY OPERATION OPERATOR OPERATORS OR ORDER OTHERS
- OUTER OUTPUT OVERLAPS PAD PARAMETERS PARTIAL PATH PENDANT POSITION POSTFIX
- PREFIX PREORDER PREPARE PRESERVE PRIOR PRIVATE PROTECTED READ RECURSIVE REF
- REFERENCING RELATIVE REPLACE RESIGNAL RESTRICT RETURN RETURNS REVOKE RIGHT
- ROLE ROUTINE ROW ROWS SAVEPOINT SCROLL SEARCH SECOND SELECT SENSITIVE SEQUENCE
- SESSION SESSION_USER SIGNAL SIMILAR SIZE SPACE SQLEXCEPTION SQLSTATE
- SQLWARNING START STATE STRUCTURE SUBSTRING SYMBOL SYSTEM_USER TABLE TEMPORARY
- TERM TEST THEN THERE TIME TIMESTAMP TIMEZONE_HOUR TIMEZONE_MINUTE TRAILING
- TRANSACTION TRANSLATE TRANSLATION TRIGGER TRIM TRUE TUPLE UNDER
- UNKNOWN UNION UNIQUE UPDATE UPPER USAGE USING VARCHAR VARIABLE VARYING VIEW VIRTUAL VISIBLE
- WAIT WHEN WHERE WHILE WITH WITHOUT WRITE YEAR ZONE
+ ABSOLUTE ACTION ACTOR ADD AFTER ALL ALLOCATE ALTER ANY AND ARE AS ASC ASSERTION ASYNC AT
+ ATTRIBUTES BEFORE BEGIN BETWEEN BIT BIT_LENGTH BOOLEAN BOTH BREADTH BY CALL CASCADE
+ CASCADED CASE CAST CATALOG CHAR CHARACTER_LENGTH CHAR_LENGTH COLLATE
+ COLLATION COLUMN COMPLETION CONNECT CONNECTION CONSTRAINT CONSTRAINTS
+ CONVERT CORRESPONDING CREATE CROSS CURRENT_DATE CURRENT_PATH CURRENT_TIME
+ CURRENT_TIMESTAMP CURRENT_USER CYCLE DATA DATE DAY DEALLOCATE DECLARE DEFAULT DEFERRABLE
+ DEFERRED DELETE DEPTH DESC DESCRIBE DESCRIPTOR DESTROY DIAGNOSTICS DICTIONARY
+ DISCONNECT DISTINCT DO DOMAIN DROP EACH ELEMENT ELSE ELSEIF END END-EXEC EQUALS EXCEPT
+ EXCEPTION EXECUTE EXTERNAL EXTRACT FACTOR FALSE FIRST FOR FROM FULL GENERAL GET
+ GLOBAL GRANT GROUP HAVING HOLD HOUR IDENTITY IF IGNORE IMMEDIATE IN INITIALLY INNER INPUT
+ INSENSITIVE INSERT INSTEAD INTERSECT INTERVAL IS ISOLATION JOIN LAST LEADING LEAVE
+ LEFT LESS LEVEL LIMIT LIST LOCAL LOOP LOWER MATCH MINUTE MODIFY MONTH NAMES
+ NATIONAL NATURAL NCHAR NEW NEW_TABLE NEXT NO NONE NOT NULL NULLIF OBJECT
+ OCTET_LENGTH OFF OID OLD OLD_TABLE ONLY OPERATION OPERATOR OPERATORS OR ORDER OTHERS
+ OUTER OUTPUT OVERLAPS PAD PARAMETERS PARTIAL PATH PENDANT POSITION POSTFIX
+ PREFIX PREORDER PREPARE PRESERVE PRIOR PRIVATE PROTECTED READ RECURSIVE REF
+ REFERENCING RELATIVE REPLACE RESIGNAL RESTRICT RETURN RETURNS REVOKE RIGHT
+ ROLE ROUTINE ROW ROWS SAVEPOINT SCROLL SEARCH SECOND SELECT SENSITIVE SEQUENCE
+ SESSION SESSION_USER SIGNAL SIMILAR SIZE SPACE SQLEXCEPTION SQLSTATE
+ SQLWARNING START STATE STRUCTURE SUBSTRING SYMBOL SYSTEM_USER TABLE TEMPORARY
+ TERM TEST THEN THERE TIME TIMESTAMP TIMEZONE_HOUR TIMEZONE_MINUTE TRAILING
+ TRANSACTION TRANSLATE TRANSLATION TRIGGER TRIM TRUE TUPLE UNDER
+ UNKNOWN UNION UNIQUE UPDATE UPPER USAGE USING VARCHAR VARIABLE VARYING VIEW VIRTUAL VISIBLE
+ WAIT WHEN WHERE WHILE WITH WITHOUT WRITE YEAR ZONE
);
# Few Exceptions are removed from the above list
@@ -57,31 +57,31 @@ our $schema;
our @tables;
BEGIN {
- $schema = Bugzilla::DB::Schema->new("Mysql");
- @tables = $schema->get_table_list();
+ $schema = Bugzilla::DB::Schema->new("Mysql");
+ @tables = $schema->get_table_list();
}
use Test::More tests => scalar(@tables);
foreach my $table (@tables) {
- my @reserved;
+ my @reserved;
- if (grep { uc($table) eq $_ } RESERVED_WORDS) {
- push(@reserved, $table);
- }
+ if (grep { uc($table) eq $_ } RESERVED_WORDS) {
+ push(@reserved, $table);
+ }
- foreach my $column ($schema->get_table_columns($table)) {
- if (grep { uc($column) eq $_ } RESERVED_WORDS) {
- push(@reserved, $column);
- }
+ foreach my $column ($schema->get_table_columns($table)) {
+ if (grep { uc($column) eq $_ } RESERVED_WORDS) {
+ push(@reserved, $column);
}
+ }
- if (scalar @reserved) {
- ok(0, "Table $table use reserved words: " . join(", ", @reserved));
- }
- else {
- ok(1, "Table $table does not use reserved words");
- }
+ if (scalar @reserved) {
+ ok(0, "Table $table use reserved words: " . join(", ", @reserved));
+ }
+ else {
+ ok(1, "Table $table does not use reserved words");
+ }
}
exit 0;
diff --git a/t/Support/Files.pm b/t/Support/Files.pm
index f3fae58fc..72737ac1f 100644
--- a/t/Support/Files.pm
+++ b/t/Support/Files.pm
@@ -17,40 +17,40 @@ use File::Find;
our @additional_files = ();
our @files = glob('*');
-find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/;}, qw(Bugzilla docs));
+find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/; },
+ qw(Bugzilla docs));
push(@files, 'extensions/create.pl', 'docs/makedocs.pl');
-our @extensions =
- grep { $_ ne 'extensions/create.pl' && ! -e "$_/disabled" }
- glob('extensions/*');
+our @extensions = grep { $_ ne 'extensions/create.pl' && !-e "$_/disabled" }
+ glob('extensions/*');
foreach my $extension (@extensions) {
- find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/;}, $extension);
+ find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/; }, $extension);
}
our @test_files = glob('t/*.t');
sub isTestingFile {
- my ($file) = @_;
- my $exclude;
-
- if ($file =~ /\.cgi$|\.pl$|\.pm$/) {
- return 1;
- }
- my $additional;
- foreach $additional (@additional_files) {
- if ($file eq $additional) { return 1; }
- }
- return undef;
+ my ($file) = @_;
+ my $exclude;
+
+ if ($file =~ /\.cgi$|\.pl$|\.pm$/) {
+ return 1;
+ }
+ my $additional;
+ foreach $additional (@additional_files) {
+ if ($file eq $additional) { return 1; }
+ }
+ return undef;
}
our (@testitems, @module_files);
foreach my $currentfile (@files) {
- if (isTestingFile($currentfile)) {
- push(@testitems, $currentfile);
- }
- push(@module_files, $currentfile) if $currentfile =~ /\.pm$/;
+ if (isTestingFile($currentfile)) {
+ push(@testitems, $currentfile);
+ }
+ push(@module_files, $currentfile) if $currentfile =~ /\.pm$/;
}
diff --git a/t/Support/Templates.pm b/t/Support/Templates.pm
index d17c7334b..e08686e0f 100644
--- a/t/Support/Templates.pm
+++ b/t/Support/Templates.pm
@@ -13,9 +13,9 @@ use warnings;
use lib 't';
use parent qw(Exporter);
-@Support::Templates::EXPORT =
- qw(@languages @include_paths @english_default_include_paths
- @referenced_files %actual_files $num_actual_files);
+@Support::Templates::EXPORT
+ = qw(@languages @include_paths @english_default_include_paths
+ @referenced_files %actual_files $num_actual_files);
use Bugzilla;
use Bugzilla::Constants;
@@ -26,15 +26,15 @@ use File::Find;
use File::Spec;
# English default include paths
-our @english_default_include_paths =
- (File::Spec->catdir(bz_locations()->{'templatedir'}, 'en', 'default'));
+our @english_default_include_paths
+ = (File::Spec->catdir(bz_locations()->{'templatedir'}, 'en', 'default'));
# And the extensions too
foreach my $extension (@Support::Files::extensions) {
- my $dir = File::Spec->catdir($extension, 'template', 'en', 'default');
- if (-e $dir) {
- push @english_default_include_paths, $dir;
- }
+ my $dir = File::Spec->catdir($extension, 'template', 'en', 'default');
+ if (-e $dir) {
+ push @english_default_include_paths, $dir;
+ }
}
# Files which are referenced in the cgi files
@@ -47,37 +47,39 @@ our %actual_files = ();
our $num_actual_files = 0;
# Set the template available languages and include paths
-our @languages = @{ Bugzilla->languages };
-our @include_paths = @{ template_include_path({ language => Bugzilla->languages }) };
+our @languages = @{Bugzilla->languages};
+our @include_paths
+ = @{template_include_path({language => Bugzilla->languages})};
our @files;
# Local subroutine used with File::Find
sub find_templates {
- # Prune CVS directories
- if (-d $_ && $_ eq 'CVS') {
- $File::Find::prune = 1;
- return;
- }
- # Only include files ending in '.tmpl'
- if (-f $_ && $_ =~ m/\.tmpl$/i) {
- my $filename;
- my $local_dir = File::Spec->abs2rel($File::Find::dir,
- $File::Find::topdir);
+ # Prune CVS directories
+ if (-d $_ && $_ eq 'CVS') {
+ $File::Find::prune = 1;
+ return;
+ }
- # File::Spec 3.13 and newer return "." instead of "" if both
- # arguments of abs2rel() are identical.
- $local_dir = "" if ($local_dir eq ".");
+ # Only include files ending in '.tmpl'
+ if (-f $_ && $_ =~ m/\.tmpl$/i) {
+ my $filename;
+ my $local_dir = File::Spec->abs2rel($File::Find::dir, $File::Find::topdir);
- if ($local_dir) {
- $filename = File::Spec->catfile($local_dir, $_);
- } else {
- $filename = $_;
- }
+ # File::Spec 3.13 and newer return "." instead of "" if both
+ # arguments of abs2rel() are identical.
+ $local_dir = "" if ($local_dir eq ".");
- push(@files, $filename);
+ if ($local_dir) {
+ $filename = File::Spec->catfile($local_dir, $_);
}
+ else {
+ $filename = $_;
+ }
+
+ push(@files, $filename);
+ }
}
# Scan the given template include path for templates
@@ -90,7 +92,7 @@ sub find_actual_files {
foreach my $include_path (@include_paths) {
- $actual_files{$include_path} = [ find_actual_files($include_path) ];
+ $actual_files{$include_path} = [find_actual_files($include_path)];
$num_actual_files += scalar(@{$actual_files{$include_path}});
}
@@ -99,20 +101,21 @@ foreach my $include_path (@include_paths) {
my %seen;
foreach my $file (@Support::Files::testitems) {
- open (FILE, $file);
- my @lines = <FILE>;
- close (FILE);
- foreach my $line (@lines) {
- if ($line =~ m/template->process\(\"(.+?)\", .+?\)/) {
- my $template = $1;
- # Ignore templates with $ in the name, since they're
- # probably vars, not real files
- next if $template =~ m/\$/;
- next if $seen{$template};
- push (@referenced_files, $template);
- $seen{$template} = 1;
- }
+ open(FILE, $file);
+ my @lines = <FILE>;
+ close(FILE);
+ foreach my $line (@lines) {
+ if ($line =~ m/template->process\(\"(.+?)\", .+?\)/) {
+ my $template = $1;
+
+ # Ignore templates with $ in the name, since they're
+ # probably vars, not real files
+ next if $template =~ m/\$/;
+ next if $seen{$template};
+ push(@referenced_files, $template);
+ $seen{$template} = 1;
}
+ }
}
1;