22

✏️ Editing: Status.pm

package HTTP::Status;

use strict;
use warnings;

our $VERSION = '6.18';

require 5.002;   # because we use prototypes

use base 'Exporter';
our @EXPORT = qw(is_info is_success is_redirect is_error status_message);
our @EXPORT_OK = qw(is_client_error is_server_error is_cacheable_by_default);

# Note also addition of mnemonics to @EXPORT below

# Unmarked codes are from RFC 7231 (2017-12-20)
# See also:
# https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml

my %StatusCode = (
    100 => 'Continue',
    101 => 'Switching Protocols',
    102 => 'Processing',                      # RFC 2518: WebDAV
    103 => 'Early Hints',                     # RFC 8297: Indicating Hints
#   104 .. 199
    200 => 'OK',
    201 => 'Created',
    202 => 'Accepted',
    203 => 'Non-Authoritative Information',
    204 => 'No Content',
    205 => 'Reset Content',
    206 => 'Partial Content',                 # RFC 7233: Range Requests
    207 => 'Multi-Status',                    # RFC 4918: WebDAV
    208 => 'Already Reported',                # RFC 5842: WebDAV bindings
#   209 .. 225
    226 => 'IM used',                         # RFC 3229: Delta encoding
#   227 .. 299
    300 => 'Multiple Choices',
    301 => 'Moved Permanently',
    302 => 'Found',
    303 => 'See Other',
    304 => 'Not Modified',                    # RFC 7232: Conditional Request
    305 => 'Use Proxy',
    307 => 'Temporary Redirect',
    308 => 'Permanent Redirect',              # RFC 7528: Permanent Redirect
#   309 .. 399
    400 => 'Bad Request',
    401 => 'Unauthorized',                    # RFC 7235: Authentication
    402 => 'Payment Required',
    403 => 'Forbidden',
    404 => 'Not Found',
    405 => 'Method Not Allowed',
    406 => 'Not Acceptable',
    407 => 'Proxy Authentication Required',   # RFC 7235: Authentication
    408 => 'Request Timeout',
    409 => 'Conflict',
    410 => 'Gone',
    411 => 'Length Required',
    412 => 'Precondition Failed',             # RFC 7232: Conditional Request
    413 => 'Request Entity Too Large',
    414 => 'Request-URI Too Large',
    415 => 'Unsupported Media Type',
    416 => 'Request Range Not Satisfiable',   # RFC 7233: Range Requests
    417 => 'Expectation Failed',
#   418 .. 420
    421 => 'Misdirected Request',             # RFC 7540: HTTP/2
    422 => 'Unprocessable Entity',            # RFC 4918: WebDAV
    423 => 'Locked',                          # RFC 4918: WebDAV
    424 => 'Failed Dependency',               # RFC 4918: WebDAV
#   425
    426 => 'Upgrade Required',
#   427
    428 => 'Precondition Required',           # RFC 6585: Additional Codes
    429 => 'Too Many Requests',               # RFC 6585: Additional Codes
#   430
    431 => 'Request Header Fields Too Large', # RFC 6585: Additional Codes
#   432 .. 450
    451 => 'Unavailable For Legal Reasons',   # RFC 7724: Legal Obstacles
#   452 .. 499
    500 => 'Internal Server Error',
    501 => 'Not Implemented',
    502 => 'Bad Gateway',
    503 => 'Service Unavailable',
    504 => 'Gateway Timeout',
    505 => 'HTTP Version Not Supported',
    506 => 'Variant Also Negotiates',         # RFC 2295: Transparant Ngttn
    507 => 'Insufficient Storage',            # RFC 4918: WebDAV
    508 => 'Loop Detected',                   # RFC 5842: WebDAV bindings
#   509
    510 => 'Not Extended',                    # RFC 2774: Extension Framework
    511 => 'Network Authentication Required', # RFC 6585: Additional Codes
);

# keep some unofficial codes that used to be in this distribution
%StatusCode = (
    %StatusCode,
    418 => 'I\'m a teapot',                   # RFC 2324: HTCPC/1.0  1-april
    425 => 'Unordered Collection',            #           WebDAV Draft
    449 => 'Retry with',                      #           microsoft
    509 => 'Bandwidth Limit Exceeded',        #           Apache / cPanel
);

