CodeDef — generic subroutine mapper
A generic Perl subroutine mapper which allows mapping of subroutines to
ActionMaps,
CoreTags, UserTag
s,
filters,
form actions,
GlobalSub
s,
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.
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.
Interchange 5.9.0:
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; }