git.maemo.org Git - dh-make-perl/blob - dev/i386/libwww-perl/libwww-perl-5.813/lib/LWP/Protocol/nogo.pm

   1 package LWP::Protocol::nogo;
   2 # If you want to disable access to a particular scheme, use this
   3 # class and then call
   4 #   LWP::Protocol::implementor(that_scheme, 'LWP::Protocol::nogo');
   5 # For then on, attempts to access URLs with that scheme will generate
   6 # a 500 error.
   7
   8 use strict;
   9 use vars qw(@ISA);
  10 require HTTP::Response;
  11 require HTTP::Status;
  12 require LWP::Protocol;
  13 @ISA = qw(LWP::Protocol);
  14
  15 sub request {
  16     my($self, $request) = @_;
  17     my $scheme = $request->url->scheme;
  18
  19     return HTTP::Response->new(
  20       &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  21       "Access to \'$scheme\' URIs has been disabled"
  22     );
  23 }
  24 1;