home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _8080d7abf26ade37891012e04c510c5c < prev    next >
Encoding:
Text File  |  2004-06-01  |  654 b   |  25 lines
  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;
  25.