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

Author: gschlossnagle
Date: Thu Apr 14 12:48:45 2005
New Revision: 985

Added:
   PHP-Sandwich/trunk/t/6.pl   (contents, props changed)
   PHP-Sandwich/trunk/t/7.pl   (contents, props changed)
Modified:
   PHP-Sandwich/trunk/PHP.xs
   PHP-Sandwich/trunk/t/3.pl
Log:
add ability to return arrays (assoc and indexed) from
PHP to Perl.  If I return $arr in PHP it's returned as
an array ref to Perl.  This seems like a natural semantic.

See examples 6 and 7 for details.




Modified: PHP-Sandwich/trunk/PHP.xs
==============================================================================
--- PHP-Sandwich/trunk/PHP.xs	(original)
+++ PHP-Sandwich/trunk/PHP.xs	Thu Apr 14 12:48:45 2005
@@ -24,6 +24,25 @@
 #define PHP_Interpreter sandwich_per_interp *
 #define PHP_Var_Scalar zval *
 
+
+static int zval_is_assoc(zval *zptr)
+{
+  zval **entry;
+  HashPosition pos;
+  char *sk;
+  uint skl;
+  ulong nk;
+
+  zend_hash_internal_pointer_reset_ex(Z_ARRVAL_P(zptr), &pos);
+  while(zend_hash_get_current_data_ex(Z_ARRVAL_P(zptr), (void **)&entry, &pos) == SUCCESS) {
+    if(zend_hash_get_current_key_ex(Z_ARRVAL_P(zptr), &sk, &skl, &nk, 1, &pos) == HASH_KEY_IS_STRING) {
+      return 1;
+    }
+    zend_hash_move_forward_ex(Z_ARRVAL_P(zptr), &pos);
+  }
+  return 0;
+}
+
 zval *SvZval(SV *sv)
 {
   zval *retval;
@@ -43,7 +62,6 @@
         STRLEN strlen;
         char *str = SvPV(sv, strlen);
         ZVAL_STRINGL(retval, str, strlen, 1);
-        fprintf(stderr, "SvPV %s\n", str);
       }
       break;
     case SVt_RV:    /* reference */
@@ -88,93 +106,90 @@
   return retval;
 }
 
-void assign_to_zval(zval *zptr, SV *sv)
-{
-  zval_dtor(zptr);
-  switch(SvTYPE(sv)) {
-    case SVt_IV:   /* int */
-      ZVAL_LONG(zptr, SvIV(sv));
-      break;
-    case SVt_NV:   /* double */
-      ZVAL_DOUBLE(zptr, SvNV(sv));
-      break;
-    case SVt_PV:    /* string */
-      {
-        STRLEN strlen;
-        char *str = SvPV(sv, strlen);
-        ZVAL_STRINGL(zptr, str, strlen, 1);
-        fprintf(stderr, "SvPV %s\n", str);
-      }
-      break;
-    case SVt_RV:    /* reference */
-      break;
-    case SVt_PVAV: /* indexed array */
-      break;
-    case SVt_PVHV: /* assoc. array */
-      break;
-    case SVt_PVCV: /* code */
-      break;
-    case SVt_PVGV: /* glob */
-      break;
-    case SVt_PVMG: /* magic */
-      break;
-    default:
-      break;
-  }
-}
-
 SV *newSVzval(zval *zptr)
 {
+  SV *retval;
   switch( zptr->type) {
     case IS_NULL:
-      fprintf(stderr, "IS_NULL\n");
-      return &PL_sv_undef;
+      retval = &PL_sv_undef;
       break;
     case IS_LONG:
-      fprintf(stderr, "IS_LONG\n");
-      return newSViv(Z_LVAL_P(zptr));
+      retval =  newSViv(Z_LVAL_P(zptr));
       break;
     case IS_DOUBLE:
-      fprintf(stderr, "IS_ODUBLE\n");
-      return newSVnv(Z_DVAL_P(zptr));
+      retval =  newSVnv(Z_DVAL_P(zptr));
       break;
     case IS_BOOL:
-      fprintf(stderr, "IS_BOOL\n");
-      return Z_BVAL_P(zptr) ? &PL_sv_yes : &PL_sv_no;
+      retval = Z_BVAL_P(zptr) ? &PL_sv_yes : &PL_sv_no;
       break;
     case IS_ARRAY:
-      /* FIXME: return by copy, not by reference */
-      fprintf(stderr, "IS_ARRAY\n");
-      return &PL_sv_undef;
+      {
+        zval **entry;
+        HashPosition pos;
+        char *sk;
+        uint skl;
+        ulong nk;
+        int is_assoc = 0;
+        if(zval_is_assoc(zptr)) {
+          retval = (SV *) newHV();
+          is_assoc = 1;
+        } else {
+          retval = (SV *) newAV();
+          is_assoc = 0;
+        }
+        zend_hash_internal_pointer_reset_ex(Z_ARRVAL_P(zptr), &pos);
+        while(zend_hash_get_current_data_ex(Z_ARRVAL_P(zptr), (void **)&entry, &pos) == SUCCESS) {
+          switch(zend_hash_get_current_key_ex(Z_ARRVAL_P(zptr), &sk, &skl, &nk, 1, &pos)) {
+            case HASH_KEY_IS_STRING:
+              if(!is_assoc) { 
+                /* something bad has happened here */ 
+              }
+              else {
+                hv_store((HV *) retval, sk, skl, newSVzval(*entry), 0);
+              }
+              break;
+            case HASH_KEY_IS_LONG:
+              if(is_assoc) {
+                char buf[32];
+                snprintf(buf, sizeof(buf), "%d", nk);
+                hv_store((HV *) retval, buf, strlen(buf), newSVzval(*entry), 0);
+              } else {
+                av_store((AV *) retval, nk, newSVzval(*entry));
+              }
+              break;
+          }
+          zend_hash_move_forward_ex(Z_ARRVAL_P(zptr), &pos);
+        }
+        retval = newRV_noinc(retval);
+      }
       break;
     case IS_OBJECT:
       /* FIXME: return by reference as a PHP::DataType::Object, not by copy */
-      fprintf(stderr, "IS_OBJECT\n");
-      return &PL_sv_undef;
+      fprintf(stderr, "Unimplemented type: IS_OBJECT\n");
+      retval = &PL_sv_undef;
       break;
     case IS_STRING:
-      fprintf(stderr, "IS_STRING\n");
-      return newSVpv(Z_STRVAL_P(zptr), Z_STRLEN_P(zptr));
+      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, "IS_RESOURCE\n");
-      return &PL_sv_undef;
+      fprintf(stderr, "Unimplemented type: IS_RESOURCE\n");
+      retval = &PL_sv_undef;
       break;
     case IS_CONSTANT:
-      fprintf(stderr, "IS_CONSTANT\n");
-      return newSVpv(Z_STRVAL_P(zptr), Z_STRLEN_P(zptr));
+      retval = newSVpv(Z_STRVAL_P(zptr), Z_STRLEN_P(zptr));
       break;
     case IS_CONSTANT_ARRAY:
-      fprintf(stderr, "IS_CONSTANT_ARRAY\n");
+      fprintf(stderr, "Unimplemented type: IS_CONSTANT_ARRAY\n");
       /* FIXME: return by copy, not by reference */
-      return &PL_sv_undef;
+      retval = &PL_sv_undef;
       break;
     default:
       fprintf(stderr, "Unknown type in newSVzval()\n");
-      return &PL_sv_undef;
+      retval = &PL_sv_undef;
       break;
   }
