File Coverage

blib/lib/HTTP/Response/Maker/Base.pm
Criterion Covered Total %
statement 37 37 100.0
branch 8 8 100.0
condition 7 8 87.5
subroutine 127 127 100.0
pod n/a
total 179 180 99.4


line stmt bran cond sub pod time code
1             package HTTP::Response::Maker::Base;
2 3     3   1537 use strict;
  3         7  
  3         84  
3 3     3   13 use warnings;
  3         7  
  3         113  
4 3     3   428719 use HTTP::Status qw(:constants status_message);
  3         8114  
  3         1942  
5 3     3   1805 use Sub::Name;
  3         1420  
  3         448  
6              
7             sub import {
8 4     4   40 my ($class, %args) = @_;
9 4         12 my $pkg = caller;
10              
11 4   100     34 my $prefix = delete $args{prefix} || '';
12 4         10 my $default_headers = delete $args{default_headers};
13 4         9 foreach my $constant (@HTTP::Status::EXPORT) {
14 256 100       1231 (my $name = $constant) =~ s/^RC_/$prefix/ or next;
15 3     3   20 no strict 'refs';
  3         6  
  3         1047  
16 236         1412 *{"$pkg\::$name"} = subname "$pkg\::$name"
  236         6710  
17 236         360 => $class->_make_response_function(&{"HTTP::Status::$constant"}, $default_headers, \%args);
18             }
19             }
20              
21             sub _make_response_function {
22 236     236   347 my ($class, $code, $default_headers, $import_option) = @_;
23              
24             return sub {
25 9     9   235 my @args = $class->_expand_args($code, $default_headers, @_);
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        9      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
        6      
26 9         59 return $class->_make_response(@args, $import_option);
27 236         2040 };
28             }
29              
30             sub _expand_args {
31 9     9   18 my $class = shift;
32 9         14 my $code = shift;
33 9   66     208 my $default_headers = shift || do {
34             require HTTP::Response::Maker;
35             \@HTTP::Response::Maker::DefaultHeaders;
36             };
37              
38 9 100       48 my $headers = ref $_[0] eq 'ARRAY' ? shift : [ @$default_headers ];
39 9         19 my $content = shift;
40 9         38 my $message = status_message($code);
41              
42 9 100       75 $content = "$code $message" if not defined $content;
43 9 100 100     73 $content = '' if $code == HTTP_NO_CONTENT || $code == HTTP_NOT_MODIFIED;
44              
45 9         48 return ( $code, $message, $headers, $content );
46             }
47              
48             1;
49              
50             __END__