Item8529: added support for STDOUT and STDERR; they are appended to t…

…he result. git-svn-id: http://svn.foswiki.org/trunk/PerlPlugin@6415 0b4bb1d4-4e5a-0410-9cc4-b2b747904278
foswiki · Feb 17, 2010 · 2fbdee4 · 2fbdee4
1 parent aa3f2f8
commit 2fbdee4
Show file tree

Hide file tree

Showing 4 changed files with 70 additions and 17 deletions.
diff --git a/data/System/PerlPlugin.txt b/data/System/PerlPlugin.txt
@@ -35,12 +35,20 @@ The =%CODE...%ENDCODE%= delimiters are compatible with !SyntaxHighlightingPlugin
 Because Foswiki::Func runs outside Foswiki access controls, this has to be
 use with care.
 
+Note that =STDOUT= and =STDERR= are automatically appended to the result of the %PERL macro. Errors and warnings, and STDERR, are output after the normal result.
+So =%<nop>PERL{"print '{{this}}'; print STDERR 'ouch'; 'that'"}%= expands to:
+
+%PERL{"print '{{this}}'; print STDERR 'ouch'; 'that'"}%
+
+(You cannot suppress errors. Instead, fix your perl)
+
 ---++ WARNING
 The default configuration is designed for the following
 requirements:
    * Basic Perl,
    * Can use loops, define and call functions, 
    * Can call Foswiki::Func functions (except readFile and saveFile),
+   * =print= (but not open)
 *This provides the user with enough rope to hang your server!*
 
 For example, an infinite loop may (in some server configurations) 

diff --git a/data/System/VarPERL.txt b/data/System/VarPERL.txt
@@ -4,7 +4,8 @@
    * Expands to the result of the perl expression, evaluated in a Safe container.
 =%<nop>PERL{topic="topic name"}%=
    * Expands to the result of the perl program contained between %<nop>CODE{}% and %<nop>ENDCODE% in the named topic.
-   * You can only use a subset of perl, as defined in the Foswiki configuration.
+   * You can only use a subset of perl, as defined in the Foswiki
+     configuration.
 
 ---++++ Examples
 If the plugin is installed, the text after 'expands to' will show the result of the example.

diff --git a/lib/Foswiki/Plugins/PerlPlugin.pm b/lib/Foswiki/Plugins/PerlPlugin.pm
@@ -29,10 +29,10 @@ package Foswiki::Plugins::PerlPlugin;
 
 use strict;
 
-use Assert;
 use Safe ();
-use File::Spec;
+use IO::Scalar ();
 
+use Assert;
 use Foswiki::Func ();
 use Foswiki::Sandbox ();
 
@@ -43,6 +43,7 @@ our $NO_PREFS_IN_TOPIC = 1;
 
 # The Safe container
 our $compartment;
+our $stderr;
 
 sub initPlugin {
     my( $topic, $web, $user, $installWeb ) = @_;
@@ -114,18 +115,38 @@ sub _PERL {
     # disable CGI::Carp which otherwise masks the errors because it
     # can't get to File::Spec
     my $result;
+    $compartment->permit('print');
+    $compartment->share_from('main', [ '*STDOUT', '*STDERR' ]);
+
+    my $stdout = '';
+    my $stderr = '';
+    tie *STDERR, 'IO::Scalar', \$stderr;
+    tie *STDOUT, 'IO::Scalar', \$stdout;
+
     {
         local $SIG{'__DIE__'} = 'DEFAULT';
-        local $SIG{'__WARN__'} = 'DEFAULT';
+        local $SIG{'__WARN__'} = sub {
+            my $mess = shift;
+            $mess =~ s/ at \(eval \d+\)( line \d+.*)$/ at$1/;
+            $stderr .= $mess;
+        };
 
         $result = $compartment->reval($expr, 1);
     }
+    untie *STDOUT;
+    untie *STDERR;
 
     # The doc says a blocked opcode will set $@, but in perl 5.10 this
     # doesn't happen and reval just gives an undef. But this is what
     # should really trap errors.
     $result = "<pre class='foswikiAlert'>%PERL error: $@</pre>" if $@;
     $result = '' unless defined $result;
+    if (length($stdout) > 0) {
+        $result .= $stdout;
+    }
+    if (length($stderr)) {
+        $result .= "<pre class='foswikiAlert'>$stderr</pre>";
+    }
     return $result;
 }
 

diff --git a/test/unit/PerlPlugin/PerlPluginTests.pm b/test/unit/PerlPlugin/PerlPluginTests.pm
@@ -14,32 +14,31 @@ sub loadExtraConfig {
 
 sub test_simpleWorkingExprs {
     my $this = shift;
-    my $t = Foswiki::Plugins::PerlPlugin::_PERL(
-        $this->{session},
-        { _DEFAULT => "'A String'"});
+    my $t = Foswiki::Func::expandCommonVariables(
+        "%PERL{\"'A String'\"}%");
     $this->assert_equals('A String', $t);
-    $t = Foswiki::Plugins::PerlPlugin::_PERL(
-        $this->{session},
-        { _DEFAULT => "101 - 59"});
+    $t = Foswiki::Func::expandCommonVariables(
+        "%PERL{\"101 - 59\"}%");
     $this->assert_equals(42, $t);
     $t = Foswiki::Func::expandCommonVariables(
         "%PERL{\"sub x{95};x()\"}%...%PERL{\"x()+164\"}%");
     $this->assert_equals("95...259", $t);
 }
 
 # Disabled due to a bug in the heredoc parser
-sub detest_hereDoc {
+sub test_hereDoc {
     my $this = shift;
-    my $t = <<'BEDRAGONS';
-%PERL{<<HERE}%
+    my $t = <<'DRAGONS';
+HERE%PERL{<<HERE}%DRAGONS
 my %x = ( a=>'%TOPIC%' );
 $x{a} =~ s/%/x/g;
-"$x{a}\n";
+$x{'a'} =~ s/xTOPICx/ BE /g;
+"$x{a}";
 HERE
-X
-BEDRAGONS
+!
+DRAGONS
     $t = Foswiki::Func::expandCommonVariables($t);
-    $this->assert_equals("xTOPICxX", $t);
+    $this->assert_equals("HERE BE DRAGONS!\n", $t);
 }
 
 sub test_syntaxError {
@@ -67,6 +66,30 @@ sub test_die {
         qr/class='foswikiAlert'>%PERL error: pig dog rabbit/, $t);
 }
 
+sub test_warn {
+    my $this = shift;
+    my $t = Foswiki::Func::expandCommonVariables(
+        '%PERL{"warn(\'pig\', \'dog\'); 2"}%');
+    $this->assert_matches(
+        qr/2\s*<.*?class='foswikiAlert'>pigdog at line 1/s, $t);
+}
+
+sub test_STDOUT {
+    my $this = shift;
+    my $t = Foswiki::Func::expandCommonVariables(
+        '%PERL{"print STDOUT \'pig dog rabbit\';\'\'"}%');
+    $this->assert_matches(
+        qr/pig dog rabbit/s, $t);
+}
+
+sub test_STDERR {
+    my $this = shift;
+    my $t = Foswiki::Func::expandCommonVariables(
+        '%PERL{"print STDERR \'were wolf\';666"}%');
+    $this->assert_matches(
+        qr/666\s*<.*?class='foswikiAlert'>were wolf<\/pre>/s, $t);
+}
+
 sub test_arithmeticError {
     my $this = shift;
     my $t = Foswiki::Func::expandCommonVariables(