UserTag — define an Interchange tag
Catalog-based usertag will run under safe restrictions,
and will only be accessible only from the corresponding catalog.
Global UserTag
s are not restricted
by Safe
and are available to all catalogs running on
the server.
Interchange 5.9.0:
Source: lib/Vend/Config.pm
Line 5129 (context shows lines 5129-5285)
sub parse_tag { my ($var, $value) = @_; my ($new); #::logDebug("parse_tag var=$var val=$value") unless $Global::Foreground; return if $Vend::ExternalProgram; unless (defined $value && $value) { return {}; } return parse_mapped_code($var, $value) if $var ne 'UserTag'; #::logDebug("ready to read tag, C='$C' SystemCodeDone=$SystemCodeDone") unless $Global::Foreground; get_system_code() unless defined $SystemCodeDone; my $c = defined $C ? $C->{UserTag} : $Global::UserTag; my($tag,$p,$val) = split /\s+/, $value, 3; unless ( $tagCanon{lc $p} ) { config_warn("Bad user tag parameter '%s' for '%s', skipping.", $p, $tag); return $c; } # Canonicalize $p = $tagCanon{lc $p}; $tag =~ tr/-/_/; $tag =~ s/\W//g and config_warn("Bad characters removed from '%s'.", $tag); if ($tagSkip{$p}) { return $c; } if($p eq 'Underride') { if($Global::UserTag->{Routine}->{$tag} or $C && $C->{UserTag}->{Routine}->{$tag}) { $c->{Done}{$tag} = 1; } } return $c if $c->{Done}{$tag}; if($CodeDest and $CodeDest eq 'CoreTag') { return $c unless $Global::TagInclude->{$tag} || $Global::TagInclude->{ALL}; } #::logDebug("ready to read tag=$tag p=$p") unless $Global::Foreground; if($p eq 'Override') { for (keys %$c) { delete $c->{$_}{$tag}; } } elsif($p eq 'Routine' or $p eq 'PosRoutine') { if (defined $c->{Source}->{$tag}->{$p}){ config_error( errmsg( "Duplicate usertag %s found", $tag, ) ); } if (defined $C && defined $Global::UserTag->{Routine}->{$tag}){ config_warn( errmsg( "Local usertag %s overrides global definition", $tag, ) ) unless $C->{Limit}{override_tag} =~ /\b$tag\b/; } my $sub; $c->{Source}->{$tag}->{$p} = $val; unless(!defined $C or $Global::AllowGlobal->{$C->{CatalogName}}) { my $safe = new Vend::Safe; my $code = $val; $code =~ s'$Vend::Session->'$foo'g; $code =~ s'$Vend::Cfg->'$bar'g; $safe->trap(@{$Global::SafeTrap}); $safe->untrap(@{$Global::SafeUntrap}); $sub = $safe->reval($code); if($@) { config_warn( "UserTag '%s' subroutine failed safe check: %s", $tag, $@, ); return $c; } } local($^W) = 1; my $fail = ''; { local $SIG{''} = sub {$fail .= "$_[0]\n";}; package Vend::Interpolate; $sub = eval $val; } if($@) { config_warn( "UserTag '%s' subroutine failed compilation:\n\n\t%s", $tag, "$@ (warnings=$fail)", ); return $c; } elsif($fail) { config_warn( "Warning while compiling UserTag '%s':\n\n\t%s", $tag, $fail, ); return $c; } config_warn( "UserTag '%s' code is not a subroutine reference", $tag, ) unless ref($sub) eq 'CODE'; $c->{$p}{$tag} = $sub; $c->{Order}{$tag} = [] unless defined $c->{Order}{$tag}; } elsif (! $C and $p eq 'MapRoutine') { #::logDebug("In MapRoutine ") unless $Global::Foreground; $val =~ s/^\s+//; $val =~ s/\s+$//; no strict 'refs'; $c->{Routine}{$tag} = \&{"$val"}; $c->{Order}{$tag} = [] unless defined $c->{Order}{$tag}; } 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("UserTag %s scalar parameter %s redefined.", $tag, $p) if defined $c->{$p}{$tag}; $c->{$p}{$tag} = $val; } return $c; }