Commit | Line | Data |
5c33dda5 |
1 | package Web::Simple::Application; |
2 | |
975048a1 |
3 | use Scalar::Util 'weaken'; |
4 | |
8bd060f4 |
5 | use Moo; |
5c33dda5 |
6 | |
876e62e1 |
7 | has 'config' => ( |
8 | is => 'ro', |
9 | default => sub { |
10 | my ($self) = @_; |
11 | +{ $self->default_config } |
12 | }, |
13 | trigger => sub { |
14 | my ($self, $value) = @_; |
15 | my %default = $self->default_config; |
16 | my @not = grep !exists $value->{$_}, keys %default; |
17 | @{$value}{@not} = @default{@not}; |
18 | } |
19 | ); |
5c33dda5 |
20 | |
445b3ea0 |
21 | sub default_config { () } |
39119082 |
22 | |
445b3ea0 |
23 | has '_dispatcher' => (is => 'lazy'); |
5c33dda5 |
24 | |
445b3ea0 |
25 | sub _build__dispatcher { |
26 | my $self = shift; |
27 | require Web::Dispatch; |
445b3ea0 |
28 | my $final = $self->_build_final_dispatcher; |
b5b4423b |
29 | |
30 | # We need to weaken both the copy of $self that the |
31 | # app parameter will close over and the copy that'll |
32 | # be passed through as a node argument. |
33 | # |
34 | # To ensure that this doesn't then result in us being |
35 | # DESTROYed unexpectedly early, our to_psgi_app method |
36 | # closes back over $self |
37 | |
38 | weaken($self); |
1f8cad5e |
39 | my %dispatch_args = ( |
e5250d96 |
40 | dispatch_app => sub { $self->dispatch_request(@_), $final }, |
1f8cad5e |
41 | dispatch_object => $self |
445b3ea0 |
42 | ); |
1f8cad5e |
43 | weaken($dispatch_args{dispatch_object}); |
44 | Web::Dispatch->new(%dispatch_args); |
5c33dda5 |
45 | } |
46 | |
3583ca04 |
47 | sub _build_final_dispatcher { |
4ed4fb42 |
48 | [ 404, [ 'Content-type', 'text/plain' ], [ 'Not found' ] ] |
5c33dda5 |
49 | } |
50 | |
5c33dda5 |
51 | sub run_if_script { |
b9e047ef |
52 | # ->to_psgi_app is true for require() but also works for plackup |
445b3ea0 |
53 | return $_[0]->to_psgi_app if caller(1); |
e27ab5c5 |
54 | my $self = ref($_[0]) ? $_[0] : $_[0]->new; |
5c33dda5 |
55 | $self->run(@_); |
56 | } |
57 | |
913a9cf9 |
58 | sub _run_cgi { |
5c33dda5 |
59 | my $self = shift; |
2bc99ccd |
60 | require Plack::Handler::CGI; |
61 | Plack::Handler::CGI->new->run($self->to_psgi_app); |
d3a61609 |
62 | } |
63 | |
e27ab5c5 |
64 | sub _run_fcgi { |
65 | my $self = shift; |
2bc99ccd |
66 | require Plack::Handler::FCGI; |
67 | Plack::Handler::FCGI->new->run($self->to_psgi_app); |
e27ab5c5 |
68 | } |
69 | |
445b3ea0 |
70 | sub to_psgi_app { |
bc57805c |
71 | my $self = ref($_[0]) ? $_[0] : $_[0]->new; |
b5b4423b |
72 | my $app = $self->_dispatcher->to_app; |
73 | |
74 | # Close over $self to keep $self alive even though |
75 | # we weakened the copies the dispatcher has; the |
76 | # if 0 causes the ops to be optimised away to |
77 | # minimise the performance impact and avoid void |
78 | # context warnings while still doing the closing |
79 | # over part. As Mithaldu said: "Gnarly." ... |
80 | |
81 | return sub { $self if 0; goto &$app; }; |
5c33dda5 |
82 | } |
83 | |
913a9cf9 |
84 | sub run { |
85 | my $self = shift; |
38faf206 |
86 | return $self->_run_fcgi if |
66350cd3 |
87 | $ENV{PHP_FCGI_CHILDREN} || $ENV{FCGI_ROLE} || $ENV{FCGI_SOCKET_PATH} |
38faf206 |
88 | || ( -S STDIN && !$ENV{GATEWAY_INTERFACE} ); |
7b930ebb |
89 | # If STDIN is a socket, almost certainly FastCGI, except for mod_cgid |
38faf206 |
90 | return $self->_run_cgi if $ENV{GATEWAY_INTERFACE}; |
ca469730 |
91 | return $self->run_cli(@ARGV); |
38faf206 |
92 | } |
4ba6d891 |
93 | |
38faf206 |
94 | sub run_cli_request { |
95 | my ($self, @args) = @_; |
ca469730 |
96 | return if !@args || $args[0] !~ m{(^[A-Z/])|\@}; |
38faf206 |
97 | unshift @args, 'GET' if $args[0] !~ /^[A-Z]/; |
ca469730 |
98 | $self->_run_cli_test_request(@args); |
99 | return 1; |
4ba6d891 |
100 | } |
101 | |
c1db3355 |
102 | sub _test_request_spec_to_http_request { |
4ba6d891 |
103 | my ($self, $method, $path, @rest) = @_; |
104 | |
c1db3355 |
105 | # if it's a reference, assume a request object |
106 | return $method if ref($method); |
913a9cf9 |
107 | |
8c3623e2 |
108 | if ($path =~ s/^(.*?)\@//) { |
109 | my $basic = $1; |
110 | require MIME::Base64; |
111 | unshift @rest, 'Authorization:', 'Basic '.MIME::Base64::encode($basic); |
112 | } |
113 | |
4ba6d891 |
114 | my $request = HTTP::Request->new($method => $path); |
c1db3355 |
115 | |
82bc2f9c |
116 | my @params; |
117 | |
118 | while (my ($header, $value) = splice(@rest, 0, 2)) { |
119 | unless ($header =~ s/:$//) { |
120 | push @params, $header, $value; |
121 | } |
15928515 |
122 | $header =~ s/_/-/g; |
123 | if ($header eq 'Content') { |
124 | $request->content($value); |
125 | } else { |
126 | $request->headers->push_header($header, $value); |
127 | } |
82bc2f9c |
128 | } |
129 | |
9f3d2dd9 |
130 | if (($method eq 'POST' or $method eq 'PUT') and @params) { |
4ba6d891 |
131 | my $content = do { |
132 | require URI; |
133 | my $url = URI->new('http:'); |
9f3d2dd9 |
134 | $url->query_form(@params); |
4ba6d891 |
135 | $url->query; |
136 | }; |
137 | $request->header('Content-Type' => 'application/x-www-form-urlencoded'); |
138 | $request->header('Content-Length' => length($content)); |
139 | $request->content($content); |
140 | } |
c1db3355 |
141 | |
142 | return $request; |
143 | } |
144 | |
145 | sub run_test_request { |
146 | my ($self, @req) = @_; |
147 | |
5b8f03a7 |
148 | require HTTP::Request; |
149 | |
c1db3355 |
150 | require Plack::Test; |
151 | |
152 | my $request = $self->_test_request_spec_to_http_request(@req); |
153 | |
4ba6d891 |
154 | Plack::Test::test_psgi( |
c1db3355 |
155 | $self->to_psgi_app, sub { shift->($request) } |
4ba6d891 |
156 | ); |
c1db3355 |
157 | } |
158 | |
159 | sub _run_cli_test_request { |
160 | my ($self, @req) = @_; |
161 | my $response = $self->run_test_request(@req); |
162 | |
163 | binmode(STDOUT); binmode(STDERR); # for win32 |
164 | |
baabba33 |
165 | print STDERR $response->status_line."\n"; |
166 | print STDERR $response->headers_as_string("\n")."\n"; |
f9d0d382 |
167 | my $content = $response->content; |
168 | $content .= "\n" if length($content) and $content !~ /\n\z/; |
169 | print STDOUT $content if $content; |
913a9cf9 |
170 | } |
171 | |
ca469730 |
172 | sub run_cli { |
173 | my ($self, @args) = @_; |
174 | return $self->run_cli_request(@args) || die $self->cli_request_usage; |
d104fb1d |
175 | } |
176 | |
ca469730 |
177 | sub cli_request_usage { |
178 | "This application does not implement its own run_cli method. To run\n". |
179 | "this script in CGI test mode, pass a URL path beginning with /:\n". |
d104fb1d |
180 | "\n". |
181 | " $0 /some/path\n". |
182 | " $0 /\n" |
183 | } |
184 | |
5c33dda5 |
185 | 1; |
32d29dcd |
186 | |
187 | =head1 NAME |
188 | |
6a4808bf |
189 | Web::Simple::Application - A base class for your Web-Simple application |
32d29dcd |
190 | |
191 | =head1 DESCRIPTION |
192 | |
193 | This is a base class for your L<Web::Simple> application. You probably don't |
194 | need to construct this class yourself, since L<Web::Simple> does the 'heavy |
195 | lifting' for you in that regards. |
196 | |
197 | =head1 METHODS |
198 | |
6a4808bf |
199 | This class exposes the following public methods. |
32d29dcd |
200 | |
201 | =head2 default_config |
202 | |
6a4808bf |
203 | Merges with the C<config> initializer to provide configuration information for |
204 | your application. For example: |
32d29dcd |
205 | |
206 | sub default_config { |
207 | ( |
208 | title => 'Bloggery', |
209 | posts_dir => $FindBin::Bin.'/posts', |
210 | ); |
211 | } |
212 | |
6a4808bf |
213 | Now, the C<config> attribute of C<$self> will be set to a HashRef |
32d29dcd |
214 | containing keys 'title' and 'posts_dir'. |
215 | |
12b3e9a3 |
216 | The keys from default_config are merged into any config supplied, so |
217 | if you construct your application like: |
6a4808bf |
218 | |
12b3e9a3 |
219 | MyWebSimpleApp::Web->new( |
220 | config => { title => 'Spoon', environment => 'dev' } |
221 | ) |
6a4808bf |
222 | |
12b3e9a3 |
223 | then C<config> will contain: |
6a4808bf |
224 | |
12b3e9a3 |
225 | { |
226 | title => 'Spoon', |
227 | posts_dir => '/path/to/myapp/posts', |
228 | environment => 'dev' |
229 | } |
32d29dcd |
230 | |
12b3e9a3 |
231 | =head2 run_if_script |
32d29dcd |
232 | |
ca469730 |
233 | The C<run_if_script> method is designed to be used at the end of the script |
12b3e9a3 |
234 | or .pm file where your application class is defined - for example: |
32d29dcd |
235 | |
236 | ## my_web_simple_app.pl |
237 | #!/usr/bin/env perl |
238 | use Web::Simple 'HelloWorld'; |
239 | |
240 | { |
241 | package HelloWorld; |
242 | |
243 | sub dispatch_request { |
244 | sub (GET) { |
245 | [ 200, [ 'Content-type', 'text/plain' ], [ 'Hello world!' ] ] |
246 | }, |
247 | sub () { |
248 | [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ] |
249 | } |
250 | } |
251 | } |
252 | |
253 | HelloWorld->run_if_script; |
254 | |
12b3e9a3 |
255 | This returns a true value, so your file is now valid as a module - so |
6a4808bf |
256 | |
12b3e9a3 |
257 | require 'my_web_simple_app.pl'; |
6a4808bf |
258 | |
12b3e9a3 |
259 | my $hw = HelloWorld->new; |
6a4808bf |
260 | |
12b3e9a3 |
261 | will work fine (and you can rename it to lib/HelloWorld.pm later to make it |
262 | a real use-able module). |
6a4808bf |
263 | |
ca469730 |
264 | Specifically, this true value is a PSGI app. You can you can pass the return |
265 | value of C<HelloWorld->run_if_script> to code expecting a PSGI app and you can |
266 | treat the file as though it were a standard PSGI application file (*.psgi). For |
267 | example you can start it up with C<plackup> |
268 | |
269 | plackup my_web_simple_app.pl |
270 | |
271 | or C<starman> |
272 | |
273 | starman my_web_simple_app.pl |
274 | |
275 | If C<run_if_script> is called from a situation where there is no caller, i.e. as |
276 | C<perl my_web_simple_app.pl> on the shell, or by a web server, it will call the |
277 | C<run> method to run the actual application itself. |
278 | |
279 | =head2 run |
32d29dcd |
280 | |
12b3e9a3 |
281 | If run under a CGI environment, your application will execute as a CGI. |
32d29dcd |
282 | |
12b3e9a3 |
283 | If run under a FastCGI environment, your application will execute as a |
284 | FastCGI process (this works both for dynamic shared-hosting-style FastCGI |
285 | and for apache FastCgiServer style setups). |
32d29dcd |
286 | |
ca469730 |
287 | If neither of these are the case, it defaults to running the C<run_cli> method |
288 | with C<@ARGV> as arguments. |
289 | |
290 | =head2 run_cli |
291 | |
292 | This method is meant to be overriden to implement your own command line mode for |
293 | the app, be this a debugger, interactive mode or page generator. |
294 | |
295 | Its default implementation calls the C<run_cli_request> method with the |
296 | arguments it was given, or, if that indicates failure by returning 0, calls |
297 | C<cli_request_usage> to print a message explaining the correct CLI usage. |
298 | |
299 | =head2 run_cli_request |
300 | |
301 | Looks at the arguments passed to it, typically C<@ARGV> captured somewhere up the |
302 | callstack, and tries to convert that into a sensible request against the |
303 | application, which it then runs. Any results are printed to C<STDOUT>. Returns |
304 | C<1> if it was able to run the request, and C<undef> if it was not able to |
305 | covert the arguments into a sensible request. |
306 | |
307 | If run with a URL path, it runs a GET request against that path - |
32d29dcd |
308 | |
12b3e9a3 |
309 | $ perl -Ilib examples/hello-world/hello-world.cgi / |
310 | 200 OK |
311 | Content-Type: text/plain |
312 | |
313 | Hello world! |
32d29dcd |
314 | |
15928515 |
315 | You can also provide a method name - |
316 | |
317 | $ perl -Ilib examples/hello-world/hello-world.cgi POST / |
318 | 405 Method Not Allowed |
319 | Content-Type: text/plain |
320 | |
321 | Method not allowed |
322 | |
323 | For a POST or PUT request, pairs on the command line will be treated |
324 | as form variables. For any request, pairs on the command line ending in : |
325 | are treated as headers, and 'Content:' will set the request body - |
326 | |
327 | $ ./myapp POST / Accept: text/html form_field_name form_field_value |
328 | |
329 | $ ./myapp POST / Content-Type: text/json Content: '{ "json": "here" }' |
330 | |
331 | The body of the response is sent to STDOUT and the headers to STDERR, so |
332 | |
333 | $ ./myapp GET / >index.html |
334 | |
335 | will generally do the right thing. |
336 | |
8c3623e2 |
337 | To send basic authentication credentials, use user:pass@ syntax - |
338 | |
339 | $ ./myapp GET bob:secret@/protected/path |
340 | |
ca469730 |
341 | =head2 cli_request_usage |
12b3e9a3 |
342 | |
ca469730 |
343 | Prints a message explaining how to pass CLI parameters. Can be overridden for |
344 | your own purposes. |
12b3e9a3 |
345 | |
346 | =head2 to_psgi_app |
347 | |
348 | This method is called by L</run_if_script> to create the L<PSGI> app coderef |
349 | for use via L<Plack> and L<plackup>. If you want to globally add middleware, |
350 | you can override this method: |
6a4808bf |
351 | |
352 | use Web::Simple 'HelloWorld'; |
353 | use Plack::Builder; |
354 | |
355 | { |
356 | package HelloWorld; |
357 | |
358 | |
359 | around 'to_psgi_app', sub { |
360 | my ($orig, $self) = (shift, shift); |
361 | my $app = $self->$orig(@_); |
362 | builder { |
363 | enable ...; ## whatever middleware you want |
364 | $app; |
365 | }; |
366 | }; |
367 | } |
368 | |
12b3e9a3 |
369 | This method can also be used to mount a Web::Simple application within |
370 | a separate C<*.psgi> file - |
371 | |
372 | use strictures 1; |
373 | use Plack::Builder; |
374 | use WSApp; |
375 | use AnotherWSApp; |
376 | |
377 | builder { |
378 | mount '/' => WSApp->to_psgi_app; |
379 | mount '/another' => AnotherWSApp->to_psgi_app; |
380 | }; |
381 | |
382 | This method can be called as a class method, in which case it implicitly |
383 | calls ->new, or as an object method ... in which case it doesn't. |
32d29dcd |
384 | |
ca30a017 |
385 | =head2 run_test_request |
386 | |
15928515 |
387 | my $res = $app->run_test_request(GET => '/' => %headers); |
ca30a017 |
388 | |
15928515 |
389 | my $res = $app->run_test_request(POST => '/' => %headers_or_form); |
ca30a017 |
390 | |
391 | my $res = $app->run_test_request($http_request); |
392 | |
393 | Accepts either an L<HTTP::Request> object or ($method, $path) and runs that |
394 | request against the application, returning an L<HTTP::Response> object. |
395 | |
396 | If the HTTP method is POST or PUT, then a series of pairs can be passed after |
397 | this to create a form style message body. If you need to test an upload, then |
398 | create an L<HTTP::Request> object by hand or use the C<POST> subroutine |
399 | provided by L<HTTP::Request::Common>. |
400 | |
8c3623e2 |
401 | If you prefix the URL with 'user:pass@' this will be converted into |
402 | an Authorization header for HTTP basic auth: |
403 | |
404 | my $res = $app->run_test_request( |
405 | GET => 'bob:secret@/protected/resource' |
406 | ); |
407 | |
15928515 |
408 | If pairs are passed where the key ends in :, it is instead treated as a |
409 | headers, so: |
410 | |
411 | my $res = $app->run_test_request( |
412 | POST => '/', |
413 | 'Accept:' => 'text/html', |
414 | some_form_key => 'value' |
415 | ); |
416 | |
417 | will do what you expect. You can also pass a special key of Content: to |
418 | set the request body: |
419 | |
420 | my $res = $app->run_test_request( |
421 | POST => '/', |
422 | 'Content-Type:' => 'text/json', |
423 | 'Content:' => '{ "json": "here" }', |
424 | ); |
425 | |
7e103e8e |
426 | =head1 AUTHORS |
32d29dcd |
427 | |
7e103e8e |
428 | See L<Web::Simple> for authors. |
32d29dcd |
429 | |
7e103e8e |
430 | =head1 COPYRIGHT AND LICENSE |
32d29dcd |
431 | |
7e103e8e |
432 | See L<Web::Simple> for the copyright and license. |
32d29dcd |
433 | |
434 | =cut |