"Fossies" - the Fresh Open Source Software Archive

Member "mod_perl-2.0.11/t/response/TestApache/util.pm" (5 Oct 2019, 3816 Bytes) of package /linux/www/apache_httpd_modules/mod_perl-2.0.11.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "util.pm": 2.0.8_vs_2.0.9.

    1 # please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
    2 package TestApache::util;
    3 
    4 # Apache2::Util tests
    5 
    6 use strict;
    7 use warnings FATAL => 'all';
    8 
    9 # to fully test this test the following locale settings need to be run:
   10 #
   11 # some /^en_/ locale, e.g. /^en_GB*
   12 # LC_CTYPE=en_GB.UTF-8 LC_TIME=en_GB.UTF-8 t/TEST -verbose apache/util.t
   13 # LC_CTYPE=en_GB       LC_TIME=en_GB       t/TEST -verbose apache/util.t
   14 #
   15 # some non-/^en_/ locale, e.g. ru_RU
   16 # LC_CTYPE=ru_RU.UTF-8 LC_TIME=ru_RU.UTF-8 t/TEST -verbose apache/util.t
   17 # LC_CTYPE=ru_RU       LC_TIME=ru_RU       t/TEST -verbose apache/util.t
   18 
   19 # regex matching (LC_CTYPE) of strftime-like (LC_TIME) strings
   20 use locale;
   21 
   22 use Apache2::RequestRec ();
   23 use Apache2::RequestIO ();
   24 use Apache2::Util ();
   25 use APR::Date ();
   26 
   27 use Apache::TestUtil;
   28 use Apache::Test;
   29 
   30 use Apache2::Const -compile => 'OK';
   31 
   32 # those are passed via PerlPassEnv
   33 my $locale = $ENV{LC_TIME} || '';
   34 
   35 my $parse_time_ok  = $locale =~ /^en_/   ? 1 : 0;
   36 my $locale_is_utf8 = $locale =~ /UTF-8$/ ? 1 : 0;
   37 
   38 sub handler {
   39     my $r = shift;
   40 
   41     plan $r, tests => 8;
   42 
   43     # ht_time
   44     {
   45         my $time = time;
   46         my $fmt = "%a, %d %b %Y %H:%M:%S %Z";
   47         my $fmtdate;
   48 
   49         $fmtdate = Apache2::Util::ht_time($r->pool);
   50         time_cmp($fmtdate, $time,
   51                  'Apache2::Util::ht_time($pool)', 0);
   52 
   53         $fmtdate = Apache2::Util::ht_time($r->pool, $time);
   54         time_cmp($fmtdate, $time,
   55                  'Apache2::Util::ht_time($pool, $time)', 1);
   56 
   57         $fmtdate = Apache2::Util::ht_time($r->pool, $time, $fmt);
   58         time_cmp($fmtdate, $time,
   59                  'Apache2::Util::ht_time($pool, $time, $fmt)', 1);
   60 
   61         my $gmt = 0;
   62         $fmtdate = Apache2::Util::ht_time($r->pool, $time, $fmt, $gmt);
   63         time_cmp($fmtdate, $time,
   64                  'Apache2::Util::ht_time($pool, $time, $fmt, $gmt)', 0);
   65     }
   66 
   67     # escape_path
   68     {
   69         my ($uri, $received, $expected);
   70 
   71         $uri = "a 'long' file?.html";
   72         ($expected = $uri) =~ s/([\s?;])/sprintf "%%%x", ord $1/ge;
   73 
   74         $received = Apache2::Util::escape_path($uri, $r->pool);
   75         ok t_cmp $received, $expected,
   76             "Apache2::Util::escape_path / partial=1 / default";
   77 
   78         $received = Apache2::Util::escape_path($uri, $r->pool, 1);
   79         ok t_cmp $received, $expected,
   80             "Apache2::Util::escape_path / partial=1 / explicit";
   81 
   82         $received = Apache2::Util::escape_path($uri, $r->pool, 0);
   83         ok t_cmp $received, $expected,
   84             "Apache2::Util::escape_path / partial=0";
   85 
   86         $uri = "a 'long' file?.html:";
   87         ($expected = $uri) =~ s/([\s?;])/sprintf "%%%x", ord $1/ge;
   88         # XXX: why does it prepend ./ only if it sees : or :/?
   89         $expected = "./$expected";
   90 
   91         $received = Apache2::Util::escape_path($uri, $r->pool, 0);
   92         ok t_cmp $received, $expected,
   93             "Apache2::Util::escape_path / partial=0 / ./ prefix ";
   94 
   95     }
   96 
   97     Apache2::Const::OK;
   98 }
   99 
  100 my $fmtdate_re = qr/^\w+, \d\d \w+ \d\d\d\d \d\d:\d\d:\d\d/;
  101 sub time_cmp {
  102     my ($fmtdate, $time, $comment, $exact_match) = @_;
  103 
  104     if ($parse_time_ok && $exact_match) {
  105         my $ptime = APR::Date::parse_http($fmtdate);
  106         t_debug "fmtdate: $fmtdate";
  107         ok t_cmp $ptime, $time, $comment;
  108     }
  109     else {
  110         if ($locale_is_utf8) {
  111             if (have_min_perl_version(5.008)) {
  112                 require Encode;
  113                 # perl doesn't know yet that $fmtdate is a utf8 string
  114                 $fmtdate = Encode::decode_utf8($fmtdate);
  115             }
  116             else {
  117                 skip "Skip locale $locale needs perl 5.8.0+", 0;
  118                 return;
  119             }
  120         }
  121         ok t_cmp $fmtdate, $fmtdate_re, $comment;
  122     }
  123 }
  124 
  125 1;
  126 
  127 __END__
  128