File Coverage

blib/lib/Dancer/HTTP.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch	2	2	100.0
condition			n/a
subroutine	5	6	83.3
pod	2	2	100.0
total	25	28	89.2

package Dancer::HTTP;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: helper for rendering HTTP status codes for Dancer
$Dancer::HTTP::VERSION = '1.3521';
use strict;
use warnings;
use base 'Exporter';
use vars '@EXPORT_OK';

my %HTTP_CODES = (

    # informational
    # 100 => 'Continue', # only on HTTP 1.1
    # 101 => 'Switching Protocols', # only on HTTP 1.1

    # processed codes
    200 => 'OK',
    201 => 'Created',
    202 => 'Accepted',

    # 203 => 'Non-Authoritative Information', # only on HTTP 1.1
    204 => 'No Content',
    205 => 'Reset Content',
    206 => 'Partial Content',

    # redirections
    301 => 'Moved Permanently',
    302 => 'Found',

    # 303 => '303 See Other', # only on HTTP 1.1
    304 => 'Not Modified',

    # 305 => '305 Use Proxy', # only on HTTP 1.1
    306 => 'Switch Proxy',

    # 307 => '307 Temporary Redirect', # on HTTP 1.1

    # problems with request
    400 => 'Bad Request',
    401 => 'Unauthorized',
    402 => 'Payment Required',
    403 => 'Forbidden',
    404 => 'Not Found',
    405 => 'Method Not Allowed',
    406 => 'Not Acceptable',
    407 => 'Proxy Authentication Required',
    408 => 'Request Timeout',
    409 => 'Conflict',
    410 => 'Gone',
    411 => 'Length Required',
    412 => 'Precondition Failed',
    413 => 'Request Entity Too Large',
    414 => 'Request-URI Too Long',
    415 => 'Unsupported Media Type',
    416 => 'Requested Range Not Satisfiable',
    417 => 'Expectation Failed',

    # problems with server
    500 => 'Internal Server Error',
    501 => 'Not Implemented',
    502 => 'Bad Gateway',
    503 => 'Service Unavailable',
    504 => 'Gateway Timeout',
    505 => 'HTTP Version Not Supported',
);

my %STATUS_TO_CODE = map { my $s = $_; $s =~ s/\W/_/g; lc $s }
                         'error' => 500,        # our alias to 500
                         reverse %HTTP_CODES;


# always return a numeric status code
# if alias, return the corresponding code
sub status {
    my (undef, $name) = @_;

    return $name if $name =~ /^\d+$/;

    $name =~ s/\W/_/g;
    return $STATUS_TO_CODE{lc $name};
}

sub codes {
    my %copy = %HTTP_CODES;
    return \%copy;
}

1;

__END__