File Coverage

blib/lib/HiD/Server.pm
Criterion Covered Total %
statement 35 39 89.7
branch 11 14 78.5
condition 7 14 50.0
subroutine 7 9 77.7
pod 5 5 100.0
total 65 81 80.2


line stmt bran cond sub pod time code
1             # ABSTRACT: Helper for 'hid server'
2              
3              
4             package HiD::Server;
5             our $AUTHORITY = 'cpan:GENEHACK';
6             $HiD::Server::VERSION = '1.991';
7 5     5   47784 use 5.014; # strict, unicode_strings
  5         22  
8 5     5   24 use warnings;
  5         9  
  5         127  
9              
10 5     5   26 use parent 'Plack::App::File';
  5         10  
  5         26  
11              
12              
13             sub locate_file {
14 13     13 1 34392 my ($self, $env) = @_;
15              
16 13   50     60 my $path = $env->{PATH_INFO} || '';
17              
18 13 50       59 $path =~ s|^/|| unless $path eq '/';
19              
20 13 50 33     119 if ( -e -d $path and $path !~ m|/$| ) {
21 0         0 $path .= '/';
22 0         0 $env->{PATH_INFO} .= '/';
23             }
24              
25 13 50 33     52 $env->{PATH_INFO} .= 'index.html'
26             if ( $path && $path =~ m|/$| );
27              
28 13         42 return $self->SUPER::locate_file( $env );
29             }
30              
31              
32             sub return_400 {
33 0     0 1 0 return $_[0]->_error_code_handler(400)
34             }
35              
36              
37             sub return_403 {
38 0     0 1 0 return $_[0]->_error_code_handler(403)
39             }
40              
41              
42             sub return_404 {
43 9     9 1 388 return $_[0]->_error_code_handler(404)
44             }
45              
46              
47             sub serve_path {
48 4     4 1 110 my ($self, $env, $file) = @_;
49              
50 4         13 my $response = $self->SUPER::serve_path( $env, $file );
51              
52 4         463 my $alternate_status = delete $self->{use_http_status_of};
53              
54 4 100 66     23 $response->[0] = $alternate_status
55             if ( $response->[0] == 200 && $alternate_status );
56              
57 4         20 return $response;
58             }
59              
60             sub _error_code_handler {
61 9     9   17 my ($self, $code) = @_;
62              
63             #default page name e.g. 404.html
64 9         21 my $default_page = "$code.html";
65              
66 9         14 my $super = "SUPER::return_$code";
67 9 100       50 return $self->$super()
68             if ( grep /^searching/, keys %$self );
69              
70             #stack of possible error pages to search
71 5         12 my @search = ( $default_page );
72              
73             #if a custom page added via the config push it onto the stack
74 5         12 my $custom_page = $self->{error_pages}->{$code};
75              
76 5 100 66     21 push @search, $custom_page
77             if ( $custom_page && lc($custom_page) ne lc($default_page) );
78              
79 5         13 while ( my $page = pop( @search ) ) {
80             #set the flag so we know what we're searching for
81 7         17 $self->{'searching_'.$page} = 1;
82 7         25 my ($file, $path_info) =
83             $self->locate_file( { PATH_INFO => '/'.$page });
84              
85             #done searching now in any case
86 7         205 delete $self->{'searching_'.$page};
87              
88             #the Array ref indicates file not found let's check the next file
89 7 100       24 next if ( ref $file eq 'ARRAY' );
90              
91             #set the http error response code for use in the actual response
92 3         8 $self->{use_http_status_of} = $code;
93 3         14 return ( $file, $path_info );
94             }
95             #found no custom or default error page lets return the default Plack error message;
96 2         6 return $self->$super();
97             }
98              
99             1;
100              
101             __END__
102              
103             =pod
104              
105             =encoding UTF-8
106              
107             =head1 NAME
108              
109             HiD::Server - Helper for 'hid server'
110              
111             =head1 DESCRIPTION
112              
113             Helper for C<hid server>
114              
115             =head1 METHODS
116              
117             =head2 locate_file
118              
119             Overrides L<Plack::App::File>'s method of the same name to handle '/' and
120             '/index.html' cases
121              
122             =head2 return_400
123              
124             Overrides L<Plack::App::File>'s 400 handler to return either configured or
125             default html page instead of the default message
126              
127             =head2 return_403
128              
129             Overrides L<Plack::App::File>'s 403 handler to return either configured or
130             default html page instead of the default message
131              
132             =head2 return_404
133              
134             Overrides L<Plack::App::File>'s 404 handler to return either configured or
135             default html page instead of the default message
136              
137             =head2 serve_path
138              
139             Overrides L<Plack::App::File>'s serve_path method
140             to put in alternate http response codes
141              
142             =head1 VERSION
143              
144             version 1.991
145              
146             =head1 AUTHOR
147              
148             John SJ Anderson <genehack@genehack.org>
149              
150             =head1 COPYRIGHT AND LICENSE
151              
152             This software is copyright (c) 2015 by John SJ Anderson.
153              
154             This is free software; you can redistribute it and/or modify it under
155             the same terms as the Perl 5 programming language system itself.
156              
157             =cut