1 package Web::Simple::Application;
4 use warnings FATAL => 'all';
7 my ($class, $data) = @_;
8 my $config = { $class->_default_config, %{($data||{})->{config}||{}} };
9 bless({ config => $config }, $class);
12 sub _default_config { () }
18 sub _construct_response_filter {
19 bless($_[1], 'Web::Simple::ResponseFilter');
22 sub _is_response_filter {
23 # simple blessed() hack
24 "$_[1]" =~ /\w+=[A-Z]/
25 and $_[1]->isa('Web::Simple::ResponseFilter');
28 sub _construct_redispatch {
29 bless(\$_[1], 'Web::Simple::Redispatch');
34 "$_[1]" =~ /\w+=[A-Z]/
35 and $_[1]->isa('Web::Simple::Redispatch');
39 sub _dispatch_parser {
40 require Web::Simple::DispatchParser;
41 return Web::Simple::DispatchParser->new;
44 sub _setup_dispatchables {
45 my ($class, $dispatch_subs) = @_;
46 my $parser = $class->_dispatch_parser;
48 foreach my $dispatch_sub (@$dispatch_subs) {
49 my $proto = prototype $dispatch_sub;
52 ? $parser->parse_dispatch_specification($proto)
55 push @dispatchables, [ $matcher, $dispatch_sub ];
59 *{"${class}::_dispatchables"} = sub { @dispatchables };
64 my ($self, $env) = @_;
65 $self->_run_dispatch_for($env, [ $self->_dispatchables ]);
68 sub _run_dispatch_for {
69 my ($self, $env, $dispatchables) = @_;
70 my @disp = @$dispatchables;
71 while (my $disp = shift @disp) {
72 my ($match, $run) = @{$disp};
73 if (my ($env_delta, @args) = $match->($env)) {
74 my $new_env = { %$env, %$env_delta };
75 if (my ($result) = $self->_run_with_self($run, @args)) {
76 if ($self->_is_response_filter($result)) {
77 return $self->_run_with_self(
79 $self->_run_dispatch_for($new_env, \@disp)
81 } elsif (my $path = $self->_is_redispatch($result)) {
82 $new_env->{PATH_INFO} = $path;
83 return $self->_run_dispatch_for($new_env, $dispatchables);
90 500, [ 'Content-type', 'text/plain' ],
91 [ 'The management apologises but we have no idea how to handle that' ]
96 my ($self, $run, @args) = @_;
97 my $class = ref($self);
99 local *{"${class}::self"} = \$self;
104 return 1 if caller(1); # 1 so we can be the last thing in the file
106 my $self = $class->new;
112 require Web::Simple::HackedPlack;
113 Plack::Server::CGI->run(sub { $self->handle_request(@_) });
118 if ($ENV{GATEWAY_INTERFACE}) {
121 my $path = shift(@ARGV);
123 require HTTP::Request::AsCGI;
124 require HTTP::Request::Common;
125 local *GET = \&HTTP::Request::Common::GET;
127 my $request = GET($path);
128 my $c = HTTP::Request::AsCGI->new($request)->setup;
131 print $c->response->as_string;