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);
16 sub _construct_response_filter {
17 bless($_[1], 'Web::Simple::ResponseFilter');
20 sub _is_response_filter {
21 # simple blessed() hack
22 "$_[1]" =~ /\w+=[A-Z]/
23 and $_[1]->isa('Web::Simple::ResponseFilter');
26 sub _construct_redispatch {
27 bless(\$_[1], 'Web::Simple::Redispatch');
32 "$_[1]" =~ /\w+=[A-Z]/
33 and $_[1]->isa('Web::Simple::Redispatch');
37 sub _dispatch_parser {
38 require Web::Simple::DispatchParser;
39 return Web::Simple::DispatchParser->new;
42 sub _setup_dispatchables {
43 my ($class, $dispatch_subs) = @_;
44 my $parser = $class->_dispatch_parser;
46 foreach my $dispatch_sub (@$dispatch_subs) {
47 my $proto = prototype $dispatch_sub;
50 ? $parser->parse_dispatch_specification($proto)
53 push @dispatchables, [ $matcher, $dispatch_sub ];
57 *{"${class}::_dispatchables"} = sub { @dispatchables };
62 my ($self, $env) = @_;
63 $self->_run_dispatch_for($env, [ $self->_dispatchables ]);
66 sub _run_dispatch_for {
67 my ($self, $env, $dispatchables) = @_;
68 my @disp = @$dispatchables;
69 while (my $disp = shift @disp) {
70 my ($match, $run) = @{$disp};
71 if (my ($env_delta, @args) = $match->($env)) {
72 my $new_env = { %$env, %$env_delta };
73 if (my ($result) = $self->_run_with_self($run, @args)) {
74 if ($self->_is_response_filter($result)) {
75 return $self->_run_with_self(
77 $self->_run_dispatch_for($new_env, \@disp)
79 } elsif (my $path = $self->_is_redispatch($result)) {
80 $new_env->{PATH_INFO} = $path;
81 return $self->_run_dispatch_for($new_env, $dispatchables);
88 500, [ 'Content-type', 'text/plain' ],
89 [ 'The management apologises but we have no idea how to handle that' ]
94 my ($self, $run, @args) = @_;
95 my $class = ref($self);
97 local *{"${class}::self"} = \$self;
102 return 1 if caller(1); # 1 so we can be the last thing in the file
104 my $self = $class->new;
110 require Web::Simple::HackedPlack;
111 Plack::Server::CGI->run(sub { $self->handle_request(@_) });
116 if ($ENV{GATEWAY_INTERFACE}) {
119 my $path = shift(@ARGV);
121 require HTTP::Request::AsCGI;
122 require HTTP::Request::Common;
123 local *GET = \&HTTP::Request::Common::GET;
125 my $request = GET($path);
126 my $c = HTTP::Request::AsCGI->new($request)->setup;
129 print $c->response->as_string;