CodeDef

SYNOPSIS

DESCRIPTION

A generic Perl subroutine mapper which allows mapping of subroutines to ActionMaps, CoreTags, UserTags, filters, form actions, GlobalSubs, ItemActions, SearchOps, LocaleChanges, OrderChecks, and Widgets.

SearchOp definition needs to be a function that creates and returns a search function. The search function will receive the data to match and should return 1 if the value matches.

DIRECTIVE TYPE AND DEFAULT VALUE

Global directive,
Catalog directive

EXAMPLES

Example: Defining a custom SearchOp

Here's an exemplary "find_hammer" SearchOp that should be placed in interchange.cfg:

CodeDef find_hammer SearchOp find_hammer

CodeDef find_hammer Routine <<EOR
sub {
  # Called with:
  # $self - search object
  # $i - index into coordinated search array
  # $string - data to match
  # $opname - name of the specified mv_column_op

  my($self, $i, $string, $opname);
  #::logDebug("Calling fake SearchOp");
  return sub {
    #::logDebug("testing with fake SearchOp");
    my $string = shift;
    $string =~ /hammer/i;
  };
}
EOR

The above simple function does not honor mv_negate or other variables. See Vend::Search::create_text_query for an example of how to create a proper search routine and honor various associated search parameters.

Example: Widgets with multiple selections

CodeDef checkbox Multiple 1

NOTES

AVAILABILITY

CodeDef is available in Interchange versions:

4.6.0-5.9.0 (git-head)

SOURCE

Interchange 5.9.0:

Source: lib/Vend/Config.pm
Line 503

['CodeDef',       'mapped_code',     ''],

Source: lib/Vend/Config.pm
Line 666

['CodeDef',       'mapped_code',       ''],

Source: lib/Vend/Config.pm
Line 5065 (context shows lines 5065-5126)

sub parse_mapped_code {
my ($var, $value) = @_;

return {} if ! $value;

## Can't give CodeDef a default or this will be premature
get_system_code() unless defined $SystemCodeDone;

my($tag,$p,$val) = split /\s+/, $value, 3;

# Canonicalize
$p = $tagCanon{lc $p} || ''
  or ::logDebug("bizarre mapped code line '$value'");
$tag =~ tr/-/_/;
$tag =~ s/\W//g
  and config_warn("Bad characters removed from '%s'.", $tag);

my $repos = $C ? ($C->{CodeDef} ||= {}) : ($Global::CodeDef ||= {});

if ($tagSkip{$p}) {
  return $repos;
}

my $dest = $valid_dest{lc $p} || $current_dest{$tag} || $CodeDest;

if(! $dest) {
  config_warn("no destination for %s %s, skipping.", $var, $tag);
  return $repos;
}
$current_dest{$tag} = $dest;
$repos->{$dest} ||= {};

my $c = $repos->{$dest};

if($Compiled{$p}) {
  $c->{$Compiled{$p}} ||= {};
  parse_action($var, "$tag $val", $c->{$Compiled{$p}} ||= {});
}
elsif(defined $tagAry{$p}) {
  my(@v) = Text::ParseWords::shellwords($val);
  $c->{$p}{$tag} = [] unless defined $c->{$p}{$tag};
  push @{$c->{$p}{$tag}}, @v;
}
elsif(defined $tagHash{$p}) {
  my(%v) = Text::ParseWords::shellwords($val);
  $c->{$p}{$tag} = {} unless defined $c->{$p}{$tag};
  for (keys %v) {
    $c->{$p}{$tag}{$_} = $v{$_};
  }
}
elsif(defined $tagBool{$p}) {
  $c->{$p}{$tag} = 1
    unless defined $val and $val =~ /^[0nf]/i;
}
else {
  config_warn("%s %s scalar parameter %s redefined.", $var, $tag, $p)
    if defined $c->{$p}{$tag};
  $c->{$p}{$tag} = $val;
}

return $repos;
}

AUTHORS

Interchange Development Group

Name