[svn:PHP-Sandwich] rev 1041 - in PHP-Sandwich/trunk: . t
[email protected] 6 May 2005 16:51:49 -0000
| Newsgroups | perl.php.sandwich.dev |
|---|---|
| Message-ID | <[email protected]> |
Author: gschlossnagle
Date: Fri May 6 09:51:48 2005
New Revision: 1041
Modified:
PHP-Sandwich/trunk/PHP.xs
PHP-Sandwich/trunk/phpfuncs.c
PHP-Sandwich/trunk/phpfuncs.h
PHP-Sandwich/trunk/phpinterp.c
PHP-Sandwich/trunk/phpinterp.h
PHP-Sandwich/trunk/t/14.t
PHP-Sandwich/trunk/t/15.t
PHP-Sandwich/trunk/t/2.t
Log:
php->perl method calls
Modified: PHP-Sandwich/trunk/PHP.xs
==============================================================================
--- PHP-Sandwich/trunk/PHP.xs (original)
+++ PHP-Sandwich/trunk/PHP.xs Fri May 6 09:51:48 2005
@@ -289,12 +289,7 @@
char *code;
CODE:
{
- if(sandwich_eval(interp, code) == 0) {
- RETVAL = &PL_sv_yes;
- } else {
- croak("PHP Error in eval(\"%s\")", code);
- RETVAL = &PL_sv_no;
- }
+ RETVAL = sandwich_eval(interp, code);
}
OUTPUT:
RETVAL
@@ -828,7 +823,7 @@
MAGIC *mg;
mg = mg_find((SvRV(in)), PERL_MAGIC_ext);
- if(!mg) return;
+ if(!mg || !mg->mg_obj || !SvROK(mg->mg_obj) || !SvIOK(SvRV(mg->mg_obj))) return;
pclass = (PHP_Class) SvIV(SvRV(mg->mg_obj));
if(!pclass) return;
old_ctx = tsrm_set_interpreter_context(pclass->interp->ctx);
Modified: PHP-Sandwich/trunk/phpfuncs.c
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.c (original)
+++ PHP-Sandwich/trunk/phpfuncs.c Fri May 6 09:51:48 2005
@@ -149,7 +149,7 @@
switch (name[0]) {
case '$':
var = get_sv(name + 1, FALSE);
- sparam = newSVzval(param, NULL);
+ sparam = newSVzval(param, SandwichG(php));
sv_setsv(var, sparam);
break;
case '@':
@@ -168,6 +168,61 @@
RETURN_TRUE;
}
+PHP_METHOD(perl, call)
+{
+ struct plobj *pl;
+ SV *var;
+ zval *retval;
+ char *name;
+ int namelen;
+ zval *param;
+ zval ***args;
+ int argc, i;
+ SV *sparam;
+ SV *prv;
+ pTHX;
+ dSP;
+
+ argc = ZEND_NUM_ARGS();
+ if(argc < 1) {
+ WRONG_PARAM_COUNT;
+ }
+ args = (zval ***) safe_emalloc(sizeof(zval **), argc, 0);
+ if(zend_get_parameters_array_ex(argc, args) == FAILURE) {
+ efree(args);
+ WRONG_PARAM_COUNT;
+ }
+ name = Z_STRVAL_PP(args[0]);
+
+ pl = zend_object_store_get_object(getThis() TSRMLS_CC);
+ aTHX = pl->perl;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ for(i = 1; i < argc; i++) {
+ var = sv_2mortal(newSVzval(*args[i], SandwichG(php)));
+ XPUSHs(var);
+ }
+ PUTBACK;
+ call_pv(name, G_SCALAR);
+ SPAGAIN;
+ prv = POPs;
+ /*
+ if(coe && SvTRUE(ERRSV)) {
+ croak(SvPVx(ERRSV, n_a));
+ }
+ */
+ SvREFCNT_inc(prv);
+ PUTBACK;
+ retval = SvZval(prv);
+ RETURN_ZVAL(retval, 1, 0);
+ SvREFCNT_dec(prv);
+ FREETMPS;
+ LEAVE;
+ efree(args);
+}
+
PHP_METHOD(perl, getinstance)
{
struct plobj *pl;
@@ -245,6 +300,7 @@
PHP_ME(perl, eval, NULL, ZEND_ACC_PUBLIC)
PHP_ME(perl, getvariable, NULL, ZEND_ACC_PUBLIC)
PHP_ME(perl, setvariable, NULL, ZEND_ACC_PUBLIC)
+ PHP_ME(perl, call, NULL, ZEND_ACC_PUBLIC)
{NULL, NULL, NULL}
};
Modified: PHP-Sandwich/trunk/phpfuncs.h
==============================================================================
--- PHP-Sandwich/trunk/phpfuncs.h (original)
+++ PHP-Sandwich/trunk/phpfuncs.h Fri May 6 09:51:48 2005
@@ -14,6 +14,8 @@
#include <SAPI.h>
#include <TSRM.h>
+#include "phpinterp.h"
+
struct plobj {
zend_object zo;
PerlInterpreter *perl;
@@ -26,6 +28,15 @@
ZEND_BEGIN_MODULE_GLOBALS(sandwich)
struct perlistats ps_stats;
+ sandwich_per_interp *php;
ZEND_END_MODULE_GLOBALS(sandwich)
+ZEND_EXTERN_MODULE_GLOBALS(sandwich);
+
+#ifdef ZTS
+#define SandwichG(v) TSRMG(sandwich_globals_id, zend_sandwich_globals *, v)
+#else
+#define SandwichG(v) (sandwich_globals.v)
+#endif
+
#endif
Modified: PHP-Sandwich/trunk/phpinterp.c
==============================================================================
--- PHP-Sandwich/trunk/phpinterp.c (original)
+++ PHP-Sandwich/trunk/phpinterp.c Fri May 6 09:51:48 2005
@@ -1,4 +1,5 @@
#include "phpinterp.h"
+#include "phpfuncs.h"
static pthread_key_t sandwich_per_thread_info_key;
@@ -113,6 +114,7 @@
if (!info->ctx) {
info->ctx = tsrm_new_interpreter_context();
+ info->ref = 1;
old_ctx = tsrm_set_interpreter_context(info->ctx);
{
TSRMLS_FETCH();
@@ -128,10 +130,10 @@
SG(options) = SAPI_OPTION_NO_CHDIR;
php_request_startup(TSRMLS_C);
PG(during_request_startup) = 0;
+ SandwichG(php) = info;
tsrm_set_interpreter_context(old_ctx);
}
}
- info->ref = 1;
return info;
}
@@ -151,15 +153,76 @@
tsrm_set_interpreter_context(old_ctx);
}
-int sandwich_eval(sandwich_per_interp *interp, char *code)
+static int my_eval_string(char *str, zval *retval_ptr, char *string_name TSRMLS_DC)
+{
+ zval pv;
+ zend_op_array *new_op_array;
+ zend_op_array *original_active_op_array = EG(active_op_array);
+ zend_function_state *original_function_state_ptr = EG(function_state_ptr);
+ zend_uchar original_handle_op_arrays;
+ int retval;
+
+ if (retval_ptr) {
+ pv.value.str.len = strlen(str);
+ pv.value.str.val = estrndup(str, pv.value.str.len);
+ }
+ pv.type = IS_STRING;
+
+ /*printf("Evaluating '%s'\n", pv.value.str.val);*/
+
+ original_handle_op_arrays = CG(handle_op_arrays);
+ CG(handle_op_arrays) = 0;
+ new_op_array = compile_string(&pv, string_name TSRMLS_CC);
+ CG(handle_op_arrays) = original_handle_op_arrays;
+
+ if (new_op_array) {
+ zval *local_retval_ptr=NULL;
+ zval **original_return_value_ptr_ptr = EG(return_value_ptr_ptr);
+ zend_op **original_opline_ptr = EG(opline_ptr);
+
+ EG(return_value_ptr_ptr) = &local_retval_ptr;
+ EG(active_op_array) = new_op_array;
+ EG(no_extensions)=1;
+
+ zend_execute(new_op_array TSRMLS_CC);
+
+ if (local_retval_ptr) {
+ if (retval_ptr) {
+ COPY_PZVAL_TO_ZVAL(*retval_ptr, local_retval_ptr);
+ } else {
+ zval_ptr_dtor(&local_retval_ptr);
+ }
+ } else {
+ if (retval_ptr) {
+ INIT_ZVAL(*retval_ptr);
+ }
+ }
+
+ EG(no_extensions)=0;
+ EG(opline_ptr) = original_opline_ptr;
+ EG(active_op_array) = original_active_op_array;
+ EG(function_state_ptr) = original_function_state_ptr;
+ destroy_op_array(new_op_array TSRMLS_CC);
+ efree(new_op_array);
+ EG(return_value_ptr_ptr) = original_return_value_ptr_ptr;
+ retval = SUCCESS;
+ } else {
+ retval = FAILURE;
+ }
+ zval_dtor(&pv);
+ return retval;
+}
+
+SV *sandwich_eval(sandwich_per_interp *interp, char *code)
{
int rv = 0;
void *old_ctx = NULL;
+ zval retval;
old_ctx = tsrm_set_interpreter_context(interp->ctx);
{
TSRMLS_FETCH();
zend_try {
- if (FAILURE == zend_eval_string_ex(code, NULL, "PHP::eval", 1 TSRMLS_CC)) {
+ if (FAILURE == my_eval_string(code, &retval, "PHP::eval" TSRMLS_CC)) {
rv = -1;
goto cleanup;
}
@@ -171,7 +234,12 @@
}
cleanup:
tsrm_set_interpreter_context(old_ctx);
- return rv;
+ if(rv == -1) {
+ croak("error in eval");
+ } else {
+ /* FIXME, do i need to copy retval? */
+ return newSVzval(&retval, interp);
+ }
}
int sandwich_include(sandwich_per_interp *interp, char *file)
Modified: PHP-Sandwich/trunk/phpinterp.h
==============================================================================
--- PHP-Sandwich/trunk/phpinterp.h (original)
+++ PHP-Sandwich/trunk/phpinterp.h Fri May 6 09:51:48 2005
@@ -29,7 +29,7 @@
void sandwhich_per_interp_shutdown(sandwich_per_interp *interp);
-int sandwich_eval(sandwich_per_interp *interp, char *code);
+SV *sandwich_eval(sandwich_per_interp *interp, char *code);
int sandwich_include(sandwich_per_interp *interp, char *file);
/* NOTE: caller must tsrm_set_interpreter_context and reset the old one */
Modified: PHP-Sandwich/trunk/t/14.t
==============================================================================
--- PHP-Sandwich/trunk/t/14.t (original)
+++ PHP-Sandwich/trunk/t/14.t Fri May 6 09:51:48 2005
@@ -32,8 +32,11 @@
my $phpval = $p->bar();
ok $phpval == 'hello', 'Check return value of PHP bar()';
ok $p->eval(q/
+ $a = new StdClass();
+ $a->name = 'george';
$perl = Perl::getInstance();
- $perl->setVariable('$scalar', 'george');
+ $perl->setVariable('$scalar', $a);
/), 'Test use of Perl::setVariable';
-is $scalar, 'george', 'Test scalar version of setVariable';
+
+is $scalar->{name}, 'george', 'Test scalar version of setVariable';
Modified: PHP-Sandwich/trunk/t/15.t
==============================================================================
--- PHP-Sandwich/trunk/t/15.t (original)
+++ PHP-Sandwich/trunk/t/15.t Fri May 6 09:51:48 2005
@@ -3,23 +3,24 @@
use Test::More tests => 5;
BEGIN {
+ diag "Testing Perl::call";
use_ok 'PHP' or die;
use_ok 'PHP::Interpreter' or die;
}
our @var;
+our $scalar;
push @var, "hello";
push @var, "goodbye";
-diag "Testing basic function autoloadind";
ok my $p = PHP::Interpreter->new, "Create new PHP interpreter";
-ok $p->eval(q/
- function foo() {
- $perl = Perl::getInstance();
- $value = $perl['@var'];
- return $value;
- }
-/), 'Define PHP function that returns Perl values';
-my @phpval = $p->foo();
-ok $phpval[0] == 'hello', 'Check return value of PHP foo()';
+sub hello { my $who = shift; return "hello $who"; }
+
+ok my $rv = $p->eval(q/
+ $perl = Perl::getInstance();
+ $rv = $perl->call('hello', 'world');
+ return $rv;
+/), 'Test use of Perl::call';
+
+is $rv, 'hello world', "Check return value of call";
Modified: PHP-Sandwich/trunk/t/2.t
==============================================================================
--- PHP-Sandwich/trunk/t/2.t (original)
+++ PHP-Sandwich/trunk/t/2.t Fri May 6 09:51:48 2005
@@ -3,11 +3,11 @@
use Test::More tests => 5;
BEGIN {
+ diag "Testing basic function autoloadind";
use_ok 'PHP' or die;
use_ok 'PHP::Interpreter' or die;
}
-diag "Testing basic function autoloadind";
ok my $p = PHP::Interpreter->new, "Create new PHP interpreter";
ok $p->eval('function hello($a) { return "hello $a"; }'),
'Add a "hello" function';