summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/modules/include.t
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 06:33:51 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 06:33:51 +0000
commit4f0770f3df78ecd5dcaefbd214f7a1415366bca6 (patch)
tree72661b8f81594b855bcc967b819263f63fa30e17 /debian/perl-framework/t/modules/include.t
parentAdding upstream version 2.4.56. (diff)
downloadapache2-4f0770f3df78ecd5dcaefbd214f7a1415366bca6.tar.xz
apache2-4f0770f3df78ecd5dcaefbd214f7a1415366bca6.zip
Adding debian version 2.4.56-1~deb11u2.debian/2.4.56-1_deb11u2
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/perl-framework/t/modules/include.t')
-rw-r--r--debian/perl-framework/t/modules/include.t661
1 files changed, 661 insertions, 0 deletions
diff --git a/debian/perl-framework/t/modules/include.t b/debian/perl-framework/t/modules/include.t
new file mode 100644
index 0000000..9ff2411
--- /dev/null
+++ b/debian/perl-framework/t/modules/include.t
@@ -0,0 +1,661 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+use File::Spec::Functions qw(catfile splitpath);
+
+Apache::TestRequest::scheme('http'); #ssl not listening on this vhost
+Apache::TestRequest::module('mod_include'); #use this module's port
+
+use constant WINFU => Apache::TestConfig::WINFU;
+
+## mod_include tests
+my($res, $str, $doc);
+my $dir = "/modules/include/";
+my $have_apache_1 = have_apache 1;
+my $have_apache_2 = have_apache 2;
+my $have_apache_21 = have_min_apache_version "2.1.0";
+my $have_apache_20 = $have_apache_2 && ! $have_apache_21;
+my $htdocs = Apache::Test::vars('documentroot');
+
+# these match the SSI files with their expected results.
+# the expectations are set by the current 2.1 mod_include
+# implementation.
+
+my %test = (
+"echo.shtml" => "echo.shtml",
+"set.shtml" => "set works",
+"comment.shtml" => "No comment here",
+"include1.shtml" => "inc-two.shtml body include.shtml body",
+"include2.shtml" => "inc-two.shtml body include.shtml body",
+"include3.shtml" => "inc-two.shtml body inc-one.shtml body ".
+ "include.shtml body",
+"include4.shtml" => "inc-two.shtml body inc-one.shtml body ".
+ "include.shtml body",
+"include5.shtml" => "inc-two.shtml body inc-one.shtml body ".
+ "inc-three.shtml body include.shtml body",
+"include6.shtml" => "inc-two.shtml body inc-one.shtml body ".
+ "inc-three.shtml body include.shtml body",
+"foo.shtml" => "[an error occurred while processing this ".
+ "directive] foo.shtml body",
+"foo1.shtml" => "[an error occurred while processing this ".
+ "directive] foo.shtml body",
+"foo2.shtml" => "[an error occurred while processing this ".
+ "directive] foo.shtml body",
+"encode.shtml" => "\# \%\^ \%23\%20\%25\%5e",
+"errmsg1.shtml" => "errmsg",
+"errmsg2.shtml" => "errmsg",
+"errmsg3.shtml" => "errmsg",
+"errmsg4.shtml" => "pass errmsg",
+"errmsg5.shtml" => "<!-- pass -->",
+"if1.shtml" => "pass",
+"if2.shtml" => "pass pass",
+"if3.shtml" => "pass pass pass",
+"if4.shtml" => "pass pass",
+"if5.shtml" => "pass pass pass",
+"if6.shtml" => "[an error occurred while processing this ".
+ "directive]",
+"if7.shtml" => "[an error occurred while processing this ".
+ "directive]",
+"if8.shtml" => "pass",
+"if9.shtml" => "pass pass",
+"if10.shtml" => "pass",
+"if11.shtml" => "pass",
+"big.shtml" => "hello pass pass pass hello",
+"newline.shtml" => "inc-two.shtml body",
+"inc-rfile.shtml" => "inc-extra2.shtml body inc-extra1.shtml body ".
+ "inc-rfile.shtml body",
+"inc-rvirtual.shtml" => "inc-extra2.shtml body inc-extra1.shtml body ".
+ "inc-rvirtual.shtml body",
+"extra/inc-bogus.shtml" => "[an error occurred while processing this ".
+ "directive] inc-bogus.shtml body",
+"abs-path.shtml" => "inc-extra2.shtml body inc-extra1.shtml body ".
+ "abs-path.shtml body",
+"parse1.shtml" => "-->",
+"parse2.shtml" => '"',
+"regex.shtml" => "(none) 1 (none)",
+"retagged1.shtml" => ["retagged1.shtml", "retagged1"],
+"retagged2.shtml" => ["----retagged2.shtml", "retagged1"],
+"echo1.shtml" => ["<!-- pass undefined echo -->", "echo1" ],
+"echo2.shtml" => ["<!-- pass undefined echo --> pass config ".
+ " echomsg pass", "echo1"],
+"echo3.shtml" => ['<!--#echo var="DOCUMENT_NAME" -->', "retagged1"],
+"notreal.shtml" => "pass <!--",
+"malformed.shtml" => "[an error occurred while processing this ".
+ "directive] malformed.shtml",
+"exec/off/cmd.shtml" => "[an error occurred while processing this ".
+ "directive]",
+"exec/on/cmd.shtml" => "pass",
+"exec/off/cgi.shtml" => "[an error occurred while processing this ".
+ "directive]",
+"exec/on/cgi.shtml" => "perl cgi",
+"ranged-virtual.shtml" => "x"x32768,
+"var128.shtml" => "x"x126 . "yz", # PR#32985
+"virtualq.shtml?foo=bar" => "foo=bar pass inc-two.shtml body foo=bar", # PR#12655
+
+"inc-nego.shtml" => "index.html.en", # requires mod_negotiation
+"mod_request/echo.shtml"=> "echo.shtml",
+"mod_request/post.shtml?foo=bar&foo2=bar2"
+ => "GET foo: bar foo2: bar2",
+"mod_request/post.shtml"=> "POST foo: bar foo2: bar2", # will be twice, only the first one succeed
+);
+
+my %ap_expr_test = (
+"apexpr/if1.shtml" => "pass",
+"apexpr/err.shtml" => "[an error occurred while processing this ".
+ "directive] err.shtml",
+"apexpr/restrict.shtml" => "[an error occurred while processing this ".
+ "directive] restrict.shtml",
+"apexpr/var.shtml" => "pass pass pass",
+"apexpr/lazyvar.shtml" => "pass",
+);
+
+if (have_min_apache_version "2.3.13") {
+ %test = (%test, %ap_expr_test);
+}
+
+# now, assuming 2.1 has the proper behavior across the board,
+# let's adjust our expectations for other versions
+
+# these tests are known to be broken in 2.0
+# we'll mark them as TODO tests in the hopes
+# that the 2.1 fixes will be backported
+
+my %todo = (
+);
+
+# some behaviors will never be backported, for various
+# reasons. these are the 1.3 legacy tests and expectations
+my %legacy_1_3 = (
+"errmsg4.shtml" => "pass",
+"malformed.shtml" => "",
+"if6.shtml" => "",
+"if7.shtml" => "",
+);
+
+# 2.0 has no legacy tests at the moment
+# but when it does, they will go here
+my %legacy_2_0 = ();
+
+# ok, now that we have our hashes established, here are
+# the manual tweaks
+if ($have_apache_1) {
+ # apache 1.3 uses different semantics for some
+ # of the if.*shtml tests to achieve the same results
+ $test{"if8a.shtml"} = delete $test{"if8.shtml"};
+ $test{"if9a.shtml"} = delete $test{"if9.shtml"};
+ $test{"if10a.shtml"} = delete $test{"if10.shtml"};
+
+ # while other tests are for entirely new behaviors
+ # and don't make sense to test at all in 1.3
+ delete $test{"echo1.shtml"};
+ delete $test{"echo2.shtml"};
+ delete $test{"echo3.shtml"};
+ delete $test{"retagged1.shtml"};
+ delete $test{"retagged2.shtml"};
+ delete $test{"regex.shtml"};
+
+ # finally, these tests are only broken in 1.3
+ $todo{"notreal.shtml"} = delete $test{"notreal.shtml"};
+}
+
+unless ($have_apache_20) {
+ # these tests are broken only in 2.0 -
+ # in 1.3 they work fine so shift them from %todo to %test
+
+ # none at the moment, but the syntax here would be
+ # $test{"errmsg5.shtml"} = delete $todo{"errmsg5.shtml"};
+}
+
+unless (have_min_apache_version "2.0.53") {
+ # this test doesn't work in 2.0 yet but should work in 1.3 and 2.1
+ delete $test{"ranged-virtual.shtml"};
+}
+
+unless ($have_apache_21) {
+ # apache 1.3 and 2.0 do not support these tests
+ delete $test{"echo2.shtml"};
+}
+
+unless (have_module 'mod_negotiation') {
+ delete $test{"inc-nego.shtml"};
+}
+
+# this test does not work on win32 (<!--#exec cmd="echo pass"-->)
+if (WINFU) {
+ delete $test{'exec/on/cmd.shtml'};
+}
+
+my @patterns = (
+ 'mod_include test',
+ 'Hello World',
+ 'footer',
+);
+
+# with the tweaks out of the way, we can get on
+# with planning the tests
+
+# first, total the number of hashed tests
+# note that some legacy tests will redefine the main
+# %test hash, so the total is not necessarily the sum
+# of all the keys
+my %tests = ();
+
+if ($have_apache_21) {
+ %tests = (%test, %todo);
+}
+elsif ($have_apache_2) {
+ %tests = (%test, %todo, %legacy_2_0);
+}
+else {
+ %tests = (%test, %todo, %legacy_1_3);
+}
+
+# now for the TODO tests
+my @todo = ();
+unless ($have_apache_21) {
+ # if 1.3 or 2.0, dynamically determine which of %test
+ # will end up being TODO tests.
+
+ my $counter = 0;
+ foreach my $test (sort keys %tests) {
+ $counter++;
+ push @todo, $counter if $todo{$test};
+ }
+}
+
+unless ($have_apache_2) {
+ # fsize comes immediately after the hashed tests
+ push @todo, (scalar keys %tests) + 1;
+}
+
+# in addition to %tests, there are 1 mod_request expected failure,
+# 1 fsize and 1 flastmod test,
+# 1 GET test, 2 query string tests, 14 XBitHack tests and 14
+# tests that use mod_bucketeer to construct brigades for mod_include
+
+my $tests = (scalar keys %tests) + 1 + @patterns + 1 + 1 + 1 + 2 + 14 + 14;
+
+plan tests => $tests,
+ todo => \@todo,
+ need 'DateTime', need_lwp, need_module 'include';
+
+foreach $doc (sort keys %tests) {
+ # do as much from %test as we can
+ if (ref $tests{$doc}) {
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc", Host => $tests{$doc}[1]),
+ $tests{$doc}[0],
+ "GET $dir$doc"
+ );
+ }
+ elsif ($doc =~ m/ranged/) {
+ if (have_cgi) {
+ ok t_cmp(GET_BODY("$dir$doc", Range => "bytes=0-"),
+ $tests{$doc},
+ "GET $dir$doc with Range"
+ );
+ }
+ else {
+ skip "Skipping virtual-range test; no cgi module", 1;
+ }
+ }
+ elsif ($doc =~ m/cgi/) {
+ if (have_cgi) {
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $tests{$doc},
+ "GET $dir$doc"
+ );
+ }
+ else {
+ skip "Skipping 'exec cgi' test; no cgi module.", 1;
+ }
+ }
+ elsif ($doc =~ m/mod_request.*\?/) {
+ # param in the url ==> use GET
+ if (have_cgi) {
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $tests{$doc},
+ "GET $dir$doc"
+ );
+ }
+ else {
+ skip "Skipping 'exec cgi' test; no cgi module.", 1;
+ }
+ }
+ elsif ($doc =~ m/mod_request/) {
+ # no param in the url ==> use POST with a content
+ if (have_cgi) {
+ ok t_cmp(super_chomp(POST_BODY "$dir$doc", content => "foo=bar&foo2=bar2"),
+ $tests{$doc},
+ "POST $dir$doc"
+ );
+ if ($doc =~ m/mod_request.*post/) {
+ # KeptBodySize is 32
+ my $r = POST("$dir$doc", content => "foo=bar&foo2=bar2&foo3=bar3&foo4=bar4");
+ ok t_cmp($r->code, 413, "sizeof(body) > KeptBodySize");
+ }
+ }
+ else {
+ skip "Skipping 'exec cgi' test; no cgi module.", 2;
+ }
+ }
+ else {
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $tests{$doc},
+ "GET $dir$doc"
+ );
+ }
+}
+
+### FLASTMOD/FSIZE TESTS
+
+# marked as TODO in 1.3 - hoping for a format backport
+{
+ my $file = catfile($htdocs, splitpath($dir), "size.shtml");
+ my $size = (stat $file)[7];
+
+ # round perl's stat size for <!--#config sizefmt="abbrev"-->
+ # this assumes the size of size.shtml is such that it is
+ # rendered in K (which it is). if size.shtml is made much
+ # larger or smaller this formatting will need to change too
+ my $abbrev = sprintf("%.1fK", $size/1024);
+
+ # and commify for <!--#config sizefmt="bytes"-->
+ my $bytes = commify($size);
+
+ my $expected = join ' ', $bytes, $bytes, $abbrev, $abbrev;
+
+ my $result = super_chomp(GET_BODY "${dir}size.shtml");
+
+ # trim output
+ $result =~ s/X//g; # the Xs were there just to pad the filesiez
+ $result = single_space($result);
+
+ ok t_cmp("$result",
+ "$expected",
+ "GET ${dir}size.shtml"
+ );
+}
+
+unless(eval "require POSIX") {
+ skip "POSIX module not found", 1;
+}
+else {
+ # use DateTime and avoid the system locale messing things up
+ use DateTime;
+ # Only for checking, whether system strftime supports %s
+ use POSIX;
+ my $strftime_gnu = (POSIX::strftime("%s", gmtime()) eq '%s' ? 0 : 1);
+
+ my $result = super_chomp(GET_BODY "${dir}file.shtml");
+ $result = single_space($result);
+
+ my $httpdtz = $1 if $result =~ /\w+, \d+-\w+-\d+ \d+:\d+:\d+ (\w+) /;
+
+ my $file = catfile($htdocs, splitpath($dir), "file.shtml");
+ my $mtime = (stat $file)[9];
+
+ my $dt = DateTime->from_epoch( epoch => $mtime,
+ locale => 'en_US', time_zone => $httpdtz||'UTC' );
+
+ my $expected = join ' ' =>
+ $dt->strftime("%A, %B %e, %G"),
+ $dt->strftime("%A, %B %e, %G"),
+ $strftime_gnu ? $dt->strftime("%s") : '%s',
+ $strftime_gnu ? $dt->strftime("%s") : '%s';
+
+ # trim output
+ $expected = single_space($expected);
+
+ ok t_cmp("$result",
+ "$expected",
+ "GET ${dir}file.shtml"
+ );
+}
+
+# some tests that can't be easily assimilated
+
+$doc = "printenv.shtml";
+ok t_cmp(GET("$dir$doc")->code,
+ "200",
+ "GET $dir$doc"
+ );
+
+### test include + query string
+$res = GET "${dir}virtual.shtml";
+
+ok $res->is_success;
+
+$str = $res->content;
+
+ok $str;
+
+for my $pat (@patterns) {
+ ok t_cmp($str, qr/$pat/, "/$pat/");
+}
+
+### MOD_BUCKETEER+MOD_INCLUDE TESTS
+if (WINFU) {
+ for (1..13) {
+ skip "Skipping XBitHack tests on this platform", 1;
+ }
+}
+else {
+ ### XBITHACK TESTS
+ # test xbithack off
+ $doc = "xbithack/off/test.html";
+ foreach ("0444", "0544", "0554") {
+ chmod oct($_), "$htdocs/$dir$doc";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),,
+ "<BODY> <!--#include virtual=\"../../inc-two.shtml\"--> </BODY>",
+ "XBitHack off [$_]"
+ );
+ }
+
+ # test xbithack on
+ $doc = "xbithack/on/test.html";
+ chmod 0444, "$htdocs$dir$doc";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ "<BODY> <!--#include virtual=\"../../inc-two.shtml\"--> </BODY>",
+ "XBitHack on [0444]"
+ );
+
+ foreach ("0544", "0554") {
+ chmod oct($_), "$htdocs/$dir$doc";
+ ok t_cmp(check_xbithack(GET "$dir$doc"),
+ "No Last-modified date ; <BODY> inc-two.shtml body </BODY>",
+ "XBitHack on [$_]"
+ );
+ }
+
+ # test timefmt - make sure filter only inserted once
+ # if Option Include and xbithack both say to process
+ $doc = "xbithack/both/timefmt.shtml";
+ my @now = localtime();
+ my $year = $now[5] + 1900;
+ chmod 0555, "$htdocs/$dir$doc";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ "xx${year}xx",
+ "XBitHack both [timefmt]"
+ );
+
+ # test xbithack full
+ $doc = "xbithack/full/test.html";
+ chmod 0444, "$htdocs/$dir$doc";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ "<BODY> <!--#include virtual=\"../../inc-two.shtml\"--> </BODY>",
+ "XBitHack full [0444]"
+ );
+ chmod 0544, "$htdocs/$dir$doc";
+ ok t_cmp(check_xbithack(GET "$dir$doc"),
+ "No Last-modified date ; <BODY> inc-two.shtml body </BODY>",
+ "XBitHack full [0544]"
+ );
+
+ my $lm;
+
+ chmod 0554, "$htdocs/$dir$doc";
+ ok t_cmp(check_xbithack(GET("$dir$doc"), \$lm),
+ "Has Last-modified date ; <BODY> inc-two.shtml body </BODY>",
+ "XBitHack full [0554]"
+ );
+
+ ok t_cmp(check_xbithack_etag(GET("$dir$doc", 'If-Modified-Since' => $lm)),
+ "No ETag ; ",
+ "XBitHack full [0554] / ETag"
+ );
+
+ ok t_cmp(GET("$dir$doc", 'If-Modified-Since' => $lm)->code, 304,
+ "XBitHack full [0554] / If-Modified-Since"
+ );
+
+ chmod 0544, "$htdocs/$dir$doc";
+ ok t_cmp(GET("$dir$doc", 'If-Modified-Since' => $lm)->code, 200,
+ "XBitHack full [0544] / If-Modified-Since"
+ );
+
+ ok t_cmp(check_xbithack_etag(GET("$dir$doc", 'If-Modified-Since' => $lm)),
+ "No ETag ; <BODY> inc-two.shtml body </BODY>",
+ "XBitHack full [0544] / ETag"
+ );
+}
+
+# we can use mod_bucketeer to create edge conditions for mod_include, since
+# it allows us to create bucket and brigade boundaries wherever we want
+if (have_module 'mod_bucketeer') {
+
+ my $expected = "____ _____ _____ ___________________ </table> ".
+ "##################################1/8</tr> ".
+ "##################################2/8</tr> ".
+ "##################################3/8</tr> ".
+ "##################################4/8</tr> ".
+ "##################################5/8</tr> ".
+ "##################################6/8$htdocs</tr> ".
+ "##################################7/8</tr> ".
+ "##################################8/8</tr> ".
+ "@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@";
+
+ $doc = "bucketeer/y.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ $expected = "____ ___________________________________".
+ "________________________________________".
+ "___ ____________________________________".
+ "________________________________________".
+ "__________ ___________________ </table> ".
+ "#####################################</tr> ".
+ "#####################################</tr> ".
+ "#####################################</tr> ".
+ "#####################################</tr> ".
+ "#####################################</tr> ".
+ "#####################################</tr> ".
+ "#####################################</tr> ".
+ "#####################################</tr> ".
+ "@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@";
+
+ for (0..3) {
+ $doc = "bucketeer/y$_.shtml";
+ my ($body) = super_chomp(GET_BODY "$dir$doc");
+ $body =~ s/\002/^B/g;
+ $body =~ s/\006/^F/g;
+ $body =~ s/\020/^P/g;
+ ok t_cmp($body,
+ $expected,
+ "GET $dir$doc"
+ );
+ }
+
+ $expected = "[an error occurred while processing this directive]";
+ $doc = "bucketeer/y4.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+
+ $expected= "pass [an error occurred while processing this directive] ".
+ "pass pass1";
+ $doc = "bucketeer/y5.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ $expected= "BeforeIfElseBlockAfterIf";
+ $doc = "bucketeer/y6.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ $expected= "Before If <!-- comment -->SomethingElse".
+ "<!-- right after if -->After if";
+ $doc = "bucketeer/y7.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ $expected= "FalseSetDone";
+ $doc = "bucketeer/y8.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ $expected= "FalseSetDone";
+ $doc = "bucketeer/y9.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ $expected= "\"pass\"";
+ $doc = "bucketeer/y10.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc"),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ ### exotic SSI(Start|End)Tags
+
+ $expected= "----retagged3.shtml";
+ $doc = "bucketeer/retagged3.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc", Host => 'retagged1'),
+ $expected,
+ "GET $dir$doc"
+ );
+
+ $expected= "---pass";
+ $doc = "bucketeer/retagged4.shtml";
+ ok t_cmp(super_chomp(GET_BODY "$dir$doc", Host => 'retagged2'),
+ $expected,
+ "GET $dir$doc"
+ );
+}
+else {
+ for (1..14) {
+ skip "Skipping bucket boundary tests, no mod_bucketeer", 1;
+ }
+}
+
+sub super_chomp {
+ my ($body) = shift;
+
+ ## super chomp - all leading and trailing \n (and \r for win32)
+ $body =~ s/^[\n\r]*//;
+ $body =~ s/[\n\r]*$//;
+ ## and all the rest change to spaces
+ $body =~ s/\n/ /g;
+ $body =~ s/\r//g; #rip out all remaining \r's
+
+ $body;
+}
+
+sub check_xbithack {
+ my ($resp) = shift;
+ my ($body) = super_chomp($resp->content);
+ my ($lastmod) = ($resp->last_modified)
+ ? "Has Last-modified date" : "No Last-modified date";
+
+ my $data = shift;
+ $$data = $resp->header('Last-Modified') if $data;
+
+ "$lastmod ; $body";
+}
+
+sub check_xbithack_etag {
+ my ($resp) = shift;
+ my ($body) = super_chomp($resp->content);
+ my ($etag) = ($resp->header('ETag'))
+ ? "Has ETag" : "No ETag";
+
+ my $data = shift;
+ $$data = $etag if $data;
+
+ "$etag ; $body";
+}
+
+sub commify {
+ # add standard commas to numbers. from perlfaq5
+
+ local $_ = shift;
+ 1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
+ return $_;
+}
+
+sub single_space {
+ # condense multiple spaces between values to a single
+ # space. also trim initial and trailing whitespace
+
+ local $_ = shift;
+ s/\s+/ /g;
+ s/(^ )|( $)//;
+ return $_;
+}