my $mnemonicCode = '';
my ($code, $message);
while (($code, $message) = each %StatusCode) {
    # create mnemonic subroutines
    $message =~ s/I'm/I am/;
    $message =~ tr/a-z \-/A-Z__/;
    $mnemonicCode .= "sub HTTP_$message () { $code }\n";
    $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n";  # legacy
    $mnemonicCode .= "push(\@EXPORT_OK, 'HTTP_$message');\n";
    $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n";
}
eval $mnemonicCode; # only one eval for speed
die if $@;

# backwards compatibility
*RC_MOVED_TEMPORARILY = \&RC_FOUND;  # 302 was renamed in the standard
push(@EXPORT, "RC_MOVED_TEMPORARILY");

*RC_NO_CODE = \&RC_UNORDERED_COLLECTION;
push(@EXPORT, "RC_NO_CODE");

our %EXPORT_TAGS = (
   constants => [grep /^HTTP_/, @EXPORT_OK],
   is => [grep /^is_/, @EXPORT, @EXPORT_OK],
);

sub status_message  ($) { $StatusCode{$_[0]}; }

sub is_info                 ($) { $_[0] && $_[0] >= 100 && $_[0] < 200; }
sub is_success              ($) { $_[0] && $_[0] >= 200 && $_[0] < 300; }
sub is_redirect             ($) { $_[0] && $_[0] >= 300 && $_[0] < 400; }
sub is_error                ($) { $_[0] && $_[0] >= 400 && $_[0] < 600; }
sub is_client_error         ($) { $_[0] && $_[0] >= 400 && $_[0] < 500; }
sub is_server_error         ($) { $_[0] && $_[0] >= 500 && $_[0] < 600; }
sub is_cacheable_by_default ($) { $_[0] && ( $_[0] == 200 # OK
                                          || $_[0] == 203 # Non-Authoritative Information
                                          || $_[0] == 204 # No Content
                                          || $_[0] == 206 # Not Acceptable
                                          || $_[0] == 300 # Multiple Choices
                                          || $_[0] == 301 # Moved Permanently
                                          || $_[0] == 404 # Not Found
                                          || $_[0] == 405 # Method Not Allowed
                                          || $_[0] == 410 # Gone
                                          || $_[0] == 414 # Request-URI Too Large
                                          || $_[0] == 451 # Unavailable For Legal Reasons
                                          || $_[0] == 501 # Not Implemented
                                            );
}

=pod

=encoding UTF-8

=head1 NAME

HTTP::Status - HTTP Status code processing

=head1 VERSION

version 6.18

=head1 SYNOPSIS

use HTTP::Status qw(:constants :is status_message);

if ($rc != HTTP_OK) {
     print status_message($rc), "\n";
 }

if (is_success($rc)) { ... }
 if (is_error($rc)) { ... }
 if (is_redirect($rc)) { ... }

=head1 DESCRIPTION

I<HTTP::Status> is a library of routines for defining and
classifying HTTP status codes for libwww-perl.  Status codes are
used to encode the overall outcome of an HTTP response message.  Codes
correspond to those defined in RFC 2616 and RFC 2518.

=head1 CONSTANTS

The following constant functions can be used as mnemonic status code
names.  None of these are exported by default.  Use the C<:constants>
tag to import them all.

HTTP_CONTINUE                        (100)
   HTTP_SWITCHING_PROTOCOLS             (101)
   HTTP_PROCESSING                      (102)
   HTTP_EARLY_HINTS                     (103)

HTTP_OK                              (200)
   HTTP_CREATED                         (201)
   HTTP_ACCEPTED                        (202)
   HTTP_NON_AUTHORITATIVE_INFORMATION   (203)
   HTTP_NO_CONTENT                      (204)
   HTTP_RESET_CONTENT                   (205)
   HTTP_PARTIAL_CONTENT                 (206)
   HTTP_MULTI_STATUS                    (207)
   HTTP_ALREADY_REPORTED                (208)

HTTP_IM_USED                         (226)

HTTP_MULTIPLE_CHOICES                (300)
   HTTP_MOVED_PERMANENTLY               (301)
   HTTP_FOUND                           (302)
   HTTP_SEE_OTHER                       (303)
   HTTP_NOT_MODIFIED                    (304)
   HTTP_USE_PROXY                       (305)
   HTTP_TEMPORARY_REDIRECT              (307)
   HTTP_PERMANENT_REDIRECT              (308)

