package HTTP::Status;
use strict;
use warnings;
our $VERSION = '6.29';
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 => 'Payload Too Large',
414 => 'URI Too Long',
415 => 'Unsupported Media Type',
416 => '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 => 'Too Early', # RFC 8470: Using Early Data in HTTP
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 7725: 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
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");
my %compat = (
REQUEST_ENTITY_TOO_LARGE => \&HTTP_PAYLOAD_TOO_LARGE,
REQUEST_URI_TOO_LARGE => \&HTTP_URI_TOO_LONG,
REQUEST_RANGE_NOT_SATISFIABLE => \&HTTP_RANGE_NOT_SATISFIABLE,
NO_CODE => \&HTTP_TOO_EARLY,
UNORDERED_COLLECTION => \&HTTP_TOO_EARLY,
);
foreach my $name (keys %compat) {
push(@EXPORT, "RC_$name");
push(@EXPORT_OK, "HTTP_$name");
no strict 'refs';
*{"RC_$name"} = $compat{$name};
*{"HTTP_$name"} = $compat{$name};
}
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] == 308 # Permanent Redirect
|| $_[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
);
}
1;
=pod
=encoding UTF-8
=head1 NAME
HTTP::Status - HTTP Status code processing
=head1 VERSION
version 6.29
=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
then C