+  return retval;
 }
 
 MODULE = PHP PACKAGE = PHP::Interpreter PREFIX=SAND_
@@ -248,9 +263,17 @@
           case IS_BOOL:
           case IS_DOUBLE:
           case IS_STRING:
+            RETVAL = newSVzval(retval);
+            /*
+
             RETVAL = NEWSV(0,0);
             sv_setref_pv(c1, "PHP::Var::Scalar", (void *) retval);
             sv_magic(RETVAL, c1, PERL_MAGIC_tiedscalar, NULL, 0);
+
+            */
+            break;
+          case IS_ARRAY:
+            RETVAL = newSVzval(retval);
             break;
           default:
             fprintf(stderr, "unsupported return type in PHP_Interpreter_call\n");

Modified: PHP-Sandwich/trunk/t/3.pl
==============================================================================
--- PHP-Sandwich/trunk/t/3.pl	(original)
+++ PHP-Sandwich/trunk/t/3.pl	Thu Apr 14 12:48:45 2005
@@ -8,7 +8,7 @@
 
 print "# Testing passing Perl AVs to PHP functions.\n";
 
-$p = new PHP::Interpreter();
-$p->eval('function dump($a) { ; }');
-@list = ('I', 'AM', 'AN', 'ARRAY');
-$arg = $p->dump(\@list);
+my $p = new PHP::Interpreter();
+$p->eval('function dump($a) { var_dump($a); }');
+my @list = ('I', 'AM', 'AN', 'ARRAY');
+$p->dump(\@list);

Added: PHP-Sandwich/trunk/t/6.pl
==============================================================================
--- (empty file)
+++ PHP-Sandwich/trunk/t/6.pl	Thu Apr 14 12:48:45 2005
@@ -0,0 +1,11 @@
+#!/opt/ecelerity/3rdParty/bin/perl 
+use PHP;
+use PHP::Interpreter;
+
+$p = new PHP::Interpreter();
+$p->eval('function pass($a) { return $a; }');
+@list = ('I', 'AM', 'AN', 'ARRAY');
+$arg = $p->pass(\@list);
+
+use Data::Dumper;
+print Dumper($arg);

Added: PHP-Sandwich/trunk/t/7.pl
==============================================================================
--- (empty file)
+++ PHP-Sandwich/trunk/t/7.pl	Thu Apr 14 12:48:45 2005
@@ -0,0 +1,11 @@
+#!/opt/ecelerity/3rdParty/bin/perl 
+use PHP;
+use PHP::Interpreter;
+
+$p = new PHP::Interpreter();
+$p->eval('function pass($a) { return $a; }');
+$hash = { 'a' => 'alpha', 'b' => 'beta', 'c' => 'charlie' };
+$arg = $p->pass($hash);
+
+use Data::Dumper;
+print Dumper $arg;