HTTP_BAD_REQUEST                     (400)
   HTTP_UNAUTHORIZED                    (401)
   HTTP_PAYMENT_REQUIRED                (402)
   HTTP_FORBIDDEN                       (403)
   HTTP_NOT_FOUND                       (404)
   HTTP_METHOD_NOT_ALLOWED              (405)
   HTTP_NOT_ACCEPTABLE                  (406)
   HTTP_PROXY_AUTHENTICATION_REQUIRED   (407)
   HTTP_REQUEST_TIMEOUT                 (408)
   HTTP_CONFLICT                        (409)
   HTTP_GONE                            (410)
   HTTP_LENGTH_REQUIRED                 (411)
   HTTP_PRECONDITION_FAILED             (412)
   HTTP_REQUEST_ENTITY_TOO_LARGE        (413)
   HTTP_REQUEST_URI_TOO_LARGE           (414)
   HTTP_UNSUPPORTED_MEDIA_TYPE          (415)
   HTTP_REQUEST_RANGE_NOT_SATISFIABLE   (416)
   HTTP_EXPECTATION_FAILED              (417)
   HTTP_MISDIRECTED REQUEST             (421)
   HTTP_UNPROCESSABLE_ENTITY            (422)
   HTTP_LOCKED                          (423)
   HTTP_FAILED_DEPENDENCY               (424)
   HTTP_UPGRADE_REQUIRED                (426)
   HTTP_PRECONDITION_REQUIRED           (428)
   HTTP_TOO_MANY_REQUESTS               (429)
   HTTP_REQUEST_HEADER_FIELDS_TOO_LARGE (431)
   HTTP_UNAVAILABLE_FOR_LEGAL_REASONS   (451)

HTTP_INTERNAL_SERVER_ERROR           (500)
   HTTP_NOT_IMPLEMENTED                 (501)
   HTTP_BAD_GATEWAY                     (502)
   HTTP_SERVICE_UNAVAILABLE             (503)
   HTTP_GATEWAY_TIMEOUT                 (504)
   HTTP_HTTP_VERSION_NOT_SUPPORTED      (505)
   HTTP_VARIANT_ALSO_NEGOTIATES         (506)
   HTTP_INSUFFICIENT_STORAGE            (507)
   HTTP_LOOP_DETECTED                   (508)
   HTTP_NOT_EXTENDED                    (510)
   HTTP_NETWORK_AUTHENTICATION_REQUIRED (511)

=head1 FUNCTIONS

The following additional functions are provided.  Most of them are
exported by default.  The C<:is> import tag can be used to import all
the classification functions.

=over 4

=item status_message( $code )

The status_message() function will translate status codes to human
readable strings. The string is the same as found in the constant
names above. If the $code is not registered in the L<list of IANA HTTP Status
Codes|https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml>
then C<undef> is returned.

=item is_info( $code )

Return TRUE if C<$code> is an I<Informational> status code (1xx).  This
class of status code indicates a provisional response which can't have
any content.

=item is_success( $code )

Return TRUE if C<$code> is a I<Successful> status code (2xx).

=item is_redirect( $code )

Return TRUE if C<$code> is a I<Redirection> status code (3xx). This class of
status code indicates that further action needs to be taken by the
user agent in order to fulfill the request.

=item is_error( $code )

Return TRUE if C<$code> is an I<Error> status code (4xx or 5xx).  The function
returns TRUE for both client and server error status codes.

=item is_client_error( $code )

Return TRUE if C<$code> is a I<Client Error> status code (4xx). This class
of status code is intended for cases in which the client seems to have
erred.

This function is B<not> exported by default.

=item is_server_error( $code )

Return TRUE if C<$code> is a I<Server Error> status code (5xx). This class
of status codes is intended for cases in which the server is aware
that it has erred or is incapable of performing the request.

This function is B<not> exported by default.

=item is_cacheable_by_default( $code )

Return TRUE if C<$code> indicates that a response is cacheable by default, and
it can be reused by a cache with heuristic expiration. All other status codes
are not cacheable by default. See L<RFC 7231 - HTTP/1.1 Semantics and Content,
Section 6.1. Overview of Status Codes|https://tools.ietf.org/html/rfc7231#section-6.1>.

This function is B<not> exported by default.

=back

=head1 SEE ALSO

L<IANA HTTP Status Codes|https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml>

=head1 BUGS

For legacy reasons all the C<HTTP_> constants are exported by default
with the prefix C<RC_>.  It's recommended to use explicit imports and
the C<:constants> tag instead of relying on this.

=head1 AUTHOR

Gisle Aas <gisle@activestate.com>

=head1 COPYRIGHT AND LICENSE

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__

#ABSTRACT: HTTP Status code processing

MR SKB