[Zope-Perl] Calling PerlMethod from PerlMethod

[Gisle Aas]

--=-=-=

Ulrich Wisser <u.wisser@publisher.de> writes:

> it seems that I can't call a PerlMethod from a PerlMethod.
> I get a Zope error
> 
> Error Type: PerlError
> Error Value: Undefined subroutine &Zope::_recompile called at
> /usr/local/Zope-2.2.5-linux2-x86/lib/perl/Zope.pm line 98.

Finally I managed to understand this bug.  I just uploaded new versions
of pyperl and zoperl to ftp://ftp.activestate.com/Zope-Perl/:

  ftp://ftp.activestate.com/Zope-Perl/pyperl-1.0.beta8.tar.gz
  ftp://ftp.activestate.com/Zope-Perl/zoperl-1.0.beta5.tar.gz

Regards,
Gisle


--=-=-=
Content-Disposition: attachment; filename=xxx
Content-Description: zoperl patch

Change 16007 by gisle@caliper on 2001/02/23 16:36:58

	Need to qualify func name in perl.safecall() to avoid
	looking it up in CopSTASH(PL_curcop) which might not be
	main when calls nest.

Affected files ...

... //depot/main/Apps/Bifrost/zoperl/lib/python/Products/PerlMethod/__init__.py#7 edit

Differences ...

==== //depot/main/Apps/Bifrost/zoperl/lib/python/Products/PerlMethod/__init__.py#7 (text) ====
Index: perl/lib/python/Products/PerlMethod/__init__.py
--- perl/lib/python/Products/PerlMethod/__init__.py.~1~	Fri Feb 23 16:57:39 2001
+++ perl/lib/python/Products/PerlMethod/__init__.py	Fri Feb 23 16:57:39 2001
@@ -152,7 +152,7 @@
             perl.eval("""local(@INC) = ("%s/lib/perl", @INC); require Zope""" %
                       string.replace(INSTANCE_HOME, "\\", "\\\\"))
         perl.call("Zope::setup_compartment", root)
-        perl.safecall(root, mask, ("_recompile", self.id,
+        perl.safecall(root, mask, ("::_recompile", self.id,
                                    self.func_code.perl_args(),
                                    self.code))
         perl.call("Zope::pm_version", root, self.bobobase_modification_time())
@@ -170,7 +170,7 @@
         if not perl.defined(root + "::do") or \
            (DevelopmentMode and self.need_recompile(root)):
             self.recompile(root)
-        args = ("do",) + args
+        args = ("::do",) + args
         return apply(perl.safecall, (root, mask, args))
 
     def args(self):
End of Patch.

--=-=-=
Content-Disposition: attachment; filename=xx2
Content-Description: pyperl patch

Change 16001 by gisle@caliper on 2001/02/23 16:03:52

	Escape potential safe compartment for defined() and get_ref() calls.

Affected files ...

... //depot/main/Apps/Bifrost/pyperl/perlmodule.c#12 edit

Differences ...

==== //depot/main/Apps/Bifrost/pyperl/perlmodule.c#12 (text) ====
Index: perl/perlmodule.c
--- perl/perlmodule.c.~1~	Fri Feb 23 16:59:01 2001
+++ perl/perlmodule.c	Fri Feb 23 16:59:01 2001
@@ -330,7 +330,7 @@
     save_hash(PL_incgv);
     GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpv("INC",TRUE,SVt_PVHV))));
     
-    ENTER_PYTHON;
+    ENTER_PYTHON; /* just so call_perl can change it back :-( */
     ret = call_perl(0, 0, G_SCALAR, realargs, keywds);
 
     ENTER_PERL;
@@ -373,13 +373,12 @@
     }
     res = call_perl(method, obj, gimme, args, keywds);
     if (leave_needed)
-	LEAVE;
+	LEAVE;  /* restore safe env */
     return res;
 }
 
 #define CALL_PERL          unsafe_call_perl
 #define RESTORE_UNSAFE_ENV if (ctx->root_stash) restore_unsafe_env(ctx)
-
 #else /* MULTI_PERL */
 
 #define CALL_PERL          call_perl
@@ -544,6 +543,9 @@
     ENTER_PERL;
     SET_CUR_PERL;
 
+    ENTER;
+    RESTORE_UNSAFE_ENV;
+
     if (isIDFIRST(*name)) {
 	type = '&';
     }
@@ -559,17 +561,19 @@
 	case '%': sv = (SV*)perl_get_hv(name, 0); break;
 	case '&': sv = (SV*)perl_get_cv(name, 0); break;
 	default:
+	    LEAVE;
 	    ENTER_PYTHON;
 	    PyErr_Format(PerlError, "Bad type spec '%c'", type);
 	    return NULL;
 	}
     }
     else {
+	LEAVE;
 	ENTER_PYTHON;
 	PyErr_Format(PerlError, "Missing identifier name");
 	return NULL;
     }
-
+    LEAVE;
     ENTER_PYTHON;
     return Py_BuildValue("i", (sv != 0));
 }
@@ -599,6 +603,9 @@
     PERL_LOCK;
     SET_CUR_PERL;
 
+    ENTER;
+    RESTORE_UNSAFE_ENV;
+
     /* We assume that none of the stuff below can trigger perl code to
      * start running, so it is safe to hold both locks while doing this work.
      */
@@ -618,11 +625,13 @@
 	case '%': sv = (SV*)perl_get_hv(name, create); break;
 	case '&': sv = (SV*)perl_get_cv(name, create); break;
 	default:
+	    LEAVE;
 	    PERL_UNLOCK;
 	    PyErr_Format(PerlError, "Bad type spec '%c'", type);
 	    return NULL;
 	}
 	if (!sv) {
+	    LEAVE;
 	    PERL_UNLOCK;
 	    PyErr_Format(PerlError, "No perl object named %s", name);
 	    return NULL;
@@ -635,6 +644,7 @@
 	case '@': sv = (SV*)newAV();  break;
 	case '%': sv = (SV*)newHV();  break;
 	default:
+	    LEAVE;
 	    PERL_UNLOCK;
 	    PyErr_Format(PerlError, "Bad type spec '%c'", type);
 	    return NULL;
@@ -644,6 +654,7 @@
     sv = newRV_noinc(sv);
     pyo = PySVRV_New(sv);
     SvREFCNT_dec(sv);  /* since PySVRV_New incremented it */
+    LEAVE;
 
     PERL_UNLOCK;
     ASSERT_LOCK_PYTHON;
End of Patch.

--=-=-=--