lib/Web/Simple/Application.pm

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