lib/TWiki/Net/HTTPResponse.pm
changeset 0 414e01d06fd5
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/TWiki/Net/HTTPResponse.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,101 @@
     1.4 +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
     1.5 +#
     1.6 +# Copyright (C) 2007 TWiki Contributors. All Rights Reserved.
     1.7 +# TWiki Contributors are listed in the AUTHORS file in the root
     1.8 +# of this distribution. NOTE: Please extend that file, not this notice.
     1.9 +#
    1.10 +# This program is free software; you can redistribute it and/or
    1.11 +# modify it under the terms of the GNU General Public License
    1.12 +# as published by the Free Software Foundation; either version 2
    1.13 +# of the License, or (at your option) any later version. For
    1.14 +# more details read LICENSE in the root of this distribution.
    1.15 +#
    1.16 +# This program is distributed in the hope that it will be useful,
    1.17 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
    1.18 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    1.19 +#
    1.20 +# As per the GPL, removal of this notice is prohibited.
    1.21 +
    1.22 +=pod
    1.23 +
    1.24 +---+ package TWiki::Net::HTTPResponse
    1.25 +
    1.26 +Fakeup of HTTP::Response for use when LWP is not available. Only implements
    1.27 +a small subset of the HTTP::Response methods:
    1.28 +| =code()= |
    1.29 +| =message()= |
    1.30 +| =header($field)= |
    1.31 +| =content()= |
    1.32 +| =is_error()= |
    1.33 +| =is_redirect()= |
    1.34 +
    1.35 +See the documentation of HTTP::Response for information about the methods.
    1.36 +
    1.37 +=cut
    1.38 +
    1.39 +package TWiki::Net::HTTPResponse;
    1.40 +
    1.41 +sub new {
    1.42 +    my ($class, $message) = @_;
    1.43 +    return bless( {
    1.44 +        code => 400, # BAD REQUEST
    1.45 +        message => $message,
    1.46 +        headers => {},
    1.47 +    }, $class);
    1.48 +}
    1.49 +
    1.50 +sub parse {
    1.51 +    my ($class, $text) = @_;
    1.52 +    my $this = new($class, 'Incomplete headers');
    1.53 +
    1.54 +    $text =~ s/\r\n/\n/gs;
    1.55 +    $text =~ s/\r/\n/gs;
    1.56 +    $text =~ s/^(.*?)\n\n//s;
    1.57 +    my $httpHeader = $1;
    1.58 +    $this->{content} = $text;
    1.59 +    if ($httpHeader =~ s/^HTTP\/[\d.]+\s(\d+)\d\d\s(.*)$//) {
    1.60 +        $this->{code} = $1;
    1.61 +        $this->{message} = $2;
    1.62 +    }
    1.63 +    $httpHeader = "\n$httpHeader\n";
    1.64 +    foreach my $header (split(/\n(?=![ \t])/, $httpHeader)) {
    1.65 +        if ($header =~ /^.*?: (.*)$/s) {
    1.66 +            $this->{headers}->{lc($1)} = $2;
    1.67 +        } else {
    1.68 +            $this->{code} = 400;
    1.69 +            $this->{message} =
    1.70 +              "Unparseable header in response: $header";
    1.71 +        }
    1.72 +    }
    1.73 +
    1.74 +    return $this;
    1.75 +}
    1.76 +
    1.77 +sub code {
    1.78 +    return shift->{code};
    1.79 +}
    1.80 +
    1.81 +sub message {
    1.82 +    return shift->{message};
    1.83 +}
    1.84 +
    1.85 +sub header {
    1.86 +    my ($this, $h) = @_;
    1.87 +    return $this->{headers}->{$h};
    1.88 +}
    1.89 +
    1.90 +sub content {
    1.91 +    return shift->{content};
    1.92 +}
    1.93 +
    1.94 +sub is_error {
    1.95 +    my $this = shift;
    1.96 +    return $this->{code} >= 400;
    1.97 +}
    1.98 +
    1.99 +sub is_redirect {
   1.100 +    my $this = shift;
   1.101 +    return $this->{code} >= 300 && $this->{code} < 400;
   1.102 +}
   1.103 +
   1.104 +1;