X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FCGI%2FEx%2FApp.pm;h=9b4f8c4bbda4c8ba3121321a9e6d4eb600c5146c;hb=85fc25755c716b7cec223d72c8e8b0fe994e26d3;hp=305fa2325e94fd2b9d909e542140ca5523145083;hpb=febed4ec71f803b083c3e61b82b9464e9bfb0992;p=chaz%2Fp5-CGI-Ex diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm index 305fa23..9b4f8c4 100644 --- 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 { \ "

Denied

You do not have access to the step \"[% forbidden_step %]\"" } +sub __forbidden_file_print { \ "

Denied

You do not have access to the step \"[% forbidden_step.html %]\"" } 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 { \ "

A fatal error occurred

Step: \"[% error_step %]\"
[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" } +sub __error_file_print { \ "

A fatal error occurred

Step: \"[% error_step.html %]\"
[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" } sub __login_require_auth { 0 } sub __login_allow_morph { shift->allow_morph(@_) && 1 }