X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=lib%2FCGI%2FEx%2FApp.pm;h=29483ccc1302ea6074bd824c510ff79861c1907b;hp=313baf443e4d25e47be64591390dd0c66b205ba1;hb=6c57b3331d84010b9e2031f8e3c8937c3117e8fc;hpb=a8620142ba0dcda3f0c5f102f791df944ed2245e diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm index 313baf4..29483cc 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 2006 - Paul Seamons # +# Copyright 2007 - Paul Seamons # # Distributed under the Perl Artistic License without warranty # ###----------------------------------------------------------------### @@ -10,9 +10,10 @@ use strict; use vars qw($VERSION); BEGIN { - $VERSION = '2.01'; + $VERSION = '2.11'; Time::HiRes->import('time') if eval {require Time::HiRes}; + eval {require Scalar::Util}; } sub croak { @@ -121,6 +122,19 @@ sub nav_loop { ### allow for becoming another package (allows for some steps in external files) $self->morph($step); + ### allow for mapping path_info pieces to form elements + if (my $info = $ENV{'PATH_INFO'}) { + my $maps = $self->run_hook('path_info_map', $step) || []; + croak 'Usage: sub path_info_map { [[qr{/path_info/(\w+)}, "keyname"]] }' + if ! UNIVERSAL::isa($maps, 'ARRAY') || (@$maps && ! UNIVERSAL::isa($maps->[0], 'ARRAY')); + foreach my $map (@$maps) { + my @match = $info =~ $map->[0]; + next if ! @match; + $self->form->{$map->[$_]} = $match[$_ - 1] foreach grep {! defined $self->form->{$map->[$_]}} 1 .. $#$map; + last; + } + } + ### run the guts of the step my $handled = $self->run_hook('run_step', $step); @@ -181,10 +195,21 @@ sub path { if (! $self->{'path'}) { my $path = $self->{'path'} = []; # empty path - my $step = $self->form->{ $self->step_key }; - $step = lc($1) if ! $step && $ENV{'PATH_INFO'} && $ENV{'PATH_INFO'} =~ m|^/(\w+)|; + ### add initial items to the form hash from path_info + if (my $info = $ENV{'PATH_INFO'}) { + my $maps = $self->path_info_map_base || []; + croak 'Usage: sub path_info_map_base { [[qr{/path_info/(\w+)}, "keyname"]] }' + if ! UNIVERSAL::isa($maps, 'ARRAY') || (@$maps && ! UNIVERSAL::isa($maps->[0], 'ARRAY')); + foreach my $map (@$maps) { + my @match = $info =~ $map->[0]; + next if ! @match; + $self->form->{$map->[$_]} = $match[$_ - 1] foreach grep {! defined $self->form->{$map->[$_]}} 1 .. $#$map; + last; + } + } ### make sure the step is valid + my $step = $self->form->{$self->step_key}; if (defined $step) { if ($step =~ /^_/) { # can't begin with _ $self->stash->{'forbidden_step'} = $step; @@ -204,6 +229,11 @@ sub path { return $self->{'path'}; } +sub path_info_map_base { + my $self = shift; + return [[qr{/(\w+)}, $self->step_key]]; +} + sub set_path { my $self = shift; my $path = $self->{'path'} ||= []; @@ -382,6 +412,8 @@ sub run_hook { my ($code, $found) = @{ $self->find_hook($hook, $step) }; if (! $code) { croak "Could not find a method named ${step}_${hook} or ${hook}"; + } elsif (! UNIVERSAL::isa($code, 'CODE')) { + croak "Value for $hook ($found) is not a code ref ($code)"; } ### record history @@ -671,9 +703,34 @@ sub stash { return $self->{'stash'} ||= {}; } +sub clear_app { + my $self = shift; + + delete @{ $self }{qw( + cgix + vob + form + cookies + stash + path + path_i + history + __morph_lineage_start_index + __morph_lineage + hash_errors + hash_fill + hash_swap + hash_common + )}; + + return $self; +} + ###----------------------------------------------------------------### ### default hook implementations +sub path_info_map { } + sub run_step { my $self = shift; my $step = shift; @@ -757,29 +814,37 @@ sub print { sub print_out { my ($self, $step, $out) = @_; - $self->cgix->print_content_type(); + $self->cgix->print_content_type; print $out; } sub swap_template { my ($self, $step, $file, $swap) = @_; - require CGI::Ex::Template; my $args = $self->run_hook('template_args', $step); - my $t = CGI::Ex::Template->new($args); + my $copy = $self; + eval {require Scalar::Util; Scalar::Util::weaken($copy)}; + $args->{'INCLUDE_PATH'} ||= sub { + my $dir = $copy->base_dir_abs || die "Could not find base_dir_abs while looking for template INCLUDE_PATH on step \"$step\""; + $dir = $dir->() if UNIVERSAL::isa($dir, 'CODE'); + return $dir; + }; + my $t = $self->template_obj($args); my $out = ''; + $t->process($file, $swap, \$out) || die $t->error; return $out; } -sub template_args { - my $self = shift; - my $step = shift; - return { - INCLUDE_PATH => sub { $self->base_dir_abs || die "Could not find base_dir_abs while looking for template INCLUDE_PATH on step \"$step\"" }, - }; +sub template_args { {} } + +sub template_obj { + my ($self, $args) = @_; + + require CGI::Ex::Template; + my $t = CGI::Ex::Template->new($args); } sub fill_template { @@ -801,14 +866,9 @@ sub pre_step { 0 } # success indicates we handled step (don't continue step or sub skip { 0 } # success indicates to skip the step (and continue loop) sub prepare { 1 } # failure means show step sub finalize { 1 } # failure means show step -sub post_print { 0 } # success indicates we handled step (don't continue loop) +sub post_print { 0 } sub post_step { 0 } # success indicates we handled step (don't continue step or loop) -sub name_step { - my ($self, $step) = @_; - return $step; -} - sub morph_package { my $self = shift; my $step = shift || ''; @@ -830,6 +890,11 @@ sub name_module { }; } +sub name_step { + my ($self, $step) = @_; + return $step; +} + sub file_print { my $self = shift; my $step = shift; @@ -848,15 +913,27 @@ sub file_val { my $self = shift; my $step = shift; - my $abs = $self->base_dir_abs || return {}; + ### determine the path to begin looking for files - allow for an arrayref + my $abs = $self->base_dir_abs || []; + $abs = $abs->() if UNIVERSAL::isa($abs, 'CODE'); + $abs = [$abs] if ! UNIVERSAL::isa($abs, 'ARRAY'); + return {} if @$abs == 0; + my $base_dir = $self->base_dir_rel; my $module = $self->run_hook('name_module', $step); - my $_step = $self->run_hook('name_step', $step); + my $_step = $self->run_hook('name_step', $step) || die "Missing name_step"; $_step .= '.'. $self->ext_val if $_step !~ /\.\w+$/; - foreach ($abs, $base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| } + foreach (@$abs, $base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| } - return $abs . $base_dir . $module . $_step; + if (@$abs > 1) { + foreach my $_abs (@$abs) { + my $path = $_abs . $base_dir . $module . $_step; + return $path if -e $path; + } + } + + return $abs->[0] . $base_dir . $module . $_step; } sub info_complete { @@ -936,9 +1013,9 @@ sub hash_validation { if (ref($file) && ! UNIVERSAL::isa($file, 'SCALAR')) { $hash = $file; - ### read the file - if it fails - errors should be in the webserver error logs + ### read the file - if it is not found, errors will be in the webserver logs (all else dies) } elsif ($file) { - $hash = eval { $self->vob->get_validation($file) } || {}; + $hash = $self->vob->get_validation($file) || {}; } else { $hash = {}; @@ -953,14 +1030,8 @@ sub hash_base { return $self->{'hash_base'} ||= do { ### create a weak copy of self to use in closures - my $copy; - if (eval {require Scalar::Util} && defined &Scalar::Util::weaken) { - $copy = $self; - Scalar::Util::weaken($copy); - } else { - $copy = bless {%$self}, ref($self); # hackish way to avoid circular refs on older perls (pre 5.8) - } - + my $copy = $self; + eval {require Scalar::Util; Scalar::Util::weaken($copy)}; my $hash = { script_name => $ENV{'SCRIPT_NAME'} || $0, path_info => $ENV{'PATH_INFO'} || '', @@ -1030,18 +1101,18 @@ sub base_dir_abs { return $self->{'base_dir_abs'} || ''; } -sub ext_val { - my $self = shift; - $self->{'ext_val'} = shift if $#_ != -1; - return $self->{'ext_val'} || 'val'; -} - sub ext_print { my $self = shift; $self->{'ext_print'} = shift if $#_ != -1; return $self->{'ext_print'} || 'html'; } +sub ext_val { + my $self = shift; + $self->{'ext_val'} = shift if $#_ != -1; + return $self->{'ext_val'} || 'val'; +} + ### where to find the javascript files ### default to using this script as a handler sub js_uri_path {