view release on metacpan or  search on metacpan

lib/CGI/Ex/App.pm  view on Meta::CPAN

}

###---------------------###
# hooks

sub file_print {
    my ($self, $step) = @_;
    my $base_dir = $self->base_dir_rel;
    my $module   = $self->run_hook('name_module', $step);
    my $_step    = $self->run_hook('name_step', $step) || croak "Missing name_step";
    $_step =~ s|\B__+|/|g;
    $_step .= '.'. $self->ext_print if $_step !~ /\.\w+$/;
    foreach ($base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| }
    return $base_dir . $module . $_step;
}

sub file_val {
    my ($self, $step) = @_;

    my $abs = $self->val_path || [];
    $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) || croak "Missing name_step";
    $_step =~ s|\B__+|/|g;
    $_step =~ s/\.\w+$//;
    $_step .= '.'. $self->ext_val;

    foreach (@$abs, $base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| }

    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 fill_template {
    my ($self, $step, $outref, $fill) = @_;
    return if ! $fill || ! scalar keys %$fill;
    my $args = $self->run_hook('fill_args', $step) || {};
    local @$args{'text', 'form'} = ($outref, $fill);
    require CGI::Ex::Fill;
    CGI::Ex::Fill::fill($args);
}

sub finalize  { 1 } # false means show step

sub hash_base {
    my ($self, $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'} ||= {} }
sub hash_errors { $_[0]->{'hash_errors'} ||= {} }
sub hash_fill   { $_[0]->{'hash_fill'}   ||= {} }
sub hash_form   { $_[0]->form }
sub hash_swap   { $_[0]->{'hash_swap'}   ||= {} }

sub hash_validation {
  my ($self, $step) = @_;
  return $self->{'hash_validation'}->{$step} ||= do {
      my $file = $self->run_hook('file_val', $step);
      $file ? $self->val_obj->get_validation($file) : {}; # if the file is not found, errors will be in the webserver logs (all else dies)
  };
}

sub info_complete {
    my ($self, $step) = @_;
    return 0 if ! $self->run_hook('ready_validate', $step);
    return $self->run_hook('validate', $step, $self->form) ? 1 : 0;
}

sub js_validation {
    my ($self, $step) = @_;
    my $form_name = $_[2] || $self->run_hook('form_name', $step);
    my $hash_val  = $_[3] || $self->run_hook('hash_validation', $step);
    return '' if ! $form_name || ! ref($hash_val) || ! scalar keys %$hash_val;
    return $self->val_obj->generate_js($hash_val, $form_name, $self->js_uri_path);
}

sub generate_form {
    my ($self, $step) = @_;
    my $form_name = $_[2] || $self->run_hook('form_name', $step);
    my $args      = ref($_[3]) eq 'HASH' ? $_[3] : {};
    my $hash_val  = $self->run_hook('hash_validation', $step);
    return '' if ! $form_name || ! ref($hash_val) || ! scalar keys %$hash_val;
    local $args->{'js_uri_path'} = $self->js_uri_path;
    return $self->val_obj->generate_form($hash_val, $form_name, $args);
}

sub morph_base { my $self = shift; ref($self) }
sub morph_package {
    my ($self, $step) = @_;
    my $cur = $self->morph_base; # default to using self as the base for morphed modules
    my $new = ($cur ? $cur .'::' : '') . ($step || croak "Missing step");
    $new =~ s/\B__+/::/g; # turn Foo::my_nested__step info Foo::my_nested::step
    $new =~ s/(?:_+|\b)(\w)/\u$1/g; # turn Foo::my_step_name into Foo::MyStepName
    return $new;
}

sub name_module {
    my ($self, $step) = @_;
    return $self->{'name_module'} ||= ($self->script_name =~ m/ (\w+) (?:\.\w+)? $/x)
        ? $1 : die "Could not determine module name from \"name_module\" lookup (".($step||'').")\n";
}