File Coverage

blib/lib/Amon2/Web.pm
Criterion Covered Total %
statement 89 122 72.9
branch 11 14 78.5
condition 4 13 30.7
subroutine 23 35 65.7
pod 17 20 85.0
total 144 204 70.5


line stmt bran cond sub pod time code
1             use strict;
2 17     17   244282 use warnings;
  17         61  
  17         519  
3 17     17   83 use Amon2::Util ();
  17         37  
  17         434  
4 17     17   740 use Amon2::Trigger qw/add_trigger call_trigger get_trigger_code/;
  17         38  
  17         418  
5 17     17   6485 use Encode ();
  17         48  
  17         1133  
6 17     17   4724 use Plack::Util ();
  17         131101  
  17         357  
7 17     17   1058 use URI::Escape ();
  17         19078  
  17         261  
8 17     17   4041 use Amon2::Web::Request;
  17         13523  
  17         409  
9 17     17   6163 use Amon2::Web::Response;
  17         67  
  17         594  
10 17     17   7354 use Scalar::Util ();
  17         63  
  17         472  
11 17     17   116 use Plack::Util;
  17         42  
  17         290  
12 17     17   105  
  17         48  
  17         2342  
13             # -------------------------------------------------------------------------
14             # Hook points:
15             # You can override these methods.
16              
17 22     22 1 164 BEGIN {
18 47     47 1 200 my $encoding = Encode::find_encoding('utf-8') || die;
  47         262  
19 0     0 1 0 }
20 0     0 1 0  
21             my $self = shift;
22 0     0 1 0 my $klass = ref $self || $self;
23 0         0  
24 17   50 17   165 require Plack::Session;
25 26     26 1 97 no strict 'refs';
26             *{"${klass}::session"} = sub {
27             my $self = shift;
28             $self->{session} ||= Plack::Session->new($self->request->env);
29 0     0 0 0 };
30 0   0     0  
31             return $self->session();
32 0         0 }
33 17     17   4556  
  17         53  
  17         21257  
34 0         0 # -------------------------------------------------------------------------
35 0     0   0 # Attributes:
36 0   0     0  
37 0         0 # -------------------------------------------------------------------------
38             # Methods:
39 0         0  
40             my ($self, $location, $params) = @_;
41             my $url = do {
42             if ($location =~ m{^https?://}i) {
43             $location;
44 40     40 1 162 } else {
45 24     24 1 282 my $url = $self->request->base;
46             $url =~ s{/+$}{};
47             $location =~ s{^/+([^/])}{/$1};
48             $url .= $location;
49             }
50             };
51 9     9 1 43 if (my $ref_params = ref $params) {
52 9         13 if ($ref_params eq 'ARRAY') {
53 9 100       52 my $uri = URI->new($url);
54 7         15 $uri->query_form($uri->query_form, map { Encode::encode($self->encoding, $_) } @$params);
55             $url = $uri->as_string;
56 2         9 } elsif ($ref_params eq 'HASH') {
57 2         7623 my @ary;
58 2         52 my $encoding = $self->encoding;
59 2         6 while (my ($k, $v) = each %$params) {
60             push @ary, Encode::encode($encoding, $k);
61             push @ary, Encode::encode($encoding, $v);
62 9 100       22 }
63 6 100       16 my $uri = URI->new($url);
    50          
64 5         20 $uri->query_form($uri->query_form, @ary);
65 5         344 $url = $uri->as_string;
  10         16218  
66 5         780 }
67             }
68 1         3 return $self->create_response(
69 1         3 302,
70 1         6 ['Location' => $url],
71 1         6 []
72 1         29 );
73             }
74 1         19  
75 1         71 my ($self, $code, $message) = @_;
76 1         253 my $codestr = Plack::Util::encode_html($code);
77             $message = Plack::Util::encode_html($message);
78             my $content = <<"...";
79 9         58 <!doctype html>
80             <html>
81             <head>
82             <meta charset=utf-8 />
83             <title>$codestr $message</title>
84             <style type="text/css">
85             body {
86             text-align: center;
87 0     0 1 0 font-family: 'Menlo', 'Monaco', Courier, monospace;
88 0         0 background-color: whitesmoke;
89 0         0 padding-top: 10%;
90 0         0 }
91             .number {
92             font-size: 800%;
93             font-weight: bold;
94             margin-bottom: 40px;
95             }
96             .message {
97             font-size: 400%;
98             }
99             </style>
100             </head>
101             <body>
102             <div class="number">$codestr</div>
103             <div class="message">$message</div>
104             </body>
105             </html>
106             ...
107             $self->create_response(
108             $code,
109             [
110             'Content-Type' => 'text/html; charset=utf-8',
111             'Content-Length' => length($content),
112             ],
113             [$content]
114             );
115             }
116              
117             my ($self) = @_;
118             return $self->create_simple_status_page(403, 'Forbidden');
119 0         0 }
120              
121             my ($self) = @_;
122             return $self->create_simple_status_page(404, 'File Not Found');
123             }
124              
125             my ($self) = @_;
126             return $self->create_simple_status_page(405, 'Method Not Allowed');
127             }
128              
129             my ($self) = @_;
130 0     0 1 0 return $self->create_simple_status_page(500, 'Internal Server Error');
131 0         0 }
132              
133             my ($class, ) = @_;
134             return sub { $class->handle_request(shift) };
135 0     0 1 0 }
136 0         0  
137             my ($class, $env) = @_;
138              
139             my $req = $class->create_request($env);
140 0     0 1 0 my $self = $class->new(
141 0         0 request => $req,
142             );
143             my $guard = $self->context_guard();
144              
145 0     0 0 0 my $response;
146 0         0 for my $code ($self->get_trigger_code('BEFORE_DISPATCH')) {
147             $response = $code->($self);
148             goto PROCESS_END if Scalar::Util::blessed($response) && $response->isa('Plack::Response');
149             }
150 8     8 1 266 $response = $self->dispatch() or die "cannot get any response";
151 8     22   45 PROCESS_END:
  22         219806  
