###----------------------------------------------------------------###
# See the perldoc in CGI/Ex/App.pod
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
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 {
### 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);
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;
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'} ||= [];
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
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;
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 {
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 || '';
};
}
+sub name_step {
+ my ($self, $step) = @_;
+ return $step;
+}
+
sub file_print {
my $self = shift;
my $step = shift;
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 {
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 = {};
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'} || '',
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 {
projects / chaz / p5-CGI-Ex / blobdiff