home *** CD-ROM | disk | FTP | other *** search
/ ftp.f-secure.com / 2014.06.ftp.f-secure.com.tar / ftp.f-secure.com / support / hotfix / fsis / IS-SpamControl.fsfix / iufssc / lib / LWP / Protocol / data.pm next >
Text File  |  2006-11-29  |  1KB  |  56 lines
  1. #
  2. # $Id: data.pm 2397 2005-12-23 13:06:15Z kankri $
  3. #
  4. # Implements access to data:-URLs as specified in RFC 2397
  5.  
  6.  
  7. package LWP::Protocol::data;
  8. use strict;
  9. use vars qw(@ISA);
  10.  
  11. require HTTP::Response;
  12. require HTTP::Status;
  13.  
  14. require LWP::Protocol;
  15. @ISA = qw(LWP::Protocol);
  16.  
  17. use HTTP::Date qw(time2str);
  18. require LWP;  # needs version number
  19.  
  20. sub request
  21. {
  22.     my($self, $request, $proxy, $arg, $size) = @_;
  23.  
  24.     # check proxy
  25.     if (defined $proxy)
  26.     {
  27.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  28.                   'You can not proxy with data';
  29.     }
  30.  
  31.     # check method
  32.     my $method = $request->method;
  33.     unless ($method eq 'GET' || $method eq 'HEAD') {
  34.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  35.                   'Library does not allow method ' .
  36.                   "$method for 'data:' URLs";
  37.     }
  38.  
  39.     my $url = $request->url;
  40.     my $response = new HTTP::Response &HTTP::Status::RC_OK, "Document follows";
  41.  
  42.     my $media_type = $url->media_type;
  43.  
  44.     my $data = $url->data;
  45.     $response->header('Content-Type'   => $media_type,
  46.               'Content-Length' => length($data),
  47.               'Date'           => time2str(time),
  48.               'Server'         => "libwww-perl-internal/$LWP::VERSION"
  49.              );
  50.     $response->content($data) if $method ne "HEAD";
  51.  
  52.     return $response;
  53. }
  54.  
  55. 1;
  56.