Added status_constant_name() and clarified what status_message() returns

Author: neilb

Changes

@@ -2,6 +2,10 @@ Revision history for HTTP-Message
 
 {{$NEXT}}
     - Remove Travis config (GH#180) (Olaf Alders)
+    - Added status_constant_name() which maps status code
+      to the name of the corresponding constant. (GH#160) (Neil Bowers)
+    - Updated the doc for status_message() to clarify that it
+      returns "Not Found" and not "HTTP_NOT_FOUND". (GH#160) (Neil Bowers)
 
 6.38      2022-10-06 21:48:18Z
     - Replace "base" with "parent" (GH#176) (James Raspass)

lib/HTTP/Status.pm

@@ -8,7 +8,7 @@ our $VERSION = '6.39';
 use Exporter 5.57 'import';
 
 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);
+our @EXPORT_OK = qw(is_client_error is_server_error is_cacheable_by_default status_constant_name);
 
 # Note also addition of mnemonics to @EXPORT below
 
@@ -90,6 +90,8 @@ my %StatusCode = (
     511 => 'Network Authentication Required', # RFC 6585: Additional Codes
 );
 
+my %StatusCodeName;
+
 # keep some unofficial codes that used to be in this distribution
 %StatusCode = (
     %StatusCode,
@@ -104,10 +106,12 @@ 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";
+    my $constant_name = "HTTP_".$message;
+    $mnemonicCode .= "sub $constant_name () { $code }\n";
     $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n";  # legacy
     $mnemonicCode .= "push(\@EXPORT_OK, 'HTTP_$message');\n";
     $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n";
+    $StatusCodeName{$code} = $constant_name
 }
 eval $mnemonicCode; # only one eval for speed
 die if $@;
@@ -139,6 +143,9 @@ our %EXPORT_TAGS = (
 
 
 sub status_message  ($) { $StatusCode{$_[0]}; }
+sub status_constant_name ($) {
+    exists($StatusCodeName{$_[0]}) ? $StatusCodeName{$_[0]} : undef;
+}
 
 sub is_info                 ($) { $_[0] && $_[0] >= 100 && $_[0] < 200; }
 sub is_success              ($) { $_[0] && $_[0] >= 200 && $_[0] < 300; }
@@ -273,7 +280,20 @@ the classification functions.
 
 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
+names above.
+For example, C<status_message(303)> will return C<"Not Found">.
+
+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 status_constant_name( $code )
+
+The status_constant_name() function will translate a status code
+to a string which has the name of the constant for that status code.
+For example, C<status_constant_name(404)> will return C<"HTTP_NOT_FOUND">.
+
+If the C<$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.
 

t/status.t

@@ -2,9 +2,9 @@ use strict;
 use warnings;
 
 use Test::More;
-plan tests => 49;
+plan tests => 52;
 
-use HTTP::Status qw(:constants :is status_message);
+use HTTP::Status qw(:constants :is status_message status_constant_name);
 
 is(HTTP_OK, 200);
 
@@ -52,3 +52,7 @@ ok(is_cacheable_by_default($_),
 ok(!is_cacheable_by_default($_),
   "... is not cacheable [$_] " . status_message($_)
 ) for (100,201,302,400,500);
+
+is(status_constant_name(HTTP_OK), "HTTP_OK");
+is(status_constant_name(404),     "HTTP_NOT_FOUND");
+is(status_constant_name(999),     undef);