X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=dev%2Fi386%2Flibwww-perl%2Flibwww-perl-5.813%2Ft%2Fbase%2Fmessage-old.t;fp=dev%2Fi386%2Flibwww-perl%2Flibwww-perl-5.813%2Ft%2Fbase%2Fmessage-old.t;h=479c926ca5378646c2220734cd17ed91172008fa;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hp=0000000000000000000000000000000000000000;hpb=df794b845212301ea0d267c919232538bfef356a;p=dh-make-perl diff --git a/dev/i386/libwww-perl/libwww-perl-5.813/t/base/message-old.t b/dev/i386/libwww-perl/libwww-perl-5.813/t/base/message-old.t new file mode 100644 index 0000000..479c926 --- /dev/null +++ b/dev/i386/libwww-perl/libwww-perl-5.813/t/base/message-old.t @@ -0,0 +1,97 @@ +#!perl -w + +# This is the old message.t test. It is not maintained any more, +# but kept around in case it happens to catch any mistakes. Please +# add new tests to message.t instead. + +use strict; +use Test qw(plan ok); + +plan tests => 20; + +require HTTP::Request; +require HTTP::Response; + +require Time::Local if $^O eq "MacOS"; +my $offset = ($^O eq "MacOS") ? Time::Local::timegm(0,0,0,1,0,70) : 0; + +my $req = HTTP::Request->new(GET => "http://www.sn.no/"); +$req->header( + "if-modified-since" => "Thu, 03 Feb 1994 00:00:00 GMT", + "mime-version" => "1.0"); + +ok($req->as_string =~ /^GET/m); +ok($req->header("MIME-Version"), "1.0"); +ok($req->if_modified_since, ((760233600 + $offset) || 0)); + +$req->content("gisle"); +$req->add_content(" aas"); +$req->add_content(\ " old interface is depreciated"); +${$req->content_ref} =~ s/\s+is\s+depreciated//; + +ok($req->content, "gisle aas old interface"); + +my $time = time; +$req->date($time); +my $timestr = gmtime($time); +my($month) = ($timestr =~ /^\S+\s+(\S+)/); # extract month; +#print "These should represent the same time:\n\t", $req->header('Date'), "\n\t$timestr\n"; +ok($req->header('Date') =~ /\Q$month/); + +$req->authorization_basic("gisle", "passwd"); +ok($req->header("Authorization"), "Basic Z2lzbGU6cGFzc3dk"); + +my($user, $pass) = $req->authorization_basic; +ok($user, "gisle"); +ok($pass, "passwd"); + +# Check the response +my $res = HTTP::Response->new(200, "This message"); +ok($res->is_success); + +my $html = $res->error_as_HTML; +ok($html =~ //i && $html =~ /This message/); + +$res->content_type("text/html;version=3.0"); +$res->content("...\n"); + +my $res2 = $res->clone; +ok($res2->code, 200); +ok($res2->header("cOntent-TYPE"), "text/html;version=3.0"); +ok($res2->content =~ />\.\.\.new(200, "This message"); +ok($res->base, undef); +$res->request($req); +$res->content_type("image/gif"); + +ok($res->base, "http://www.sn.no/"); +$res->header('Base', 'http://www.sn.no/xxx/'); +ok($res->base, "http://www.sn.no/xxx/"); + +# Check the AUTLOAD delegate method with regular expressions +"This string contains text/html" =~ /(\w+\/\w+)/; +$res->content_type($1); +ok($res->content_type, "text/html"); + +# Check what happens when passed a new URI object +require URI; +$req = HTTP::Request->new(GET => URI->new("http://localhost")); +ok($req->uri, "http://localhost"); + +$req = HTTP::Request->new(GET => "http://www.example.com", + [ Foo => 1, bar => 2 ], "FooBar\n"); +ok($req->as_string, <clear; +ok($req->as_string, <