152             $self->call_trigger('AFTER_DISPATCH' => $response);
153              
154             return $response->finalize;
155 22     22 0 57 }
156              
157 22         83 my ($self, $path, $query) = @_;
158 22         89 my $root = $self->req->{env}->{SCRIPT_NAME} || '/';
159             $root =~ s{([^/])$}{$1/};
160             $path =~ s{^/}{};
161 22         81  
162             my @q;
163 22         35 while (my ($key, $val) = each %$query) {
164 22         107 $val = URI::Escape::uri_escape(Encode::encode($self->encoding, $val));
165 4         11 push @q, "${key}=${val}";
166 4 100 66     165 }
167             $root . $path . (scalar @q ? '?' . join('&', @q) : '');
168 20 50       85 }
169 22         354  
170             my $self = shift;
171             my $html = $self->create_view()->render(@_);
172 22         95  
173             for my $code ($self->get_trigger_code('HTML_FILTER')) {
174             $html = $code->($self, $html);
175             }
176 1     1 1 12  
177 1   50     6 $html = $self->encode_html($html);
178 1         4  
179 1         5 return $self->create_response(
180             200,
181 1         2 [
182 1         12 'Content-Type' => $self->html_content_type,
183 1         4 'Content-Length' => length($html)
184 1         181 ],
185             $html,
186 1 50       22 );
187             }
188              
189             # You can override this method on your application.
190 0     0 1   my ($self, $html) = @_;
191 0           return Encode::encode($self->encoding, $html);
192             }
193 0            
194 0           1;
195              
196             =head1 NAME
197 0            
198             Amon2::Web - Web Application Base.
199 0            
200             =head1 SYNOPSIS
201              
202             package MyApp;
203             use parent qw/Amon2/;
204              
205             package MyApp::Web;
206             use parent qw/MyApp Amon2::Web/;
207              
208             =head1 DESCRIPTION
209              
210             This is a web application base class.
211 0     0 1    
212 0           =head1 METHODS
213              
214             =over 4
215              
216             =item C<< $c->create_request() >>
217              
218             Create new request object from C<< $c >>.
219              
220             You can override this method to change request object's class.
221              
222             =item C<< $c->create_response($code, \@headers, \@body) >>
223              
224             Create new response object.
225              
226             You can override this method to change response object's class.
227              
228             =item C<< $c->create_view() >>
229              
230             Create new view object. View object should have C<< $view->render(@_) >> method.
231              
232             You can override this method to change view object's class.
233              
234             =item C<< $c->dispatch() : Plack::Response >>
235              
236             Do dispatch request. This method must return instance of L<Plack::Response>.
237              
238             You can override this method to change behavior.
239              
240             =item C<< $c->html_content_type() : Str >>
241              
242             Returns default Content-Type value for the HTML response.
243              
244             You can override this method to change behavior.
245              
246             =item C<< $c->request() : Plack::Request >>
247              
248             =item C<< $c->req() : Plack::Request >>
249              
250             This is a accessor method to get the request object in this context.
251              
252             =item C<< $c->redirect($location : Str, \%parameters) : Plack::Response >>
253              
254             Create a response object to redirect for C< $location > with C<< \%parameters >>.
255              
256             $c->redirect('/foo', +{bar => 3})
257              
258             is same as following(if base URL is http://localhost:5000/)
259              
260             $c->create_response(302, [Location => 'http://localhost:5000/foo?bar=3'])
261              
262             =item C<< $c->res_403() >>
263              
264             Create new response object which has 403 status code.
265              
266             =item C<< $c->res_404() >>
267              
268             Create new response object which has 404 status code.
269              
270             =item C<< $c->res_405() >>
271              
272             Create new response object which has 405 status code.
273              
274             =item C<< $c->create_simple_status_page($code, $message) >>
275              
276             Create a new response object which represents specified status code.
277              
278             =item C<< MyApp->to_app() : CodeRef >>
279              
280             Create an instance of PSGI application.
281              
282             =item C<< $c->uri_for($path: Str, \%args) : Str >>
283              
284             Create URI from C<< $path >> and C<< \%args >>.
285              
286             This method returns relative URI.
287              
288             =item C<< $c->render($tmpl[, @args|%args]) : Plack::Web::Response >>
289              
290             This method renders HTML.
291              
292             =item C<< $c->encoding() >>
293              
294             Return a encoding object using C<< Encode::find_encoding() >>.
295              
296             You can override this method to change behavior.
297              
298             =item C<< $c->encode_html($html) : Str >>
299              
300             This method encodes HTML from bytes.
301              
302             You can override this method to change behavior.
303              
304             =back