[prev in list] [next in list] [prev in thread] [next in thread]
List: pecl-cvs
Subject: [PECL-CVS] =?utf-8?q?svn:_/pecl/perl/tags/_perl-1.0.1/CREDITS_perl-1.0.1/EXPERIMENTAL_perl-1.0.1/REA
From: Ferenc_Kovacs <tyrael () php ! net>
Date: 2013-01-23 12:27:27
Message-ID: svn-tyrael-1358944047-329276-1918333876 () svn ! php ! net
[Download RAW message or body]
tyrael Wed, 23 Jan 2013 12:27:27 +0000
Revision: http://svn.php.net/viewvc?view=revision&revision=329276
Log:
Tagging the 1.0.1 release
Changed paths:
A pecl/perl/tags/perl-1.0.1/
A + pecl/perl/tags/perl-1.0.1/CREDITS
(from pecl/perl/trunk/CREDITS:r329274)
A + pecl/perl/tags/perl-1.0.1/EXPERIMENTAL
(from pecl/perl/trunk/EXPERIMENTAL:r329274)
A + pecl/perl/tags/perl-1.0.1/README
(from pecl/perl/trunk/README:r329274)
A + pecl/perl/tags/perl-1.0.1/TODO
(from pecl/perl/trunk/TODO:r329274)
A + pecl/perl/tags/perl-1.0.1/config.m4
(from pecl/perl/trunk/config.m4:r329274)
A + pecl/perl/tags/perl-1.0.1/config.w32
(from pecl/perl/trunk/config.w32:r329274)
A + pecl/perl/tags/perl-1.0.1/package.xml
(from pecl/perl/trunk/package.xml:r329275)
A + pecl/perl/tags/perl-1.0.1/perl.dsp
(from pecl/perl/trunk/perl.dsp:r329274)
A + pecl/perl/tags/perl-1.0.1/php_perl.c
(from pecl/perl/trunk/php_perl.c:r329274)
A + pecl/perl/tags/perl-1.0.1/php_perl.h
(from pecl/perl/trunk/php_perl.h:r329275)
A pecl/perl/tags/perl-1.0.1/tests/
A + pecl/perl/tags/perl-1.0.1/tests/perl001.phpt
(from pecl/perl/trunk/tests/perl001.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl001.pl
(from pecl/perl/trunk/tests/perl001.pl:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl002.phpt
(from pecl/perl/trunk/tests/perl002.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl003.phpt
(from pecl/perl/trunk/tests/perl003.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl004.phpt
(from pecl/perl/trunk/tests/perl004.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl005.phpt
(from pecl/perl/trunk/tests/perl005.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl006.phpt
(from pecl/perl/trunk/tests/perl006.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl007.phpt
(from pecl/perl/trunk/tests/perl007.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl008.phpt
(from pecl/perl/trunk/tests/perl008.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl009.phpt
(from pecl/perl/trunk/tests/perl009.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl010.phpt
(from pecl/perl/trunk/tests/perl010.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl011.phpt
(from pecl/perl/trunk/tests/perl011.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl012.phpt
(from pecl/perl/trunk/tests/perl012.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl013.phpt
(from pecl/perl/trunk/tests/perl013.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl014.phpt
(from pecl/perl/trunk/tests/perl014.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl015.phpt
(from pecl/perl/trunk/tests/perl015.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl016.phpt
(from pecl/perl/trunk/tests/perl016.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl017.phpt
(from pecl/perl/trunk/tests/perl017.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl018.phpt
(from pecl/perl/trunk/tests/perl018.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl019.phpt
(from pecl/perl/trunk/tests/perl019.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl020.phpt
(from pecl/perl/trunk/tests/perl020.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl021.phpt
(from pecl/perl/trunk/tests/perl021.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl022.phpt
(from pecl/perl/trunk/tests/perl022.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl023.phpt
(from pecl/perl/trunk/tests/perl023.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl024.phpt
(from pecl/perl/trunk/tests/perl024.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl025.phpt
(from pecl/perl/trunk/tests/perl025.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl026.phpt
(from pecl/perl/trunk/tests/perl026.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl027.phpt
(from pecl/perl/trunk/tests/perl027.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl028.phpt
(from pecl/perl/trunk/tests/perl028.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl029.phpt
(from pecl/perl/trunk/tests/perl029.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl030.phpt
(from pecl/perl/trunk/tests/perl030.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl031.phpt
(from pecl/perl/trunk/tests/perl031.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl032.phpt
(from pecl/perl/trunk/tests/perl032.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl033.phpt
(from pecl/perl/trunk/tests/perl033.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl034.phpt
(from pecl/perl/trunk/tests/perl034.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl035.phpt
(from pecl/perl/trunk/tests/perl035.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl036.phpt
(from pecl/perl/trunk/tests/perl036.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl037.phpt
(from pecl/perl/trunk/tests/perl037.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl038.phpt
(from pecl/perl/trunk/tests/perl038.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl039.phpt
(from pecl/perl/trunk/tests/perl039.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl040.phpt
(from pecl/perl/trunk/tests/perl040.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl041.phpt
(from pecl/perl/trunk/tests/perl041.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl042.phpt
(from pecl/perl/trunk/tests/perl042.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl043.phpt
(from pecl/perl/trunk/tests/perl043.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl044.phpt
(from pecl/perl/trunk/tests/perl044.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl045.phpt
(from pecl/perl/trunk/tests/perl045.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl046.phpt
(from pecl/perl/trunk/tests/perl046.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl047.phpt
(from pecl/perl/trunk/tests/perl047.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl048.phpt
(from pecl/perl/trunk/tests/perl048.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl049.phpt
(from pecl/perl/trunk/tests/perl049.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl050.phpt
(from pecl/perl/trunk/tests/perl050.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl051.phpt
(from pecl/perl/trunk/tests/perl051.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl052.phpt
(from pecl/perl/trunk/tests/perl052.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl053.phpt
(from pecl/perl/trunk/tests/perl053.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl054.phpt
(from pecl/perl/trunk/tests/perl054.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl055.phpt
(from pecl/perl/trunk/tests/perl055.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl056.phpt
(from pecl/perl/trunk/tests/perl056.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl057.phpt
(from pecl/perl/trunk/tests/perl057.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl058.phpt
(from pecl/perl/trunk/tests/perl058.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl059.phpt
(from pecl/perl/trunk/tests/perl059.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl060.phpt
(from pecl/perl/trunk/tests/perl060.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl061.phpt
(from pecl/perl/trunk/tests/perl061.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl062.phpt
(from pecl/perl/trunk/tests/perl062.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl063.phpt
(from pecl/perl/trunk/tests/perl063.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl064.phpt
(from pecl/perl/trunk/tests/perl064.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl065.phpt
(from pecl/perl/trunk/tests/perl065.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl066.phpt
(from pecl/perl/trunk/tests/perl066.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl067.phpt
(from pecl/perl/trunk/tests/perl067.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl068.phpt
(from pecl/perl/trunk/tests/perl068.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl069.phpt
(from pecl/perl/trunk/tests/perl069.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/perl070.phpt
(from pecl/perl/trunk/tests/perl070.phpt:r329274)
A + pecl/perl/tags/perl-1.0.1/tests/skipif.inc
(from pecl/perl/trunk/tests/skipif.inc:r329274)
["svn-diffs-329276.txt" (text/x-diff)]
Copied: pecl/perl/tags/perl-1.0.1/CREDITS (from rev 329274, pecl/perl/trunk/CREDITS)
===================================================================
--- pecl/perl/tags/perl-1.0.1/CREDITS (rev 0)
+++ pecl/perl/tags/perl-1.0.1/CREDITS 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,2 @@
+perl
+Dmitry Stogov
Copied: pecl/perl/tags/perl-1.0.1/EXPERIMENTAL (from rev 329274, \
pecl/perl/trunk/EXPERIMENTAL) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/EXPERIMENTAL (rev 0)
+++ pecl/perl/tags/perl-1.0.1/EXPERIMENTAL 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,5 @@
+this extension is experimental,
+its functions may change their names
+or move to extension all together
+so do not rely to much on them
+you have been warned!
Copied: pecl/perl/tags/perl-1.0.1/README (from rev 329274, pecl/perl/trunk/README)
===================================================================
--- pecl/perl/tags/perl-1.0.1/README (rev 0)
+++ pecl/perl/tags/perl-1.0.1/README 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,162 @@
+What is ext/perl?
+=================
+
+ This extension allows embedding of Perl Interpreter into PHP5 to:
+ * execute Perl files
+ * evaluate Perl code
+ * access values of Perl variables
+ * call Perl subroutines
+ * instantiate and manipulate of Perl objects
+
+Requirements
+============
+ PHP 5.0.0RC2 or later
+ Perl 5.8.0 or later
+
+Quick install
+=============
+
+ Step 1. Compile this extension. PHP_PREFIX and PERL_PREFIX mast point to real
+ PHP and Perl instalation prefixes.
+
+ export PHP_PREFIX="/usr"
+ export PERL_PREFIX="/usr"
+ $PHP_PREFIX/bin/phpize
+ ./configure --with-perl=$PERL_PREFIX \
--with-php-config=$PHP_PREFIX/bin/php-config + make
+
+ Step 2. Install the extension (this step can require root privileges)
+
+ make install
+
+ Step 3. Add perl extension into your php.ini (this step can require root \
privileges) +
+ extension=perl.so
+
+Windows Installation Notes
+==========================
+
+ Step 1. Download ActivePerl binaries for Windows from
+ http://www.activestate.com/Products/ActivePerl/
+ and install them.
+
+ Step 2. Put this extension into corresponding PHP source tree (into ext/perl)
+
+ Step 3. Compile the extension
+
+ SET PERL_HOME=C:\perl
+ msdev perl.dsp /MAKE "perl - Win32 Release_TS"
+
+ Step 4. Copy php_perl.dll (from Release_TS) to PHP extension dir
+
+ Step 5. Add perl extension into your php.ini
+
+ extension=php_perl.dll
+
+PHP API
+=======
+
+ new Perl()
+ ----------
+ Creates perl interpreter. It allows
+
+ * reading and modifying of Perl variables
+ * calling Perl functions
+ * evaluating Perl code
+ * loading and executing exteranl Perl files
+
+ Examples:
+ $perl = new Perl();
+ var_dump($perl->x); // print scalar Perl variable - $x
+ var_dump($perl->array->x); // print array Perl variable - @x
+ var_dump($perl->hash->x); // print hash Perl variable - %x
+ $perl->func(); // call Perl function 'func' in void context
+ $x = $perl->func(); // call Perl function 'func' in scalar context
+ $y = $perl->array->func(); // call Perl function 'func' in array context
+ $y = $perl->hash->func(); // call Perl function 'func' in hash context
+
+ $perl->eval('use Digest::MD5');
+ echo $perl->{'Digest::MD5::md5_hex'}('Hello');
+
+
+ Perl->eval($perl_code)
+ ----------------------
+ Evaluates Perl code and returns result. If Perl code is invalid it will
+ throw PHP exception.
+
+ Exampes:
+ $perl = new Perl();
+ $perl->eval('require "test.pl";');
+ echo $perl->eval($x.'+'.$y.';');
+ $perl->eval('$z='.$x.'+'.$y.';');
+
+ By default Perl code is evaluated in scalar context, but it can be
+ evaluated in array or hash context too.
+
+ Exampes:
+ $perl = new Perl();
+ $perl->eval('("a","b","c")'); // eval in void context
+ var_dump($perl->eval('("a","b","c")')); // eval in scalar context
+ var_dump($perl->array->eval('("a","b","c")')); // eval in array context
+ var_dump($perl->hash->eval('("a","b","c")')); // eval in hash context
+
+
+ Perl->require($perl_file_name)
+ ------------------------------
+ Loads and executes Perl file. It doesn't return any value. If required Perl
+ file doesn't exist or invalid it will throw PHP exception.
+
+ Examples:
+ $perl = new Perl();
+ $perl->require('test.pl');
+
+ new Perl($perl_class_name[, $constructor = "new"[, ...]])
+ -----------------------------------------------------
+ Creates an instance of Perl class through calling specified constructor
+ or "new" if constructor is not specified. Additional parameters passed
+ to Perl's constructor. The created object allows:
+
+ * reading and modifying of object properties
+ * calling methods
+ * cloning
+
+ Examples:
+ $x = new Perl("Test");
+ $y = new Perl("Test","copy",$x);
+ $z = clone $y;
+ echo $z->property;
+ echo $z->method(1,2,3);
+
+ Methods can be called in array or hash context in the same way as Perl
+ functions, but all properties are acessable directly (without array or
+ hash modifiers).
+
+ Examples:
+ $x = new Perl("Test");
+ $x->f(); // call method "f" in void context
+ var_dump($x->f()); // call method "f" in scalar context
+ var_dump($x->array->f()); // call method "f" in array context
+ var_dump($x->hash->f()); // call method "f" in hash context
+
+
+
+Known BUGS and limitations
+==========================
+ * Perl objects passed between Perl and PHP by reference all other data type
+ (including arrays and hashes) passed by value. So modification of Perl's
+ arrays and hashes in PHP will not have effect in Perl.
+
+ $x = $perl->array->x;
+ $x[0] = 1; // Perl's array @x still unmodifyed
+
+ But you can use PHP references to do this. The following code works fine.
+
+ $x = &$perl->array->x;
+ $x[0] = 1; // Modifies Perl's array @x
+
+ * pecl/perl can't call internal Perl functions
+ (print, die, ...).
+
+This extension was testd on RedHat Linux 9.0 with PHP 5.0.0RC2-dev (non ZTS build)
+and perl-5.8.0 (installed from RPM) and on Windows 2000 with PHP-5.0.0RC2-dev
+(ZTS build) and perl-5.8.0.
Copied: pecl/perl/tags/perl-1.0.1/TODO (from rev 329274, pecl/perl/trunk/TODO)
===================================================================
--- pecl/perl/tags/perl-1.0.1/TODO (rev 0)
+++ pecl/perl/tags/perl-1.0.1/TODO 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,7 @@
+-? call internal Perl functions (print)
+ (see test: 18)
+-? PHP memory leaks
+ (see tests: 53)
+- Perl memory leaks
+- *** Warning: Linking the shared library library perl.la against the
+ DynaLoader.a is not portable!
Copied: pecl/perl/tags/perl-1.0.1/config.m4 (from rev 329274, \
pecl/perl/trunk/config.m4) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/config.m4 (rev 0)
+++ pecl/perl/tags/perl-1.0.1/config.m4 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,33 @@
+dnl $Id$
+dnl config.m4 for extension perl
+
+PHP_ARG_WITH(perl, for perl support,
+[ --with-perl[=DIR] Include perl support. DIR is the perl base directory.])
+
+if test "$PHP_PERL" != "no"; then
+ for i in $PHP_PERL /usr/local /usr; do
+ if test -x $i/bin/perl; then
+ PERL_DIR=$i
+ break
+ fi
+ done
+
+ if test -z "$PERL_DIR"; then
+ AC_MSG_ERROR([Cannot find perl executable under $PHP_PERL.])
+ fi
+
+ EXTRA_CFLAGS=`$PERL_DIR/bin/perl -MExtUtils::Embed -e ccopts`
+ EXTRA_LDFLAGS=`$PERL_DIR/bin/perl -MExtUtils::Embed -e ldopts`
+
+ PHP_SUBST(EXTRA_CFLAGS)
+ PHP_SUBST(EXTRA_LDFLAGS)
+dnl PHP_EVAL_LIBLINE($PERL_LDFLAGS, PERL_SHARED_LIBADD)
+dnl PHP_EVAL_INCLINE($PERL_CFLAGS)
+
+dnl PHP_SUBST(PERL_SHARED_LIBADD)
+
+dnl PHP_ADD_LIBRARY_WITH_PATH(perl, $PERL_DIR, MYSQL_SHARED_LIBADD)
+dnl PHP_ADD_INCLUDE($PERL_DIR)
+ AC_DEFINE(HAVE_PERL,1,[Whether you have perl])
+ PHP_NEW_EXTENSION(perl, php_perl.c, $ext_shared)
+fi
Copied: pecl/perl/tags/perl-1.0.1/config.w32 (from rev 329274, \
pecl/perl/trunk/config.w32) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/config.w32 (rev 0)
+++ pecl/perl/tags/perl-1.0.1/config.w32 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,16 @@
+// $Id$
+// config.w32 for extension perl
+
+ARG_WITH("perl", "Perl support (where to find Perl interpriter)", "no");
+
+if (PHP_PERL != "no") {
+ if (CHECK_LIB("perl*.lib", "perl", PHP_PERL + ";\\Perl\\lib\\CORE" ) &&
+ CHECK_HEADER_ADD_INCLUDE("perl.h", "CFLAGS_PERL", PHP_PERL + \
";\\Perl\\lib\\CORE")) { + EXTENSION("perl", "php_perl.c");
+ AC_DEFINE("HAVE_PERL", 1, "Perl support");
+
+ ADD_FLAG("CFLAGS_PERL", "/DHAVE_PERL /D_CONSOLE /DNO_STRICT \
/DPERL_IMLICIT_CONTEXT /DPERL_IMPLICIT_SYS /DUSE_PERLIO /DPERL_MSVCRT_READFIX"); + } \
else { + WARNING("perl not enabled; libraries and headers not found");
+ }
+}
Copied: pecl/perl/tags/perl-1.0.1/package.xml (from rev 329275, \
pecl/perl/trunk/package.xml) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/package.xml (rev 0)
+++ pecl/perl/tags/perl-1.0.1/package.xml 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,130 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<package packagerversion="1.9.0" version="2.0" \
xmlns="http://pear.php.net/dtd/package-2.0" \
xmlns:tasks="http://pear.php.net/dtd/tasks-1.0" \
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" \
xsi:schemaLocation="http://pear.php.net/dtd/tasks-1.0 \
+http://pear.php.net/dtd/tasks-1.0.xsd +http://pear.php.net/dtd/package-2.0
+http://pear.php.net/dtd/package-2.0.xsd">
+ <name>perl</name>
+ <channel>pecl.php.net</channel>
+ <summary>Embedded Perl.</summary>
+ <description>This extension embeds Perl Interpreter into PHP. It allows execute \
Perl files, evaluate Perl code, access Perl variables and instantiate Perl objects. + \
</description> + <lead>
+ <name>Dmitry Stogov</name>
+ <user>dmitry</user>
+ <email>dmitry@zend.com</email>
+ <active>yes</active>
+ </lead>
+ <date>2013-01-23</date>
+ <time>13:00:00</time>
+ <version>
+ <release>1.0.1</release>
+ <api>1.0.0</api>
+ </version>
+ <stability>
+ <release>stable</release>
+ <api>stable</api>
+ </stability>
+ <license uri="http://www.php.net/license">PHP</license>
+ <notes>
+Initial release
+ </notes>
+ <contents>
+ <dir name="/">
+ <dir name="tests">
+ <file baseinstalldir="perl" name="perl001.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl001.pl" role="test" />
+ <file baseinstalldir="perl" name="perl002.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl003.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl004.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl005.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl006.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl007.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl008.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl009.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl010.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl011.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl012.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl013.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl014.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl015.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl016.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl017.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl018.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl019.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl020.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl021.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl022.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl023.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl024.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl025.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl026.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl027.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl028.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl029.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl030.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl031.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl032.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl033.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl034.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl035.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl036.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl037.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl038.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl039.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl040.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl041.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl042.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl043.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl044.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl045.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl046.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl047.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl048.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl049.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl050.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl051.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl052.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl053.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl054.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl055.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl056.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl057.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl058.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl059.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl060.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl061.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl062.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl063.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl064.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl065.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl066.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl067.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl068.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl069.phpt" role="test" />
+ <file baseinstalldir="perl" name="perl070.phpt" role="test" />
+ <file baseinstalldir="perl" name="skipif.inc" role="test" />
+ </dir> <!-- //tests -->
+ <file baseinstalldir="perl" name="config.m4" role="src" />
+ <file baseinstalldir="perl" name="config.w32" role="src" />
+ <file baseinstalldir="perl" name="CREDITS" role="doc" />
+ <file baseinstalldir="perl" name="EXPERIMENTAL" role="doc" />
+ <file baseinstalldir="perl" name="perl.dsp" role="src" />
+ <file baseinstalldir="perl" name="php_perl.c" role="src" />
+ <file baseinstalldir="perl" name="php_perl.h" role="src" />
+ <file baseinstalldir="perl" name="README" role="doc" />
+ <file baseinstalldir="perl" name="TODO" role="doc" />
+ </dir> <!-- / -->
+ </contents>
+ <dependencies>
+ <required>
+ <php>
+ <min>5.0.0</min>
+ </php>
+ <pearinstaller>
+ <min>1.4.0b1</min>
+ </pearinstaller>
+ </required>
+ </dependencies>
+ <providesextension>perl</providesextension>
+ <extsrcrelease />
+</package>
Copied: pecl/perl/tags/perl-1.0.1/perl.dsp (from rev 329274, \
pecl/perl/trunk/perl.dsp) \
=================================================================== (Binary files \
differ)
Copied: pecl/perl/tags/perl-1.0.1/php_perl.c (from rev 329274, \
pecl/perl/trunk/php_perl.c) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/php_perl.c (rev 0)
+++ pecl/perl/tags/perl-1.0.1/php_perl.c 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,1955 @@
+/*
+ +----------------------------------------------------------------------+
+ | PHP Version 4 |
+ +----------------------------------------------------------------------+
+ | Copyright (c) 1997-2003 The PHP Group |
+ +----------------------------------------------------------------------+
+ | This source file is subject to version 3.0 of the PHP license, |
+ | that is bundled with this package in the file LICENSE, and is |
+ | available through the world-wide-web at the following url: |
+ | http://www.php.net/license/3_0.txt. |
+ | If you did not receive a copy of the PHP license and are unable to |
+ | obtain it through the world-wide-web, please send a note to |
+ | license@php.net so we can mail you a copy immediately. |
+ +----------------------------------------------------------------------+
+ | Author: Dmitry Stogov <dmitry@zend.com> |
+ +----------------------------------------------------------------------+
+ $Id$
+*/
+
+#ifdef COMPILE_DL_PERL
+#define HAVE_PERL 1
+#endif
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#if HAVE_PERL
+
+#ifdef ZEND_WIN32
+# define _WINSOCK2API_ /* using winsock.h instead of winsock2.h */
+# define READDIR_H
+# define _INET_H_
+# define _NETDB_H_
+#endif
+
+#include <EXTERN.h> /* from the Perl distribution */
+#include <perl.h> /* from the Perl distribution */
+#include <perliol.h> /* from the Perl distribution */
+#include <perlapi.h> /* from the Perl distribution */
+
+//#include <XSUB.h> /* from the Perl distribution */
+
+#define ST(off) PL_stack_base[ax + (off)]
+
+#undef YYDEBUG /* bypass macros redeclaration warning */
+#undef END_EXTERN_C /* bypass macros redeclaration warning */
+
+#include "php.h"
+#include "php_ini.h"
+#include "zend_objects_API.h"
+#include "zend_exceptions.h"
+#include "zend_extensions.h"
+#include "ext/standard/info.h"
+#include "SAPI.h"
+#include "php_perl.h"
+
+#ifndef Z_ISREF
+# define Z_REFCOUNT_PP(ppz) Z_REFCOUNT_P(*(ppz))
+# define Z_SET_REFCOUNT_PP(ppz, rc) Z_SET_REFCOUNT_P(*(ppz), rc)
+# define Z_ADDREF_PP(ppz) Z_ADDREF_P(*(ppz))
+# define Z_DELREF_PP(ppz) Z_DELREF_P(*(ppz))
+# define Z_ISREF_PP(ppz) Z_ISREF_P(*(ppz))
+# define Z_SET_ISREF_PP(ppz) Z_SET_ISREF_P(*(ppz))
+# define Z_UNSET_ISREF_PP(ppz) Z_UNSET_ISREF_P(*(ppz))
+# define Z_SET_ISREF_TO_PP(ppz, isref) Z_SET_ISREF_TO_P(*(ppz), isref)
+
+# define Z_REFCOUNT_P(pz) (pz)->refcount
+# define Z_SET_REFCOUNT_P(pz, rc) do {(pz)->refcount = (rc);} while(0)
+# define Z_ADDREF_P(pz) ++(pz)->refcount
+# define Z_DELREF_P(pz) --(pz)->refcount
+# define Z_ISREF_P(pz) (pz)->is_ref
+# define Z_SET_ISREF_P(pz) do {(pz)->is_ref = 1;} while(0)
+# define Z_UNSET_ISREF_P(pz) do {(pz)->is_ref = 1;} while(0)
+# define Z_SET_ISREF_TO_P(pz, isref) do {(pz)->is_ref = (isref);} while(0)
+
+# define Z_REFCOUNT(z) Z_REFCOUNT_P(&(z))
+# define Z_SET_REFCOUNT(z, rc) Z_SET_REFCOUNT_P(&(z), rc)
+# define Z_ADDREF(z) Z_ADDREF_P(&(z))
+# define Z_DELREF(z) Z_DELREF_P(&(z))
+# define Z_ISREF(z) Z_ISREF_P(&(z))
+# define Z_SET_ISREF(z) Z_SET_ISREF_P(&(z))
+# define Z_UNSET_ISREF(z) Z_UNSET_ISREF_P(&(z))
+# define Z_SET_ISREF_TO(z, isref) Z_SET_ISREF_TO_P(&(z), isref)
+#endif
+
+ZEND_BEGIN_MODULE_GLOBALS(perl)
+ PerlInterpreter *perl;
+ HashTable perl_objects; /* this hash is used to make one to one
+ mapping between Perl and PHP objects */
+ZEND_END_MODULE_GLOBALS(perl)
+
+#ifdef ZTS
+#define PERLG(v) TSRMG(perl_globals_id, zend_perl_globals *, v)
+#else
+#define PERLG(v) (perl_globals.v)
+#endif
+
+ZEND_DECLARE_MODULE_GLOBALS(perl);
+
+PHP_METHOD(Perl, eval);
+PHP_METHOD(Perl, require);
+
+static zend_function_entry perl_functions[] = {
+ PHP_ME(Perl, eval, NULL, ZEND_ACC_PUBLIC)
+ PHP_ME(Perl, require, NULL, ZEND_ACC_PUBLIC)
+ {NULL, NULL, NULL}
+};
+
+/****************************************************************************/
+/* This code was produced by `perl -MExtUtils::Embed -e xsinit` */
+
+EXTERN_C void xs_init (pTHX);
+
+EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
+
+EXTERN_C void
+xs_init(pTHX)
+{
+ char *file = __FILE__;
+ dXSUB_SYS;
+
+ /* DynaLoader is a special case */
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+/****************************************************************************/
+
+typedef enum _perl_context {
+ PERL_SCALAR,
+ PERL_ARRAY,
+ PERL_HASH
+} perl_context;
+
+typedef struct php_perl_object {
+ zend_object zo;
+ SV *sv; /* Perl's representation of object */
+ HashTable *properties; /* Temporary collection of object properties */
+ perl_context context; /* flag for next perl call, property */
+} php_perl_object;
+
+
+static zend_class_entry* perl_class_entry;
+static zend_class_entry* perl_exception_class_entry;
+
+/* PHP <-> Perl data conversion routines */
+static SV* php_perl_zval_to_sv_noref(PerlInterpreter* my_perl, zval* zv, HashTable* \
var_hash TSRMLS_DC); +static SV* php_perl_zval_to_sv_ref(PerlInterpreter* my_perl, \
zval* zv, HashTable* var_hash TSRMLS_DC); +static SV* \
php_perl_zval_to_sv(PerlInterpreter* my_perl, zval* zv TSRMLS_DC); +static zval* \
php_perl_sv_to_zval_noref(PerlInterpreter* my_perl, SV* sv, zval* zv, HashTable* \
var_hash TSRMLS_DC); +static zval* php_perl_sv_to_zval_ref(PerlInterpreter* my_perl, \
SV* sv, zval* zv, HashTable* var_hash TSRMLS_DC); +static zval* \
php_perl_sv_to_zval(PerlInterpreter* my_perl, SV* sv, zval* zv TSRMLS_DC); +
+/* Handlers for Perl objects overloading */
+static zend_object_value php_perl_clone(zval *object TSRMLS_DC);
+static zval* php_perl_read_property(zval *object, zval *member, int type TSRMLS_DC);
+static void php_perl_write_property(zval *object, zval *member, zval *value \
TSRMLS_DC); +static zval* php_perl_read_dimension(zval *object, zval *offset, int \
type TSRMLS_DC); +static void php_perl_write_dimension(zval *object, zval *offset, \
zval *value TSRMLS_DC); +static int php_perl_has_property(zval *object, zval *member, \
int check_empty TSRMLS_DC); +static void php_perl_unset_property(zval *object, zval \
*member TSRMLS_DC); +static int php_perl_has_dimension(zval *object, zval *offset, \
int check_empty TSRMLS_DC); +static void php_perl_unset_dimension(zval *object, zval \
*offset TSRMLS_DC); +static HashTable* php_perl_get_properties(zval *object \
TSRMLS_DC); +#if (ZEND_EXTENSION_API_NO >= 220041030)
+static zend_function *php_perl_get_method(zval **object_ptr, char *method, int \
method_len TSRMLS_DC); +#else
+static zend_function *php_perl_get_method(zval *object, char *method, int method_len \
TSRMLS_DC); +#endif
+static int php_perl_call_function_handler(char *method, \
INTERNAL_FUNCTION_PARAMETERS); +static zend_function *php_perl_get_constructor(zval \
*object TSRMLS_DC); +static zend_class_entry* php_perl_get_class_entry(const zval \
*object TSRMLS_DC); +static int php_perl_get_class_name(const zval *object, char \
**class_name, zend_uint *class_name_len, int parent TSRMLS_DC); +static zval* \
php_perl_get(zval *object TSRMLS_DC); +static void php_perl_set(zval **object, zval \
*value TSRMLS_DC); +
+static void php_perl_constructor_handler(INTERNAL_FUNCTION_PARAMETERS);
+
+static void php_perl_destructor(void *perl_object, zend_object_handle handle \
TSRMLS_DC); +static void php_perl_cleaner(void *perl_object, zend_object_handle \
handle TSRMLS_DC); +
+static zend_object_handlers php_perl_object_handlers = {
+ zend_objects_store_add_ref, /* add_ref */
+ zend_objects_store_del_ref, /* del_ref */
+ php_perl_clone, /* clone_obj */
+
+ php_perl_read_property, /* read_property */
+ php_perl_write_property, /* write_property */
+ php_perl_read_dimension, /* read_dimension */
+ php_perl_write_dimension, /* write_dimension */
+ NULL, /* get_property_ptr_ptr */
+ NULL, /* get */
+ NULL, /* set */
+ php_perl_has_property, /* has_property */
+ php_perl_unset_property, /* unset_property */
+ php_perl_has_dimension, /* has_dimension */
+ php_perl_unset_dimension, /* unset_dimension */
+ php_perl_get_properties, /* get_properties */
+ php_perl_get_method, /* get_method */
+ php_perl_call_function_handler, /* call_method */
+ php_perl_get_constructor, /* get_constructor */
+ php_perl_get_class_entry, /* get_class_entry */
+ php_perl_get_class_name, /* get_class_name */
+ NULL, /* compare_objects */
+ NULL, /* cast_object */
+ NULL, /* count_elements */
+};
+
+static zend_object_handlers php_perl_proxy_handlers = {
+ zend_objects_store_add_ref, /* add_ref */
+ zend_objects_store_del_ref, /* del_ref */
+ php_perl_clone, /* clone_obj */
+
+ php_perl_read_property, /* read_property */
+ php_perl_write_property, /* write_property */
+ php_perl_read_dimension, /* read_dimension */
+ php_perl_write_dimension, /* write_dimension */
+ NULL, /* get_property_ptr_ptr */
+ php_perl_get, /* get */
+ php_perl_set, /* set */
+ php_perl_has_property, /* has_property */
+ php_perl_unset_property, /* unset_property */
+ php_perl_has_dimension, /* has_dimension */
+ php_perl_unset_dimension, /* unset_dimension */
+ php_perl_get_properties, /* get_properties */
+ php_perl_get_method, /* get_method */
+ php_perl_call_function_handler, /* call_method */
+ php_perl_get_constructor, /* get_constructor */
+ php_perl_get_class_entry, /* get_class_entry */
+ php_perl_get_class_name, /* get_class_name */
+ NULL, /* compare_objects */
+ NULL, /* cast_object */
+ NULL, /* count_elements */
+};
+
+zend_internal_function php_perl_constructor_function = {
+ ZEND_INTERNAL_FUNCTION,
+ "Perl",
+ NULL,
+ 0,
+ NULL,
+ 2,
+ 0,
+ NULL,
+ 0,
+ 0,
+ php_perl_constructor_handler
+};
+
+static SV* PerlIOPHP_getarg(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
+{
+ Perl_croak(aTHX_ "an attempt to getarg from a stale io handle");
+ return NULL;
+}
+
+static SSize_t PerlIOPHP_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
+{
+ return zend_write(vbuf, count);
+}
+
+static IV PerlIOPHP_flush(pTHX_ PerlIO *f)
+{
+ TSRMLS_FETCH();
+ sapi_flush(TSRMLS_C);
+ return 0;
+}
+
+static IV PerlIOPHP_noop_fail(pTHX_ PerlIO *f)
+{
+ return -1;
+}
+
+static PerlIO_funcs PerlIO_PHP = {
+ sizeof(PerlIO_funcs),
+ "PHP",
+ sizeof(struct _PerlIO),
+ PERLIO_K_MULTIARG | PERLIO_K_RAW,
+ PerlIOBase_pushed,
+ PerlIOBase_popped,
+ NULL,
+ PerlIOBase_binmode,
+ PerlIOPHP_getarg,
+ PerlIOBase_fileno,
+ PerlIOBase_dup,
+ PerlIOBase_read,
+ NULL,
+ PerlIOPHP_write,
+ NULL, /* can't seek on STD{IN|OUT}, fail on call*/
+ NULL, /* can't tell on STD{IN|OUT}, fail on call*/
+ PerlIOBase_close,
+ PerlIOPHP_flush,
+ PerlIOPHP_noop_fail, /* fill */
+ PerlIOBase_eof,
+ PerlIOBase_error,
+ PerlIOBase_clearerr,
+ PerlIOBase_setlinebuf,
+ NULL, /* get_base */
+ NULL, /* get_bufsiz */
+ NULL, /* get_ptr */
+ NULL, /* get_cnt */
+ NULL, /* set_ptrcnt */
+};
+
+/* Creates Perl interpriter if it was not created brfore */
+static PerlInterpreter* php_perl_init(TSRMLS_D)
+{
+ PerlInterpreter* my_perl = PERLG(perl);
+
+ if (my_perl == NULL) {
+ char *embedding[] = { "", "-e", "0" };
+
+ my_perl = perl_alloc();
+ perl_construct(my_perl);
+ PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+ perl_parse(my_perl, xs_init, 3, embedding, (char **)NULL);
+/*???FIXME: I don't understend if it need or not
+ perl_run(my_perl);
+*/
+ PerlIO_define_layer(aTHX_ &PerlIO_PHP);
+ PerlIO_apply_layers(aTHX_ PerlIO_stdout(), "w", ":PHP");
+
+ PERLG(perl) = my_perl;
+ zend_hash_init(&PERLG(perl_objects), 0, NULL, NULL, 0);
+ }
+ return my_perl;
+}
+
+/* Destroys Perl interpriter if it was created brfore */
+static void php_perl_destroy(TSRMLS_D)
+{
+ PerlInterpreter* my_perl = PERLG(perl);
+
+ if (my_perl != NULL) {
+ zend_hash_destroy(&PERLG(perl_objects));
+ perl_destruct(my_perl);
+ perl_free(my_perl);
+ PERLG(perl) = NULL;
+ }
+}
+
+/* Remembers mapping betwenn Perl and PHP object */
+static void php_perl_remember_object(SV* sv, zend_object_handle handle TSRMLS_DC) {
+ zend_hash_add(&PERLG(perl_objects), (char*)SvRV(sv), sizeof(sv),
+ &handle, sizeof(zend_object_handle), NULL);
+}
+
+/* Forgets mapping betwenn Perl and PHP object */
+static inline void php_perl_forget_object(SV* sv TSRMLS_DC) {
+ if (sv) {
+ zend_hash_del(&PERLG(perl_objects), (char*)SvRV(sv), sizeof(sv));
+ }
+}
+
+/* Converts PHP's value to Perl's eqivalent */
+static SV* php_perl_zval_to_sv(PerlInterpreter *my_perl,
+ zval *zv TSRMLS_DC)
+{
+ HashTable var_hash;
+ SV* sv;
+
+ zend_hash_init(&var_hash, 0, NULL, NULL, 0);
+ sv = php_perl_zval_to_sv_ref(my_perl, zv, &var_hash TSRMLS_CC);
+ zend_hash_destroy(&var_hash);
+ return sv;
+}
+
+static SV* php_perl_zval_to_sv_ref(PerlInterpreter *my_perl,
+ zval *zv,
+ HashTable *var_hash TSRMLS_DC)
+{
+ SV* sv;
+
+ if ((Z_ISREF_P(zv) || Z_TYPE_P(zv) == IS_OBJECT || Z_TYPE_P(zv) == IS_ARRAY) &&
+ zend_hash_find(var_hash, (char*)zv, sizeof(zv), (void**)&sv) == SUCCESS) {
+ sv = *(SV**)sv;
+ SvREFCNT_inc(sv);
+ return sv;
+ }
+ sv = php_perl_zval_to_sv_noref(my_perl, zv, var_hash TSRMLS_CC);
+ if (Z_ISREF_P(zv) || Z_TYPE_P(zv) == IS_OBJECT || Z_TYPE_P(zv) == IS_ARRAY) {
+ zend_hash_add(var_hash, (char*)zv, sizeof(zv), &sv, sizeof(SV*), NULL);
+ }
+ return sv;
+}
+
+static SV* php_perl_zval_to_sv_noref(PerlInterpreter *my_perl,
+ zval *zv,
+ HashTable *var_hash TSRMLS_DC)
+{
+ switch (Z_TYPE_P(zv)) {
+ case IS_NULL:
+ return &PL_sv_undef;
+ case IS_LONG:
+ return newSViv(Z_LVAL_P(zv));
+ case IS_DOUBLE:
+ return newSVnv(Z_DVAL_P(zv));
+ case IS_STRING:
+ return newSVpv(Z_STRVAL_P(zv), Z_STRLEN_P(zv));
+ case IS_ARRAY: {
+ HashTable* ht = zv->value.ht;
+ int is_hash = 0;
+
+ /* checking if 'hv' is array or hash */
+ zend_hash_internal_pointer_reset(ht);
+ while (1) {
+ int key_type = zend_hash_get_current_key_type(ht);
+ if (key_type == HASH_KEY_NON_EXISTANT) {
+ break;
+ }
+ if (key_type == HASH_KEY_IS_STRING) {
+ is_hash = 1;
+ break;
+ }
+ zend_hash_move_forward(ht);
+ }
+
+ if (is_hash) {
+ /* converting to Perl's hash */
+ HV* hv = newHV();
+ SV* sv = (SV*)newRV((SV*)hv);
+ zval** zv_ptr;
+
+ if (Z_ISREF_P(zv) || Z_TYPE_P(zv) == IS_ARRAY) {
+ zend_hash_add(var_hash, (char*)zv, sizeof(zv), &sv, sizeof(SV*), NULL);
+ }
+
+ for (zend_hash_internal_pointer_reset(ht);
+ zend_hash_get_current_data(ht, (void **) &zv_ptr) == SUCCESS;
+ zend_hash_move_forward(ht)
+ ) {
+ char* key;
+ int key_len;
+ ulong index;
+
+ if (zend_hash_get_current_key_ex(ht, &key, &key_len, &index, 0, NULL) != \
HASH_KEY_IS_STRING) { + char xkey[16];
+ zend_sprintf(xkey, "%ld", index);
+ hv_store(hv, xkey, strlen(xkey),
+ php_perl_zval_to_sv_ref(my_perl, *zv_ptr, var_hash TSRMLS_CC), 0);
+ } else {
+ hv_store(hv, key, key_len-1,
+ php_perl_zval_to_sv_ref(my_perl, *zv_ptr, var_hash TSRMLS_CC), 0);
+ }
+ }
+
+ return sv;
+ } else {
+ /* converting to Perl's array */
+ AV* av = newAV();
+ SV* sv = (SV*)newRV((SV*)av);
+ zval** zv_ptr;
+
+ if (Z_ISREF_P(zv) || Z_TYPE_P(zv) == IS_ARRAY) {
+ zend_hash_add(var_hash, (char*)zv, sizeof(zv), &sv, sizeof(SV*), NULL);
+ }
+
+ for (zend_hash_internal_pointer_reset(ht);
+ zend_hash_get_current_data(ht, (void **) &zv_ptr) == SUCCESS;
+ zend_hash_move_forward(ht)
+ ) {
+ char *key;
+ ulong index;
+
+ if (zend_hash_get_current_key(ht, &key, &index, 0) != HASH_KEY_IS_STRING) \
{ + av_store(av, index,
+ php_perl_zval_to_sv_ref(my_perl, *zv_ptr, var_hash TSRMLS_CC));
+ }
+ }
+ return sv;
+ }
+ }
+ case IS_OBJECT:
+ if (zv->value.obj.handlers == &php_perl_object_handlers ||
+ zv->value.obj.handlers == &php_perl_proxy_handlers) {
+ php_perl_object *obj = zend_object_store_get_object(zv TSRMLS_CC);
+ return newSVsv(obj->sv);
+ }
+ break;
+ case IS_BOOL:
+ return Z_LVAL_P(zv)?&PL_sv_yes:&PL_sv_no;
+ default:
+ break;
+ }
+ zend_error(E_ERROR, "[perl] Can't convert PHP type (%d) to Perl",
+ Z_TYPE_P(zv));
+ return &PL_sv_undef;
+}
+
+/* Converts Perl's value to PHP's eqivalent */
+static zval* php_perl_sv_to_zval(PerlInterpreter* my_perl, SV* sv, zval* zv \
TSRMLS_DC) +{
+ HashTable var_hash;
+
+ zend_hash_init(&var_hash, 0, NULL, NULL, 0);
+ zv = php_perl_sv_to_zval_ref(my_perl, sv, zv, &var_hash TSRMLS_CC);
+ zend_hash_destroy(&var_hash);
+ return zv;
+}
+
+static zval* php_perl_sv_to_zval_ref(PerlInterpreter *my_perl,
+ SV *sv,
+ zval *zv,
+ HashTable *var_hash TSRMLS_DC)
+{
+ zval** z;
+
+ if (SvREFCNT(sv) > 1 &&
+ zend_hash_find(var_hash, (char*)sv, sizeof(sv), (void**)&z) == SUCCESS) {
+ if (zv != NULL) {
+ FREE_ZVAL(zv);
+ }
+ if (Z_TYPE_PP(z) != IS_OBJECT) {
+ Z_SET_ISREF_PP(z);
+ }
+ Z_ADDREF_PP(z);
+ return *z;
+ }
+
+ if (zv == NULL) {ALLOC_INIT_ZVAL(zv);}
+
+ if (SvREFCNT(sv) > 1) {
+ zend_hash_add(var_hash, (char*)sv, sizeof(sv), &zv, sizeof(zval*), NULL);
+ }
+ return php_perl_sv_to_zval_noref(my_perl, sv, zv, var_hash TSRMLS_CC);
+}
+
+static zval* php_perl_sv_to_zval_noref(PerlInterpreter *my_perl,
+ SV *sv,
+ zval *zv,
+ HashTable *var_hash TSRMLS_DC)
+{
+ if (sv) {
+ if (SvTYPE(sv) == SVt_NULL) { /* null */
+ ZVAL_NULL(zv);
+ } else if (SvIOK(sv)) { /* integer */
+ ZVAL_LONG(zv, SvIV(sv));
+ } else if (SvNOK(sv)) { /* double */
+ ZVAL_DOUBLE(zv, SvNV(sv));
+ } else if (SvPOK(sv)) { /* string */
+ int len;
+ char *str = SvPV(sv, len);
+ ZVAL_STRINGL(zv, str, len, 1);
+ } else if (sv_isobject(sv)) { /* object */
+ zend_object_handle* handle;
+ if (zend_hash_find(&PERLG(perl_objects), (char*)SvRV(sv), sizeof(SV*), \
(void**)&handle) == SUCCESS) { + zv->type = IS_OBJECT;
+ zv->value.obj.handlers = &php_perl_object_handlers;;
+ zv->value.obj.handle = *handle;
+ zend_objects_store_add_ref(zv TSRMLS_CC);
+ } else {
+ php_perl_object *obj = (php_perl_object*)emalloc(sizeof(php_perl_object));
+ obj->sv = sv;
+ obj->properties = NULL;
+ SvREFCNT_inc(sv);
+ zv->type = IS_OBJECT;
+ zv->value.obj.handlers = &php_perl_object_handlers;
+ zv->value.obj.handle =
+ zend_objects_store_put(obj, php_perl_destructor, NULL, NULL TSRMLS_CC);
+ php_perl_remember_object(sv, zv->value.obj.handle TSRMLS_CC);
+ }
+ } else if (SvROK(sv)) { /* reference */
+ zv = php_perl_sv_to_zval_ref(my_perl, SvRV(sv), zv, var_hash TSRMLS_CC);
+ } else if (SvTYPE(sv) == SVt_PVAV) { /* array */
+ I32 i = 0;
+ I32 len = av_len((AV*)sv);
+
+ array_init(zv);
+ for (i = 0; i <= len; i++) {
+ SV** el_sv = av_fetch((AV*)sv, i, 0);
+ if (el_sv != NULL && *el_sv != NULL) {
+ add_index_zval(zv, i,
+ php_perl_sv_to_zval_ref(my_perl, *el_sv, NULL, var_hash TSRMLS_CC));
+ }
+ }
+ } else if (SvTYPE(sv) == SVt_PVHV) { /* hash */
+ SV* el_sv;
+ char* key;
+ I32 key_len;
+
+ array_init(zv);
+ hv_iterinit((HV*)sv);
+ while ((el_sv = hv_iternextsv((HV*)sv, &key, &key_len)) != NULL) {
+ add_assoc_zval_ex(zv, key, key_len+1,
+ php_perl_sv_to_zval_ref(my_perl, el_sv, NULL, var_hash TSRMLS_CC));
+ }
+ } else {
+ zend_error(E_ERROR, "[perl] Can't convert Perl type (%ld) to PHP",
+ SvTYPE(sv));
+ }
+ }
+ return zv;
+}
+
+/* Calls constructor of Perl's class and returns created object */
+static SV* php_perl_call_constructor(PerlInterpreter* my_perl,
+ const char* class_name,
+ int class_name_len,
+ const char* constructor,
+ int constructor_len,
+ int argc,
+ zval** argv[] TSRMLS_DC)
+{
+ SV* ret;
+ int func_len = class_name_len + constructor_len + 3;
+ char *func = (char*)emalloc(func_len);
+
+ dSP; /* initialize stack pointer */
+
+ int i;
+
+ strcpy(func, class_name);
+ strcpy(func + class_name_len, "::");
+ strcpy(func + class_name_len + 2, constructor);
+
+
+ ENTER; /* everything created after here */
+ SAVETMPS; /* ...is a temporary variable. */
+ PUSHMARK(SP); /* remember the stack pointer */
+
+ XPUSHs(sv_2mortal(newSVpv(class_name, class_name_len)));
+ for (i=0; i<argc; i++) {
+ XPUSHs(sv_2mortal(php_perl_zval_to_sv(my_perl, *argv[i] TSRMLS_CC)));
+ }
+
+ PUTBACK; /* make local stack pointer global */
+ call_pv(func, G_SCALAR | G_EVAL | G_KEEPERR); /* call the function \
*/ + SPAGAIN; /* refresh stack pointer */
+
+ ret = POPs;
+ SvREFCNT_inc(ret);
+
+ PUTBACK;
+ FREETMPS; /* free that return value */
+ LEAVE; /* ...and the XPUSHed "mortal" args.*/
+
+ efree(func);
+ return ret;
+}
+
+/* Calls method of Perl's object */
+static void php_perl_call_method(PerlInterpreter* my_perl, SV* obj,
+ const char* func, int argc, zval** argv[],
+ perl_context context,
+ zval* return_value TSRMLS_DC)
+{
+ dSP; /* initialize stack pointer */
+
+ int i;
+
+ ENTER; /* everything created after here */
+ SAVETMPS; /* ...is a temporary variable. */
+ PUSHMARK(SP); /* remember the stack pointer */
+
+ XPUSHs(obj);
+
+ for (i=0; i<argc; i++) {
+ XPUSHs(sv_2mortal(php_perl_zval_to_sv(my_perl, *argv[i] TSRMLS_CC)));
+ }
+
+ PUTBACK; /* make local stack pointer global */
+ if (return_value != NULL) {
+ if (context != PERL_SCALAR) {
+ int count, i;
+ I32 ax;
+ HashTable var_hash;
+
+ count = call_method(func, G_ARRAY | G_EVAL | G_KEEPERR); /* call the \
function */ + SPAGAIN; /* refresh stack \
pointer */ + sp -= count;
+ ax = (sp - PL_stack_base) + 1;
+ zend_hash_init(&var_hash, 0, NULL, NULL, 0);
+ array_init(return_value);
+ if (context == PERL_ARRAY) {
+ for (i = 0; i < count; i++) {
+ add_next_index_zval(return_value,
+ php_perl_sv_to_zval_ref(my_perl, (SV*)(SV*)ST(i), NULL, &var_hash \
TSRMLS_CC)); + }
+ } else {
+ for (i = 0; i < count; i++) {
+ int key_len;
+ char *key = SvPV(ST(i), key_len);
+ if (i != count-1) {
+ add_assoc_zval_ex(return_value, key, key_len+1,
+ php_perl_sv_to_zval_ref(my_perl, (SV*)(SV*)ST(++i), NULL, &var_hash \
TSRMLS_CC)); + } else {
+ add_assoc_null_ex(return_value, key, key_len+1);
+ }
+ }
+ }
+ zend_hash_destroy(&var_hash);
+ } else {
+ call_method(func, G_SCALAR | G_EVAL | G_KEEPERR); /* call the function \
*/ + SPAGAIN; /* refresh stack pointer */
+
+ php_perl_sv_to_zval(my_perl, POPs, return_value TSRMLS_CC);
+ }
+ } else {
+ call_method(func, G_DISCARD | G_EVAL | G_KEEPERR); /* call the function \
*/ + SPAGAIN; /* refresh stack pointer */
+ }
+ PUTBACK;
+ FREETMPS; /* free that return value */
+ LEAVE; /* ...and the XPUSHed "mortal" args.*/
+}
+
+/* Calls Perl's function */
+static void php_perl_call(PerlInterpreter* my_perl,
+ const char* func, int argc, zval** argv[],
+ perl_context context,
+ zval* return_value TSRMLS_DC)
+{
+ dSP; /* initialize stack pointer */
+
+ int i;
+
+ ENTER; /* everything created after here */
+ SAVETMPS; /* ...is a temporary variable. */
+ PUSHMARK(SP); /* remember the stack pointer */
+
+ for (i=0; i<argc; i++) {
+ XPUSHs(sv_2mortal(php_perl_zval_to_sv(my_perl, *argv[i] TSRMLS_CC)));
+ }
+ PUTBACK; /* make local stack pointer global */
+ if (return_value != NULL) {
+ if (context != PERL_SCALAR) {
+ int count, i;
+ I32 ax;
+ HashTable var_hash;
+
+ count = call_pv(func, G_ARRAY | G_EVAL | G_KEEPERR); /* call the \
function */ + SPAGAIN; /* refresh stack \
pointer */ + sp -= count;
+ ax = (sp - PL_stack_base) + 1;
+ zend_hash_init(&var_hash, 0, NULL, NULL, 0);
+ array_init(return_value);
+ if (context == PERL_ARRAY) {
+ for (i = 0; i < count; i++) {
+ add_next_index_zval(return_value,
+ php_perl_sv_to_zval_ref(my_perl, (SV*)(SV*)ST(i), NULL, &var_hash \
TSRMLS_CC)); + }
+ } else {
+ for (i = 0; i < count; i++) {
+ int key_len;
+ char *key = SvPV(ST(i), key_len);
+ if (i != count-1) {
+ add_assoc_zval_ex(return_value, key, key_len+1,
+ php_perl_sv_to_zval_ref(my_perl, (SV*)(SV*)ST(++i), NULL, &var_hash \
TSRMLS_CC)); + } else {
+ add_assoc_null_ex(return_value, key, key_len+1);
+ }
+ }
+ }
+ zend_hash_destroy(&var_hash);
+ } else {
+ call_pv(func, G_SCALAR | G_EVAL | G_KEEPERR); /* call the function \
*/ + SPAGAIN; /* refresh stack pointer */
+
+ php_perl_sv_to_zval(my_perl, POPs, return_value TSRMLS_CC);
+ }
+ } else {
+ call_pv(func, G_DISCARD | G_EVAL | G_KEEPERR); /* call the function \
*/ + SPAGAIN; /* refresh stack pointer */
+ }
+ PUTBACK;
+ FREETMPS; /* free that return value */
+ LEAVE; /* ...and the XPUSHed "mortal" args.*/
+}
+
+/****************************************************************************/
+
+static zval* php_perl_get(zval *object TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + zval *retval;
+
+ if (obj->sv == NULL) {
+ zend_error(E_ERROR, "[perl] Can not get value");
+ return NULL;
+ }
+ retval = php_perl_sv_to_zval(my_perl, obj->sv, NULL TSRMLS_CC);
+ /* ensure we're creating a temporary variable */
+ if (retval) {Z_SET_REFCOUNT_P(retval, 0);}
+ return retval;
+}
+
+static void php_perl_set(zval **object, zval *value TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(*object \
TSRMLS_CC); + SV *sv = obj->sv;
+
+ if (sv == NULL) {
+ zend_error(E_ERROR, "[perl] Can not set value");
+ return;
+ }
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+ sv_setsv(sv, php_perl_zval_to_sv(my_perl, value TSRMLS_CC));
+}
+
+/* Returns element of array based Perl's object */
+static zval* php_perl_read_dimension(zval *object, zval *offset, int type TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ zval *retval = NULL;
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+
+ if (sv == NULL) {
+ zend_error(E_ERROR, "[perl] Can not get dimension");
+ return NULL;
+ }
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+
+ if (SvTYPE(sv) == SVt_PVAV) {
+ AV* av = (AV*)sv;
+ SV** prop_val;
+
+ convert_to_long(offset);
+
+ prop_val = av_fetch(av, Z_LVAL_P(offset), 0);
+ if (prop_val != NULL) {
+ zend_bool write = FALSE;
+ if (type != BP_VAR_R && type != BP_VAR_IS) {
+ if (*prop_val != NULL && type != BP_VAR_R && type != BP_VAR_IS) {
+ write = TRUE;
+/*
+ SV* tmp_sv = *prop_val;
+
+ while (1) {
+ if (sv_isobject(tmp_sv) ||
+ SvTYPE(tmp_sv) == SVt_PVAV ||
+ SvTYPE(tmp_sv) == SVt_PVHV) {
+ write = TRUE;
+ break;
+ } else if (SvTYPE(tmp_sv) != SVt_RV) {
+ break;
+ }
+ tmp_sv = SvRV(tmp_sv);
+ }
+*/
+ }
+ }
+ if (write && !sv_isobject(*prop_val)) {
+ php_perl_object *obj = (php_perl_object*)emalloc(sizeof(php_perl_object));
+
+ obj->zo.ce = perl_class_entry;
+ obj->sv = newRV(*prop_val);
+ obj->properties = NULL;
+ obj->context = PERL_SCALAR;
+
+ ALLOC_INIT_ZVAL(retval);
+ Z_SET_REFCOUNT_P(retval, 0);
+ Z_SET_ISREF_P(retval);
+ Z_TYPE_P(retval) = IS_OBJECT;
+ Z_OBJ_HT_P(retval) = &php_perl_proxy_handlers;
+ Z_OBJ_HANDLE_P(retval) = zend_objects_store_put(obj, php_perl_destructor, \
NULL, NULL TSRMLS_CC); + } else {
+ ALLOC_INIT_ZVAL(retval);
+ retval = php_perl_sv_to_zval(my_perl, *prop_val, retval TSRMLS_CC);
+ /* ensure we're creating a temporary variable */
+ if (retval) {Z_SET_REFCOUNT_P(retval, 0);}
+ }
+ }
+ } else if (SvTYPE(sv) == SVt_PVHV) {
+ retval = php_perl_read_property(object, offset, type TSRMLS_CC);
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not an array");
+ }
+ if (retval == NULL) {
+ return EG(uninitialized_zval_ptr);
+ } else {
+ return retval;
+ }
+}
+
+/* Sets element of array based Perl's object */
+static void php_perl_write_dimension(zval *object, zval *offset, zval *value \
TSRMLS_DC) +{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+
+ if (sv == NULL) {
+ zend_error(E_ERROR, "[perl] Can not set dimension");
+ }
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+
+ if (SvTYPE(sv) == SVt_PVAV) {
+ AV* av = (AV*)sv;
+
+ convert_to_long(offset);
+
+ av_store(av, Z_LVAL_P(offset), php_perl_zval_to_sv(my_perl, value TSRMLS_CC));
+ } else if (SvTYPE(sv) == SVt_PVHV) {
+ php_perl_write_property(object, offset, value TSRMLS_CC);
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not an array");
+ }
+}
+
+/* Checks if element of array based Perl's object isset or empty */
+static int php_perl_has_dimension(zval *object, zval *offset, int check_empty \
TSRMLS_DC) +{
+ int ret = 0;
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+
+ if (sv == NULL) {
+ zend_error(E_ERROR, "[perl] Can not check dimension");
+ return 0;
+ }
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+ if (SvTYPE(sv) == SVt_PVAV) {
+ AV* av = (AV*)sv;
+
+ convert_to_long(offset);
+
+ if (check_empty) {
+ /* empty() */
+ SV** prop_val = av_fetch(av, Z_LVAL_P(offset), 0);
+ if (prop_val != NULL) {
+ zval *zv;
+ ALLOC_INIT_ZVAL(zv);
+ php_perl_sv_to_zval(my_perl, *prop_val, zv TSRMLS_CC);
+ ret = zend_is_true(zv);
+ zval_ptr_dtor(&zv);
+ }
+ } else {
+ /* isset() */
+ if (av_exists(av, Z_LVAL_P(offset))) {
+ ret = 1;
+ }
+ }
+ } else if (SvTYPE(sv) == SVt_PVHV) {
+ ret = php_perl_has_property(object, offset, check_empty TSRMLS_CC);
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not an array");
+ }
+ return ret;
+}
+
+/* Deletes element of array based Perl's object */
+static void php_perl_unset_dimension(zval *object, zval *offset TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+
+ if (sv == NULL) {
+ zend_error(E_ERROR, "[perl] Can not unset dimension");
+ }
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+ if (SvTYPE(sv) == SVt_PVAV) {
+ AV* av = (AV*)sv;
+
+ convert_to_long(offset);
+
+ av_delete(av, Z_LVAL_P(offset), G_DISCARD);
+ } else if (SvTYPE(sv) == SVt_PVHV) {
+ php_perl_unset_property(object, offset TSRMLS_CC);
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not an array");
+ }
+}
+
+/* Returns propery of hash based Perl's object */
+static zval* php_perl_read_property(zval *object, zval *member, int type TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ zval *retval = NULL;
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + zval tmp_member;
+ SV* sv = NULL;
+ zend_bool write = obj->context != PERL_SCALAR &&
+ type != BP_VAR_R && type != BP_VAR_IS;
+
+ if (member->type != IS_STRING) {
+ tmp_member = *member;
+ zval_copy_ctor(&tmp_member);
+ convert_to_string(&tmp_member);
+ member = &tmp_member;
+ }
+ if (obj->context == PERL_SCALAR) {
+ if (zend_binary_strcmp(Z_STRVAL_P(member), Z_STRLEN_P(member), "array", \
sizeof("array")-1) == 0) { + php_perl_object *new_obj;
+ zval* new_object;
+
+ new_obj = emalloc(sizeof(php_perl_object));
+ memcpy(new_obj, obj, sizeof(php_perl_object));
+ new_obj->context = PERL_ARRAY;
+ new_obj->properties = NULL;
+
+ ALLOC_INIT_ZVAL(new_object);
+ Z_SET_REFCOUNT_P(new_object, 0);
+ Z_TYPE_P(new_object) = IS_OBJECT;
+ new_object->value.obj.handlers = &php_perl_object_handlers;
+ new_object->value.obj.handle =
+ zend_objects_store_put(new_obj, php_perl_cleaner, NULL, NULL TSRMLS_CC);
+
+ return new_object;
+ } else if (zend_binary_strcmp(Z_STRVAL_P(member),Z_STRLEN_P(member),"hash",sizeof("hash")-1) \
== 0) { + php_perl_object *new_obj;
+ zval* new_object;
+
+ new_obj = emalloc(sizeof(php_perl_object));
+ memcpy(new_obj, obj, sizeof(php_perl_object));
+ new_obj->context = PERL_HASH;
+ new_obj->properties = NULL;
+
+ ALLOC_INIT_ZVAL(new_object);
+ Z_SET_REFCOUNT_P(new_object, 0);
+ Z_TYPE_P(new_object) = IS_OBJECT;
+ new_object->value.obj.handlers = &php_perl_object_handlers;
+ new_object->value.obj.handle =
+ zend_objects_store_put(new_obj, php_perl_cleaner, NULL, NULL TSRMLS_CC);
+
+ return new_object;
+ } else if (zend_binary_strcmp(Z_STRVAL_P(member),Z_STRLEN_P(member),"scalar",sizeof("scalar")-1) \
== 0) { + php_perl_object *new_obj;
+ zval* new_object;
+
+ new_obj = emalloc(sizeof(php_perl_object));
+ memcpy(new_obj, obj, sizeof(php_perl_object));
+ new_obj->context = PERL_SCALAR;
+ new_obj->properties = NULL;
+
+ ALLOC_INIT_ZVAL(new_object);
+ Z_SET_REFCOUNT_P(new_object, 0);
+ Z_TYPE_P(new_object) = IS_OBJECT;
+ new_object->value.obj.handlers = &php_perl_object_handlers;
+ new_object->value.obj.handle =
+ zend_objects_store_put(new_obj, php_perl_cleaner, NULL, NULL TSRMLS_CC);
+
+ return new_object;
+ }
+ }
+
+ if (obj->sv == NULL) {
+ if (obj->context == PERL_ARRAY) {
+ sv = (SV*)get_av(Z_STRVAL_P(member), write);
+ if (sv && !AvARRAY(sv)) {if (write) {av_clear((AV*)sv);} else {sv = NULL;}}
+ } else if (obj->context == PERL_HASH) {
+ sv = (SV*)get_hv(Z_STRVAL_P(member), write);
+ if (sv && !HvARRAY(sv)) {if (write) {hv_clear((HV*)sv);} else {sv = NULL;}}
+ } else {
+ sv = get_sv(Z_STRVAL_P(member), FALSE);
+ if (sv && !SvOK(sv)) {sv = NULL;}
+ }
+ if (sv == NULL) {
+ if (obj->context == PERL_ARRAY) {
+ zend_error(E_NOTICE, "[perl] Undefined variable: '@%s'", \
Z_STRVAL_P(member)); + } else if (obj->context == PERL_HASH) {
+ zend_error(E_NOTICE, "[perl] Undefined variable: '%%%s'", \
Z_STRVAL_P(member)); + } else {
+ zend_error(E_NOTICE, "[perl] Undefined variable: '$%s'", \
Z_STRVAL_P(member)); + }
+ }
+ } else {
+ sv = obj->sv;
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+
+ if (SvTYPE(sv) == SVt_PVHV) {
+ HV* hv = (HV*)sv;
+ SV** prop_val;
+
+ prop_val = hv_fetch(hv, Z_STRVAL_P(member), Z_STRLEN_P(member), 0);
+ if (prop_val != NULL) {
+ sv = *prop_val;
+ write = FALSE;
+ if (sv != NULL && type != BP_VAR_R && type != BP_VAR_IS) {
+ write = TRUE;
+/*
+ SV* tmp_sv = sv;
+
+ while (1) {
+ if (sv_isobject(tmp_sv) ||
+ SvTYPE(tmp_sv) == SVt_PVAV ||
+ SvTYPE(tmp_sv) == SVt_PVHV) {
+ write = TRUE;
+ break;
+ } else if (SvTYPE(tmp_sv) != SVt_RV) {
+ break;
+ }
+ tmp_sv = SvRV(tmp_sv);
+ }
+*/
+ }
+ }
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not a hash");
+ }
+ }
+
+ if (sv != NULL) {
+ if (write && !sv_isobject(sv)) {
+ php_perl_object *obj = (php_perl_object*)emalloc(sizeof(php_perl_object));
+
+ obj->zo.ce = perl_class_entry;
+ obj->sv = newRV(sv);
+ obj->properties = NULL;
+ obj->context = PERL_SCALAR;
+
+ ALLOC_INIT_ZVAL(retval);
+ Z_SET_REFCOUNT_P(retval, 0);
+ Z_SET_ISREF_P(retval);
+ Z_TYPE_P(retval) = IS_OBJECT;
+ Z_OBJ_HT_P(retval) = &php_perl_proxy_handlers;
+ Z_OBJ_HANDLE_P(retval) = zend_objects_store_put(obj, php_perl_destructor, \
NULL, NULL TSRMLS_CC); + } else {
+ retval = php_perl_sv_to_zval(my_perl, sv, retval TSRMLS_CC);
+ /* ensure we're creating a temporary variable */
+ if (retval) {Z_SET_REFCOUNT_P(retval, 0);}
+ }
+ }
+
+ if (member == &tmp_member) {
+ zval_dtor(member);
+ }
+ if (retval == NULL) {
+ return EG(uninitialized_zval_ptr);
+ } else {
+ return retval;
+ }
+}
+
+/* Sets propery of hash based Perl's object */
+static void php_perl_write_property(zval *object, zval *member, zval *value \
TSRMLS_DC) +{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+ zval tmp_member;
+
+ if (member->type != IS_STRING) {
+ tmp_member = *member;
+ zval_copy_ctor(&tmp_member);
+ convert_to_string(&tmp_member);
+ member = &tmp_member;
+ }
+ if (sv == NULL) {
+ if (obj->context == PERL_ARRAY) {
+ AV *av = get_av(Z_STRVAL_P(member), TRUE);
+ if (Z_TYPE_P(value) == IS_ARRAY) {
+ HashTable *ht = Z_ARRVAL_P(value);
+ zval** zv_ptr;
+ HashTable var_hash;
+
+ zend_hash_init(&var_hash, 0, NULL, NULL, 0);
+ for (zend_hash_internal_pointer_reset(ht);
+ zend_hash_get_current_data(ht, (void **) &zv_ptr) == SUCCESS;
+ zend_hash_move_forward(ht)
+ ) {
+ char *key;
+ ulong index;
+
+ if (zend_hash_get_current_key(ht, &key, &index, 0) != HASH_KEY_IS_STRING) \
{ + av_store(av, index,
+ php_perl_zval_to_sv_ref(my_perl, *zv_ptr, &var_hash TSRMLS_CC));
+ }
+ }
+ zend_hash_destroy(&var_hash);
+ } else {
+ zend_error(E_NOTICE, "[perl] array required");
+ }
+ } else if (obj->context == PERL_HASH) {
+ HV *hv = get_hv(Z_STRVAL_P(member), TRUE);
+ if (Z_TYPE_P(value) == IS_ARRAY) {
+ HashTable *ht = Z_ARRVAL_P(value);
+ zval** zv_ptr;
+ HashTable var_hash;
+
+ zend_hash_init(&var_hash, 0, NULL, NULL, 0);
+ for (zend_hash_internal_pointer_reset(ht);
+ zend_hash_get_current_data(ht, (void **) &zv_ptr) == SUCCESS;
+ zend_hash_move_forward(ht)
+ ) {
+ char* key;
+ int key_len;
+ ulong index;
+
+ if (zend_hash_get_current_key_ex(ht, &key, &key_len, &index, 0, NULL) != \
HASH_KEY_IS_STRING) { + char xkey[16];
+ zend_sprintf(xkey, "%ld", index);
+ hv_store(hv, xkey, strlen(xkey),
+ php_perl_zval_to_sv_ref(my_perl, *zv_ptr, &var_hash TSRMLS_CC), 0);
+ } else {
+ hv_store(hv, key, key_len-1,
+ php_perl_zval_to_sv_ref(my_perl, *zv_ptr, &var_hash TSRMLS_CC), 0);
+ }
+ }
+ zend_hash_destroy(&var_hash);
+ } else {
+ zend_error(E_NOTICE, "[perl] array required");
+ }
+ } else {
+ SV *sv = get_sv(Z_STRVAL_P(member), TRUE);
+ sv_setsv(sv, php_perl_zval_to_sv(my_perl, value TSRMLS_CC));
+ }
+ } else {
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+
+ if (SvTYPE(sv) == SVt_PVHV) {
+ HV* hv = (HV*)sv;
+
+ hv_store(hv, Z_STRVAL_P(member), Z_STRLEN_P(member),
+ php_perl_zval_to_sv(my_perl, value TSRMLS_CC), 0);
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not a hash");
+ }
+ }
+ if (member == &tmp_member) {
+ zval_dtor(member);
+ }
+}
+
+/* Checks if propery of hash based Perl's object isset or empty */
+static int php_perl_has_property(zval *object, zval *member, int check_empty \
TSRMLS_DC) +{
+ int ret = 0;
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+ zval tmp_member;
+
+ if (member->type != IS_STRING) {
+ tmp_member = *member;
+ zval_copy_ctor(&tmp_member);
+ convert_to_string(&tmp_member);
+ member = &tmp_member;
+ }
+
+ if (sv == NULL) {
+ SV* sv;
+ if (obj->context == PERL_ARRAY) {
+ sv = (SV*)get_av(Z_STRVAL_P(member), FALSE);
+ if (sv && !AvARRAY(sv)) {sv = NULL;}
+ } else if (obj->context == PERL_HASH) {
+ sv = (SV*)get_hv(Z_STRVAL_P(member), FALSE);
+ if (sv && !HvARRAY(sv)) {sv = NULL;}
+ } else {
+ sv = get_sv(Z_STRVAL_P(member), FALSE);
+ if (sv && !SvOK(sv)) {sv = NULL;}
+ }
+ if (sv) {
+ if (check_empty) {
+ zval *zv;
+ ALLOC_INIT_ZVAL(zv);
+ php_perl_sv_to_zval(my_perl, sv, zv TSRMLS_CC);
+ ret = zend_is_true(zv);
+ zval_ptr_dtor(&zv);
+ } else {
+ ret = 1;
+ }
+ }
+ } else {
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+ if (SvTYPE(sv) == SVt_PVHV) {
+ HV* hv = (HV*)sv;
+
+ if (check_empty) {
+ /* empty() */
+ SV** prop_val = hv_fetch(hv, Z_STRVAL_P(member), Z_STRLEN_P(member), 0);
+ if (prop_val != NULL) {
+ zval *zv;
+ ALLOC_INIT_ZVAL(zv);
+ php_perl_sv_to_zval(my_perl, *prop_val, zv TSRMLS_CC);
+ ret = zend_is_true(zv);
+ zval_ptr_dtor(&zv);
+ }
+ } else {
+ /* isset() */
+ if (hv_exists(hv, Z_STRVAL_P(member), Z_STRLEN_P(member))) {
+ ret = 1;
+ }
+ }
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not a hash");
+ }
+ }
+ if (member == &tmp_member) {
+ zval_dtor(member);
+ }
+ return ret;
+}
+
+/* Deletes propery of hash based Perl's object */
+static void php_perl_unset_property(zval *object, zval *member TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+ zval tmp_member;
+
+ if (member->type != IS_STRING) {
+ tmp_member = *member;
+ zval_copy_ctor(&tmp_member);
+ convert_to_string(&tmp_member);
+ member = &tmp_member;
+ }
+
+ if (sv == NULL) {
+ if (obj->context == PERL_ARRAY) {
+ AV *av = get_av(Z_STRVAL_P(member), FALSE);
+ av_undef(av);
+ } else if (obj->context == PERL_HASH) {
+ HV *hv = get_hv(Z_STRVAL_P(member), FALSE);
+ hv_undef(hv);
+ } else {
+ SV *sv = get_sv(Z_STRVAL_P(member), FALSE);
+ sv_setsv(sv, &PL_sv_undef);
+ }
+ } else {
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+ if (SvTYPE(sv) == SVt_PVHV) {
+ HV* hv = (HV*)sv;
+ hv_delete(hv, Z_STRVAL_P(member), Z_STRLEN_P(member), G_DISCARD);
+ } else {
+ zend_error(E_WARNING, "[perl] Object is not a hash");
+ }
+ }
+ if (member == &tmp_member) {
+ zval_dtor(member);
+ }
+}
+
+/* Constructs Perl object by calling constructor */
+static void php_perl_constructor_handler(INTERNAL_FUNCTION_PARAMETERS)
+{
+ char* perl_class_name;
+ int perl_class_name_len;
+ char* constructor = "new";
+ int constructor_len = 3;
+ int argc = ZEND_NUM_ARGS();
+ zval *object = this_ptr;
+
+ if (argc == 0) {
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + obj->sv = NULL;
+ obj->properties = NULL;
+ } else if (zend_parse_parameters((argc>2?2:argc) TSRMLS_CC, "s|s",
+ &perl_class_name, &perl_class_name_len,
+ &constructor, &constructor_len) != FAILURE) {
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + zval*** argv = NULL;
+
+ if (argc > 2) {
+ argv = (zval***)safe_emalloc(sizeof(zval **), argc, 0);
+ if (zend_get_parameters_array_ex(argc, argv) == FAILURE) {
+ efree(argv);
+ RETURN_FALSE;
+ }
+ }
+
+ obj->sv = php_perl_call_constructor(my_perl,
+ perl_class_name, perl_class_name_len,
+ constructor, constructor_len,
+ argc-2, argv+2 TSRMLS_CC);
+
+ if (argc > 2) {
+ efree(argv);
+ }
+
+ if(SvTRUE(ERRSV)) {
+ STRLEN na;
+ zval_ptr_dtor(&object);
+ zend_throw_exception_ex(perl_exception_class_entry, 0 TSRMLS_CC,
+ "[perl] constructor error: %s", SvPV(ERRSV, na));
+ return;
+ }
+
+ php_perl_remember_object(obj->sv, object->value.obj.handle TSRMLS_CC);
+ }
+ zval_ptr_dtor(&object);
+}
+
+/* get_constructor handler for overloaded Perl objects */
+static zend_function *php_perl_get_constructor(zval *object TSRMLS_DC)
+{
+ return (zend_function *)&php_perl_constructor_function;
+}
+
+/* get_method handler for overloaded Perl objects */
+#if (ZEND_EXTENSION_API_NO >= 220041030)
+static zend_function *php_perl_get_method(zval **object_ptr, char *method, int \
method_len TSRMLS_DC) +#else
+static zend_function *php_perl_get_method(zval *object, char *method, int method_len \
TSRMLS_DC) +#endif
+{
+ zend_internal_function *f;
+#if (ZEND_EXTENSION_API_NO >= 220041030)
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(*object_ptr \
TSRMLS_CC); +#else
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); +#endif
+
+ if (obj->sv == NULL) {
+#if (ZEND_EXTENSION_API_NO >= 220041030)
+ zend_function *f = zend_get_std_object_handlers()->get_method(object_ptr, \
method, method_len TSRMLS_CC); +#else
+ zend_function *f = zend_get_std_object_handlers()->get_method(object, method, \
method_len TSRMLS_CC); +#endif
+ if (f) {
+ return f;
+ }
+ }
+ f = emalloc(sizeof(zend_internal_function));
+ memset(f, 0, sizeof(zend_internal_function));
+ f->type = ZEND_OVERLOADED_FUNCTION_TEMPORARY;
+/*???FIXME: Some tests fail with following code enabled
+ f->scope = perl_class_entry;
+*/
+ f->function_name = estrndup(method, method_len);
+ return (zend_function *)f;
+}
+
+/* Calls method of overloaded Perl's object */
+static int php_perl_call_function_handler(char *method, \
INTERNAL_FUNCTION_PARAMETERS) +{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ zval *object = this_ptr;
+ int argc = ZEND_NUM_ARGS();
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + zval ***argv = NULL;
+
+ if (argc > 0) {
+ argv = (zval***)safe_emalloc(sizeof(zval**), argc, 0);
+ zend_get_parameters_array_ex(argc, argv);
+ }
+
+ if (obj->sv == NULL) {
+ php_perl_call(my_perl, method, argc, argv, obj->context,
+ return_value_used?return_value:NULL TSRMLS_CC);
+ } else {
+ php_perl_call_method(my_perl, obj->sv, method, argc, argv, obj->context,
+ return_value_used?return_value:NULL TSRMLS_CC);
+ }
+
+ zval_ptr_dtor(&object);
+ if (argc > 0) {
+ efree(argv);
+ }
+
+ if(SvTRUE(ERRSV)) {
+ STRLEN na;
+ zend_throw_exception_ex(perl_exception_class_entry, 0 TSRMLS_CC,
+ "[perl] call error: %s", SvPV(ERRSV, na));
+ return FAILURE;
+ }
+
+ return SUCCESS;
+}
+
+/* Returns all properties of Perl's object */
+static HashTable* php_perl_get_properties(zval *object TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+ HashTable *ht;
+
+ if (sv == NULL) {
+ return NULL;
+ }
+ if (obj->properties != NULL) {
+ ht = obj->properties;
+
+ if (ht->nApplyCount > 0) {
+ return ht;
+ } else if (active_opline != NULL) {
+ /* each() support */
+#define ZSTRCMP(zv,str) \
(zend_binary_strcmp(Z_STRVAL(zv),Z_STRLEN(zv),str,sizeof(str)-1)==0) +//#define \
ZSTRCMP(zv,str) ((Z_STRLEN(zv) == sizeof(str)-1) && \ +// \
(memcmp(Z_STRVAL(zv), str, sizeof(str)-1) == 0)) + if (active_opline->opcode == \
ZEND_DO_FCALL && + active_opline->extended_value == 1 &&
+ active_opline->op1.op_type == IS_CONST &&
+ active_opline->op1.u.constant.type == IS_STRING &&
+ (ZSTRCMP(active_opline->op1.u.constant, "each") ||
+ ZSTRCMP(active_opline->op1.u.constant, "next") ||
+ ZSTRCMP(active_opline->op1.u.constant, "prev") ||
+ ZSTRCMP(active_opline->op1.u.constant, "key") ||
+ ZSTRCMP(active_opline->op1.u.constant, "current"))) {
+ return ht;
+ }
+ }
+
+ /* rebuild HashTable for properties */
+ zend_hash_clean(ht);
+ } else {
+ ALLOC_HASHTABLE(ht);
+ zend_hash_init(ht, 0, NULL, ZVAL_PTR_DTOR, 0);
+ obj->properties = ht;
+ }
+
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+ if (SvTYPE(sv) == SVt_PVHV) {
+ HV* hv = (HV*)sv;
+ SV* el_sv;
+ char* key;
+ I32 key_len;
+
+ hv_iterinit(hv);
+ while ((el_sv = hv_iternextsv(hv, &key, &key_len)) != NULL) {
+ zval* el_zv;
+ ALLOC_INIT_ZVAL(el_zv);
+ php_perl_sv_to_zval(my_perl, el_sv, el_zv TSRMLS_CC);
+ zend_hash_add(ht, key, key_len+1, (void*)&el_zv, sizeof(zval *), NULL);
+ }
+ } else if (SvTYPE(sv) == SVt_PVAV) {
+ AV* av = (AV*)sv;
+ I32 len = av_len(av);
+ I32 i;
+
+ for (i = 0; i <= len; i++) {
+ SV** el_sv = av_fetch(av, i, 0);
+ if (el_sv != NULL && *el_sv != NULL) {
+ zval* el_zv;
+ ALLOC_INIT_ZVAL(el_zv);
+ php_perl_sv_to_zval(my_perl, *el_sv, el_zv TSRMLS_CC);
+ zend_hash_index_update(ht, i, (void*)&el_zv, sizeof(zval *), NULL);
+ }
+ }
+ }
+ return ht;
+}
+
+/* Returns class name of overloaded Perl's object */
+static int php_perl_get_class_name(const zval *object, char **class_name, zend_uint \
*class_name_len, int parent TSRMLS_DC) +{
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + SV* sv = obj->sv;
+ if (sv == NULL) {
+ *class_name = emalloc(sizeof("Perl"));
+ strcpy(*class_name,"Perl");
+ *class_name_len = sizeof("Perl")-1;
+ return SUCCESS;
+ } else {
+ HV* stash;
+ while (SvTYPE(sv) == SVt_RV) {
+ sv = SvRV(sv);
+ }
+ if ((stash = SvSTASH(sv)) != NULL) {
+ char *name = HvNAME(stash);
+ int len = strlen(name);
+ *class_name = emalloc(len+sizeof("Perl::"));
+ strcpy(*class_name,"Perl::");
+ strcpy((*class_name)+sizeof("Perl::")-1,name);
+ *class_name_len = len+sizeof("Perl::")-1;
+ return SUCCESS;
+ } else if (SvTYPE(sv) == SVt_PVAV) {
+ *class_name = emalloc(sizeof("Perl::array"));
+ strcpy(*class_name,"Perl::array");
+ *class_name_len = sizeof("Perl::array")-1;
+ return SUCCESS;
+ } else if (SvTYPE(sv) == SVt_PVHV) {
+ *class_name = emalloc(sizeof("Perl::hash"));
+ strcpy(*class_name,"Perl::hash");
+ *class_name_len = sizeof("Perl::hash")-1;
+ return SUCCESS;
+ } else {
+ *class_name = emalloc(sizeof("Perl::scalar"));
+ strcpy(*class_name,"Perl::scalar");
+ *class_name_len = sizeof("Perl::scalar")-1;
+ return SUCCESS;
+ }
+ }
+ return FAILURE;
+}
+
+/* Returns class_entry of overloaded Perl's objects */
+static zend_class_entry* php_perl_get_class_entry(const zval *object TSRMLS_DC)
+{
+ return perl_class_entry;
+}
+
+/* Destructor for overloaded Perl's objects */
+static void php_perl_destructor(void *perl_object, zend_object_handle handle \
TSRMLS_DC) +{
+ if (perl_object) {
+ php_perl_object *obj = (php_perl_object*)perl_object;
+ PerlInterpreter* my_perl = PERLG(perl);
+ if (obj->properties) {
+ /* removing properties */
+ zend_hash_destroy(obj->properties);
+ FREE_HASHTABLE(obj->properties);
+ }
+ if (my_perl != NULL && obj->sv != NULL) {
+ php_perl_forget_object(obj->sv TSRMLS_CC);
+ /* removing perl object */
+ sv_free(obj->sv);
+ }
+ efree(perl_object);
+ }
+}
+
+static void php_perl_cleaner(void *perl_object, zend_object_handle handle TSRMLS_DC)
+{
+ if (perl_object) {
+ php_perl_object *obj = (php_perl_object*)perl_object;
+ if (obj->properties) {
+ /* removing properties */
+ zend_hash_destroy(obj->properties);
+ FREE_HASHTABLE(obj->properties);
+ }
+ efree(perl_object);
+ }
+}
+
+/* Makes a copy of overloaded perl object.
+ It copies only properties or elements of object, but does'nt copy nested
+ arrays, hashes or objects */
+static zend_object_value php_perl_clone(zval *object TSRMLS_DC)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ zend_object_value new_value;
+
+ php_perl_object *old = zend_object_store_get_object(object TSRMLS_CC);
+ php_perl_object *obj = (php_perl_object*)emalloc(sizeof(php_perl_object));
+
+ if (old->sv != NULL) {
+ SV* old_sv = SvRV(old->sv);
+ SV* new_sv = NULL;
+
+ if (SvTYPE(old_sv) == SVt_PVAV) {
+ /* array */
+ I32 len = av_len((AV*)old_sv);
+ I32 i;
+
+ new_sv = (SV*)newAV();
+ for (i = 0; i <= len; i++) {
+ SV** el_sv = av_fetch((AV*)old_sv, i, 0);
+ if (el_sv != NULL && *el_sv != NULL) {
+ av_push((AV*)new_sv, newSVsv(*el_sv));
+ }
+ }
+ } else if (SvTYPE(old_sv) == SVt_PVHV) {
+ /* hash */
+ new_sv = (SV*)newHVhv((HV*)old_sv);
+ } else if (SvOK(old_sv)) {
+ /* scalar */
+ new_sv = newSVsv(old_sv);
+ } else {
+ /* unknown */
+ zend_error(E_ERROR, "[perl] Can't clone perl object (type [%ld])", \
SvTYPE(old_sv)); + }
+ obj->sv = sv_bless(newRV_noinc(new_sv), SvSTASH(old_sv));
+ } else {
+ obj->sv = NULL;
+ }
+ obj->zo.ce = old->zo.ce;
+ obj->properties = NULL;
+ obj->context = PERL_SCALAR;
+
+ new_value.handlers = &php_perl_object_handlers;
+ new_value.handle =
+ zend_objects_store_put(obj, php_perl_destructor, NULL, NULL TSRMLS_CC);
+
+ if (obj->sv) {
+ php_perl_remember_object(obj->sv, new_value.handle TSRMLS_CC);
+ }
+
+ return new_value;
+}
+
+/* Creates overloaded Perl's object */
+static zend_object_value php_perl_create_object(zend_class_entry *class_type \
TSRMLS_DC) +{
+ zend_object_value new_value;
+
+ php_perl_object *obj = (php_perl_object*)emalloc(sizeof(php_perl_object));
+ obj->zo.ce = class_type;
+ obj->sv = NULL;
+ obj->properties = NULL;
+ obj->context = PERL_SCALAR;
+
+ new_value.handlers = &php_perl_object_handlers;
+ new_value.handle =
+ zend_objects_store_put(obj, php_perl_destructor, NULL, NULL TSRMLS_CC);
+
+ return new_value;
+}
+
+/****************************************************************************/
+
+static void php_perl_iterator_dtor(zend_object_iterator *iter TSRMLS_DC);
+static int php_perl_iterator_valid(zend_object_iterator *iter TSRMLS_DC);
+static void php_perl_iterator_current_data(zend_object_iterator *iter, zval ***data \
TSRMLS_DC); +static int php_perl_iterator_current_key(zend_object_iterator *iter, \
char **str_key, uint *str_key_len, ulong *int_key TSRMLS_DC); +static void \
php_perl_iterator_move_forward(zend_object_iterator *iter TSRMLS_DC); +static void \
php_perl_iterator_rewind(zend_object_iterator *iter TSRMLS_DC); +
+zend_object_iterator_funcs php_perl_iterator_funcs = {
+ php_perl_iterator_dtor,
+ php_perl_iterator_valid,
+ php_perl_iterator_current_data,
+ php_perl_iterator_current_key,
+ php_perl_iterator_move_forward,
+ php_perl_iterator_rewind,
+};
+
+static void php_perl_iterator_dtor(zend_object_iterator *iterator TSRMLS_DC)
+{
+ zval* object =(zval*)iterator->data;
+ zval_ptr_dtor(&object);
+ efree(iterator);
+}
+
+static int php_perl_iterator_valid(zend_object_iterator *iterator TSRMLS_DC)
+{
+ zval* object =(zval*)iterator->data;
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + if (obj->properties) {
+ return zend_hash_has_more_elements(obj->properties);
+ }
+ return FAILURE;
+}
+
+static void php_perl_iterator_current_data(zend_object_iterator *iterator, zval \
***data TSRMLS_DC) +{
+ zval* object =(zval*)iterator->data;
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + if (obj->properties) {
+ zend_hash_get_current_data(obj->properties, (void**)data);
+ }
+}
+
+static int php_perl_iterator_current_key(zend_object_iterator *iterator, char \
**str_key, uint *str_key_len, ulong *int_key TSRMLS_DC) +{
+ zval* object =(zval*)iterator->data;
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + if (obj->properties) {
+ return zend_hash_get_current_key_ex(obj->properties, str_key, str_key_len, \
int_key, 1, NULL); + }
+ return HASH_KEY_NON_EXISTANT;
+}
+
+static void php_perl_iterator_move_forward(zend_object_iterator *iterator TSRMLS_DC)
+{
+ zval* object =(zval*)iterator->data;
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + if (obj->properties) {
+ zend_hash_move_forward(obj->properties);
+ }
+}
+
+static void php_perl_iterator_rewind(zend_object_iterator *iterator TSRMLS_DC)
+{
+ zval* object =(zval*)iterator->data;
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(object \
TSRMLS_CC); + if (obj->properties) {
+ /* removing properties */
+ zend_hash_destroy(obj->properties);
+ FREE_HASHTABLE(obj->properties);
+ obj->properties = NULL;
+ }
+ php_perl_get_properties(object TSRMLS_CC);
+ if (obj->properties) {
+ zend_hash_internal_pointer_reset(obj->properties);
+ }
+}
+
+#if PHP_VERSION_ID >= 50200
+zend_object_iterator *php_perl_get_iterator(zend_class_entry *ce, zval *object, int \
by_ref TSRMLS_DC) +#else
+zend_object_iterator *php_perl_get_iterator(zend_class_entry *ce, zval *object \
TSRMLS_DC) +#endif
+{
+ zend_object_iterator *iterator = emalloc(sizeof(zend_object_iterator));
+ Z_ADDREF_P(object);
+ iterator->data = (void*)object;
+ iterator->funcs = &php_perl_iterator_funcs;
+
+ return iterator;
+}
+/****************************************************************************/
+
+static void php_perl_init_globals(zend_perl_globals *perl_globals)
+{
+ perl_globals->perl = NULL;
+}
+
+PHP_MINIT_FUNCTION(perl)
+{
+ zend_class_entry perl_ce;
+ ZEND_INIT_MODULE_GLOBALS(perl, php_perl_init_globals, NULL);
+
+ INIT_CLASS_ENTRY(perl_ce, "Perl", perl_functions);
+ perl_ce.create_object = php_perl_create_object;
+ perl_class_entry = zend_register_internal_class(&perl_ce TSRMLS_CC);
+ perl_class_entry->get_iterator = php_perl_get_iterator;
+
+ INIT_CLASS_ENTRY(perl_ce, "PerlException", NULL);
+#if ZEND_MODULE_API_NO >= 20060613
+ perl_exception_class_entry = zend_register_internal_class_ex(&perl_ce, \
zend_exception_get_default(TSRMLS_C), NULL TSRMLS_CC); +#else
+ perl_exception_class_entry = zend_register_internal_class_ex(&perl_ce, \
zend_exception_get_default(), NULL TSRMLS_CC); +#endif
+
+ return SUCCESS;
+}
+
+PHP_MSHUTDOWN_FUNCTION(perl)
+{
+ return SUCCESS;
+}
+
+PHP_RSHUTDOWN_FUNCTION(perl)
+{
+ php_perl_destroy(TSRMLS_C);
+ return SUCCESS;
+}
+
+PHP_MINFO_FUNCTION(perl)
+{
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+
+ php_info_print_table_start();
+ php_info_print_table_header(2, "Perl support", "enabled");
+ php_info_print_table_row(2, "Extension version", PHP_PERL_VERSION);
+ php_info_print_table_row(2, "Revision", "$Revision$");
+ php_info_print_table_row(2, "Perl version", Perl_form(aTHX_ "%vd",PL_patchlevel));
+ php_info_print_table_end();
+}
+
+/* perl_require($perl_file_name)
+ Loads and executes Perl file. Produces a error if file does not exist or
+ has Perl's errors */
+PHP_METHOD(Perl, require)
+{
+ char* perl_filename;
+ int perl_filename_len;
+
+ if (zend_parse_parameters(ZEND_NUM_ARGS() TSRMLS_CC, "s",
+ &perl_filename, &perl_filename_len) == FAILURE) {
+ return;
+ } else {
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ require_pv(perl_filename);
+ if(SvTRUE(ERRSV)) {
+ STRLEN na;
+
+ zend_throw_exception_ex(perl_exception_class_entry, 0 TSRMLS_CC,
+ "[perl] require error: %s", SvPV(ERRSV, na));
+ }
+ }
+}
+
+/* perl_eval($perl_code)
+ Evaluates Perl code and returns result.
+ Produces a error if code has Perl's errors */
+PHP_METHOD(Perl, eval)
+{
+ char* perl_code;
+ int perl_code_len;
+
+ if (zend_parse_parameters(ZEND_NUM_ARGS() TSRMLS_CC, "s",
+ &perl_code, &perl_code_len) != FAILURE) {
+ PerlInterpreter* my_perl = php_perl_init(TSRMLS_C);
+ php_perl_object *obj = (php_perl_object*)zend_object_store_get_object(this_ptr \
TSRMLS_CC); + SV* sv;
+ dSP;
+ sv = newSVpv(perl_code, perl_code_len);
+ if (return_value_used) {
+ if (obj->context != PERL_SCALAR) {
+ int count, i;
+ I32 ax;
+ HashTable var_hash;
+
+ count = eval_sv(sv, G_ARRAY|G_KEEPERR);
+ SPAGAIN;
+ sp -= count;
+ ax = (sp - PL_stack_base) + 1;
+ zend_hash_init(&var_hash, 0, NULL, NULL, 0);
+ array_init(return_value);
+ if (obj->context == PERL_ARRAY) {
+ for (i = 0; i < count; i++) {
+ add_next_index_zval(return_value,
+ php_perl_sv_to_zval_ref(my_perl, (SV*)(SV*)ST(i), NULL, &var_hash \
TSRMLS_CC)); + }
+ } else {
+ for (i = 0; i < count; i++) {
+ int key_len;
+ char *key = SvPV(ST(i), key_len);
+ if (i != count-1) {
+ add_assoc_zval_ex(return_value, key, key_len+1,
+ php_perl_sv_to_zval_ref(my_perl, (SV*)(SV*)ST(++i), NULL, &var_hash \
TSRMLS_CC)); + } else {
+ add_assoc_null_ex(return_value, key, key_len+1);
+ }
+ }
+ }
+ zend_hash_destroy(&var_hash);
+ } else {
+ eval_sv(sv, G_SCALAR|G_KEEPERR);
+ SPAGAIN;
+ php_perl_sv_to_zval(my_perl, POPs, return_value TSRMLS_CC);
+ }
+ PUTBACK;
+ } else {
+ eval_sv(sv, G_DISCARD|G_KEEPERR);
+ }
+ sv_free(sv);
+
+ if (SvTRUE(ERRSV)) {
+ STRLEN na;
+ zend_throw_exception_ex(perl_exception_class_entry, 0 TSRMLS_CC,
+ "[perl] eval error: %s", SvPV(ERRSV, na));
+ }
+ }
+}
+
+zend_module_entry perl_module_entry = {
+#if ZEND_MODULE_API_NO >= 20010901
+ STANDARD_MODULE_HEADER,
+#endif
+ "perl",
+ NULL,
+ PHP_MINIT(perl),
+ PHP_MSHUTDOWN(perl),
+ NULL,
+ PHP_RSHUTDOWN(perl),
+ PHP_MINFO(perl),
+#if ZEND_MODULE_API_NO >= 20010901
+ PHP_PERL_VERSION,
+#endif
+ STANDARD_MODULE_PROPERTIES
+};
+
+#ifdef COMPILE_DL_PERL
+ZEND_GET_MODULE(perl)
+#endif
+
+#endif
Copied: pecl/perl/tags/perl-1.0.1/php_perl.h (from rev 329275, \
pecl/perl/trunk/php_perl.h) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/php_perl.h (rev 0)
+++ pecl/perl/tags/perl-1.0.1/php_perl.h 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,40 @@
+/*
+ +----------------------------------------------------------------------+
+ | PHP Version 4 |
+ +----------------------------------------------------------------------+
+ | Copyright (c) 1997-2003 The PHP Group |
+ +----------------------------------------------------------------------+
+ | This source file is subject to version 3.0 of the PHP license, |
+ | that is bundled with this package in the file LICENSE, and is |
+ | available through the world-wide-web at the following url: |
+ | http://www.php.net/license/3_0.txt. |
+ | If you did not receive a copy of the PHP license and are unable to |
+ | obtain it through the world-wide-web, please send a note to |
+ | license@php.net so we can mail you a copy immediately. |
+ +----------------------------------------------------------------------+
+ | Author: Dmitry Stogov <dmitry@zend.com> |
+ +----------------------------------------------------------------------+
+ $Id$
+*/
+
+#ifndef PHP_PERL_H
+#define PHP_PERL_H
+
+#include "php.h"
+
+extern zend_module_entry perl_module_entry;
+#define phpext_perl_ptr &perl_module_entry
+
+#define PHP_PERL_VERSION "1.0.1"
+
+#ifdef PHP_WIN32
+#define PHP_PERL_API __declspec(dllexport)
+#else
+#define PHP_PERL_API
+#endif
+
+#ifdef ZTS
+#include "TSRM.h"
+#endif
+
+#endif
Copied: pecl/perl/tags/perl-1.0.1/tests/perl001.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl001.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl001.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl001.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,14 @@
+--TEST--
+Test 1: require of existing file
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+error_reporting(E_ALL);
+$perl = new Perl();
+$perl->require(dirname(__FILE__)."/perl001.pl");
+echo "ok\n";
+?>
+--EXPECT--
+ok
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl001.pl (from rev 329274, \
pecl/perl/trunk/tests/perl001.pl) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl001.pl (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl001.pl 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1 @@
+print "ok\n"
Copied: pecl/perl/tags/perl-1.0.1/tests/perl002.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl002.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl002.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl002.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,20 @@
+--TEST--
+Test 2: require of non existing file
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--INI--
+log_errors_max_len=4096
+--FILE--
+<?php
+error_reporting(E_ALL);
+$perl = new Perl();
+$perl->require(dirname(__FILE__)."/perl002.pl");
+echo "ok\n";
+?>
+--EXPECTF--
+Fatal error: Uncaught exception 'PerlException' with message '[perl] require error: \
Can't locate %sperl002.pl in @INC (@INC contains: %s) at (eval %d) line %d. +' in \
%sperl002.php:%d +Stack trace:
+#0 %sperl002.php(4): Perl->require('%s')
+#1 {main}
+ thrown in %sperl002.php on line %d
Copied: pecl/perl/tags/perl-1.0.1/tests/perl003.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl003.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl003.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl003.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,13 @@
+--TEST--
+Test 3: eval
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval('print "ok\n";');
+echo "ok\n";
+?>
+--EXPECT--
+ok
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl004.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl004.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl004.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl004.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,19 @@
+--TEST--
+Test 4: returning scalar value from eval()
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+var_dump($perl->eval(''));
+var_dump($perl->eval('5+3;'));
+var_dump($perl->eval('5.5+3.2;'));
+var_dump($perl->eval('reverse "0123456789";'));
+echo "ok\n";
+?>
+--EXPECT--
+NULL
+int(8)
+float(8.7)
+string(10) "9876543210"
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl005.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl005.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl005.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl005.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,20 @@
+--TEST--
+Test 5: returning array value from eval()
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+var_dump($perl->eval('[1,2.5,"string"];'));
+echo "ok\n";
+?>
+--EXPECT--
+array(3) {
+ [0]=>
+ int(1)
+ [1]=>
+ float(2.5)
+ [2]=>
+ string(6) "string"
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl006.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl006.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl006.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl006.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,20 @@
+--TEST--
+Test 6: returning hash value from eval()
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+var_dump($perl->eval('{"int"=>1,"double"=>3.5,"string"=>"string"};'));
+echo "ok\n";
+?>
+--EXPECT--
+array(3) {
+ ["double"]=>
+ float(3.5)
+ ["int"]=>
+ int(1)
+ ["string"]=>
+ string(6) "string"
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl007.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl007.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl007.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl007.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,19 @@
+--TEST--
+Test 7: Evaluating invalid Perlcode (eval)
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--INI--
+log_errors_max_len=4096
+--FILE--
+<?php
+$perl = new Perl();
+var_dump($perl->eval('$a = $s{$d}.'));
+echo "ok\n";
+?>
+--EXPECTF--
+Fatal error: Uncaught exception 'PerlException' with message '[perl] eval error: \
syntax error at (eval %d) line %d, at EOF +' in %sperl007.php:%d
+Stack trace:
+#0 %sperl007.php(3): Perl->eval('$a = $s{$d}.')
+#1 {main}
+ thrown in %sperl007.php on line %d
Copied: pecl/perl/tags/perl-1.0.1/tests/perl008.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl008.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl008.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl008.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,20 @@
+--TEST--
+Test 8: accessing scalar perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval('$a = 5;');
+var_dump($perl->a);
+$perl->eval('$a = 2.5;');
+var_dump($perl->a);
+$perl->eval('$a = "str";');
+var_dump($perl->a);
+echo "ok\n";
+?>
+--EXPECT--
+int(5)
+float(2.5)
+string(3) "str"
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl009.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl009.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl009.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl009.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,21 @@
+--TEST--
+Test 9: accessing array perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval('@a = (4, 2.5, "str");');
+var_dump($perl->array->a);
+echo "ok\n";
+?>
+--EXPECT--
+array(3) {
+ [0]=>
+ int(4)
+ [1]=>
+ float(2.5)
+ [2]=>
+ string(3) "str"
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl010.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl010.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl010.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl010.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,21 @@
+--TEST--
+Test 10: accessing hash perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval('%a = ("int" => 4, "double" => 2.5, "str" => "str");');
+var_dump($perl->hash->a);
+echo "ok\n";
+?>
+--EXPECT--
+array(3) {
+ ["double"]=>
+ float(2.5)
+ ["str"]=>
+ string(3) "str"
+ ["int"]=>
+ int(4)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl011.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl011.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl011.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl011.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,13 @@
+--TEST--
+Test 11: accessing undefined perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+error_reporting(E_ALL);
+$perl = new Perl();
+var_dump($perl->tmpvar);
+?>
+--EXPECTF--
+Notice: [perl] Undefined variable: '$tmpvar' in %s on line %d
+NULL
Copied: pecl/perl/tags/perl-1.0.1/tests/perl012.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl012.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl012.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl012.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,47 @@
+--TEST--
+Test 12: calling perl user function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f_integer {
+ return 5;
+}
+sub f_double {
+ return 2.5;
+}
+sub f_string {
+ return "str";
+}
+sub f_array {
+ my @x=(2);
+ return \\@x;
+}
+sub f_hash {
+ my %x=('str'=>'str');
+ return \\%x;
+}
+PERL_END
+);
+var_dump($perl->f_integer());
+var_dump($perl->f_double());
+var_dump($perl->f_string());
+var_dump($perl->f_array());
+var_dump($perl->f_hash());
+echo "ok\n";
+?>
+--EXPECT--
+int(5)
+float(2.5)
+string(3) "str"
+array(1) {
+ [0]=>
+ int(2)
+}
+array(1) {
+ ["str"]=>
+ string(3) "str"
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl013.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl013.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl013.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl013.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,23 @@
+--TEST--
+Test 13: passing scalar argument to user function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f {
+ return shift(@_);
+}
+PERL_END
+);
+var_dump($perl->f(5));
+var_dump($perl->f(2.5));
+var_dump($perl->f("str"));
+echo "ok\n";
+?>
+--EXPECT--
+int(5)
+float(2.5)
+string(3) "str"
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl014.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl014.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl014.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl014.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,32 @@
+--TEST--
+Test 14: passing array argument to user function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f {
+ \$var = shift(@_);
+}
+PERL_END
+);
+$perl->f(array(1,2.5,"str",array(1)));
+var_dump($perl->var);
+echo "ok\n";
+?>
+--EXPECT--
+array(4) {
+ [0]=>
+ int(1)
+ [1]=>
+ float(2.5)
+ [2]=>
+ string(3) "str"
+ [3]=>
+ array(1) {
+ [0]=>
+ int(1)
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl015.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl015.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl015.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl015.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,32 @@
+--TEST--
+Test 15: passing hash argument to user function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f {
+ \$var = shift(@_);
+}
+PERL_END
+);
+$perl->f(array("a"=>1,"b"=>2.5,"c"=>"str","d"=>array(1)));
+var_dump($perl->var);
+echo "ok\n";
+?>
+--EXPECT--
+array(4) {
+ ["c"]=>
+ string(3) "str"
+ ["a"]=>
+ int(1)
+ ["b"]=>
+ float(2.5)
+ ["d"]=>
+ array(1) {
+ [0]=>
+ int(1)
+ }
+}
+ok
\ No newline at end of file
Copied: pecl/perl/tags/perl-1.0.1/tests/perl016.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl016.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl016.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl016.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,27 @@
+--TEST--
+Test 16: passing many arguments to user function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub sum {
+ my \$x = shift(@_);
+ foreach my \$y (@_) {
+ \$x += \$y;
+ }
+ return \$x;
+}
+
+PERL_END
+);
+
+var_dump($perl->eval("sum(1,2,3,4,5);"));
+var_dump($perl->sum(1,2,3,4,5));
+echo "ok\n";
+?>
+--EXPECT--
+int(15)
+int(15)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl017.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl017.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl017.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl017.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,22 @@
+--TEST--
+Test 17: calling function from external Perl module
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+use Digest::MD5 qw(md5_hex);
+PERL_END
+);
+
+var_dump($perl->eval('md5_hex("Hello");'));
+var_dump($perl->md5_hex('Hello'));
+var_dump($perl->{'Digest::MD5::md5_hex'}('Hello'));
+echo "ok\n";
+?>
+--EXPECT--
+string(32) "8b1a9953c4611296a827abf8c47804d7"
+string(32) "8b1a9953c4611296a827abf8c47804d7"
+string(32) "8b1a9953c4611296a827abf8c47804d7"
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl018.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl018.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl018.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl018.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,15 @@
+--TEST--
+Test 18: calling internal Perl function (not implemented by pecl/perl)
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval('print "Hello\n"');
+$perl->print("Hello\n");
+echo "ok\n";
+?>
+--EXPECT--
+Hello
+Hello
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl019.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl019.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl019.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl019.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,24 @@
+--TEST--
+Test 19: die() in user function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f {
+ die("Bye bye!");
+}
+PERL_END
+);
+
+$perl->f();
+echo "ok\n";
+?>
+--EXPECTF--
+Fatal error: Uncaught exception 'PerlException' with message '[perl] call error: \
(in cleanup) Bye bye! at (eval %d) line %d. +' in %sperl019.php:%d
+Stack trace:
+#0 %sperl019.php(10): Perl->f()
+#1 {main}
+ thrown in %sperl019.php on line %d
Copied: pecl/perl/tags/perl-1.0.1/tests/perl020.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl020.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl020.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl020.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,20 @@
+--TEST--
+Test 20: die() in perl_eval()
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+ die("Bye bye!");
+PERL_END
+);
+echo "ok\n";
+?>
+--EXPECTF--
+Fatal error: Uncaught exception 'PerlException' with message '[perl] eval error: \
(in cleanup) Bye bye! at (eval %d) line %d. +' in %sperl020.php:%d
+Stack trace:
+#0 %sperl020.php(6): Perl->eval('%s')
+#1 {main}
+ thrown in %sperl020.php on line %d
Copied: pecl/perl/tags/perl-1.0.1/tests/perl021.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl021.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl021.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl021.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,43 @@
+--TEST--
+Test 21: returning object from eval()
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 12;
+ bless \$self, \$type;
+ return \$self;
+ }
+package Bar;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'y'} = 8;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+var_dump($perl->eval('Foo->new()'));
+var_dump($perl->eval('Bar::new("Bar")'));
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["x"]=>
+ int(12)
+}
+object(Perl::Bar)#2 (1) {
+ ["y"]=>
+ int(8)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl022.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl022.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl022.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl022.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,29 @@
+--TEST--
+Test 22: returning object from perl function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 12;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+var_dump($perl->{'Foo::new'}('Foo'));
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["x"]=>
+ int(12)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl023.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl023.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl023.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl023.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,58 @@
+--TEST--
+Test 23: creating new Perl objects
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 11;
+ bless \$self, \$type;
+ return \$self;
+ }
+ sub new2 {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 12;
+ bless \$self, \$type;
+ return \$self;
+ }
+ sub new3 {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = shift;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+var_dump($foo);
+$foo = new Perl('Foo','new2');
+var_dump($foo);
+$foo = new Perl('Foo','new3',13);
+var_dump($foo);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["x"]=>
+ int(11)
+}
+object(Perl::Foo)#3 (1) {
+ ["x"]=>
+ int(12)
+}
+object(Perl::Foo)#2 (1) {
+ ["x"]=>
+ int(13)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl024.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl024.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl024.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl024.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,33 @@
+--TEST--
+Test 24: reading scalar object's properties
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'int'} = 12;
+ \$self->{'float'} = 2.5;
+ \$self->{'str'} = 'str';
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+var_dump($foo->int);
+var_dump($foo->float);
+var_dump($foo->str);
+echo "ok\n";
+?>
+--EXPECT--
+int(12)
+float(2.5)
+string(3) "str"
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl025.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl025.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl025.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl025.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,34 @@
+--TEST--
+Test 25: reading array object's property
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = [1, 2.5, "str"];
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+var_dump($foo->x);
+echo "ok\n";
+?>
+--EXPECT--
+array(3) {
+ [0]=>
+ int(1)
+ [1]=>
+ float(2.5)
+ [2]=>
+ string(3) "str"
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl026.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl026.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl026.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl026.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,34 @@
+--TEST--
+Test 26: reading hash object's property
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = {"int"=>1, "flost"=>2.5, "str"=>"str"};
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+var_dump($foo->x);
+echo "ok\n";
+?>
+--EXPECT--
+array(3) {
+ ["str"]=>
+ string(3) "str"
+ ["int"]=>
+ int(1)
+ ["flost"]=>
+ float(2.5)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl027.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl027.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl027.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl027.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,42 @@
+--TEST--
+Test 27: reading object object's property
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Bar;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ bless \$self, \$type;
+ return \$self;
+ }
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'bar'} = Bar->new;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+var_dump($foo->bar);
+var_dump($foo);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Bar)#3 (0) {
+}
+object(Perl::Foo)#2 (1) {
+ ["bar"]=>
+ object(Perl::Bar)#3 (0) {
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl028.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl028.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl028.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl028.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,37 @@
+--TEST--
+Test 28: setting scalar object's properties
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'int'} = 12;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+$foo->int = 5;
+$foo->float = 2.5;
+$foo->str = "str";
+var_dump($foo);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (3) {
+ ["float"]=>
+ float(2.5)
+ ["str"]=>
+ string(3) "str"
+ ["int"]=>
+ int(5)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl029.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl029.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl029.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl029.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,44 @@
+--TEST--
+Test 29: setting array object's property
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'a1'} = [1,2];
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+$foo->a1 = array(2,1);
+$foo->a2 = array(1,2);
+var_dump($foo);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (2) {
+ ["a2"]=>
+ array(2) {
+ [0]=>
+ int(1)
+ [1]=>
+ int(2)
+ }
+ ["a1"]=>
+ array(2) {
+ [0]=>
+ int(2)
+ [1]=>
+ int(1)
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl030.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl030.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl030.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl030.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,44 @@
+--TEST--
+Test 30: setting hash object's property
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'a1'} = {"one"=>1,"two"=>2};
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+$foo->a1 = array("one"=>2,"two"=>1);
+$foo->a2 = array("one"=>1,"two"=>2);
+var_dump($foo);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (2) {
+ ["a2"]=>
+ array(2) {
+ ["one"]=>
+ int(1)
+ ["two"]=>
+ int(2)
+ }
+ ["a1"]=>
+ array(2) {
+ ["one"]=>
+ int(2)
+ ["two"]=>
+ int(1)
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl031.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl031.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl031.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl031.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,43 @@
+--TEST--
+Test 31: setting object object's property
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Bar;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 1;
+ bless \$self, \$type;
+ return \$self;
+ }
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+$foo->bar = $bar =new Perl('Bar');
+$bar->x = 2;
+var_dump($foo);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["bar"]=>
+ object(Perl::Bar)#3 (1) {
+ ["x"]=>
+ int(2)
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl032.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl032.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl032.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl032.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,49 @@
+--TEST--
+Test 32: calling objects methods (without arguments)
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'int'} = 12;
+ \$self->{'float'} = 2.5;
+ \$self->{'str'} = "str";
+ bless \$self, \$type;
+ return \$self;
+ }
+
+ sub getInt {
+ my \$self = shift;
+ return \$self->{'int'};
+ }
+
+ sub getFloat {
+ my \$self = shift;
+ return \$self->{'float'};
+ }
+
+ sub getStr {
+ my \$self = shift;
+ return \$self->{'str'};
+ }
+
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+var_dump($foo->getInt());
+var_dump($foo->getFloat());
+var_dump($foo->getStr());
+echo "ok\n";
+?>
+--EXPECT--
+int(12)
+float(2.5)
+string(3) "str"
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl033.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl033.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl033.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl033.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,38 @@
+--TEST--
+Test 33: calling objects methods with arguments
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'sum'} = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+
+ sub sum {
+ my \$self = shift;
+ foreach my \$x (@_) {
+ \$self->{'sum'} += \$x;
+ }
+ return \$self->{'sum'};
+ }
+
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+var_dump($foo->sum(1,2,3,4,5));
+var_dump($foo->sum(1,2,3,4,5));
+echo "ok\n";
+?>
+--EXPECT--
+int(15)
+int(30)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl034.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl034.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl034.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl034.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,33 @@
+--TEST--
+Test 34: passing object argument to user function
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 12;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+ sub f {
+ \$var = shift(@_);
+ }
+PERL_END
+);
+$perl->f(new Perl('Foo'));
+var_dump($perl->var);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["x"]=>
+ int(12)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl035.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl035.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl035.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl035.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,38 @@
+--TEST--
+Test 35: checking isset() and empty() on object properies
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'p1'} = 12;
+ \$self->{'p2'} = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+var_dump(isset($x->p1));
+var_dump(isset($x->p2));
+var_dump(isset($x->p3));
+var_dump(empty($x->p1));
+var_dump(empty($x->p2));
+var_dump(empty($x->p3));
+echo "ok\n";
+?>
+--EXPECT--
+bool(true)
+bool(true)
+bool(false)
+bool(false)
+bool(true)
+bool(true)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl036.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl036.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl036.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl036.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,32 @@
+--TEST--
+Test 36: clearing object properies with unset()
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'p1'} = 1;
+ \$self->{'p2'} = 2;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+unset($x->p2);
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["p1"]=>
+ int(1)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl037.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl037.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl037.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl037.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,38 @@
+--TEST--
+Test 37: cloning perl objects
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 12;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$y = clone $x;
+$x->x = 1;
+$y->x = 2;
+var_dump($x);
+var_dump($y);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["x"]=>
+ int(1)
+}
+object(Perl::Foo)#3 (1) {
+ ["x"]=>
+ int(2)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl038.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl038.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl038.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl038.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,42 @@
+--TEST--
+Test 38: cloning perl objects
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = [0];
+ bless \$self, \$type;
+ return \$self;
+ }
+ sub modify {
+ my \$self = shift;
+ \$self->{'x'}->[0] = shift;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$y = clone $x;
+$x->modify(1);
+$y->modify(2);
+var_dump($x->x);
+var_dump($y->x);
+echo "ok\n";
+?>
+--EXPECT--
+array(1) {
+ [0]=>
+ int(2)
+}
+array(1) {
+ [0]=>
+ int(2)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl039.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl039.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl039.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl039.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,30 @@
+--TEST--
+Test 39: creating array based perl objects
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ [0]=>
+ int(0)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl040.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl040.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl040.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl040.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,33 @@
+--TEST--
+Test 40: accessing elements of array based perl object
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 0;
+ \$self->[1] = 1.5;
+ \$self->[2] = "str";
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+var_dump($x[0]);
+var_dump($x[1]);
+var_dump($x[2]);
+echo "ok\n";
+?>
+--EXPECT--
+int(0)
+float(1.5)
+string(3) "str"
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl041.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl041.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl041.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl041.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,38 @@
+--TEST--
+Test 41: setting elements of array based perl object
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 0;
+ \$self->[1] = 1.5;
+ \$self->[2] = "str";
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$x[0] = 3;
+$x[2] = "ok";
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (3) {
+ [0]=>
+ int(3)
+ [1]=>
+ float(1.5)
+ [2]=>
+ string(2) "ok"
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl042.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl042.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl042.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl042.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,38 @@
+--TEST--
+Test 42: checking isset() and empty() on elements of array based perl object
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 2;
+ \$self->[1] = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+var_dump(isset($x[0]));
+var_dump(isset($x[1]));
+var_dump(isset($x[2]));
+var_dump(empty($x[0]));
+var_dump(empty($x[1]));
+var_dump(empty($x[2]));
+echo "ok\n";
+?>
+--EXPECT--
+bool(true)
+bool(true)
+bool(false)
+bool(false)
+bool(true)
+bool(true)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl043.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl043.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl043.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl043.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,35 @@
+--TEST--
+Test 43: clearing clearing elements of array based object with unset()
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 1;
+ \$self->[1] = 2;
+ \$self->[3] = 3;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+unset($x[1]);
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (2) {
+ [0]=>
+ int(1)
+ [3]=>
+ int(3)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl044.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl044.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl044.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl044.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,42 @@
+--TEST--
+Test 44: cloning array based perl objects
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+ sub modify {
+ my \$self = shift;
+ \$self->[0] = shift;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$y = clone $x;
+$x->modify(1);
+$y->modify(2);
+var_dump($x);
+var_dump($y);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ [0]=>
+ int(1)
+}
+object(Perl::Foo)#3 (1) {
+ [0]=>
+ int(2)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl045.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl045.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl045.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl045.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,29 @@
+--TEST--
+Test 45: modifying property of object
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{x} = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$x->x++;
+++$x->x;
+var_dump($x->x);
+echo "ok\n";
+?>
+--EXPECT--
+int(2)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl046.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl046.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl046.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl046.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,29 @@
+--TEST--
+Test 46: modifying element of array based object
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$x[0]++;
+++$x[0];
+var_dump($x[0]);
+echo "ok\n";
+?>
+--EXPECT--
+int(2)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl047.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl047.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl047.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl047.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,34 @@
+--TEST--
+Test 47: foreach() on Perl object
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{x} = 1;
+ \$self->{y} = 2;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$i = 0;
+foreach($x as $var => $val) {
+ echo "$var = ";
+ var_dump($val);
+ if (++$i > 5) break;
+}
+echo "ok\n";
+?>
+--EXPECT--
+y = int(2)
+x = int(1)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl048.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl048.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl048.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl048.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,33 @@
+--TEST--
+Test 48: foreach() on array based Perl object
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 1;
+ \$self->[1] = 2;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$i = 0;
+foreach($x as $val) {
+ var_dump($val);
+ if (++$i > 5) break;
+}
+echo "ok\n";
+?>
+--EXPECT--
+int(1)
+int(2)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl049.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl049.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl049.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl049.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,16 @@
+--TEST--
+Test 49: creating and using perl objects from external module
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval('use Digest::MD5;');
+$ctx = new Perl('Digest::MD5');
+$ctx->add("Hello");
+echo $ctx->hexdigest()."\n";
+echo "ok\n";
+?>
+--EXPECT--
+8b1a9953c4611296a827abf8c47804d7
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl050.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl050.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl050.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl050.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,32 @@
+--TEST--
+Test 50: Perl's references support
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$x = $perl->eval(<<<PERL_END
+ \$x = [1];
+ \$x->[1] = \\\$x->[0];
+ return \$x;
+PERL_END
+);
+var_dump($x);
+$x[0] = 2;
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+array(2) {
+ [0]=>
+ &int(1)
+ [1]=>
+ &int(1)
+}
+array(2) {
+ [0]=>
+ &int(2)
+ [1]=>
+ &int(2)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl051.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl051.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl051.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl051.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,53 @@
+--TEST--
+Test 51: PHP's references support
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f {
+ \$x = shift(@_);
+ \$x->[0] = 3;
+ return \$x;
+}
+PERL_END
+);
+
+$x = array(1);
+$x[1] =& $x[0];
+var_dump($x);
+$x[0] = 2;
+var_dump($x);
+$x = $perl->f($x);
+var_dump($x);
+$x[1] = 4;
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+array(2) {
+ [0]=>
+ &int(1)
+ [1]=>
+ &int(1)
+}
+array(2) {
+ [0]=>
+ &int(2)
+ [1]=>
+ &int(2)
+}
+array(2) {
+ [0]=>
+ &int(3)
+ [1]=>
+ &int(3)
+}
+array(2) {
+ [0]=>
+ &int(4)
+ [1]=>
+ &int(4)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl052.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl052.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl052.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl052.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,42 @@
+--TEST--
+Test 52: Perl's cyclic structures support
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$x = $perl->eval(<<<PERL_END
+ \$x = [1];
+ \$x->[1] = \\\$x;
+ return \$x;
+PERL_END
+);
+var_dump($x);
+$x[0] = 2;
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+array(2) {
+ [0]=>
+ int(1)
+ [1]=>
+ array(2) {
+ [0]=>
+ int(1)
+ [1]=>
+ *RECURSION*
+ }
+}
+array(2) {
+ [0]=>
+ int(2)
+ [1]=>
+ array(2) {
+ [0]=>
+ int(2)
+ [1]=>
+ *RECURSION*
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl053.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl053.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl053.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl053.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,61 @@
+--TEST--
+Test 53: PHP's cyclic structures support
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f {
+ \$x = shift(@_);
+ \$x->[0] = 3;
+ return \$x;
+}
+PERL_END
+);
+
+$x = array(1);
+$x[1] =& $x;
+$x[0] = 2;
+var_dump($x);
+$y = $perl->f($x);
+var_dump($y);
+$x[0] = 4;
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+array(2) {
+ [0]=>
+ int(2)
+ [1]=>
+ array(2) {
+ [0]=>
+ int(2)
+ [1]=>
+ *RECURSION*
+ }
+}
+array(2) {
+ [0]=>
+ int(3)
+ [1]=>
+ array(2) {
+ [0]=>
+ int(3)
+ [1]=>
+ *RECURSION*
+ }
+}
+array(2) {
+ [0]=>
+ int(4)
+ [1]=>
+ array(2) {
+ [0]=>
+ int(4)
+ [1]=>
+ *RECURSION*
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl054.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl054.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl054.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl054.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,47 @@
+--TEST--
+Test 54: Perl's cyclic object structures support
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$x = $perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+ \$x = new Foo;
+ \$x->{'foo'} = \$x;
+ return \$x;
+PERL_END
+);
+var_dump($x);
+$x->x = 1;
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ *RECURSION*
+ }
+}
+object(Perl::Foo)#2 (2) {
+ ["x"]=>
+ int(1)
+ ["foo"]=>
+ object(Perl::Foo)#2 (2) {
+ ["x"]=>
+ int(1)
+ ["foo"]=>
+ *RECURSION*
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl055.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl055.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl055.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl055.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,46 @@
+--TEST--
+Test 55: Perl's cyclic object structures support
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$x->foo = $x;
+var_dump($x);
+$x->x = 1;
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ *RECURSION*
+ }
+}
+object(Perl::Foo)#2 (2) {
+ ["x"]=>
+ int(1)
+ ["foo"]=>
+ object(Perl::Foo)#2 (2) {
+ ["x"]=>
+ int(1)
+ ["foo"]=>
+ *RECURSION*
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl056.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl056.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl056.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl056.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,46 @@
+--TEST--
+Test 56: Perl's cyclic object structures support
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+sub f {
+ my \$x = shift(@_);
+ return \$x;
+}
+PERL_END
+);
+$x = new Perl('Foo');
+$x->foo = $x;
+var_dump($x);
+$x = $perl->f($x);
+var_dump($x);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ *RECURSION*
+ }
+}
+object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ object(Perl::Foo)#2 (1) {
+ ["foo"]=>
+ *RECURSION*
+ }
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl057.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl057.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl057.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl057.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,36 @@
+--TEST--
+Test 57: Perl and PHP output buffering
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+function xxx($str) {
+ return "buf[\n".$str."]\n";
+}
+ob_start("xxx");
+
+echo "PHP echo 1\n";
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+format STDOUT =
+Perl's write
+.
+write;
+PERL_END
+);
+echo "PHP echo 2\n";
+$perl->eval("print \"Perl's print\n\";");
+echo "PHP echo 3\n";
+$perl->eval("printf \"Perl's printf\n\";");
+echo "PHP echo 4\n";
+?>
+--EXPECT--
+buf[
+PHP echo 1
+Perl's write
+PHP echo 2
+Perl's print
+PHP echo 3
+Perl's printf
+PHP echo 4
+]
Copied: pecl/perl/tags/perl-1.0.1/tests/perl058.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl058.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl058.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl058.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,32 @@
+--TEST--
+Test 58: Proxy test
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'a1'} = 1;;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$foo = new Perl('Foo');
+$x = & $foo->a1;
+$x = 2;
+var_dump($foo);
+echo "ok\n";
+?>
+--EXPECT--
+object(Perl::Foo)#2 (1) {
+ ["a1"]=>
+ int(2)
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl059.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl059.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl059.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl059.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,28 @@
+--TEST--
+Test 59: Calling perl subroutine in array context
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+sub f {
+ return ("Hello", "World");
+}
+PERL_END
+);
+$a = $perl->f();
+var_dump($a);
+$a = $perl->array->f();
+var_dump($a);
+echo "ok\n";
+?>
+--EXPECT--
+string(5) "World"
+array(2) {
+ [0]=>
+ string(5) "Hello"
+ [1]=>
+ string(5) "World"
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl060.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl060.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl060.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl060.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,46 @@
+--TEST--
+Test 60: Calling perl method in array context
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ bless \$self, \$type;
+ return \$self;
+ }
+
+ sub f {
+ my \$self = shift;
+ if (wantarray) {
+ return ("Hello", "World");
+ } else {
+ return 0;
+ }
+ }
+PERL_END
+);
+$foo = new Perl("Foo");
+$a = $foo->f();
+var_dump($a);
+$a = $foo->array->f();
+var_dump($a);
+$a = $foo->f();
+var_dump($a);
+echo "ok\n";
+?>
+--EXPECT--
+int(0)
+array(2) {
+ [0]=>
+ string(5) "Hello"
+ [1]=>
+ string(5) "World"
+}
+int(0)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl061.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl061.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl061.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl061.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,29 @@
+--TEST--
+Test 61: Modifying object property with += operator
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = {};
+ \$self->{'x'} = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$x->x += 2;
+$x->x += 2;
+var_dump($x->x);
+echo "ok\n";
+?>
+--EXPECT--
+int(4)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl062.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl062.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl062.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl062.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,29 @@
+--TEST--
+Test 62: Modifying object element with += operator
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ \$self->[0] = 0;
+ bless \$self, \$type;
+ return \$self;
+ }
+package main;
+PERL_END
+);
+$x = new Perl('Foo');
+$x[0] += 2;
+$x[0] += 2;
+var_dump($x[0]);
+echo "ok\n";
+?>
+--EXPECT--
+int(4)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl063.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl063.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl063.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl063.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,18 @@
+--TEST--
+Test 63: Modifying scalar Perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->x = 12;
+$perl->x++;
+$perl->x -= 2;
+var_dump($perl->x);
+$perl->eval('print $x,"\n"');
+echo "ok\n";
+?>
+--EXPECT--
+int(11)
+11
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl064.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl064.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl064.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl064.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,32 @@
+--TEST--
+Test 64: Modifying array Perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->array->x = array(1,2,3);
+$perl->eval('print @x,"\n"');
+var_dump(isset($perl->array->x));
+var_dump(empty($perl->array->x));
+var_dump($perl->array->x);
+unset($perl->array->x);
+var_dump(isset($perl->array->x));
+var_dump(empty($perl->array->x));
+echo "ok\n";
+?>
+--EXPECT--
+123
+bool(true)
+bool(false)
+array(3) {
+ [0]=>
+ int(1)
+ [1]=>
+ int(2)
+ [2]=>
+ int(3)
+}
+bool(false)
+bool(true)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl065.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl065.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl065.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl065.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,30 @@
+--TEST--
+Test 65: Modifying hash Perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->hash->x = array("a"=>1,"b"=>2);
+$perl->eval('print %x,"\n"');
+var_dump(isset($perl->hash->x));
+var_dump(empty($perl->hash->x));
+var_dump($perl->hash->x);
+unset($perl->hash->x);
+var_dump(isset($perl->hash->x));
+var_dump(empty($perl->array->x));
+echo "ok\n";
+?>
+--EXPECT--
+a1b2
+bool(true)
+bool(false)
+array(2) {
+ ["a"]=>
+ int(1)
+ ["b"]=>
+ int(2)
+}
+bool(false)
+bool(true)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl066.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl066.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl066.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl066.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,25 @@
+--TEST--
+Test 66: Modifying scalar Perl variables
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->x = 123;
+$perl->eval('print $x,"\n"');
+var_dump(isset($perl->x));
+var_dump(empty($perl->x));
+var_dump($perl->x);
+unset($perl->x);
+var_dump(isset($perl->x));
+var_dump(empty($perl->x));
+echo "ok\n";
+?>
+--EXPECT--
+123
+bool(true)
+bool(false)
+int(123)
+bool(false)
+bool(true)
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl067.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl067.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl067.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl067.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,29 @@
+--TEST--
+Test 67: Eval code in scalar/array/hash context
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+var_dump($perl->eval('("a","b","c")'));
+var_dump($perl->array->eval('("a","b","c")'));
+var_dump($perl->hash->eval('("a","b","c")'));
+echo "ok\n";
+?>
+--EXPECT--
+string(1) "c"
+array(3) {
+ [0]=>
+ string(1) "a"
+ [1]=>
+ string(1) "b"
+ [2]=>
+ string(1) "c"
+}
+array(2) {
+ ["a"]=>
+ string(1) "b"
+ ["c"]=>
+ NULL
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl068.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl068.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl068.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl068.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,30 @@
+--TEST--
+Test 68: Function call in scalar/array/hash context
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval('sub f() {return ("a","b","c");}');
+var_dump($perl->f());
+var_dump($perl->array->f());
+var_dump($perl->hash->f());
+echo "ok\n";
+?>
+--EXPECT--
+string(1) "c"
+array(3) {
+ [0]=>
+ string(1) "a"
+ [1]=>
+ string(1) "b"
+ [2]=>
+ string(1) "c"
+}
+array(2) {
+ ["a"]=>
+ string(1) "b"
+ ["c"]=>
+ NULL
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl069.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl069.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl069.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl069.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,46 @@
+--TEST--
+Test 69: Method call in scalar/array/hash context
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+$perl->eval(<<<PERL_END
+package Foo;
+ sub new {
+ my \$this = shift;
+ my \$type = ref(\$this) || \$this;
+ my \$self = [];
+ bless \$self, \$type;
+ return \$self;
+ }
+ sub f {
+ return ("a","b","c");
+ }
+package main;
+PERL_END
+);
+
+$obj = new Perl("Foo");
+var_dump($obj->f());
+var_dump($obj->array->f());
+var_dump($obj->hash->f());
+echo "ok\n";
+?>
+--EXPECT--
+string(1) "c"
+array(3) {
+ [0]=>
+ string(1) "a"
+ [1]=>
+ string(1) "b"
+ [2]=>
+ string(1) "c"
+}
+array(2) {
+ ["a"]=>
+ string(1) "b"
+ ["c"]=>
+ NULL
+}
+ok
Copied: pecl/perl/tags/perl-1.0.1/tests/perl070.phpt (from rev 329274, \
pecl/perl/trunk/tests/perl070.phpt) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/perl070.phpt (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/perl070.phpt 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,16 @@
+--TEST--
+Test 70: Catching Perl errors
+--SKIPIF--
+<?php require_once('skipif.inc'); ?>
+--FILE--
+<?php
+$perl = new Perl();
+try {
+ var_dump($perl->eval('$a = $s{$d}.'));
+ echo "ok\n";
+} catch (PerlException $exception) {
+ echo "Perl error: " . $exception->getMessage() . "\n";
+}
+?>
+--EXPECTF--
+Perl error: [perl] eval error: syntax error at (eval %d) line %d, at EOF
Copied: pecl/perl/tags/perl-1.0.1/tests/skipif.inc (from rev 329274, \
pecl/perl/trunk/tests/skipif.inc) \
===================================================================
--- pecl/perl/tags/perl-1.0.1/tests/skipif.inc (rev 0)
+++ pecl/perl/tags/perl-1.0.1/tests/skipif.inc 2013-01-23 12:27:27 UTC (rev 329276)
@@ -0,0 +1,3 @@
+<?php
+ if (!extension_loaded('perl')) die('skip perl extension not available');
+?>
--
PECL CVS Mailing List
To unsubscribe, visit: http://www.php.net/unsub.php
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic