The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
GRICHTER / Embperl-2.4.0 / test / html / registry / Execute.htm 
#
# Example for using Embperl::Execute
#
# run this under mod_perl / Apache::Registry
#


use Embperl ;

my($r) = @_;

# workaround for broken $r -> chdir_file in Apache::Registry on ActiveState perl
use Cwd ;
use File::Basename ;
if ($Embperl::modperlapi < 2)
    {
    eval { require Apache::compat } ;
    $@ = '' ;
    }
else
    {
    eval { require Apache2::compat } ;
    $@ = '' ;
    }
    
my $fn = $r -> filename ;
chdir(dirname ($fn)) ;


$Embperl::DebugDefault = 0xffffdffd ;


$tst1 = '<P>Here is some text</P>' ;

$r -> status (200) ;
$r -> send_http_header () ;

print "<HTML><TITLE>Test for Embperl::Execute</TITLE><BODY>\n" ;
print "<H1> 1.) Include from memory</H1>\n" ;

Embperl::Execute ({input		=> \$tst1,
						 mtime      => 1,  
						 inputfile	=> 'Some text',
						 req_rec    => $r}) ;


print "\n<H1> 2.) Include from memory with some Embperl code</H1>\n" ;

Embperl::Execute ({input		=> \'[- @ar = (a1, b2, c3) -]<table><tr><td>[+$ar[$col]+]</td> </tr> </table> </P>',
						 mtime      => 1,  
						 inputfile	=> 'table',
						 req_rec    => $r}) ;

print "\n<H1> 3.) Include from memory with passing of variables</H1>\n" ;


$MyPackage::Interface::Var = 'Some Var' ;

Embperl::Execute ({input		=> \'<P>Transfer some vars [+ $Var +] !</P>',
						 inputfile	=> 'Var',
						 mtime      => 1,
						 'package'  => 'MyPackage::Interface',
						 req_rec    => $r}) ;

print "\n<H1> 4.) Change the variable, but not the code</H1>\n" ;

$MyPackage::Interface::Var = 'Do it again' ;

# code is the same, so give the same mtime and inputfile to avoid recompile
# Note you get problems is you change the code, but did not restart the server or
# change the value in mtime. So make sure if you change something also change mtime!

Embperl::Execute ({input		=> \'<P>Transfer some vars [+ $Var +] !</P>',
						 inputfile	=> 'Var2',
						 mtime      => 1,  
						 'package'  => 'MyPackage::Interface',
						 req_rec    => $r}) ;


print "\n<H1> 5.) Use \@param to pass parameters</H1>\n" ;


Embperl::Execute ({input		=> \'<P>Use @param to transfer some data ([+ "@param" +]) !</P>',
						 inputfile	=> 'Param',
                         debug      => 0xffffdffd,
    					 req_rec    => $r,
						 param      => [1, 2, 3, 4] }
						 ) ;


print "\n<H1> 6.) Use \@param to pass parameters and return it</H1>\n" ;


my @p = ('vara', 'varb') ;

print "\n<H3> \$p[0] is $p[0] and \$p[1] is $p[1]<H3>" ;

Embperl::Execute ({input		=> \'<P>Got data in @param ([+ "@param" +]) !</P>[- $param[0] = "newA" ; $param[1] = "newB" ; -]<P>Change data in @param to ([+ "@param" +]) !</P>',
						 inputfile	=> 'Param & Return',
						 req_rec    => $r,
						 param      => \@p }
						 ) ;

print "\n<H3> \$p[0] is now $p[0] and \$p[1] is now $p[1]<H3>" ;

print "<H1> 7.) Presetup \%fdat and \@ffld</H1>\n" ;

my %myfdat = ('test' => 'value',
              'fdat' => 'text') ;
              
my @myffld = sort keys %myfdat ;             

Embperl::Execute ({input		=> \'<P><table><tr><td>[+ $ffld[$row] +]</td><td>[+ do { local $^W = 0 ; $fdat{$ffld[$row]} } +]</td></tr></table></P>',
						 inputfile	=> 'fdat & ffld',
						 req_rec    => $r,
						 fdat  => \%myfdat,
						 ffld  => \@myffld}
						 ) ;


print "\n<H1> 8.) Inculde a file</H1>\n" ;


Embperl::Execute ({inputfile	=> '../inc.htm', input_escmode => 7,
						 req_rec    => $r}) ;


print "\n<H1> 9.) Inculde a file and return output in a scalar</H1>\n" ;

my $out ;

Embperl::Execute ({inputfile	=> '../inc.htm', input_escmode => 7,
						 output     => \$out,
						 req_rec    => $r}) ;


print "\n<H3>$out</H3>\n" ;

print "\n<H1> 10.) Test \$req_rec inside Execute</H1>\n" ;

Embperl::Execute ('../reqrec.htm') ;


print "\n<H1> 11.) Done :-)</H1>\n" ;


print "</body></html>\n";