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

Author: gschlossnagle
Date: Sat Jun  3 20:43:11 2006
New Revision: 6463

Modified:
   PHP-Sandwich/trunk/lib/PHP/Interpreter.pm
   PHP-Sandwich/trunk/phpfuncs.c
   PHP-Sandwich/trunk/t/test_perl_classes.t

Log:
add call_method, a convenient wrapper around the 
perlapi call call_method().




Modified: PHP-Sandwich/trunk/lib/PHP/Interpreter.pm
==============================================================================
--- PHP-Sandwich/trunk/lib/PHP/Interpreter.pm	(original)
+++ PHP-Sandwich/trunk/lib/PHP/Interpreter.pm	Sat Jun  3 20:43:11 2006
@@ -278,6 +278,18 @@
 
 This will return a PHP object of type 'PerlSV::IO::File' that will proxy all the Perl classes' method calls.
 
+=head3 call_method()
+
+Call as static (class) method of a perl class.
+
+  <?php
+     $perl = Perl::getInstance();
+     $file = __FILE__;
+     $instance = $perl->call_method('IO::File', 'new_from_fd', $fh);
+  ?>
+
+This will effectively call 'IO::File->new_from_fd($fd)' and return a PHP object of type 'PerlSV::IO::File' that will proxy all the Perl classes' method calls.
+
 =head3 getVariable()
 
 Access a Perl symbol by name.

Modified: PHP-Sandwich/trunk/phpfuncs.c
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.c	(original)
+++ PHP-Sandwich/trunk/phpfuncs.c	Sat Jun  3 20:43:11 2006
@@ -270,20 +270,6 @@
   _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(
@@ -452,6 +438,75 @@
   }
 }
 
+PHP_METHOD(perl, call_method)
+{
+  struct plobj *pl;
+  SV           *var;
+  zval         *retval;
+  zval         *param;
+  zval         ***args;
+  SV           *sparam;
+  int          argc, i;
+  SV           *prv;
+  zval **name[2];
+
+  pTHX;
+
+  if(ZEND_NUM_ARGS() < 2) {
+    WRONG_PARAM_COUNT;
+  }
+  if(zend_get_parameters_array_ex(2, name) == FAILURE) {
+      WRONG_PARAM_COUNT;
+  } else if(Z_TYPE_PP(name[0]) != IS_STRING || Z_TYPE_PP(name[1]) != IS_STRING) {
+      WRONG_PARAM_COUNT;
+  }
+
+  pl = zend_object_store_get_object(getThis() TSRMLS_CC);
+#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);
+    EXTEND(SP, argc + 1);
+    for(i = 0; i < argc; i++) {
+      /* skip the first arg, we'll pass this to call_method */
+      if(i == 1) continue;
+      var = newSVzval(*args[i], SandwichG(php));
+      var = sv_2mortal(var);
+      XPUSHs(var);
+    }
+    PUTBACK;
+    cnt = call_method(Z_STRVAL_PP(name[1]), G_SCALAR | G_EVAL);
+    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);
+  }
+}
+
 static zval *
 sv_prop_read(zval *obj, zval *member, int type TSRMLS_DC)
 {
@@ -925,6 +980,7 @@
   PHP_ME(perl, setvariable, NULL, ZEND_ACC_PUBLIC) 
   PHP_ME(perl, call, NULL, ZEND_ACC_PUBLIC) 
   PHP_ME(perl, new, NULL, ZEND_ACC_PUBLIC) 
+  PHP_ME(perl, call_method, NULL, ZEND_ACC_PUBLIC) 
   {NULL, NULL, NULL}
 };
 

Modified: PHP-Sandwich/trunk/t/test_perl_classes.t
==============================================================================
--- PHP-Sandwich/trunk/t/test_perl_classes.t	(original)
+++ PHP-Sandwich/trunk/t/test_perl_classes.t	Sat Jun  3 20:43:11 2006
@@ -1,6 +1,6 @@
 #!/opt/ecelerity/3rdParty/bin/perl -w
 use strict;
-use Test::More tests => 10;
+use Test::More tests => 12;
 use Test::Builder;
 use IO::File;
 
@@ -57,3 +57,17 @@
     }
 ^), "We should get a value back from the file";
 like $ret, qr/^#\!.*perl\s+-w$/, "We should have a shebang line";
+
+# Make sure that call_method() calls class methods, too.
+ok $ret = $php->eval(q^
+    $perl = Perl::getInstance();
+    $file = $perl->call('file');
+    $fh = $perl->new("IO::File", "<$file");
+    $fh = $perl->call_method('IO::File', 'new_from_fd', $fh, 'r');
+    if ($fh) {
+        return $fh->getline();
+    } else {
+        throw new Exception("Couldn't open $file");
+    }
+^), "We should get a value back from the file";
+like $ret, qr/^#\!.*perl\s+-w$/, "We should have a shebang line";

• [svn:PHP-Sandwich] r6463 - in PHP-Sandwich/trunk: . lib/PHP t by gschlossnagle