FormAction — define or override form action
The directive allows definition of form actions. Some pre-defined
actions that you might already be familiar with are
return,
submit or
refresh.
Example: Checkout Action
This action can be used on the shopping cart page to update the cart and go to the checkout page with an image button.
FormAction checkout <<EOR
sub {
$Tag->update('quantity');
$CGI->{mv_nextpage} = 'checkout';
return 1;
}
EOR
Catalog version of the directive is protected by Safe.
For a complete discussion, please see the form action glossary entry.
Interchange 5.9.0:
Source: lib/Vend/Config.pm
Line 2161 (context shows lines 2161-2258)
sub parse_action {
my ($var, $value, $mapped) = @_;
if (! $value) {
return $InitializeEmpty{$var} ? '' : {};
}
return if $Vend::ExternalProgram;
my $c;
if($mapped) {
$c = $mapped;
}
elsif(defined $C) {
$c = $C->{$var} ||= {};
}
else {
no strict 'refs';
$c = ${"Global::$var"} ||= {};
}
if (defined $C and ! $c->{_mvsafe}) {
my $calc = Vend::Interpolate::reset_calc();
$c->{_mvsafe} = $calc;
}
my ($name, $sub) = split /\s+/, $value, 2;
$name =~ s/-/_/g;
## Determine if we are in a catalog config, and if
## perl should be global and/or strict
my $nostrict;
my $perlglobal = 1;
if($C) {
$nostrict = $Global::PerlNoStrict->{$C->{CatalogName}};
$perlglobal = $Global::AllowGlobal->{$C->{CatalogName}};
}
# Untaint and strip this pup
$sub =~ s/^\s*((?s:.)*\S)\s*//;
$sub = $1;
if($sub !~ /\s/) {
no strict 'refs';
if($sub =~ /::/ and ! $C) {
$c->{$name} = \&{"$sub"};
}
else {
if($C and $C->{Sub}) {
$c->{$name} = $C->{Sub}{$sub};
}
if(! $c->{$name} and $Global::GlobalSub) {
$c->{$name} = $Global::GlobalSub->{$sub};
}
}
if(! $c->{$name} and $AllowScalarAction{$var}) {
$c->{$name} = $sub;
}
elsif(! $c->{$name}) {
$@ = errmsg("Mapped %s action routine '%s' is non-existent.", $var, $sub);
}
}
elsif ( ! $mapped and $sub !~ /^sub\b/) {
if($AllowScalarAction{$var}) {
$c->{$name} = $sub;
}
else {
my $code = <<EOF;
sub {
return Vend::Interpolate::interpolate_html(<<EndOfThisHaiRYTHING);
$sub
EndOfThisHaiRYTHING
}
EOF
$c->{$name} = eval $code;
}
}
elsif ($perlglobal) {
package Vend::Interpolate;
if($nostrict) {
no strict;
$c->{$name} = eval $sub;
}
else {
$c->{$name} = eval $sub;
}
}
else {
package Vend::Interpolate;
$c->{$name} = $c->{_mvsafe}->reval($sub);
}
if($@) {
config_warn("Action '%s' did not compile correctly (%s).", $name, $@);
}
return $c;
}