develooper Front page | perl.php.sandwich.dev | Postings from June 2006

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

From:
gschlossnagle
Date:
June 3, 2006 19:28
Subject:
[svn:PHP-Sandwich] r6458 - in PHP-Sandwich/trunk: . t
Message ID:
20060604022834.3FD41CBA47@x12.develooper.com
Author: gschlossnagle
Date: Sat Jun  3 19:28:33 2006
New Revision: 6458

Modified:
   PHP-Sandwich/trunk/PHP.xs
   PHP-Sandwich/trunk/phpfuncs.c
   PHP-Sandwich/trunk/t/test_symbols.t

Log:
support coderefs passed into PHP


Modified: PHP-Sandwich/trunk/PHP.xs
==============================================================================
--- PHP-Sandwich/trunk/PHP.xs	(original)
+++ PHP-Sandwich/trunk/PHP.xs	Sat Jun  3 19:28:33 2006
@@ -155,6 +155,7 @@
       }
       break;
     case SVt_PVCV: /* code */
+      plsv_wrap_sv(retval, sv TSRMLS_CC);
       break;
     case SVt_PVGV: /* glob */
       /* use orig_sv here to avoid losing your bless */

Modified: PHP-Sandwich/trunk/phpfuncs.c
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.c	(original)
+++ PHP-Sandwich/trunk/phpfuncs.c	Sat Jun  3 19:28:33 2006
@@ -270,6 +270,20 @@
   _sandwich_call_method(Z_STRVAL_PP(name[0]), INTERNAL_FUNCTION_PARAM_PASSTHRU, 1);
 }
 
+PHP_METHOD(perl, coderef)
+{
+  zval **name[1];
+  if(ZEND_NUM_ARGS() < 1) {
+    WRONG_PARAM_COUNT;
+  }
+  if(zend_get_parameters_array_ex(1, name) == FAILURE) {
+      WRONG_PARAM_COUNT;
+  } else if(Z_TYPE_PP(name[0]) != IS_STRING) {
+      WRONG_PARAM_COUNT;
+  }
+  _sandwich_call_method(NULL, INTERNAL_FUNCTION_PARAM_PASSTHRU, 1);
+}
+
 static PHP_FUNCTION(sandwich_method_handler)
 {
   _sandwich_call_method(
@@ -574,7 +588,6 @@
       efree(args);
       WRONG_PARAM_COUNT;
     }
-    
     pl = zend_object_store_get_object(getThis() TSRMLS_CC);
 #ifdef USE_ITHREADS
     aTHX = pl->perl;
@@ -637,7 +650,7 @@
 
   lc_method_name = emalloc(len + 1);
   zend_str_tolower_copy(lc_method_name, name, len);
-  if (zend_hash_find(&plobj_ce->function_table, lc_method_name, len+1, (void**)&func) == SUCCESS) {
+  if (zend_hash_find(&plsv_ce->function_table, lc_method_name, len+1, (void**)&func) == SUCCESS) {
     efree(lc_method_name);
     return func;
   }
@@ -706,6 +719,67 @@
   RETURN_STRINGL(string, stringlen, 1);
 }  
 
+PHP_METHOD(perlsv, call)
+{
+  struct plsv  *pl;
+  SV           *var;
+  zval         *retval;
+  char         *name;
+  int           namelen;
+  zval         *param;
+  zval         ***args;
+  SV           *sparam;
+  int          argc, i;
+  SV           *prv;
+  pTHX;
+
+  pl = (struct plsv *) zend_object_store_get_object(getThis() TSRMLS_CC);
+  if(!pl->sv || SvTYPE(pl->sv) != SVt_PVCV) {
+    /* fixme, be more descriptive */
+    WRONG_PARAM_COUNT;
+  }
+#ifdef USE_ITHREADS
+  aTHX = pl->perl;
+#endif
+  {
+    int cnt;
+    STRLEN n_a;
+    dSP;
+  
+    argc = ZEND_NUM_ARGS();
+    args = (zval ***) safe_emalloc(sizeof(zval **), argc, 0);
+    if(zend_get_parameters_array_ex(argc, args) == FAILURE) {
+      efree(args);
+      WRONG_PARAM_COUNT;
+    }
+    ENTER; SAVETMPS;
+    PUSHMARK(SP);
+    if(argc) EXTEND(SP, argc);
+    for(i = 0; i < argc; i++) {
+      var = newSVzval(*args[i], SandwichG(php));
+      var = sv_2mortal(var);
+      XPUSHs(var);
+    }
+    PUTBACK;
+    cnt = call_sv(pl->sv, G_SCALAR | G_EVAL | G_KEEPERR);
+    SPAGAIN;
+    if(cnt == 1) {
+      prv = POPs;
+      SvREFCNT_inc(prv);
+      retval = SvZval(prv TSRMLS_CC);
+      RETVAL_ZVAL(retval, 1, 0);
+    } else {
+      RETVAL_NULL();
+    }
+    if(SvTRUE(ERRSV)) {
+    //  croak(SvPVx(ERRSV, n_a));
+    }
+    PUTBACK;
+    FREETMPS; LEAVE;
+    efree(args);
+  }
+}
+
 struct plsv_iterator {
   zend_object_iterator iter;
   SV *sv;
@@ -856,6 +930,7 @@
 
 static function_entry plsv_functions[] = {
   PHP_ME(perlsv, __tostring, NULL, ZEND_ACC_PUBLIC)
+  PHP_ME(perlsv, call, NULL, ZEND_ACC_PUBLIC) 
   {NULL, NULL, NULL}
 };
 

Modified: PHP-Sandwich/trunk/t/test_symbols.t
==============================================================================
--- PHP-Sandwich/trunk/t/test_symbols.t	(original)
+++ PHP-Sandwich/trunk/t/test_symbols.t	Sat Jun  3 19:28:33 2006
@@ -26,11 +26,11 @@
 is $output, '1, 2, 3', 'Check the array output';
 $php->clear_output;
 
-$php->eval(q/echo fread($fh, 100)/), 'Access the file handle';
+$php->eval(q/echo fread($fh, 100);/), 'Access the file handle';
 is $output, 'File handle output.', 'Check the file handle output';
 $php->clear_output;
 
-ok $php->eval(q/code();/), 'Execute the code'; # Maybe $code()?
+ok $php->eval(q/echo $code->call();/), 'Execute the code'; # Maybe $code()?
 is $output, 'hello', 'Check the code output';
 $php->clear_output;
 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About