ch26.htm

《Perl 5 Unreleased》

12 }</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
Look at lines 34 and 35 in Listing 26.9. The returned values from
the Perl function are picked off one at a time using the <TT><FONT FACE="Courier">POPn</FONT></TT>
macro to get double values from the stack. The global stack is
readjusted before returning from the C function.
<HR>
<BLOCKQUOTE>
<B>Listing 26.9. Calling the </B><TT><B><FONT FACE="Courier">GetRatio</FONT></B></TT><B>
function.<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1&nbsp;&nbsp;&nbsp;&nbsp;/* How
to return lists back from Perl functions */<BR>
&nbsp;2<BR>
&nbsp;3 #include &lt;stdio.h&gt;<BR>
&nbsp;4 #include &lt;EXTERN.h&gt;<BR>
&nbsp;5 #include &lt;perl.h&gt;<BR>
&nbsp;6<BR>
&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static void getRatio(int
a, int b);<BR>
&nbsp;8&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static PerlInterpreter *my_perl;
<BR>
&nbsp;9<BR>
10&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int main(int argc, char **argv,
char **env)<BR>
11&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>
12&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my_perl
= perl_alloc();<BR>
13&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_construct(my_perl);
<BR>
14&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_parse(my_perl,
NULL, argc, argv, env);<BR>
15&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;getRatio(8,3);<BR>
16&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_destruct(my_perl);
<BR>
17&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_free(my_perl);
<BR>
18&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>
19<BR>
20<BR>
21&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static void getRatio(int a, int
b)<BR>
22&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>
23&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dSP ;
<BR>
24&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int count
;<BR>
25&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ENTER
;<BR>
26&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SAVETMPS;
<BR>
27&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUSHMARK(sp)
;<BR>
28&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(a)));
<BR>
29&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(b)));
<BR>
30&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK
;<BR>
31&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;count
= perl_call_pv(&quot;GetRatio&quot;, G_ARRAY);<BR>
32&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SPAGAIN
;<BR>
33&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (count
!= 2) croak(&quot;Whoa! \n&quot;) ;<BR>
34&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf
(&quot;%d / %d = %f\n&quot;, a, b, POPn) ;<BR>
35&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf
(&quot;%d / %d = %f\n&quot;, b, a, POPn) ;<BR>
36&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK
;<BR>
37&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FREETMPS
;<BR>
38&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;LEAVE
;<BR>
39&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
Placing <TT><FONT FACE="Courier">G_SCALAR</FONT></TT> instead
of <TT><FONT FACE="Courier">G_ARRAY</FONT></TT> in the code in
Listing 29.9 would have forced a scalar value to be returned.
Only the last item of the array would have been returned and the
value of <TT><FONT FACE="Courier">count</FONT></TT> would be set
to <TT><FONT FACE="Courier">1</FONT></TT>.
<P>
Note how this Perl subroutine takes precautions not to crash by
first checking the divisor by zero. Now, this time let's not return
a value. Instead, let's call the <TT><FONT FACE="Courier">die()</FONT></TT>
function if a bogus value is sent into the function <TT><FONT FACE="Courier">GetRatio</FONT></TT>.
We'll try to trap the errors caused by calling the function with
the <TT><FONT FACE="Courier">G_EVAL</FONT></TT> flag set.
<H2><A NAME="UsingG_EVAL"><B><FONT SIZE=5 COLOR=#FF0000>Using
</FONT></B><TT><B><FONT SIZE=5 COLOR=#FF0000 FACE="Courier">G_EVAL</FONT></B></TT></A>
</H2>
<P>
The <TT><FONT FACE="Courier">G_EVAL</FONT></TT> flag is useful
when calling functions you think may <TT><FONT FACE="Courier">die()</FONT></TT>.
The <TT><FONT FACE="Courier">G_EVAL</FONT></TT> flag is <TT><FONT FACE="Courier">OR</FONT></TT>-ed
in with any other flags to such a call. Listing 26.10 presents
a Perl function that calls the <TT><FONT FACE="Courier">die</FONT></TT>
function in case one of the arguments sent into it is zero. Because
we know that this function can <TT><FONT FACE="Courier">die</FONT></TT>,
we'll send in a value that causes it to <TT><FONT FACE="Courier">die</FONT></TT>.
The code to make this fatal call (to illustrate how <TT><FONT FACE="Courier">G_EVAL</FONT></TT>
is used) is shown in Listing 26.11.
<HR>
<BLOCKQUOTE>
<B>Listing 26.10. A Perl function that can </B><TT><B><FONT FACE="Courier">die</FONT></B></TT><B>.
<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1 sub GetRatioEval<BR>
&nbsp;2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>
&nbsp;3&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my($a,
$b) = @_ ;<BR>
&nbsp;4&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $c, $d;<BR>
&nbsp;5&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;die &quot;Hey! A is 0 \n&quot;
if ($a == 0);<BR>
&nbsp;6&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;die &quot;Hey! B is 0 \n&quot;
if ($b == 0);<BR>
&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c = $a/$b;<BR>
&nbsp;8&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$d = $b/$a;<BR>
&nbsp;9&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;($c,$d);
<BR>
10&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}</FONT></TT>
</BLOCKQUOTE>
<HR>
<HR>
<BLOCKQUOTE>
<B>Listing 26.11. A C program to use the </B><TT><B><FONT FACE="Courier">G_EVAL</FONT></B></TT><B>
flag.<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1&nbsp;&nbsp;/* Call the suicidal
function to use G_EVAL */<BR>
&nbsp;2<BR>
&nbsp;3 #include &lt;stdio.h&gt;<BR>
&nbsp;4 #include &lt;EXTERN.h&gt;<BR>
&nbsp;5 #include &lt;perl.h&gt;<BR>
&nbsp;6<BR>
&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static void getRatio(int
a, int b);<BR>
&nbsp;8&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static PerlInterpreter *my_perl;
<BR>
&nbsp;9<BR>
10&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int main(int argc, char **argv,
char **env)<BR>
11&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>
12&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my_perl
= perl_alloc();<BR>
13&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_construct(my_perl);
<BR>
14&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_parse(my_perl,
NULL, argc, argv, env);<BR>
15&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;getRatio(8,0);
<BR>
16&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_destruct(my_perl);
<BR>
17&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_free(my_perl);
<BR>
18&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>
19<BR>
20<BR>
21&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static void getRatio(int a, int
b)<BR>
22&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>
23&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dSP ;
<BR>
24&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int count
;<BR>
25&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SV
*svp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/*
New line */<BR>
26&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ENTER
;<BR>
27&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SAVETMPS;
<BR>
28&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUSHMARK(sp)
;<BR>
29&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(a)));
<BR>
30&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(b)));
<BR>
31&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK
;<BR>
32&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;count
= perl_call_pv(&quot;GetRatioEval&quot;, G_ARRAY | G_EVAL);<BR>
33&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SPAGAIN
;<BR>
34&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svp =
GvSV(gv_fetchpv(&quot;@&quot;, TRUE, SVt_PV));<BR>
35&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (SvTRUE(svp))
<BR>
36&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>
37&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf
(&quot;Die by division: %s\n&quot;, SvPV(svp, na)) ;<BR>
38&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;POPs
;<BR>
39&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>
40&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else<BR>
41&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>
42&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (count
!= 2) croak(&quot;Whoa! \n&quot;) ;<BR>
43&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf
(&quot;%d / %d = %f\n&quot;, a, b, POPn) ;<BR>
44&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf
(&quot;%d / %d = %f\n&quot;, b, a, POPn) ;<BR>
45&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>
46&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK
;<BR>
47&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FREETMPS
;<BR>
48&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;LEAVE
;<BR>
49&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
In the code shown in Listing 26.11, the call to the Perl function
will terminate in a <TT><FONT FACE="Courier">die()</FONT></TT>
function call. The returned value from this Perl function call
is checked in line 34. The variable we are looking at is the <TT><FONT FACE="Courier">$@</FONT></TT>
variable in Perl. The syntax for this call is
<BLOCKQUOTE>
<TT><FONT FACE="Courier">svp = GvSV(gv_fetchpv(&quot;@&quot;,
TRUE, SVt_PV));</FONT></TT>
</BLOCKQUOTE>
<P>
The value of the variable is checked in the following lines, and
the stack is adjusted with a call to pop off the string. The string
is retrieved with a call to the <TT><FONT FACE="Courier">SvPV()</FONT></TT>
function in line 38.
<H2><A NAME="GettingSpecialVariableValues"><B><FONT SIZE=5 COLOR=#FF0000>Getting
Special Variable Values</FONT></B></A></H2>
<P>
In Listing 26.7 we recovered values of special variables, <TT><FONT FACE="Courier">$&lt;</FONT></TT>
and <TT><FONT FACE="Courier">$(</FONT></TT>, to get the UID and
GID of the calling process via a Perl subroutine. The Perl subroutine
was simply an example of how to call a routine. Now let's see
how we can get values of special variables in Perl directly. The
call to get these values is
<BLOCKQUOTE>
<TT><FONT FACE="Courier">svp = GvSV(gv_fetchpv(variableName, defaultValue,
SVt_PV));</FONT></TT>
</BLOCKQUOTE>
<P>
Let's look at the function in Listing 26.12 to see how to get
the UID and GID of a calling C program.
<HR>
<BLOCKQUOTE>
<B>Listing 26.12. Function for getting the values of </B><TT><B><FONT FACE="Courier">$&lt;</FONT></B></TT><B>
and </B><TT><B><FONT FACE="Courier">$(</FONT></B></TT><B> directly.
<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1 static int getUserInfo()<BR>
&nbsp;2 {<BR>
&nbsp;3&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dSP ;<BR>
&nbsp;4 int tmp;<BR>
&nbsp;5 SV *svp;<BR>
&nbsp;6&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUSHMARK(sp);<BR>
&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svp = GvSV(gv_fetchpv(&quot;&lt;&quot;,
0, SVt_PV));<BR>
&nbsp;8 tmp =&nbsp;&nbsp;SvIV(svp);<BR>
&nbsp;9 printf (&quot;\n UID = %d&quot;