lib/Web/Simple/Application.pm

   1 package Web::Simple::Application;
   2
   3 use Moo;
   4
   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 });
  11
  12 sub default_config { () }
  13
  14 has '_dispatcher' => (is => 'lazy');
  15
  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   );
  26 }
  27
  28 sub _build_final_dispatcher {
  29   [ 404, [ 'Content-type', 'text/plain' ], [ 'Not found' ] ]
  30 }
  31
  32 sub run_if_script {
  33   # ->to_psgi_app is true for require() but also works for plackup
  34   return $_[0]->to_psgi_app if caller(1);
  35   my $self = ref($_[0]) ? $_[0] : $_[0]->new;
  36   $self->run(@_);
  37 }
  38
  39 sub _run_cgi {
  40   my $self = shift;
  41   require Plack::Server::CGI;
  42   Plack::Server::CGI->run($self->to_psgi_app);
  43 }
  44
  45 sub _run_fcgi {
  46   my $self = shift;
  47   require Plack::Server::FCGI;
  48   Plack::Server::FCGI->run($self->to_psgi_app);
  49 }
  50
  51 sub to_psgi_app {
  52   my $self = ref($_[0]) ? $_[0] : $_[0]->new;
  53   $self->_dispatcher->to_app;
  54 }
  55
  56 sub run {
  57   my $self = shift;
  58   if ($ENV{PHP_FCGI_CHILDREN} || $ENV{FCGI_ROLE} || $ENV{FCGI_SOCKET_PATH}) {
  59     return $self->_run_fcgi;
  60   } elsif ($ENV{GATEWAY_INTERFACE}) {
  61     return $self->_run_cgi;
  62   }
  63   unless (@ARGV && $ARGV[0] =~ m{^/}) {
  64     return $self->_run_cli(@ARGV);
  65   }
  66
  67   my $path = shift @ARGV;
  68
  69   require HTTP::Request::Common;
  70   require Plack::Test;
  71   local *GET = \&HTTP::Request::Common::GET;
  72
  73   my $request = GET($path);
  74   my $response;
  75   Plack::Test::test_psgi($self->to_psgi_app, sub { $response = shift->($request) });
  76   print $response->as_string;
  77 }
  78
  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
  91 1;