Name

UserTag — define an Interchange tag

SYNOPSIS

DESCRIPTION

DIRECTIVE TYPE AND DEFAULT VALUE

Global directive,
Catalog directive

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

Catalog-based usertag will run under safe restrictions, and will only be accessible only from the corresponding catalog. Global UserTags are not restricted by Safe and are available to all catalogs running on the server.

AVAILABILITY

UserTag is available in Interchange versions:

4.6.0-5.9.0 (git-head)

SOURCE

Interchange 5.9.0:

Source: lib/Vend/Config.pm
Line 500

['UserTag',       'tag',         ''],

Source: lib/Vend/Config.pm
Line 661

['UserTag',       'tag',          ''],

Source: lib/Vend/Config.pm
Line 5109 (context shows lines 5109-5265)

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{'__WARN__'} = 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;
}

AUTHORS

Interchange Development Group

SEE ALSO

CodeDef(7ic), ActionMap(7ic), FormAction(7ic), Sub(7ic)

DocBook! Interchange!