1 package Web::Simple::Application;
3 use Scalar::Util 'weaken';
11 +{ $self->default_config }
14 my ($self, $value) = @_;
15 my %default = $self->default_config;
16 my @not = grep !exists $value->{$_}, keys %default;
17 @{$value}{@not} = @default{@not};
21 sub default_config { () }
23 has param_encoding => (is => "lazy");
25 sub _build_param_encoding { "UTF-8" }
27 has '_dispatcher' => (is => 'lazy');
29 sub _build__dispatcher {
31 require Web::Dispatch;
32 require Web::Simple::DispatchNode;
33 my $final = $self->_build_final_dispatcher;
35 # We need to weaken both the copy of $self that the
36 # app parameter will close over and the copy that'll
37 # be passed through as a node argument.
39 # To ensure that this doesn't then result in us being
40 # DESTROYed unexpectedly early, our to_psgi_app method
41 # closes back over $self
44 my $node_args = { app_object => $self };
45 weaken($node_args->{app_object});
48 { "Web::Dispatch::ParamParser.param_encoding" => $self->param_encoding },
49 $self->dispatch_request(@_), $final;
51 node_class => 'Web::Simple::DispatchNode',
52 node_args => $node_args
56 sub _build_final_dispatcher {
57 [ 404, [ 'Content-type', 'text/plain' ], [ 'Not found' ] ]
61 # ->to_psgi_app is true for require() but also works for plackup
62 return $_[0]->to_psgi_app if caller(1);
63 my $self = ref($_[0]) ? $_[0] : $_[0]->new;
69 require Plack::Handler::CGI;
70 Plack::Handler::CGI->new->run($self->to_psgi_app);
75 require Plack::Handler::FCGI;
76 Plack::Handler::FCGI->new->run($self->to_psgi_app);
80 my $self = ref($_[0]) ? $_[0] : $_[0]->new;
81 my $app = $self->_dispatcher->to_app;
83 # Close over $self to keep $self alive even though
84 # we weakened the copies the dispatcher has; the
85 # if 0 causes the ops to be optimised away to
86 # minimise the performance impact and avoid void
87 # context warnings while still doing the closing
88 # over part. As Mithaldu said: "Gnarly." ...
90 return sub { $self if 0; goto &$app; };
96 $ENV{PHP_FCGI_CHILDREN} || $ENV{FCGI_ROLE} || $ENV{FCGI_SOCKET_PATH}
97 || ( -S STDIN && !$ENV{GATEWAY_INTERFACE} )
98 # If STDIN is a socket, almost certainly FastCGI, except for mod_cgid
100 return $self->_run_fcgi;
101 } elsif ($ENV{GATEWAY_INTERFACE}) {
102 return $self->_run_cgi;
104 unless (@ARGV && $ARGV[0] =~ m{(^[A-Z/])|\@}) {
105 return $self->_run_cli(@ARGV);
110 unshift(@args, 'GET') if $args[0] !~ /^[A-Z]/;
112 $self->_run_cli_test_request(@args);
115 sub _test_request_spec_to_http_request {
116 my ($self, $method, $path, @rest) = @_;
118 # if it's a reference, assume a request object
119 return $method if ref($method);
121 if ($path =~ s/^(.*?)\@//) {
123 require MIME::Base64;
124 unshift @rest, 'Authorization:', 'Basic '.MIME::Base64::encode($basic);
127 my $request = HTTP::Request->new($method => $path);
131 while (my ($header, $value) = splice(@rest, 0, 2)) {
132 unless ($header =~ s/:$//) {
133 push @params, $header, $value;
136 if ($header eq 'Content') {
137 $request->content($value);
139 $request->headers->push_header($header, $value);
143 if (($method eq 'POST' or $method eq 'PUT') and @params) {
146 my $url = URI->new('http:');
147 $url->query_form(@params);
150 $request->header('Content-Type' => 'application/x-www-form-urlencoded');
151 $request->header('Content-Length' => length($content));
152 $request->content($content);
158 sub run_test_request {
159 my ($self, @req) = @_;
161 require HTTP::Request;
165 my $request = $self->_test_request_spec_to_http_request(@req);
167 Plack::Test::test_psgi(
168 $self->to_psgi_app, sub { shift->($request) }
172 sub _run_cli_test_request {
173 my ($self, @req) = @_;
174 my $response = $self->run_test_request(@req);
176 binmode(STDOUT); binmode(STDERR); # for win32
178 print STDERR $response->status_line."\n";
179 print STDERR $response->headers_as_string("\n")."\n";
180 my $content = $response->content;
181 $content .= "\n" if length($content) and $content !~ /\n\z/;
182 print STDOUT $content if $content;
187 die $self->_cli_usage;
191 "To run this script in CGI test mode, pass a URL path beginning with /:\n".
201 Web::Simple::Application - A base class for your Web-Simple application
205 This is a base class for your L<Web::Simple> application. You probably don't
206 need to construct this class yourself, since L<Web::Simple> does the 'heavy
207 lifting' for you in that regards.
211 This class exposes the following public methods.
213 =head2 default_config
215 Merges with the C<config> initializer to provide configuration information for
216 your application. For example:
221 posts_dir => $FindBin::Bin.'/posts',
225 Now, the C<config> attribute of C<$self> will be set to a HashRef
226 containing keys 'title' and 'posts_dir'.
228 The keys from default_config are merged into any config supplied, so
229 if you construct your application like:
231 MyWebSimpleApp::Web->new(
232 config => { title => 'Spoon', environment => 'dev' }
235 then C<config> will contain:
239 posts_dir => '/path/to/myapp/posts',
245 The run_if_script method is designed to be used at the end of the script
246 or .pm file where your application class is defined - for example:
248 ## my_web_simple_app.pl
250 use Web::Simple 'HelloWorld';
255 sub dispatch_request {
257 [ 200, [ 'Content-type', 'text/plain' ], [ 'Hello world!' ] ]
260 [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ]
265 HelloWorld->run_if_script;
267 This returns a true value, so your file is now valid as a module - so
269 require 'my_web_simple_app.pl';
271 my $hw = HelloWorld->new;
273 will work fine (and you can rename it to lib/HelloWorld.pm later to make it
274 a real use-able module).
276 However, it detects if it's being run as a script (via testing $0) and if
277 so attempts to do the right thing.
279 If run under a CGI environment, your application will execute as a CGI.
281 If run under a FastCGI environment, your application will execute as a
282 FastCGI process (this works both for dynamic shared-hosting-style FastCGI
283 and for apache FastCgiServer style setups).
285 If run from the commandline with a URL path, it runs a GET request against
288 $ perl -Ilib examples/hello-world/hello-world.cgi /
290 Content-Type: text/plain
294 You can also provide a method name -
296 $ perl -Ilib examples/hello-world/hello-world.cgi POST /
297 405 Method Not Allowed
298 Content-Type: text/plain
302 For a POST or PUT request, pairs on the command line will be treated
303 as form variables. For any request, pairs on the command line ending in :
304 are treated as headers, and 'Content:' will set the request body -
306 $ ./myapp POST / Accept: text/html form_field_name form_field_value
308 $ ./myapp POST / Content-Type: text/json Content: '{ "json": "here" }'
310 The body of the response is sent to STDOUT and the headers to STDERR, so
312 $ ./myapp GET / >index.html
314 will generally do the right thing.
316 To send basic authentication credentials, use user:pass@ syntax -
318 $ ./myapp GET bob:secret@/protected/path
320 Additionally, you can treat the file as though it were a standard PSGI
321 application file (*.psgi). For example you can start up up with C<plackup>
323 plackup my_web_simple_app.pl
327 starman my_web_simple_app.pl
331 This method is called by L</run_if_script> to create the L<PSGI> app coderef
332 for use via L<Plack> and L<plackup>. If you want to globally add middleware,
333 you can override this method:
335 use Web::Simple 'HelloWorld';
342 around 'to_psgi_app', sub {
343 my ($orig, $self) = (shift, shift);
344 my $app = $self->$orig(@_);
346 enable ...; ## whatever middleware you want
352 This method can also be used to mount a Web::Simple application within
353 a separate C<*.psgi> file -
361 mount '/' => WSApp->to_psgi_app;
362 mount '/another' => AnotherWSApp->to_psgi_app;
365 This method can be called as a class method, in which case it implicitly
366 calls ->new, or as an object method ... in which case it doesn't.
370 Used for running your application under stand-alone CGI and FCGI modes.
372 I should document this more extensively but run_if_script will call it when
373 you need it, so don't worry about it too much.
375 =head2 run_test_request
377 my $res = $app->run_test_request(GET => '/' => %headers);
379 my $res = $app->run_test_request(POST => '/' => %headers_or_form);
381 my $res = $app->run_test_request($http_request);
383 Accepts either an L<HTTP::Request> object or ($method, $path) and runs that
384 request against the application, returning an L<HTTP::Response> object.
386 If the HTTP method is POST or PUT, then a series of pairs can be passed after
387 this to create a form style message body. If you need to test an upload, then
388 create an L<HTTP::Request> object by hand or use the C<POST> subroutine
389 provided by L<HTTP::Request::Common>.
391 If you prefix the URL with 'user:pass@' this will be converted into
392 an Authorization header for HTTP basic auth:
394 my $res = $app->run_test_request(
395 GET => 'bob:secret@/protected/resource'
398 If pairs are passed where the key ends in :, it is instead treated as a
401 my $res = $app->run_test_request(
403 'Accept:' => 'text/html',
404 some_form_key => 'value'
407 will do what you expect. You can also pass a special key of Content: to
408 set the request body:
410 my $res = $app->run_test_request(
412 'Content-Type:' => 'text/json',
413 'Content:' => '{ "json": "here" }',
418 See L<Web::Simple> for authors.
420 =head1 COPYRIGHT AND LICENSE
422 See L<Web::Simple> for the copyright and license.