Name

FormAction — define or override form action

SYNOPSIS

action_name perl_code

DESCRIPTION

The directive allows definition of form actions. Some pre-defined actions that you might already be familiar with are return, submit or refresh.

DIRECTIVE TYPE AND DEFAULT VALUE

Global directive,
Catalog directive

EXAMPLES

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

NOTES

Catalog version of the directive is protected by Safe.

For a complete discussion, please see the form action glossary entry.

AVAILABILITY

FormAction is available in Interchange versions:

4.6.0-5.9.0 (git-head)

SOURCE

Interchange 5.9.0:

Source: lib/Vend/Config.pm
Line 469

['FormAction',     'action',       ''],

Source: lib/Vend/Config.pm
Line 542

['FormAction',     'action',       ''],

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;

}

AUTHORS

Interchange Development Group

SEE ALSO

UserTag(7ic), CodeDef(7ic)

DocBook! Interchange!