vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libwww-perl/libwww-perl-5.813/t/base/message-old.t

   1 #!perl -w
   2
   3 # This is the old message.t test.  It is not maintained any more,
   4 # but kept around in case it happens to catch any mistakes.  Please
   5 # add new tests to message.t instead.
   6
   7 use strict;
   8 use Test qw(plan ok);
   9
  10 plan tests => 20;
  11
  12 require HTTP::Request;
  13 require HTTP::Response;
  14
  15 require Time::Local if $^O eq "MacOS";
  16 my $offset = ($^O eq "MacOS") ? Time::Local::timegm(0,0,0,1,0,70) : 0;
  17
  18 my $req = HTTP::Request->new(GET => "http://www.sn.no/");
  19 $req->header(
  20         "if-modified-since" => "Thu, 03 Feb 1994 00:00:00 GMT",
  21         "mime-version"      => "1.0");
  22
  23 ok($req->as_string =~ /^GET/m);
  24 ok($req->header("MIME-Version"), "1.0");
  25 ok($req->if_modified_since, ((760233600 + $offset) || 0));
  26
  27 $req->content("gisle");
  28 $req->add_content(" aas");
  29 $req->add_content(\ " old interface is depreciated");
  30 ${$req->content_ref} =~ s/\s+is\s+depreciated//;
  31
  32 ok($req->content, "gisle aas old interface");
  33
  34 my $time = time;
  35 $req->date($time);
  36 my $timestr = gmtime($time);
  37 my($month) = ($timestr =~ /^\S+\s+(\S+)/);  # extract month;
  38 #print "These should represent the same time:\n\t", $req->header('Date'), "\n\t$timestr\n";
  39 ok($req->header('Date') =~ /\Q$month/);
  40
  41 $req->authorization_basic("gisle", "passwd");
  42 ok($req->header("Authorization"), "Basic Z2lzbGU6cGFzc3dk");
  43
  44 my($user, $pass) = $req->authorization_basic;
  45 ok($user, "gisle");
  46 ok($pass, "passwd");
  47
  48 # Check the response
  49 my $res = HTTP::Response->new(200, "This message");
  50 ok($res->is_success);
  51
  52 my $html = $res->error_as_HTML;
  53 ok($html =~ /<head>/i && $html =~ /This message/);
  54
  55 $res->content_type("text/html;version=3.0");
  56 $res->content("<html>...</html>\n");
  57
  58 my $res2 = $res->clone;
  59 ok($res2->code, 200);
  60 ok($res2->header("cOntent-TYPE"), "text/html;version=3.0");
  61 ok($res2->content =~ />\.\.\.</);
  62
  63 # Check the base method:
  64 $res = HTTP::Response->new(200, "This message");
  65 ok($res->base, undef);
  66 $res->request($req);
  67 $res->content_type("image/gif");
  68
  69 ok($res->base, "http://www.sn.no/");
  70 $res->header('Base', 'http://www.sn.no/xxx/');
  71 ok($res->base, "http://www.sn.no/xxx/");
  72
  73 # Check the AUTLOAD delegate method with regular expressions
  74 "This string contains text/html" =~ /(\w+\/\w+)/;
  75 $res->content_type($1);
  76 ok($res->content_type, "text/html");
  77
  78 # Check what happens when passed a new URI object
  79 require URI;
  80 $req = HTTP::Request->new(GET => URI->new("http://localhost"));
  81 ok($req->uri, "http://localhost");
  82
  83 $req = HTTP::Request->new(GET => "http://www.example.com",
  84                           [ Foo => 1, bar => 2 ], "FooBar\n");
  85 ok($req->as_string, <<EOT);
  86 GET http://www.example.com
  87 Bar: 2
  88 Foo: 1
  89
  90 FooBar
  91 EOT
  92
  93 $req->clear;
  94 ok($req->as_string,  <<EOT);
  95 GET http://www.example.com
  96
  97 EOT