use vars qw($VERSION);
BEGIN {
- $VERSION = '2.15';
+ $VERSION = '2.17';
Time::HiRes->import('time') if eval {require Time::HiRes};
eval {require Scalar::Util};
$self->init;
+ $self->init_from_conf;
+
return $self;
}
###----------------------------------------------------------------###
+sub init_from_conf {
+ my $self = shift;
+ return if ! $self->load_conf;
+ my $conf = $self->conf;
+ @{ $self }{ keys %$conf } = values %$conf;
+ return;
+}
+
+sub load_conf { shift->{'load_conf'} ||= @_ ? 1 : 0 }
+
+sub conf {
+ my $self = shift;
+ return $self->{'conf'} ||= do {
+ my $conf = $self->conf_obj->read($self->conf_file, {no_warn_on_fail => 1}) || croak $@;
+ my $hash = $self->conf_validation;
+ if ($hash && scalar keys %$hash) {
+ my $err_obj = $self->vob->validate($conf, $hash);
+ die $err_obj if $err_obj;
+ }
+ $conf;
+ }
+}
+
+sub conf_path {
+ my $self = shift;
+ return $self->{'conf_path'} || $self->base_dir_abs;
+}
+
+sub conf_file {
+ my $self = shift;
+ return $self->{'conf_file'} ||= do {
+ my $module = $self->name_module || croak 'Missing name_module during conf_file call';
+ $module .'.'. $self->conf_ext;
+ };
+}
+
+sub conf_ext {
+ my $self = shift;
+ $self->{'conf_ext'} = shift if @_ == 1;
+ return $self->{'conf_ext'} || 'pl';
+}
+
+sub conf_args { shift->{'conf_args'} || {} }
+
+sub conf_obj {
+ my $self = shift;
+ return $self->{'conf_obj'} || do {
+ my $args = $self->conf_args;
+ $args->{'paths'} ||= $self->conf_path;
+ $args->{'directive'} ||= 'MERGE';
+ require CGI::Ex::Conf;
+ CGI::Ex::Conf->new($args);
+ };
+}
+
+sub conf_validation {}
+
+###----------------------------------------------------------------###
+
sub navigate {
my ($self, $args) = @_;
$self = $self->new($args) if ! ref $self;
### run the step loop
eval {
- local $self->{'__morph_lineage_start_index'} = $#{$self->{'__morph_lineage'} || []};
+ local $self->{'_morph_lineage_start_index'} = $#{$self->{'_morph_lineage'} || []};
$self->nav_loop;
};
if ($@) {
my $self = shift;
### keep from an infinate nesting
- local $self->{'recurse'} = $self->{'recurse'} || 0;
- if ($self->{'recurse'} ++ >= $self->recurse_limit) {
+ local $self->{'_recurse'} = $self->{'_recurse'} || 0;
+ if ($self->{'_recurse'}++ >= $self->recurse_limit) {
my $err = "recurse_limit (".$self->recurse_limit.") reached";
$err .= " number of jumps (".$self->{'jumps'}.")" if ($self->{'jumps'} || 0) > 1;
croak $err;
my $self = shift;
my $err = shift;
- die $err;
+ die $err if $self->{'_handling_error'};
+ local $self->{'_handling_error'} = 1;
+ local $self->{'_recurse'} = 0; # allow for this next step - even if we hit a recurse error
+
+ $self->stash->{'error_step'} = $self->current_step;
+ $self->stash->{'error'} = $err;
+ $self->replace_path($self->error_step);
+ $self->jump; # exits nav loop when finished
}
###----------------------------------------------------------------###
-sub default_step { shift->{'default_step'} || 'main' }
-
-sub js_step { shift->{'js_step'} || 'js' }
-
+sub default_step { shift->{'default_step'} || 'main' }
+sub js_step { shift->{'js_step'} || 'js' }
+sub login_step { shift->{'login_step'} || '__login' }
+sub error_step { shift->{'error_step'} || '__error' }
sub forbidden_step { shift->{'forbidden_step'} || '__forbidden' }
sub step_key { shift->{'step_key'} || 'step' }
my $self = shift;
### undo morphs
- if (my $ref = $self->{'__morph_lineage'}) {
+ if (my $ref = $self->{'_morph_lineage'}) {
### use the saved index - this allows for early "morphers" to only get rolled back so far
- my $index = $self->{'__morph_lineage_start_index'};
+ my $index = $self->{'_morph_lineage_start_index'};
$index = -1 if ! defined $index;
$self->unmorph while $#$ref != $index;
}
my $allow = $self->allow_morph($step) || return;
### place to store the lineage
- my $lin = $self->{'__morph_lineage'} ||= [];
+ my $lin = $self->{'_morph_lineage'} ||= [];
my $cur = ref $self; # what are we currently
push @$lin, $cur; # store so subsequent unmorph calls can do the right thing
sub unmorph {
my $self = shift;
- my $step = shift || '__no_step';
- my $lin = $self->{'__morph_lineage'} || return;
+ my $step = shift || '_no_step';
+ my $lin = $self->{'_morph_lineage'} || return;
my $cur = ref $self;
my $prev = pop(@$lin) || croak "unmorph called more times than morph - current ($cur)";
- delete $self->{'__morph_lineage'} if ! @$lin;
+ delete $self->{'_morph_lineage'} if ! @$lin;
### if we are not already that package - bless us there
my $hist = {
$args->{'cleanup_user'} ||= sub { my ($auth, $user) = @_; $self->cleanup_user( $user, $auth) };
$args->{'login_print'} ||= sub {
my ($auth, $template, $hash) = @_;
- my $step = '__login';
+ my $step = $self->login_step;
my $hash_base = $self->run_hook('hash_base', $step) || {};
my $hash_comm = $self->run_hook('hash_common', $step) || {};
my $hash_swap = $self->run_hook('hash_swap', $step) || {};
$self->{'vob'} = shift if @_ == 1;
return $self->{'vob'} ||= do {
require CGI::Ex::Validate;
+ my $args = $self->vob_args;
+ $args->{'cgix'} ||= $self->cgix;
CGI::Ex::Validate->new($self->vob_args); # return of the do
};
}
-sub vob_args {
+sub vob_args { shift->{'vob_args'} || {} }
+
+sub vob_path {
my $self = shift;
- return {
- cgix => $self->cgix,
- };
+ return $self->{'vob_path'} || $self->template_path;
}
### provide a place for placing variables
path
path_i
history
- __morph_lineage_start_index
- __morph_lineage
+ _morph_lineage_start_index
+ _morph_lineage
hash_errors
hash_fill
hash_swap
sub print {
my ($self, $step, $swap, $fill) = @_;
-
- my $file = $self->run_hook('file_print', $step); # get a filename relative to base_dir_abs
-
+ my $file = $self->run_hook('file_print', $step); # get a filename relative to template_path
my $out = $self->run_hook('swap_template', $step, $file, $swap);
-
$self->run_hook('fill_template', $step, \$out, $fill);
$self->run_hook('print_out', $step, \$out);
}
sub print_out {
my ($self, $step, $out) = @_;
- $self->cgix->print_content_type;
- print ref($out) ? $$out : $out;
+ $self->cgix->print_content_type($self->mimetype($step), $self->charset($step));
+ print ref($out) eq 'SCALAR' ? $$out : $out;
}
+sub mimetype { shift->{'mimetype'} || 'text/html' }
+sub charset { shift->{'charset'} || '' }
+
sub swap_template {
my ($self, $step, $file, $swap) = @_;
my $args = $self->run_hook('template_args', $step);
- 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;
- };
+ $args->{'INCLUDE_PATH'} ||= $args->{'include_path'} || $self->template_path;
- my $t = $self->template_obj($args);
+ my $t = $self->template_obj($args);
my $out = '';
-
$t->process($file, $swap, \$out) || die $t->error;
return $out;
}
-sub template_args { {} }
+sub template_path {
+ my $self = shift;
+ return $self->{'template_path'} || $self->base_dir_abs;
+}
+
+sub template_args { shift->{'template_args'} || {} }
sub template_obj {
my ($self, $args) = @_;
CGI::Ex::Fill::fill($args);
}
-sub fill_args { {} }
+sub fill_args { shift->{'fill_args'} || {} }
sub pre_step { 0 } # success indicates we handled step (don't continue step or loop)
sub skip { 0 } # success indicates to skip the step (and continue loop)
my $step = shift;
### determine the path to begin looking for files - allow for an arrayref
- my $abs = $self->base_dir_abs || [];
+ my $abs = $self->vob_path || [];
$abs = $abs->() if UNIVERSAL::isa($abs, 'CODE');
$abs = [$abs] if ! UNIVERSAL::isa($abs, 'ARRAY');
return {} if @$abs == 0;
my $copy = $self;
eval {require Scalar::Util; Scalar::Util::weaken($copy)};
my $hash = {
- script_name => $copy->script_name,
- path_info => $copy->path_info,
+ script_name => $self->script_name,
+ path_info => $self->path_info,
js_validation => sub { $copy->run_hook('js_validation', $step, shift) },
- form_name => sub { $copy->run_hook('form_name', $step) },
+ form_name => $self->run_hook('form_name', $step),
$self->step_key => $step,
}; # return of the do
};
sub base_dir_rel {
my $self = shift;
- $self->{'base_dir_rel'} = shift if $#_ != -1;
+ $self->{'base_dir_rel'} = shift if @_ == 1;
return $self->{'base_dir_rel'} || '';
}
sub base_dir_abs {
my $self = shift;
- $self->{'base_dir_abs'} = shift if $#_ != -1;
- return $self->{'base_dir_abs'} || '';
+ $self->{'base_dir_abs'} = shift if @_ == 1;
+ return $self->{'base_dir_abs'} || ['.']; # default to the current directory
}
sub ext_print {
my $self = shift;
- $self->{'ext_print'} = shift if $#_ != -1;
+ $self->{'ext_print'} = shift if @_ == 1;
return $self->{'ext_print'} || 'html';
}
sub ext_val {
my $self = shift;
- $self->{'ext_val'} = shift if $#_ != -1;
+ $self->{'ext_val'} = shift if @_ == 1;
return $self->{'ext_val'} || 'val';
}
sub __forbidden_info_complete { 0 }
-sub __forbidden_hash_swap { {forbidden_step => shift->stash->{'forbidden_step'}} }
+sub __forbidden_hash_swap { shift->stash }
sub __forbidden_file_print { \ "<h1>Denied</h1>You do not have access to the step <b>\"[% forbidden_step %]\"</b>" }
+###----------------------------------------------------------------###
+### a step that is used by the default handle_error
+
+sub __error_info_complete { 0 }
+
+sub __error_hash_swap { 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 %]" }
+
###----------------------------------------------------------------###
1;
projects / chaz / p5-CGI-Ex / blobdiff