home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / HTTP / Status.pm < prev   
Text File  |  1997-05-20  |  5KB  |  203 lines
  1. #
  2. # $Id: Status.pm,v 1.20 1997/05/20 20:31:41 aas Exp $
  3.  
  4. package HTTP::Status;
  5.  
  6. require 5.002;   # becase we use prototypes
  7.  
  8. =head1 NAME
  9.  
  10. HTTP::Status - HTTP Status code processing
  11.  
  12. =head1 SYNOPSIS
  13.  
  14.  use HTTP::Status;
  15.  
  16.  if ($rc != RC_OK) {
  17.      print status_message($rc), "\n";
  18.  }
  19.  
  20.  if (is_success($rc)) { ... }
  21.  if (is_error($rc)) { ... }
  22.  if (is_redirect($rc)) { ... }
  23.  
  24. =head1 DESCRIPTION
  25.  
  26. I<HTTP::Status> is a library of routines for defining and
  27. classification of HTTP status codes for libwww-perl.  Status codes are
  28. used to encode the overall outcome of a HTTP response message.  Codes
  29. correspond to those defined in RFC 2068.
  30.  
  31. =head1 CONSTANTS
  32.  
  33. The following constant functions can be used as mnemonic status code
  34. names:
  35.  
  36.    RC_CONTINUE                (100)
  37.    RC_SWITCHING_PROTOCOLS        (101)
  38.  
  39.    RC_OK                (200)
  40.    RC_CREATED                (201)
  41.    RC_ACCEPTED                (202)
  42.    RC_NON_AUTHORITATIVE_INFORMATION    (203)
  43.    RC_NO_CONTENT            (204)
  44.    RC_RESET_CONTENT            (205)
  45.    RC_PARTIAL_CONTENT            (206)
  46.  
  47.    RC_MULTIPLE_CHOICES            (300)
  48.    RC_MOVED_PERMANENTLY            (301)
  49.    RC_MOVED_TEMPORARILY            (302)
  50.    RC_SEE_OTHER                (303)
  51.    RC_NOT_MODIFIED            (304)
  52.    RC_USE_PROXY                (305)
  53.  
  54.    RC_BAD_REQUEST            (400)
  55.    RC_UNAUTHORIZED            (401)
  56.    RC_PAYMENT_REQUIRED            (402)
  57.    RC_FORBIDDEN                (403)
  58.    RC_NOT_FOUND                (404)
  59.    RC_METHOD_NOT_ALLOWED        (405)
  60.    RC_NOT_ACCEPTABLE            (406)
  61.    RC_PROXY_AUTHENTICATION_REQUIRED    (407)
  62.    RC_REQUEST_TIMEOUT            (408)
  63.    RC_CONFLICT                (409)
  64.    RC_GONE                (410)
  65.    RC_LENGTH_REQUIRED            (411)
  66.    RC_PRECONDITION_FAILED        (412)
  67.    RC_REQUEST_ENTITY_TOO_LARGE        (413)
  68.    RC_REQUEST_URI_TOO_LARGE        (414)
  69.    RC_UNSUPPORTED_MEDIA_TYPE        (415)
  70.  
  71.    RC_INTERNAL_SERVER_ERROR        (500)
  72.    RC_NOT_IMPLEMENTED            (501)
  73.    RC_BAD_GATEWAY            (502)
  74.    RC_SERVICE_UNAVAILABLE        (503)
  75.    RC_GATEWAY_TIMEOUT            (504)
  76.    RC_HTTP_VERSION_NOT_SUPPORTED    (505)
  77.  
  78. =cut
  79.  
  80. #####################################################################
  81.  
  82.  
  83. require Exporter;
  84. @ISA = qw(Exporter);
  85. @EXPORT = qw(is_info is_success is_redirect is_error status_message);
  86. @EXPORT_OK = qw(is_client_error is_server_error);
  87.  
  88. # Note also addition of mnemonics to @EXPORT below
  89.  
  90. my %StatusCode = (
  91.     100 => 'Continue',
  92.     101 => 'Switching Protocols',
  93.     200 => 'OK',
  94.     201 => 'Created',
  95.     202 => 'Accepted',
  96.     203 => 'Non-Authoritative Information',
  97.     204 => 'No Content',
  98.     205 => 'Reset Content',
  99.     206 => 'Partial Content',
  100.     300 => 'Multiple Choices',
  101.     301 => 'Moved Permanently',
  102.     302 => 'Moved Temporarily',
  103.     303 => 'See Other',
  104.     304 => 'Not Modified',
  105.     305 => 'Use Proxy',
  106.     400 => 'Bad Request',
  107.     401 => 'Unauthorized',
  108.     402 => 'Payment Required',
  109.     403 => 'Forbidden',
  110.     404 => 'Not Found',
  111.     405 => 'Method Not Allowed',
  112.     406 => 'Not Acceptable',
  113.     407 => 'Proxy Authentication Required',
  114.     408 => 'Request Timeout',
  115.     409 => 'Conflict',
  116.     410 => 'Gone',
  117.     411 => 'Length Required',
  118.     412 => 'Precondition Failed',
  119.     413 => 'Request Entity Too Large',
  120.     414 => 'Request-URI Too Large',
  121.     415 => 'Unsupported Media Type',
  122.     500 => 'Internal Server Error',
  123.     501 => 'Not Implemented',
  124.     502 => 'Bad Gateway',
  125.     503 => 'Service Unavailable',
  126.     504 => 'Gateway Timeout',
  127.     505 => 'HTTP Version Not Supported',
  128. );
  129.  
  130. my $mnemonicCode = '';
  131. my ($code, $message);
  132. while (($code, $message) = each %StatusCode) {
  133.     # create mnemonic subroutines
  134.     $message =~ tr/a-z \-/A-Z__/;
  135.     $mnemonicCode .= "sub RC_$message () { $code }\t";
  136.     # make them exportable
  137.     $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n";
  138. }
  139. # warn $mnemonicCode; # for development
  140. eval $mnemonicCode; # only one eval for speed
  141. die if $@;
  142.  
  143. =head1 FUNCTIONS
  144.  
  145. The following additional functions are provided.  Most of them are
  146. exported by default.
  147.  
  148. =over 4
  149.  
  150. =item status_message($code)
  151.  
  152. The status_message() function will translate status codes to human
  153. readable strings. The string is the same as found in the constant
  154. names above.
  155.  
  156. =cut
  157.  
  158. sub status_message ($)
  159. {
  160.     return undef unless exists $StatusCode{$_[0]};
  161.     $StatusCode{$_[0]};
  162. }
  163.  
  164. =item is_info($code)
  165.  
  166. Return TRUE if C<$code> is an I<Informational> status code.
  167.  
  168. =item is_success($code)
  169.  
  170. Return TRUE if C<$code> is a I<Successful> status code.
  171.  
  172. =item is_redirect($code)
  173.  
  174. Return TRUE if C<$code> is a I<Redirection> status code.
  175.  
  176. =item is_error($code)
  177.  
  178. Return TRUE if C<$code> is an I<Error> status code.  The function
  179. return TRUE for both client error or a server error status codes.
  180.  
  181. =item is_client_error($code)
  182.  
  183. Return TRUE if C<$code> is an I<Client Error> status code.  This
  184. function is B<not> exported by default.
  185.  
  186. =item is_server_error($code)
  187.  
  188. Return TRUE if C<$code> is an I<Server Error> status code.   This
  189. function is B<not> exported by default.
  190.  
  191. =back
  192.  
  193. =cut
  194.  
  195. sub is_info         ($) { $_[0] >= 100 && $_[0] < 200; }
  196. sub is_success      ($) { $_[0] >= 200 && $_[0] < 300; }
  197. sub is_redirect     ($) { $_[0] >= 300 && $_[0] < 400; }
  198. sub is_error        ($) { $_[0] >= 400 && $_[0] < 600; }
  199. sub is_client_error ($) { $_[0] >= 400 && $_[0] < 500; }
  200. sub is_server_error ($) { $_[0] >= 500 && $_[0] < 600; }
  201.  
  202. 1;
  203.