perl — evaluate embedded Perl code
Attribute | Pos. | Req. | Default | Description |
---|---|---|---|---|
tables | table | Yes | No | ||
subs | 0 |
imports subroutines defined by Sub
|
||
short_errors | 0 | log error message only | ||
no_return | 0 |
store result into session key mv_perl_result instead of returning it
|
||
interpolate | 0 | interpolate input? | ||
reparse | 1 | interpolate output? | ||
hide | 0 | Hide the tag return value? |
The [calc]
tag is lower-overhead variant of [perl]
, because it
does not accept arguments, does not try to interpolate tag body, does not
pre-open any database tables, and it doesn't do any extra wrapping.
The [calc]
tag will remember variable values inside the page, so you
can do the equivalent of a memory store and memory recall for a loop. In
other words, variables you initialize or set in one [calc]
block are
also visible in all further [calc]
blocks on the same page.
There is no reason to ever use this tag inside [perl]
or [mvasp]
.
Interchange 5.9.0:
Source: code/SystemTag/perl.coretag
Lines: 16
# Copyright 2002-2007 Interchange Development Group and others # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. See the LICENSE file for details. # # $Id: perl.coretag,v 1.5 2007-03-30 23:40:49 pajamian Exp $ UserTag perl Order tables UserTag perl addAttr UserTag perl attrAlias table tables UserTag perl hasEndTag UserTag perl PosNumber 1 UserTag perl Version $Revision: 1.5 $ UserTag perl MapRoutine Vend::Interpolate::tag_perl
Source: lib/Vend/Interpolate.pm
Lines: 1743
sub tag_perl { my ($tables, $opt,$body) = @_; my ($result,@share); #::logDebug("tag_perl MVSAFE=$MVSAFE::Safe opts=" . uneval($opt)); if($Vend::NoInterpolate) { logGlobal({ level => 'alert' }, "Attempt to interpolate perl/ITL from RPC, no permissions." ); return undef; } if ($MVSAFE::Safe) { #::logDebug("tag_perl: Attempt to call perl from within Safe."); return undef; } #::logDebug("tag_perl: tables=$tables opt=" . uneval($opt) . " body=$body"); #::logDebug("tag_perl initialized=$Vend::Calc_initialized: carts=" . uneval($::Carts)); if($opt->{subs} or $opt->{arg} =~ /\bsub\b/) { no strict 'refs'; for(keys %{$Global::GlobalSub}) { #::logDebug("tag_perl share subs: GlobalSub=$_"); next if defined $Global::AdminSub->{$_} and ! $Global::AllowGlobal->{$Vend::Cat}; *$_ = \&{$Global::GlobalSub->{$_}}; push @share, "&$_"; } for(keys %{$Vend::Cfg->{Sub} || {}}) { #::logDebug("tag_perl share subs: Sub=$_"); *$_ = \&{$Vend::Cfg->{Sub}->{$_}}; push @share, "&$_"; } } if($tables) { my (@tab) = grep /\S/, split /\s+/, $tables; foreach my $tab (@tab) { next if $Db{$tab}; my $db = database_exists_ref($tab); next unless $db; my $dbh; $db = $db->ref(); if($db->config('type') == 10) { my @extra_tabs = $db->_shared_databases(); push (@tab, @extra_tabs); $dbh = $db->dbh(); } elsif ($db->can('dbh')) { $dbh = $db->dbh(); } if($hole) { if ($dbh) { $Sql{$tab} = $hole->wrap($dbh); } $Db{$tab} = $hole->wrap($db); if($db->config('name') ne $tab) { $Db{$db->config('name')} = $Db{$tab}; } } else { $Sql{$tab} = $db->[$Vend::Table::DBI::DBI] if $db =~ /::DBI/; $Db{$tab} = $db; } } } $Tag = $hole->wrap($Tag) if $hole and ! $Vend::TagWrapped++; init_calc() if ! $Vend::Calc_initialized; $ready_safe->share(@share) if @share; if($Vend::Cfg->{Tie_Watch}) { eval { for(@{$Vend::Cfg->{Tie_Watch}}) { logGlobal("touching $_"); my $junk = $Config->{$_}; } }; } $Items = $Vend::Items; $body = readfile($opt->{file}) . $body if $opt->{file}; # Skip costly eval of code entirely if perl tag was called with no code, # likely used only for the side-effect of opening database handles return if $body !~ /\S/; $body =~ tr/\r//d if $Global::Windows; $MVSAFE::Safe = 1; if ( ( $opt->{global} or (! defined $opt->{global} and $Global::PerlAlwaysGlobal->{$Vend::Cat} ) ) and $Global::AllowGlobal->{$Vend::Cat} ) { $MVSAFE::Safe = 0 unless $MVSAFE::Unsafe; } if(! $MVSAFE::Safe) { if ($Global::PerlNoStrict->{$Vend::Cat} || $opt->{no_strict}) { no strict; $result = eval($body); } else { $result = eval($body); } } else { $result = $ready_safe->reval($body); } undef $MVSAFE::Safe; if ($@) { #::logDebug("tag_perl failed $@"); my $msg = $@; if($Vend::Try) { $Vend::Session->{try}{$Vend::Try} .= "\n" if $Vend::Session->{try}{$Vend::Try}; $Vend::Session->{try}{$Vend::Try} .= $@; } if($opt->{number_errors}) { my @lines = split("\n",$body); my $counter = 1; map { $_ = sprintf("% 4d %s",$counter++,$_); } @lines; $body = join("\n",@lines); } if($opt->{trim_errors}) { if($msg =~ /line (\d+)\.$/) { my @lines = split("\n",$body); my $start = $1 - $opt->{trim_errors} - 1; my $length = (2 * $opt->{trim_errors}) + 1; @lines = splice(@lines,$start,$length); $body = join("\n",@lines); } } if($opt->{eval_label}) { $msg =~ s/\(eval \d+\)/($opt->{eval_label})/g; } if($opt->{short_errors}) { chomp($msg); logError( "Safe: %s" , $msg ); logGlobal({ level => 'debug' }, "Safe: %s" , $msg ); } else { logError( "Safe: %s\n%s\n" , $msg, $body ); logGlobal({ level => 'debug' }, "Safe: %s\n%s\n" , $msg, $body ); } return $opt->{failure}; } #::logDebug("tag_perl initialized=$Vend::Calc_initialized: carts=" . uneval($::Carts)); if ($opt->{no_return}) { $Vend::Session->{mv_perl_result} = $result; $result = join "", @Vend::Document::Out; @Vend::Document::Out = (); } #::logDebug("tag_perl succeeded result=$result\nEND"); return $result; }
Source: lib/Vend/Interpolate.pm
Lines: 1743
sub tag_perl { my ($tables, $opt,$body) = @_; my ($result,@share); #::logDebug("tag_perl MVSAFE=$MVSAFE::Safe opts=" . uneval($opt)); if($Vend::NoInterpolate) { logGlobal({ level => 'alert' }, "Attempt to interpolate perl/ITL from RPC, no permissions." ); return undef; } if ($MVSAFE::Safe) { #::logDebug("tag_perl: Attempt to call perl from within Safe."); return undef; } #::logDebug("tag_perl: tables=$tables opt=" . uneval($opt) . " body=$body"); #::logDebug("tag_perl initialized=$Vend::Calc_initialized: carts=" . uneval($::Carts)); if($opt->{subs} or $opt->{arg} =~ /\bsub\b/) { no strict 'refs'; for(keys %{$Global::GlobalSub}) { #::logDebug("tag_perl share subs: GlobalSub=$_"); next if defined $Global::AdminSub->{$_} and ! $Global::AllowGlobal->{$Vend::Cat}; *$_ = \&{$Global::GlobalSub->{$_}}; push @share, "&$_"; } for(keys %{$Vend::Cfg->{Sub} || {}}) { #::logDebug("tag_perl share subs: Sub=$_"); *$_ = \&{$Vend::Cfg->{Sub}->{$_}}; push @share, "&$_"; } } if($tables) { my (@tab) = grep /\S/, split /\s+/, $tables; foreach my $tab (@tab) { next if $Db{$tab}; my $db = database_exists_ref($tab); next unless $db; my $dbh; $db = $db->ref(); if($db->config('type') == 10) { my @extra_tabs = $db->_shared_databases(); push (@tab, @extra_tabs); $dbh = $db->dbh(); } elsif ($db->can('dbh')) { $dbh = $db->dbh(); } if($hole) { if ($dbh) { $Sql{$tab} = $hole->wrap($dbh); } $Db{$tab} = $hole->wrap($db); if($db->config('name') ne $tab) { $Db{$db->config('name')} = $Db{$tab}; } } else { $Sql{$tab} = $db->[$Vend::Table::DBI::DBI] if $db =~ /::DBI/; $Db{$tab} = $db; } } } $Tag = $hole->wrap($Tag) if $hole and ! $Vend::TagWrapped++; init_calc() if ! $Vend::Calc_initialized; $ready_safe->share(@share) if @share; if($Vend::Cfg->{Tie_Watch}) { eval { for(@{$Vend::Cfg->{Tie_Watch}}) { logGlobal("touching $_"); my $junk = $Config->{$_}; } }; } $Items = $Vend::Items; $body = readfile($opt->{file}) . $body if $opt->{file}; # Skip costly eval of code entirely if perl tag was called with no code, # likely used only for the side-effect of opening database handles return if $body !~ /\S/; $body =~ tr/\r//d if $Global::Windows; $MVSAFE::Safe = 1; if ( ( $opt->{global} or (! defined $opt->{global} and $Global::PerlAlwaysGlobal->{$Vend::Cat} ) ) and $Global::AllowGlobal->{$Vend::Cat} ) { $MVSAFE::Safe = 0 unless $MVSAFE::Unsafe; } if(! $MVSAFE::Safe) { if ($Global::PerlNoStrict->{$Vend::Cat} || $opt->{no_strict}) { no strict; $result = eval($body); } else { $result = eval($body); } } else { $result = $ready_safe->reval($body); } undef $MVSAFE::Safe; if ($@) { #::logDebug("tag_perl failed $@"); my $msg = $@; if($Vend::Try) { $Vend::Session->{try}{$Vend::Try} .= "\n" if $Vend::Session->{try}{$Vend::Try}; $Vend::Session->{try}{$Vend::Try} .= $@; } if($opt->{number_errors}) { my @lines = split("\n",$body); my $counter = 1; map { $_ = sprintf("% 4d %s",$counter++,$_); } @lines; $body = join("\n",@lines); } if($opt->{trim_errors}) { if($msg =~ /line (\d+)\.$/) { my @lines = split("\n",$body); my $start = $1 - $opt->{trim_errors} - 1; my $length = (2 * $opt->{trim_errors}) + 1; @lines = splice(@lines,$start,$length); $body = join("\n",@lines); } } if($opt->{eval_label}) { $msg =~ s/\(eval \d+\)/($opt->{eval_label})/g; } if($opt->{short_errors}) { chomp($msg); logError( "Safe: %s" , $msg ); logGlobal({ level => 'debug' }, "Safe: %s" , $msg ); } else { logError( "Safe: %s\n%s\n" , $msg, $body ); logGlobal({ level => 'debug' }, "Safe: %s\n%s\n" , $msg, $body ); } return $opt->{failure}; } #::logDebug("tag_perl initialized=$Vend::Calc_initialized: carts=" . uneval($::Carts)); if ($opt->{no_return}) { $Vend::Session->{mv_perl_result} = $result; $result = join "", @Vend::Document::Out; @Vend::Document::Out = (); } #::logDebug("tag_perl succeeded result=$result\nEND"); return $result; }