add PSGI handler

[chaz/p5-CGI-Ex] / lib / CGI / Ex / App.pm

diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm
index 305fa2325e94fd2b9d909e542140ca5523145083..9b4f8c4bbda4c8ba3121321a9e6d4eb600c5146c 100644 (file)
--- a/lib/CGI/Ex/App.pm
+++ b/lib/CGI/Ex/App.pm
@@ -2,7 +2,7 @@ package CGI::Ex::App;
 
 ###---------------------###
 #  See the perldoc in CGI/Ex/App.pod
-#  Copyright 2008 - Paul Seamons
+#  Copyright 2004-2012 - Paul Seamons
 #  Distributed under the Perl Artistic License without warranty
 
 use strict;
@@ -11,7 +11,7 @@ BEGIN {
     eval { use Time::HiRes qw(time) };
     eval { use Scalar::Util };
 }
-our $VERSION = '2.27';
+our $VERSION = '2.37';
 
 sub new {
     my $class = shift || croak "Usage: ".__PACKAGE__."->new";
@@ -33,6 +33,15 @@ sub init_from_conf {
     return;
 }
 
+sub import { # only ever called with explicit use CGI::Ex::App qw() - not with use base
+    my $class = shift;
+    if (@_ = grep { /^:?App($|__)/ } @_) {
+        require CGI::Ex::App::Constants;
+        unshift @_, 'CGI::Ex::App::Constants';
+        goto &CGI::Ex::App::Constants::import;
+    }
+}
+
 ###---------------------###
 
 sub navigate {
@@ -272,10 +281,10 @@ sub history            { $_[0]->{'history'}        ||= []           }
 sub js_step            { $_[0]->{'js_step'}        || 'js'          }
 sub login_step         { $_[0]->{'login_step'}     || '__login'     }
 sub mimetype           { $_[0]->{'mimetype'}       ||  'text/html'  }
-sub path_info          { $_[0]->{'path_info'}      ||  $ENV{'PATH_INFO'}   || '' }
+sub path_info          { defined $_[0]->{'path_info'}   ? $_[0]->{'path_info'}   :  $_[0]->cgix->env->{'PATH_INFO'}   || '' }
 sub path_info_map_base { $_[0]->{'path_info_map_base'} ||[[qr{/(\w+)}, $_[0]->step_key]] }
 sub recurse_limit      { $_[0]->{'recurse_limit'}  ||  15                   }
-sub script_name        { $_[0]->{'script_name'}    ||  $ENV{'SCRIPT_NAME'} || $0 }
+sub script_name        { defined $_[0]->{'script_name'} ? $_[0]->{'script_name'} :  $_[0]->cgix->env->{'SCRIPT_NAME'} || $0 }
 sub stash              { $_[0]->{'stash'}          ||= {}    }
 sub step_key           { $_[0]->{'step_key'}       || 'step' }
 sub template_args      { $_[0]->{'template_args'} }
@@ -691,17 +700,18 @@ sub finalize  { 1 } # false means show step
 sub hash_base {
     my ($self, $step) = @_;
 
-    return $self->{'hash_base'} ||= do {
-        my $copy = $self;  eval { require Scalar::Util; Scalar::Util::weaken($copy) };
-        my $hash = {
-            script_name     => $self->script_name,
-            path_info       => $self->path_info,
-            js_validation   => sub { $copy->run_hook('js_validation', $step, shift) },
-            generate_form   => sub { $copy->run_hook('generate_form', $step, (ref($_[0]) ? (undef, shift) : shift)) },
-            form_name       => $self->run_hook('form_name', $step),
-            $self->step_key => $step,
-        };
+    my $hash = $self->{'hash_base'} ||= {
+        script_name => $self->script_name,
+        path_info   => $self->path_info,
     };
+
+    my $copy = $self;  eval { require Scalar::Util; Scalar::Util::weaken($copy) };
+    $hash->{'js_validation'} = sub { $copy->run_hook('js_validation', $step, shift) };
+    $hash->{'generate_form'} = sub { $copy->run_hook('generate_form', $step, (ref($_[0]) ? (undef, shift) : shift)) };
+    $hash->{'form_name'}     = $self->run_hook('form_name', $step);
+    $hash->{$self->step_key} = $step;
+
+    return $hash;
 }
 
 sub hash_common { $_[0]->{'hash_common'} ||= {} }
@@ -771,7 +781,7 @@ sub prepare    { 1 } # false means show step
 sub print_out {
     my ($self, $step, $out) = @_;
     $self->cgix->print_content_type($self->mimetype($step), $self->charset($step));
-    print ref($out) eq 'SCALAR' ? $$out : $out;
+    $self->cgix->print_body(ref($out) eq 'SCALAR' ? $$out : $out);
 }
 
 sub ready_validate {
@@ -782,7 +792,7 @@ sub ready_validate {
             return (grep { exists $form->{$_} } @keys) ? 1 : 0;
         }
     }
-    return ($ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq 'POST') ? 1 : 0;
+    return ($self->cgix->env->{'REQUEST_METHOD'} && $self->cgix->env->{'REQUEST_METHOD'} eq 'POST') ? 1 : 0;
 }
 
 sub refine_path {
@@ -798,7 +808,7 @@ sub refine_path {
 sub set_ready_validate { # hook and method
     my $self = shift;
     my ($step, $is_ready) = (@_ == 2) ? @_ : (undef, shift);
-    $ENV{'REQUEST_METHOD'} = ($is_ready) ? 'POST' : 'GET';
+    $self->cgix->env->{'REQUEST_METHOD'} = ($is_ready) ? 'POST' : 'GET';
     return $is_ready;
 }
 
@@ -925,15 +935,16 @@ sub js_run_step { # step that allows for printing javascript libraries that are
     return 1;
 }
 
+sub __forbidden_require_auth { 0 }
 sub __forbidden_allow_morph { shift->allow_morph(@_) && 1 }
 sub __forbidden_info_complete { 0 } # step that will be used the path method determines it is forbidden
 sub __forbidden_hash_common  { shift->stash }
-sub __forbidden_file_print { \ "<h1>Denied</h1>You do not have access to the step <b>\"[% forbidden_step %]\"</b>" }
+sub __forbidden_file_print { \ "<h1>Denied</h1>You do not have access to the step <b>\"[% forbidden_step.html %]\"</b>" }
 
 sub __error_allow_morph { shift->allow_morph(@_) && 1 }
 sub __error_info_complete { 0 } # step that is used by the default handle_error
 sub __error_hash_common  { shift->stash }
-sub __error_file_print { \ "<h1>A fatal error occurred</h1>Step: <b>\"[% error_step %]\"</b><br>[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" }
+sub __error_file_print { \ "<h1>A fatal error occurred</h1>Step: <b>\"[% error_step.html %]\"</b><br>[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" }
 
 sub __login_require_auth { 0 }
 sub __login_allow_morph { shift->allow_morph(@_) && 1 }