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

[email protected] 7 Jun 2005 11:23:12 -0000
Newsgroups perl.php.sandwich.dev
Message-ID <[email protected]>
Author: gschlossnagle
Date: Tue Jun  7 04:23:11 2005
New Revision: 1071

Modified:
   PHP-Sandwich/trunk/PHP.xs
   PHP-Sandwich/trunk/PHP/Interpreter.pm
   PHP-Sandwich/trunk/phpinterp.c
   PHP-Sandwich/trunk/t/2.t
   PHP-Sandwich/trunk/t/9.t
   PHP-Sandwich/trunk/typemap
Log:
Add support for PHP resources.  

Work most of stubs for perl magic vars


Modified: PHP-Sandwich/trunk/PHP.xs
==============================================================================
--- PHP-Sandwich/trunk/PHP.xs	(original)
+++ PHP-Sandwich/trunk/PHP.xs	Tue Jun  7 04:23:11 2005
@@ -26,9 +26,16 @@ typedef struct {
   sandwich_per_interp *interp;
 } *PHP_Class;
 
+typedef struct {
+  zval *val;
+  sandwich_per_interp *interp;
+} *PHP_Resource;
+
 #define PHP_Interpreter sandwich_per_interp *
 #define PHP_Var_Scalar zval *
 
+static int get_class_name(zval *z, char **name, zend_uint *namelen);
+
 static int zval_is_assoc(zval *zptr)
 {
   zval **entry;
@@ -49,12 +56,15 @@ static int zval_is_assoc(zval *zptr)
 
 zval *SvZval(SV *sv)
 {
+  SV *orig_sv;
   zval *retval = NULL;
   int type;
   MAKE_STD_ZVAL(retval);
 
   /* derference sv as much as possible */
-  while(SvROK(sv)) {
+  fprintf(stderr, "sv: %p\n", sv);
+  orig_sv = sv;
+  while(SvROK(sv) && !SvMAGICAL(sv)) {
     sv = SvRV(sv);
   }
   type = SvTYPE(sv);
@@ -99,7 +109,19 @@ zval *SvZval(SV *sv)
       }
       break;
     case SVt_PVHV: /* assoc. array */
-      {
+      if(SvMAGICAL(sv)) {
+        if(strncmp(HvNAME(SvSTASH(sv)), "PHP::Class::", sizeof("PHP::Class::") -1 ) == 0) {
+          MAGIC *mg;
+          PHP_Class pclass;
+          mg = mg_find(sv, PERL_MAGIC_ext);
+          if(!mg || !mg->mg_obj || !SvROK(mg->mg_obj) || !SvIOK(SvRV(mg->mg_obj))) break;
+          pclass = (PHP_Class) SvIV(SvRV(mg->mg_obj));
+          retval = pclass->val;
+        } else {
+          // handle non-PHP classes
+        }
+      }
+      else {
         int i = 0;
         SV *element;
         char *key;
@@ -116,15 +138,26 @@ zval *SvZval(SV *sv)
       break;
     case SVt_PVGV: /* glob */
       fprintf(stderr, "SVt_PVGV\n");
+      sv_dump(sv);
       break;
     case SVt_PVMG: /* magic */
-      fprintf(stderr, "SVt_PVMG\n");
+      if(sv_isobject(orig_sv)) {
+        if(strcmp(HvNAME(SvSTASH(sv)), "PHP::Resource") == 0) {
+          PHP_Resource prsrc = (PHP_Resource) SvIV(sv);
+          retval = prsrc->val;
+        } else {
+          /* should wrap me in a zend object */
+        }
+      } else {
+        // do something else
+      }
       break;
     case SVt_PVLV: 
       fprintf(stderr, "SVt_PVLV\n");
       break;
     default:
       fprintf(stderr, "SVt_??? default\n");
+      ZVAL_NULL(retval);
       break;
   }
   return retval;
@@ -133,6 +166,8 @@ zval *SvZval(SV *sv)
 SV *newSVzval(zval *zptr, PHP_Interpreter interp)
 {
   SV *retval;
+  void *old_ctx;
+  old_ctx = tsrm_set_interpreter_context(interp->ctx);
   switch( zptr->type) {
     case IS_NULL:
       retval = &PL_sv_undef;
@@ -196,10 +231,12 @@ SV *newSVzval(zval *zptr, PHP_Interprete
           SV * c1;
           PHP_Class pclass;
 
-          c1 = sv_newmortal();
+          c1 = newSV(0);
           pclass = malloc(sizeof(*pclass));
           /* FIXME: don't leak! */
-          pclass->val = zptr;
+
+          MAKE_STD_ZVAL(pclass->val);
+          ZVAL_ZVAL(pclass->val, zptr, 1, 0);
           pclass->interp = interp;
           sandwich_interp_inc_ref(interp);
           if(get_class_name(zptr, &name, &namelen) < 0) {
@@ -228,9 +265,21 @@ SV *newSVzval(zval *zptr, PHP_Interprete
       retval = newSVpv(Z_STRVAL_P(zptr), Z_STRLEN_P(zptr));
       break;
     case IS_RESOURCE:
-      /* FIXME: return by reference as a PHP::DataType::Reference, not by copy */
-      fprintf(stderr, "Unimplemented type: IS_RESOURCE\n");
-      retval = &PL_sv_undef;
+        {
+          SV * c1;
+          PHP_Resource prsrc;
+
+          c1 = newSV(0);
+          prsrc = malloc(sizeof(*prsrc));
+          /* FIXME: don't leak! */
+          MAKE_STD_ZVAL(prsrc->val);
+          ZVAL_ZVAL(prsrc->val, zptr, 1, 0);
+          sandwich_interp_inc_ref(interp);
+          prsrc->interp = interp;
+          sv_setref_pv(c1, "PHP::Resource", (void *) prsrc);
+          retval = newSV(0);
+          sv_magic(retval, c1, PERL_MAGIC_tiedscalar, NULL, 0);
+        }
       break;
     case IS_CONSTANT:
       retval = newSVpv(Z_STRVAL_P(zptr), Z_STRLEN_P(zptr));
@@ -241,10 +290,12 @@ SV *newSVzval(zval *zptr, PHP_Interprete
       retval = &PL_sv_undef;
       break;
     default:
-      fprintf(stderr, "Unknown type in newSVzval()\n");
+      fprintf(stderr, "Unknown type %d in newSVzval()\n", zptr->type);
+      { char *ptr = NULL; *ptr = 1; }
       retval = &PL_sv_undef;
       break;
   }
+  tsrm_set_interpreter_context(old_ctx);
   return retval;
 }
 
@@ -310,7 +361,7 @@ SV *SAND_include(interp, file)
   OUTPUT:
     RETVAL
 
-SV *SAND_call(interp, method_name, ...)
+SV *SAND_call(method_name, interp, ...)
   PHP_Interpreter interp;
   char *method_name;
   CODE:
@@ -369,7 +420,7 @@ SV *SAND_call(interp, method_name, ...)
               SV * c1;
               PHP_Class pclass;
 
-              c1 = sv_newmortal();
+              c1 = newSV(0);
               pclass = malloc(sizeof(*pclass));
               /* FIXME: don't leak! */
               pclass->val = retval;
@@ -397,6 +448,22 @@ SV *SAND_call(interp, method_name, ...)
               RETVAL = sv_bless(RETVAL, package);
             }
             break;
+          case IS_RESOURCE:
+              {
+                SV * c1;
+                PHP_Resource prsrc;
+
+                c1 = newSV(0);
+                prsrc = malloc(sizeof(*prsrc));
+                /* FIXME: don't leak! */
+                prsrc->val = retval;
+                sandwich_interp_inc_ref(interp);
+                prsrc->interp = interp;
+                RETVAL = newSV(0);
+                sv_setref_pv(c1, "PHP::Resource", (void *) prsrc);
+                sv_magic(RETVAL, c1, PERL_MAGIC_tiedscalar, NULL, 0);
+              }
+            break;
           default:
             fprintf(stderr, "unsupported return type in PHP_Interpreter_call\n");
             RETVAL = &PL_sv_undef;
@@ -681,7 +748,7 @@ SV *PHP_V_C__AUTOLOAD(self, method_name,
       zval *retval;
       PHP_Interpreter interp;
       char *croakstr = NULL;
-      
+
       mg = mg_find((SvRV(self)), PERL_MAGIC_ext);
       pclass = (PHP_Class) SvIV(SvRV(mg->mg_obj));
 
@@ -763,7 +830,7 @@ SV *PHP_V_C__AUTOLOAD(self, method_name,
                 SV * c1;
                 PHP_Class pclass;
   
-                c1 = sv_newmortal();
+                c1 = newSV(0);
                 pclass = malloc(sizeof(*pclass));
                 /* FIXME: don't leak! */
                 pclass->val = retval;
@@ -789,6 +856,22 @@ SV *PHP_V_C__AUTOLOAD(self, method_name,
                 sv_setref_pv(RETVAL, objectname, (void *) pclass);
                 //RETVAL = sv_bless(RETVAL, package);
               }
+            case IS_RESOURCE:
+                {
+                  SV * c1;
+                  PHP_Resource prsrc;
+
+                  c1 = newSV(0);
+                  prsrc = malloc(sizeof(*prsrc));
+                  /* FIXME: don't leak! */
+                  prsrc->val = retval;
+                  prsrc->interp = interp;
+                  sandwich_interp_inc_ref(interp);
+                  RETVAL = newSV(0);
+                  sv_setref_pv(c1, "PHP::Resource", (void *) prsrc);
+                  sv_magic(RETVAL, c1, PERL_MAGIC_tiedscalar, NULL, 0);
+                }
+              break;
               break;
             default:
               fprintf(stderr, "unsupported return type in PHP_Interpreter_call\n");
@@ -885,3 +968,49 @@ SV* PHP_V_C_create(in, class, ...)
     }
   OUTPUT:
     RETVAL
+
+MODULE = PHP PACKAGE = PHP::Resource PREFIX=PHP_V_R_
+
+REQUIRE:        1.9505
+PROTOTYPES:     DISABLE
+
+PHP_Resource PHP_V_R_FETCH(zptr)
+  PHP_Resource zptr;
+  PHP_Resource rv;
+  CODE:
+    {
+      void *old_ctx = tsrm_set_interpreter_context(zptr->interp->ctx);
+      RETVAL = malloc(sizeof(*RETVAL));
+      MAKE_STD_ZVAL(RETVAL->val);
+      ZVAL_ZVAL(RETVAL->val, zptr->val, 1, 0);
+      RETVAL->interp = zptr->interp;
+      sandwich_interp_inc_ref(zptr->interp);
+      tsrm_set_interpreter_context(old_ctx);
+    }
+  OUTPUT:
+    RETVAL
+
+void PHP_V_R_STORE(zptr, new)
+  PHP_Resource zptr;
+  SV *new;
+  CODE:
+    {
+      sv_dump(new);
+    }
+
+void PHP_V_R_DESTROY(prsrc)
+  PHP_Resource prsrc;
+  CODE:
+    {
+      if(!prsrc || !prsrc->interp) return;
+      void *old_ctx = tsrm_set_interpreter_context(prsrc->interp->ctx);
+      {
+        TSRMLS_FETCH();
+        zval_ptr_dtor(&prsrc->val);
+      }
+      tsrm_set_interpreter_context(old_ctx);
+      /* potentially shutdown ZE */
+      sandwich_interp_dec_ref(prsrc->interp);
+      fprintf(stderr, "freeing %p\n", prsrc);
+      free(prsrc);
+    }

Modified: PHP-Sandwich/trunk/PHP/Interpreter.pm
==============================================================================
--- PHP-Sandwich/trunk/PHP/Interpreter.pm	(original)
+++ PHP-Sandwich/trunk/PHP/Interpreter.pm	Tue Jun  7 04:23:11 2005
@@ -8,11 +8,9 @@ use vars qw($VERSION @ISA @EXPORT @EXPOR
 @ISA = qw(AutoLoader);
 
 sub AUTOLOAD {
-  my $self = shift;
   my $sub = $AUTOLOAD;
   $sub =~ s/.*:://;
   unshift @_, $sub;
-  unshift @_, $self;
   goto &call;
 }
 

Modified: PHP-Sandwich/trunk/phpinterp.c
==============================================================================
--- PHP-Sandwich/trunk/phpinterp.c	(original)
+++ PHP-Sandwich/trunk/phpinterp.c	Tue Jun  7 04:23:11 2005
@@ -153,7 +153,7 @@ void sandwich_per_interp_shutdown(sandwi
   tsrm_set_interpreter_context(old_ctx);
 }
 
-static int my_eval_string(char *str, zval *retval_ptr, char *string_name TSRMLS_DC)
+int my_eval_string(char *str, zval *retval_ptr, char *string_name TSRMLS_DC)
 {
   zval pv;
   zend_op_array *new_op_array;
@@ -163,12 +163,14 @@ static int my_eval_string(char *str, zva
   int retval;
 
   if (retval_ptr) {
-    pv.value.str.len = strlen(str);
-    pv.value.str.val = estrndup(str, pv.value.str.len);
+    pv.value.str.len = strlen(str) + sizeof(" return true;") -1;
+    pv.value.str.val = emalloc(pv.value.str.len + 1);
+    strcpy(pv.value.str.val, str);
+    strcat(pv.value.str.val, " return true;");
   }
   pv.type = IS_STRING;
 
-  /*printf("Evaluating '%s'\n", pv.value.str.val);*/
+  /* printf("Evaluating '%s'\n", pv.value.str.val); */
 
   original_handle_op_arrays = CG(handle_op_arrays);
   CG(handle_op_arrays) = 0;

Modified: PHP-Sandwich/trunk/t/2.t
==============================================================================
--- PHP-Sandwich/trunk/t/2.t	(original)
+++ PHP-Sandwich/trunk/t/2.t	Tue Jun  7 04:23:11 2005
@@ -1,6 +1,6 @@
 #!/opt/ecelerity/3rdParty/bin/perl
 use strict;
-use Test::More tests => 5;
+use Test::More tests => 6;
 
 BEGIN {
     diag "Testing basic function autoloadind";
@@ -13,3 +13,5 @@ ok $p->eval('function hello($a) { return
   'Add a "hello" function';
 is $p->hello('george'),  'hello george',
   'We should get the proper return value of the "hello" function"';
+
+is $p->eval('return "hello world";'), "hello world";

Modified: PHP-Sandwich/trunk/t/9.t
==============================================================================
--- PHP-Sandwich/trunk/t/9.t	(original)
+++ PHP-Sandwich/trunk/t/9.t	Tue Jun  7 04:23:11 2005
@@ -27,3 +27,4 @@ $arg->{a} = 456;
 is $arg->{a}, 456, "attribute writing";
 is $arg->bar(), 'george', 'function calls';
 is $PHP::Class::Foo::ISA[0], 'PHP::Class', 'class inherits correctly';
+

Modified: PHP-Sandwich/trunk/typemap
==============================================================================
--- PHP-Sandwich/trunk/typemap	(original)
+++ PHP-Sandwich/trunk/typemap	Tue Jun  7 04:23:11 2005
@@ -1,5 +1,6 @@
 PHP_Interpreter T_PTROBJ_SPECIAL
 PHP_Var_Scalar T_PTROBJ_SPECIAL
+PHP_Resource T_PTROBJ_SPECIAL
 PHP_Class T_PTROBJ_SPECIAL
 
 INPUT