Commit | Line | Data |
5c33dda5 |
1 | package Web::Simple::Application; |
2 | |
8bd060f4 |
3 | use Moo; |
5c33dda5 |
4 | |
8bd060f4 |
5 | has 'config' => (is => 'ro', trigger => sub { |
6 | my ($self, $value) = @_; |
7 | my %default = $self->_default_config; |
8 | my @not = grep !exists $value->{$_}, keys %default; |
9 | @{$value}{@not} = @default{@not}; |
10 | }); |
5c33dda5 |
11 | |
445b3ea0 |
12 | sub default_config { () } |
39119082 |
13 | |
445b3ea0 |
14 | has '_dispatcher' => (is => 'lazy'); |
5c33dda5 |
15 | |
445b3ea0 |
16 | sub _build__dispatcher { |
17 | my $self = shift; |
18 | require Web::Dispatch; |
19 | require Web::Simple::DispatchNode; |
20 | my $final = $self->_build_final_dispatcher; |
21 | Web::Dispatch->new( |
22 | app => sub { $self->dispatch_request(@_), $final }, |
23 | node_class => 'Web::Simple::DispatchNode', |
24 | node_args => { app_object => $self } |
25 | ); |
5c33dda5 |
26 | } |
27 | |
3583ca04 |
28 | sub _build_final_dispatcher { |
4ed4fb42 |
29 | [ 404, [ 'Content-type', 'text/plain' ], [ 'Not found' ] ] |
5c33dda5 |
30 | } |
31 | |
5c33dda5 |
32 | sub run_if_script { |
b9e047ef |
33 | # ->to_psgi_app is true for require() but also works for plackup |
445b3ea0 |
34 | return $_[0]->to_psgi_app if caller(1); |
e27ab5c5 |
35 | my $self = ref($_[0]) ? $_[0] : $_[0]->new; |
5c33dda5 |
36 | $self->run(@_); |
37 | } |
38 | |
913a9cf9 |
39 | sub _run_cgi { |
5c33dda5 |
40 | my $self = shift; |
e27ab5c5 |
41 | require Plack::Server::CGI; |
b9e047ef |
42 | Plack::Server::CGI->run($self->to_psgi_app); |
d3a61609 |
43 | } |
44 | |
e27ab5c5 |
45 | sub _run_fcgi { |
46 | my $self = shift; |
47 | require Plack::Server::FCGI; |
b9e047ef |
48 | Plack::Server::FCGI->run($self->to_psgi_app); |
e27ab5c5 |
49 | } |
50 | |
445b3ea0 |
51 | sub to_psgi_app { |
bc57805c |
52 | my $self = ref($_[0]) ? $_[0] : $_[0]->new; |
445b3ea0 |
53 | $self->_dispatcher->to_app; |
5c33dda5 |
54 | } |
55 | |
913a9cf9 |
56 | sub run { |
57 | my $self = shift; |
e27ab5c5 |
58 | if ($ENV{PHP_FCGI_CHILDREN} || $ENV{FCGI_ROLE} || $ENV{FCGI_SOCKET_PATH}) { |
59 | return $self->_run_fcgi; |
60 | } elsif ($ENV{GATEWAY_INTERFACE}) { |
2514ad17 |
61 | return $self->_run_cgi; |
913a9cf9 |
62 | } |
d104fb1d |
63 | unless (@ARGV && $ARGV[0] =~ m{^/}) { |
db2899c3 |
64 | return $self->_run_cli(@ARGV); |
d104fb1d |
65 | } |
66 | |
67 | my $path = shift @ARGV; |
913a9cf9 |
68 | |
913a9cf9 |
69 | require HTTP::Request::Common; |
e27ab5c5 |
70 | require Plack::Test; |
913a9cf9 |
71 | local *GET = \&HTTP::Request::Common::GET; |
72 | |
73 | my $request = GET($path); |
e27ab5c5 |
74 | my $response; |
b9e047ef |
75 | Plack::Test::test_psgi($self->to_psgi_app, sub { $response = shift->($request) }); |
e27ab5c5 |
76 | print $response->as_string; |
913a9cf9 |
77 | } |
78 | |
d104fb1d |
79 | sub _run_cli { |
80 | my $self = shift; |
81 | die $self->_cli_usage; |
82 | } |
83 | |
84 | sub _cli_usage { |
85 | "To run this script in CGI test mode, pass a URL path beginning with /:\n". |
86 | "\n". |
87 | " $0 /some/path\n". |
88 | " $0 /\n" |
89 | } |
90 | |
5c33dda5 |
91 | 1; |