[svn:PHP-Sandwich] rev 1032 - in PHP-Sandwich/trunk: . t

Author: gschlossnagle
Date: Thu Apr 28 15:59:57 2005
New Revision: 1032

Modified:
   PHP-Sandwich/trunk/phpfuncs.c
   PHP-Sandwich/trunk/phpinterp.c
   PHP-Sandwich/trunk/phpinterp.h
   PHP-Sandwich/trunk/t/12.t
Log:
add Perl::eval() in the PHP class.  mostly works, though the
return vvalue of the function back into PHP seems borked atm.



Modified: PHP-Sandwich/trunk/phpfuncs.c
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.c	(original)
+++ PHP-Sandwich/trunk/phpfuncs.c	Thu Apr 28 15:59:57 2005
@@ -40,12 +40,70 @@
   return_value->value.obj = plobj_create_object(plobj_ce TSRMLS_CC);
 }
 
+SV *my_eval_sv(pTHX_ SV *sv, I32 coe) {
+  SV *retval;
+  STRLEN n_a;
+  dSP;
+
+  ENTER;
+  SAVETMPS;
+  PUSHMARK(SP);
+  PUTBACK;
+  eval_sv(sv, G_SCALAR);
+ 
+  SPAGAIN;
+  retval = POPs;
+  if(coe && SvTRUE(ERRSV)) {
+    croak(SvPVx(ERRSV, n_a));
+  }
+
+  SvREFCNT_inc(retval);
+  PUTBACK;
+  FREETMPS;
+  LEAVE;
+
+  return retval;
+}
+
+static SV *sandwich_perl_eval(pTHX_ char *command_in) {
+  SV *retval;
+  SV *command;
+  fprintf(stderr, "calling %s\n", command_in);
+  command = newSVpv(command_in, 0);
+  //command = sv_2mortal(newSVpv(command_in, 0));
+  retval = my_eval_sv(aTHX_ command, FALSE);
+  return retval;
+}
+
+PHP_METHOD(perl, eval)
+{
+  struct plobj *pl;
+  char *func;
+  long funclen;
+  SV *rv;
+  pTHX;
+
+  if (zend_parse_parameters(ZEND_NUM_ARGS() TSRMLS_CC, "s", &func, &funclen) == FAILURE) {
+    return;
+  }
+  pl = zend_object_store_get_object(getThis() TSRMLS_CC);
+  aTHX = pl->perl;
+  if((rv = sandwich_perl_eval(aTHX_ func)) == NULL)  { 
+    fprintf(stderr, "eval returned null\n"); 
+  } else {
+    zval *retval = SvZval(rv);
+    RETURN_ZVAL(retval, 1, 0);
+    SvREFCNT_dec(rv);
+  }
+}
+
 static function_entry pl_functions[] = {
   PHP_ME(perl, getinstance, NULL, ZEND_ACC_PUBLIC | ZEND_ACC_STATIC)
   {NULL, NULL, NULL}
 };
 
 static function_entry plobj_functions[] = {
+  PHP_ME(perl, eval, NULL, ZEND_ACC_PUBLIC)
   {NULL, NULL, NULL}
 };
 
@@ -71,13 +129,16 @@
 {
   struct plobj      *pl;
   zend_object_value  obj;
+  dTHX;
   
   pl = ecalloc(1, sizeof(*pl));
   pl->zo.ce = ce;
-
+  
   ALLOC_HASHTABLE(pl->zo.properties);
   zend_hash_init(pl->zo.properties, 0, NULL, ZVAL_PTR_DTOR, 0);
 
+  pl->perl = aTHX;
+
   return pl;
 }
 

Modified: PHP-Sandwich/trunk/phpinterp.c
==============================================================================
--- PHP-Sandwich/trunk/phpinterp.c	(original)
+++ PHP-Sandwich/trunk/phpinterp.c	Thu Apr 28 15:59:57 2005
@@ -82,7 +82,7 @@
   pthread_key_create(&sandwich_per_thread_info_key, NULL);
 
   if (!tsrm_startup(128, 32, TSRM_ERROR_LEVEL_CORE, "/tmp/TSRM.log")) {
-    Perl_croak("Failed to init PHP TSRM!\n");
+    croak("Failed to init PHP TSRM!\n");
     return -1;
   }
   

Modified: PHP-Sandwich/trunk/phpinterp.h
==============================================================================
--- PHP-Sandwich/trunk/phpinterp.h	(original)
+++ PHP-Sandwich/trunk/phpinterp.h	Thu Apr 28 15:59:57 2005
@@ -1,6 +1,10 @@
 #ifndef _SANDWICH_PHPINTERP_H
 #define _SANDWICH_PHPINTERP_H
 
+#include <EXTERN.h>
+#include <perl.h>
+#include <perlapi.h>
+
 #undef module_name
 #undef API_EXPORT
 #include <main/php_config.h>
@@ -34,4 +38,6 @@
 #define sandwich_interp_inc_ref(interp)  interp->ref++
 #define sandwich_interp_dec_ref(interp)  if(--interp->ref == 0) sandwich_per_interp_shutdown(interp)
 
+zval *SvZval(SV *sv);
+
 #endif

Modified: PHP-Sandwich/trunk/t/12.t
==============================================================================
--- PHP-Sandwich/trunk/t/12.t	(original)
+++ PHP-Sandwich/trunk/t/12.t	Thu Apr 28 15:59:57 2005
@@ -1,6 +1,6 @@
 #!/opt/ecelerity/3rdParty/bin/perl
 use strict;
-use Test::More tests => 5;
+use Test::More tests => 7;
 
 BEGIN {
     use_ok 'PHP' or die;
@@ -13,3 +13,13 @@
   'Add a "callme" Perl::getInstance() wrapper';
 ok $p->callme()->isa('PHP::Class::PerlObject'),
   'We should get a perl object back from Perl::getInstance()';
+ok $p->eval(q!
+  function callme2() { 
+    $pl = Perl::getInstance(); 
+    $rv = $pl->eval('return "hello";'); 
+    print "returning $rv\n";
+    return $rv;
+  }
+!),
+  'Add a "callme2" wrapper';
+is $p->callme2(), "hello";