vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/base/response.t

   1
   2 # Test extra HTTP::Response methods.  Basic operation is tested in the
   3 # message.t test suite.
   4
   5
   6 print "1..8\n";
   7
   8
   9 use HTTP::Date;
  10 use HTTP::Request;
  11 use HTTP::Response;
  12
  13 my $time = time;
  14
  15 $req = HTTP::Request->new(GET => 'http://www.sn.no');
  16 $req->date($time - 30);
  17
  18 $r = new HTTP::Response 200, "OK";
  19 $r->client_date($time - 20);
  20 $r->date($time - 25);
  21 $r->last_modified($time - 5000000);
  22 $r->request($req);
  23
  24 print $r->as_string;
  25
  26 $current_age = $r->current_age;
  27
  28 if ($current_age < 35  || $current_age > 40) {
  29     print "not ";
  30 }
  31 print "ok 1\n";
  32
  33 $freshness_lifetime = $r->freshness_lifetime;
  34 if ($freshness_lifetime < 12 * 3600) {
  35     print "not ";
  36 }
  37 print "ok 2\n";
  38
  39 $is_fresh = $r->is_fresh;
  40
  41 print "not " unless $is_fresh;
  42 print "ok 3\n";
  43
  44 print "current_age        = $current_age\n";
  45 print "freshness_lifetime = $freshness_lifetime\n";
  46 print "response is ";
  47 print "not " unless $is_fresh;
  48 print "fresh\n";
  49
  50
  51 print "it will be fresh is ";
  52 print $freshness_lifetime - $current_age;
  53 print " more seconds\n";
  54
  55 # OK, now we add an Expires header
  56 $r->expires($time);
  57 print $r->as_string;
  58
  59 $freshness_lifetime = $r->freshness_lifetime;
  60 print "freshness_lifetime = $freshness_lifetime\n";
  61 print "not " unless $freshness_lifetime == 25;
  62 print "ok 4\n";
  63 $r->remove_header('expires');
  64
  65 # Now we try the 'Age' header and the Cache-Contol:
  66
  67 $r->header('Age', 300);
  68 $r->push_header('Cache-Control', 'junk');
  69 $r->push_header(Cache_Control => 'max-age = 10');
  70
  71 print $r->as_string;
  72
  73 $current_age = $r->current_age;
  74 $freshness_lifetime = $r->freshness_lifetime;
  75
  76 print "current_age        = $current_age\n";
  77 print "freshness_lifetime = $freshness_lifetime\n";
  78
  79 print "not " if $current_age < 300;
  80 print "ok 5\n";
  81
  82 print "not " if $freshness_lifetime != 10;
  83 print "ok 6\n";
  84
  85 print "not " unless $r->fresh_until;  # should return something
  86 print "ok 7\n";
  87
  88 my $r2 = HTTP::Response->parse($r->as_string);
  89 my @h = $r2->header('Cache-Control');
  90 print "not " unless scalar @h == 2;
  91 print "ok 8\n"