summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/modules/substitute.t
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--debian/perl-framework/t/modules/substitute.t125
1 files changed, 125 insertions, 0 deletions
diff --git a/debian/perl-framework/t/modules/substitute.t b/debian/perl-framework/t/modules/substitute.t
new file mode 100644
index 0000000..0f111c0
--- /dev/null
+++ b/debian/perl-framework/t/modules/substitute.t
@@ -0,0 +1,125 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil qw(t_write_file);
+
+Apache::TestRequest::user_agent(keep_alive => 1);
+
+my $debug = 0;
+my $url = '/modules/substitue/test.txt';
+
+# mod_bucketeer control chars
+my $B = chr(0x02);
+my $F = chr(0x06);
+my $P = chr(0x10);
+
+my @simple_cases = ();
+
+my @test_cases = (
+ [ "f${B}o${P}ofoo" => 's/foo/bar/' ],
+ [ "f${B}o${P}ofoo" => 's/fo/fa/', 's/fao/bar/' ],
+ [ "foofoo" => 's/Foo/bar/' ],
+ [ "fo${F}ofoo" => 's/Foo/bar/i' ],
+ [ "foOFoo" => 's/OF/of/', 's/foo/bar/' ],
+ [ "fofooo" => 's/(.)fo/$1of/', 's/foo/bar/' ],
+ [ "foof\noo" => 's/f.oo/bar/' ],
+ [ "xfooo" => 's/foo/fo/' ],
+ [ "xfoo" x 4000 => 's/foo/bar/', 's/FOO/BAR/' ],
+ [ "foox\n" x 4000 => 's/foo/bar/', 's/FOO/BAR/' ],
+ [ "a.baxb(" => 's/a.b/a$1/n' ],
+ [ "a.baxb(" => 's/a.b/a$1/n', 's/1axb(/XX/n' ],
+ [ "xfoo" x 4000 => 's/foo/bar/n', 's/FOO/BAR/n' ],
+);
+
+if (have_min_apache_version("2.3.5")) {
+ # tests for r1307067
+ push @test_cases, [ "x<body>x" => 's/<body>/&/' ],
+ [ "x<body>x" => 's/<body>/$0/' ],
+ [ "foobar" => 's/(oo)b/c$1/' ],
+ [ "foobar" => 's/(oo)b/c\$1/' ],
+ [ "foobar" => 's/(oo)b/\d$1/' ];
+}
+
+if (have_min_apache_version("2.4.42")) {
+ push @simple_cases, [ "foo\nbar" => 's/foo.*/XXX$0XXX', "XXXfooXXX\nbar" ],
+}
+plan tests => scalar @test_cases + scalar @simple_cases,
+ need need_lwp,
+ need_module('mod_substitute'),
+ need_module('mod_bucketeer');
+
+foreach my $t (@test_cases) {
+ my ($content, @rules) = @{$t};
+
+ write_testfile($content);
+ write_htaccess(@rules);
+
+ # We assume that perl does the right thing (TM) and compare that with
+ # mod_substitute's result.
+ my $expect = $content;
+ $expect =~ s/[$B$F$P]+//g;
+ foreach my $rule (@rules) {
+ if ($rule =~ s/n$//) {
+ # non-regex match, escape specials for perl
+ my @parts = split('/', $rule);
+ $parts[1] = quotemeta($parts[1]);
+ $parts[2] = quotemeta($parts[2]);
+ $rule = join('/', @parts);
+ $rule .= '/' if (scalar @parts == 3);
+ }
+ else {
+ # special case: HTTPD uses $0 for the whole match, perl uses $&
+ $rule =~ s/\$0/\$&/g;
+ }
+ $rule .= "g"; # mod_substitute always does global search & replace
+
+ # "no warnings" because the '\d' in one of the rules causes a warning,
+ # which we have set to be fatal.
+ eval "{\n no warnings ; \$expect =~ $rule\n}";
+ }
+
+ my $response = GET('/modules/substitute/test.txt');
+ my $rc = $response->code;
+ my $got = $response->content;
+ my $ok = ($rc == 200) && ($got eq $expect);
+ print "got $rc '$got'", ($ok ? ": OK\n" : ", expected '$expect'\n");
+
+ ok($ok);
+}
+
+foreach my $t (@simple_cases) {
+ my ($content, $rule, $expect) = @{$t};
+ write_testfile($content);
+ write_htaccess($rule);
+ my $response = GET('/modules/substitute/test.txt');
+ my $rc = $response->code;
+ my $got = $response->content;
+ my $ok = ($rc == 200) && ($got eq $expect);
+ print "got $rc '$got'", ($ok ? ": OK\n" : ", expected '$expect'\n");
+
+ ok($ok);
+}
+exit 0;
+
+### sub routines
+sub write_htaccess
+{
+ my @rules = @_;
+ my $file = File::Spec->catfile(Apache::Test::vars('serverroot'), 'htdocs',
+ 'modules', 'substitute', '.htaccess');
+ my $content = "SetOutputFilter BUCKETEER;SUBSTITUTE\n";
+ $content .= "Substitute $_\n" for @rules;
+ t_write_file($file, $content);
+ print "$content<===\n" if $debug;
+}
+
+sub write_testfile
+{
+ my $content = shift;
+ my $file = File::Spec->catfile(Apache::Test::vars('serverroot'), 'htdocs',
+ 'modules', 'substitute', 'test.txt');
+ t_write_file($file, $content);
+ print "$content<===\n" if $debug;
+}