summaryrefslogtreecommitdiffstats
path: root/t/008filter.t
diff options
context:
space:
mode:
Diffstat (limited to 't/008filter.t')
-rw-r--r--t/008filter.t288
1 files changed, 146 insertions, 142 deletions
diff --git a/t/008filter.t b/t/008filter.t
index d86e6c7a6..6c9924020 100644
--- a/t/008filter.t
+++ b/t/008filter.t
@@ -29,196 +29,200 @@ 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);
+ # 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 (@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");
- }
- }
+ 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*$//;
- # Ignore blocks explicitly marked as ok
- return 1 if $directive =~ /\b## no-008filter\b/;
+ # Ignore blocks explicitly marked as ok
+ return 1 if $directive =~ /\b## no-008filter\b/;
- # 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|FLUSH|
ELSIF|SET|SWITCH|CASE|WHILE|RETURN|STOP|
TRY|CATCH|FINAL|THROW|CLEAR|MACRO|FILTER|
RAWPERL|PERL|CALL|WRAPPER)/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 =~ /[+\-*\/]/;
+ # + - * /
+ return 1 if $directive =~ /[+\-*\/]/;
- # Numbers
- return 1 if $directive =~ /^[0-9]+$/;
+ # Numbers
+ return 1 if $directive =~ /^[0-9]+$/;
- # Simple assignments
- return 1 if $directive =~ /^[\w\.\$\{\}]+\s+=\s+/;
+ # 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/;
+ # 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$/;
+ # Special values always used for numbers
+ return 1 if $directive =~ /^[ijkn]$/;
+ return 1 if $directive =~ /^count$/;
- # Params
- return 1 if $directive =~ /^Param\(/;
+ # Params
+ return 1 if $directive =~ /^Param\(/;
- # Hooks
- return 1 if $directive =~ /^Hook.process\(/;
+ # Hooks
+ return 1 if $directive =~ /^Hook.process\(/;
- # Other functions guaranteed to return OK output
- return 1 if $directive =~ /^(time2str|url)\(/;
+ # 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\()/;
+ # 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)$/;
+ # Special Template Toolkit loop variable
+ return 1 if $directive =~ /^loop\.(index|count)$/;
- # Branding terms
- return 1 if $directive =~ /^terms\./;
+ # 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|json|null|id|
markdown)\b/x;
- return 0;
+ return 0;
}
$/ = $oldrecsep;
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-05-03 15:58:01 +0200