1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
|
#
# 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";
|