"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/site/lib/LWP/Protocol/data.pm" (7 Mar 2020, 1233 Bytes) of package /windows/misc/install-tl.zip:


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.

    1 package LWP::Protocol::data;
    2 
    3 # Implements access to data:-URLs as specified in RFC 2397
    4 
    5 use strict;
    6 
    7 our $VERSION = '6.43';
    8 
    9 require HTTP::Response;
   10 require HTTP::Status;
   11 
   12 use base qw(LWP::Protocol);
   13 
   14 use HTTP::Date qw(time2str);
   15 require LWP;  # needs version number
   16 
   17 sub request
   18 {
   19     my($self, $request, $proxy, $arg, $size) = @_;
   20 
   21     # check proxy
   22     if (defined $proxy)
   23     {
   24     return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
   25                   'You can not proxy with data');
   26     }
   27 
   28     # check method
   29     my $method = $request->method;
   30     unless ($method eq 'GET' || $method eq 'HEAD') {
   31     return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
   32                   'Library does not allow method ' .
   33                   "$method for 'data:' URLs");
   34     }
   35 
   36     my $url = $request->uri;
   37     my $response = HTTP::Response->new( HTTP::Status::RC_OK, "Document follows");
   38 
   39     my $media_type = $url->media_type;
   40 
   41     my $data = $url->data;
   42     $response->header('Content-Type'   => $media_type,
   43               'Content-Length' => length($data),
   44               'Date'           => time2str(time),
   45               'Server'         => "libwww-perl-internal/$LWP::VERSION"
   46              );
   47 
   48     $data = "" if $method eq "HEAD";
   49     return $self->collect_once($arg, $response, $data);
   50 }
   51 
   52 1;