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


line stmt bran cond sub pod time code
1             package Dancer::HTTP;
2             our $AUTHORITY = 'cpan:SUKRIA';
3             #ABSTRACT: helper for rendering HTTP status codes for Dancer
4             $Dancer::HTTP::VERSION = '1.3514_04'; # TRIAL
5             $Dancer::HTTP::VERSION = '1.351404';
6 191     191   55066 use strict;
  191         363  
  191         4733  
7 191     191   819 use warnings;
  191         316  
  191         4215  
8 191     191   896 use base 'Exporter';
  191         321  
  191         16266  
9 191     191   1215 use vars '@EXPORT_OK';
  191         375  
  191         51758  
10              
11             my %HTTP_CODES = (
12              
13             # informational
14             # 100 => 'Continue', # only on HTTP 1.1
15             # 101 => 'Switching Protocols', # only on HTTP 1.1
16              
17             # processed codes
18             200 => 'OK',
19             201 => 'Created',
20             202 => 'Accepted',
21              
22             # 203 => 'Non-Authoritative Information', # only on HTTP 1.1
23             204 => 'No Content',
24             205 => 'Reset Content',
25             206 => 'Partial Content',
26              
27             # redirections
28             301 => 'Moved Permanently',
29             302 => 'Found',
30              
31             # 303 => '303 See Other', # only on HTTP 1.1
32             304 => 'Not Modified',
33              
34             # 305 => '305 Use Proxy', # only on HTTP 1.1
35             306 => 'Switch Proxy',
36              
37             # 307 => '307 Temporary Redirect', # on HTTP 1.1
38              
39             # problems with request
40             400 => 'Bad Request',
41             401 => 'Unauthorized',
42             402 => 'Payment Required',
43             403 => 'Forbidden',
44             404 => 'Not Found',
45             405 => 'Method Not Allowed',
46             406 => 'Not Acceptable',
47             407 => 'Proxy Authentication Required',
48             408 => 'Request Timeout',
49             409 => 'Conflict',
50             410 => 'Gone',
51             411 => 'Length Required',
52             412 => 'Precondition Failed',
53             413 => 'Request Entity Too Large',
54             414 => 'Request-URI Too Long',
55             415 => 'Unsupported Media Type',
56             416 => 'Requested Range Not Satisfiable',
57             417 => 'Expectation Failed',
58              
59             # problems with server
60             500 => 'Internal Server Error',
61             501 => 'Not Implemented',
62             502 => 'Bad Gateway',
63             503 => 'Service Unavailable',
64             504 => 'Gateway Timeout',
65             505 => 'HTTP Version Not Supported',
66             );
67              
68             my %STATUS_TO_CODE = map { my $s = $_; $s =~ s/\W/_/g; lc $s }
69             'error' => 500, # our alias to 500
70             reverse %HTTP_CODES;
71              
72              
73             # always return a numeric status code
74             # if alias, return the corresponding code
75             sub status {
76 60     60 1 8448 my (undef, $name) = @_;
77              
78 60 100       351 return $name if $name =~ /^\d+$/;
79              
80 13         35 $name =~ s/\W/_/g;
81 13         77 return $STATUS_TO_CODE{lc $name};
82             }
83              
84             sub codes {
85 0     0 1   my %copy = %HTTP_CODES;
86 0           return \%copy;
87             }
88              
89             1;
90              
91             __END__