File Coverage

blib/lib/HTTP/Throwable/Role/Status/MethodNotAllowed.pm
Criterion Covered Total %
statement 17 17 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod 0 2 0.0
total 24 26 92.3


line stmt bran cond sub pod time code
1             package HTTP::Throwable::Role::Status::MethodNotAllowed 0.028;
2             our $AUTHORITY = 'cpan:STEVAN';
3              
4 2     2   3375 use Type::Utils qw(subtype as where enum);
  2         10717  
  2         22  
5 2     2   1571 use Types::Standard qw(ArrayRef);
  2         6  
  2         9  
6 2     2   1487 use List::Util 1.45 qw[ uniq ];
  2         46  
  2         226  
7              
8 2     2   16 use Moo::Role;
  2         4  
  2         21  
9              
10             with(
11             'HTTP::Throwable',
12             'HTTP::Throwable::Role::BoringText',
13             );
14              
15             my $method_enum_type = enum "HttpThrowableTypeMethod" => [ qw[
16             OPTIONS GET HEAD
17             POST PUT DELETE
18             TRACE CONNECT
19             ] ];
20              
21             # TODO: Consider adding a coersion to upper-case lower-cased strings and to
22             # uniq the given input. -- rjbs, 2011-02-21
23             my $method_list_type = subtype "HttpThrowableTypeMethodList",
24             as ArrayRef[ $method_enum_type ],
25             where { (scalar uniq @{$_}) == (scalar @{$_}) };
26              
27 3     3 0 135 sub default_status_code { 405 }
28 3     3 0 267 sub default_reason { 'Method Not Allowed' }
29              
30             has 'allow' => (
31             is => 'ro',
32             isa => $method_list_type,
33             required => 1
34             );
35              
36             around 'build_headers' => sub {
37             my $next = shift;
38             my $self = shift;
39             my $headers = $self->$next( @_ );
40             push @$headers => ('Allow' => join "," => @{ $self->allow });
41             $headers;
42             };
43              
44              
45 2     2   1152 no Moo::Role; 1;
  2         6  
  2         8  
46              
47             =pod
48              
49             =encoding UTF-8
50              
51             =head1 NAME
52              
53             HTTP::Throwable::Role::Status::MethodNotAllowed - 405 Method Not Allowed
54              
55             =head1 VERSION
56              
57             version 0.028
58              
59             =head1 DESCRIPTION
60              
61             The method specified in the Request-Line is not allowed for the
62             resource identified by the Request-URI. The response MUST include
63             an Allow header containing a list of valid methods for the requested
64             resource.
65              
66             =head1 PERL VERSION
67              
68             This library should run on perls released even a long time ago. It should work
69             on any version of perl released in the last five years.
70              
71             Although it may work on older versions of perl, no guarantee is made that the
72             minimum required version will not be increased. The version may be increased
73             for any reason, and there is no promise that patches will be accepted to lower
74             the minimum required perl.
75              
76             =head1 ATTRIBUTES
77              
78             =head2 allow
79              
80             This is an ArrayRef of HTTP methods, it is required and the HTTP
81             methods will be type checked to ensure validity and uniqueness.
82              
83             =head1 SEE ALSO
84              
85             HTTP Methods - L
86              
87             =head1 AUTHORS
88              
89             =over 4
90              
91             =item *
92              
93             Stevan Little
94              
95             =item *
96              
97             Ricardo Signes
98              
99             =back
100              
101             =head1 COPYRIGHT AND LICENSE
102              
103             This software is copyright (c) 2011 by Infinity Interactive, Inc.
104              
105             This is free software; you can redistribute it and/or modify it under
106             the same terms as the Perl 5 programming language system itself.
107              
108             =cut
109              
110             __END__