[Zope-Perl] Trapping exceptions from perl API calls

[Gisle Aas]

The TODO file has the following entry:

  When doing direct maniplulation of perl data from python we might risk
  getting a croak.  Especially if the data underneath happens to be
  tied.  What can be done about that?

What this means is demonstrated by the following example:
-------------------------------------------------------------------
import perl

perl.eval("""

{
    package Foo;

    sub TIEARRAY {
        my $class = shift;
        my $self = bless {}, $class;
        $self;
    }
}

tie @a, "Foo";

""")

a = perl.get_ref("@a")
print a

try:
   print len(a)
except:
    print "Bad len"

print "done\n";
-------------------------------------------------------------------

If you run this you will see:

  <perl ARRAY(0x8126f8c) ref at 80e6c70>
  Can't locate object method "FETCHSIZE" via package "Foo".

What happens here is that the python len(a) call is transformed into
an av_len() call on the underlying perl array.  The av_len() invokes
perl's tie magic which eventually croaks because a FETCHSIZE method
was not defined.  Since av_len() is called directly outside any eval
{} block, perl decides to print the error message on stderr and call
exit() directly.  It means that python doesn't get a chance to trap
the exception, which again is kind of bad.

Perl does not provide an easy interface for trapping exceptions from
direct API calls.  The following example shows one way to do it at the
C level.  But it is far too gross for my taste.  A simple API call
like av_len() becomes nearly 50 lines of C code.  Multiply that with
50 places where the perl API is called in svrv_object.c and you get
something ugly.

-------------------------------------------------------------------
#include <EXTERN.h>
#include <perl.h>

void
do_something()
{
    croak("Did you catch this?");
}

void eval_do_something()
{

    dJMPENV;
    LOGOP myop;
    int status;
    register PERL_CONTEXT *cx;
    PMOP *newpm;
    I32 optype;
    SV **newsp;
    I32 gimme;

    Zero(&myop, 1, LOGOP);
    myop.op_flags |= OPf_WANT_SCALAR;
    myop.op_next = Nullop;
    PL_op = (OP*)&myop;

    gimme = GIMME_V;

    //PL_markstack_ptr--;
    ENTER;
    SAVETMPS;
      
    push_return(Nullop);
    PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
    PUSHEVAL(cx, 0, 0);
    PL_eval_root = PL_op;
    PL_in_eval = EVAL_INEVAL;
    sv_setpv(ERRSV,"");
    //PL_markstack_ptr++;

    JMPENV_PUSH(status);
    switch (status) {
    case 0:
	//////////////////////////////////////////
	do_something();
	//////////////////////////////////////////
	break;
    case 3:
	printf("caugth longjmp 3\n");
	break;
    default:
	printf("should not happen, status = %d\n", status);
    }
    JMPENV_POP;
    
    POPBLOCK(cx,newpm);
    POPEVAL(cx);
    pop_return();
    FREETMPS;
    LEAVE;
}

int main(int argc, char**argv, char**env)
{
  int i;
  char *embedding[] = {"", "-e", "0"};
  PerlInterpreter *my_perl = perl_alloc();
  perl_construct(my_perl);
  perl_parse(my_perl, NULL, 3, embedding, NULL);
  perl_run(my_perl);

  /* I want to do the equivalent of:

         eval { do_something() };
         if ($@) {
            ....
         }

     in C.
     This is my first try:
   */


  eval_do_something();
  if (SvTRUE(ERRSV))
      printf("$@ is '%s'\n", SvPV_nolen(ERRSV));

  printf("continuing...\n");
}

/*
  Compile with: cc ctry.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
 */
-------------------------------------------------------------------