Perl PHP Soap

It is stronger than me I do not like the PHP and I like the Perl. It is pure and hard ostracism. However in fact theses languages have the same root. Finally is too easy to be believed that the data-processing languages are like the human ones, more they are near more they are hated.

With words full with innocence, I would say:

• The PHP, especially version 5 it too is of the ball to make Web pages and that done of the object.
• But the Perl it is even more ball, to make other tricks!

Thus I made a dream... A dream where Perl and php cohabits, each one while remaining so that it can do best.

And God invented Soap.

Then, I dreamed of PerlPHPSoap...

1. In Perl you can write a Soap server in 4 lines.
2. In PHP you can do of Soap and can do virtual methods.

Then why not to call an object Perl since PHP?

With a gargage collector which allows of vacuum the unused objects.

#!/usr/bin/perl
 
use SOAP::Transport::HTTP;
use SOAP::Lite;
use lib $ENV{HOME} . '/perl/soap';
 
local $hserver =
my $h = {
	 server => {
#		    addr => 'localhost',
		    port => 8082,
		    modules_path => $ENV{HOME} . '/perl/soap',
		   },
	 childsleep => 10,
	 objttl => 20,
	 objcookies => {},
	 uri => 'http://soap.doudouke.org/',
	};
 
 
$SIG{PIPE} = 'IGNORE';
 
 
sub timer {
  my $self = shift;
#  print "timer: ", scalar localtime(shift), "\n";
#  print "timer call\n";
  for my $cookie (keys %{$h->{objcookies}}) {
    my $obj = $h->{objcookies}->{$cookie};
    if (defined $obj->{lastuse}) {
      if (($obj->{lastuse} + $h->{objttl}) lt time()) {
	print "DESTROY $obj\n";
	$h->{objcookies}->{$cookie} = undef;
	next;
      }
      print "obj $obj timeout => ",
	scalar localtime($obj->{lastuse} + $h->{objttl}), "\n";
    }
  }
  return 1;
}
 
sub daemonexit {
  print "Daemon exit\n";
  exit;
}
 
 
sub childtimer {
  my $sleeptime = shift;
  while (1) {
    sleep($sleeptime);
    my $soaptimer = SOAP::Lite->proxy($h->{proxy})->uri($h->{uri});
#    print "child timer event\n";
    my $timerok = $soaptimer->timer(time())->result;
#    print "timerok: ", $timerok, "\n";
    unless ($timerok) {
      print "timer child exit\n";
      $soaptimer->daemonexit();
      exit;
    }
  }
}
 
$h->{proxy} = "http://localhost:$h->{server}->{port}/";
 
unless (fork()) {
  childtimer($h->{childsleep});
}
 
my $daemon = SOAP::Transport::HTTP::Daemon
  -> new (
	  LocalAddr => $h->{server}->{addr},
	  LocalPort => $h->{server}->{port},
	  Reuse => 1,
	 )
  -> dispatch_to($h->{server}->{modules_path},
		 'timer', 'daemonexit',
		 'PerlPHPSoap',
		 'Test::Echo',
		)
  -> options({compress_threshold => 10000})
;
print "Contact to PerlPHP SOAP server at ", $daemon->url, "\n";
$daemon->handle;

This module manages the cookies objects to find them and dynamically load modules.

package PerlPHPSoap;
use Data::Dumper;
use Digest::MD5 qw(md5_hex);
use lib $ENV{HOME} . '/perl/soap';
use PerlPHPSoap::Test;
 
sub register {
  my $self = shift;
  my $hash = md5_hex($self);
#  print "Register Object: $self $hash\n";
  $::hserver->{objcookies}->{$hash} = $self;
  $self->{lastuse} = time();
  return $hash;
}
 
 
sub register_obj {
  my $self = shift;
  my $obj = shift;
  my $hash = md5_hex($obj);
#  print "Register Object: $obj $hash\n";
  $::hserver->{objcookies}->{$hash} = $obj;
  $self->{lastuse} = time();
  return $hash;
}
 
 
sub updatetimeout {
  my $self = shift;
  $self->{lastuse} = time();
}
 
sub getobjbycookie {
#  print "getobjbycookie: ", join(', ', @_) , "\n";
  my $self = shift;
  my $hash = shift;
#  print "objcookies: ", join (', ', keys %{$::hserver->{objcookies}}) ,"\n";
  $self = $::hserver->{objcookies}->{$hash};
#  print "getobjbycookie: ", (defined $self ? $self : "KO"), "\n";
  return ($::hserver->{objcookies}->{$hash});
}
 
 
sub getcookie {
  my $self = shift;
  return md5_hex($self);
}
 
 
sub unregister {
  my $self = shift;
  my $hash = md5_hex($self);
  if (defined $::hserver->{objcookies}->{$hash}) {
#    print "UnRegister Object: $self $hash\n";
    $::hserver->{objcookies}->{$hash} = undef;
  }
}
 
sub __call {
  my $self = shift;
  my $phpname = shift;
  my $methode = shift;
  my $perlname = $phpname;
  $perlname =~ s/__/::/g;
#  print "Phpname: $phpname\n";
#  print "Perlname: $perlname\n";
#  print "Methode: $methode\n";
#  for $p ($INC[0]) {
#    $filename = $perlname;
#    $filename =~ s/::/\//g;
#    print `ls -l $p/$filename.pm`;
#  }
#  require $perlname;
  eval "require $perlname"; # Dynamic load
  if ($methode eq 'new') {
    my $args = shift;
    my $obj = $perlname->new(@$args);
    my $cookie = $obj->register();
#    print "Obj: $obj => $cookie\n";
    return [$cookie, ref($obj), $obj];
  }
  my $cookie = shift;
  my $args = shift;
  if ($methode eq 'DESTROY') {
    my $obj = $self->getobjbycookie($cookie);
    $obj->unregister();
  }
  my $obj = $self->getobjbycookie($cookie);
#  print "OBJ => $obj\n";
  $obj->updatetimeout();
  return $obj->$methode(@$args);
}
 
sub AUTOLOAD {
  my $self = shift;
  my $name = '';
  my $phpname = shift;
  if ($AUTOLOAD =~ /^.*?::(.*)$/) {
    $name = $1;
  }
  my $perlname = $phpname;
  $perlname =~ s/__/::/g;
  print "Phpname : $phpname\n";
  print "Perlname : $perlname\n";
  print "AUTOLOAD: $AUTOLOAD\n";
  print "name: $name\n";
  return 'Autoload OK';
}
 
 
1;

Allows method’s calls from php Perl‘s objects.

<?
 
require 'SOAP/Client.php';
 
class PerlPHPSoap
{
  private $namespace = 'http://soap.doudouke.org/PerlPHPSoap';
  private $soapclient;
  private $proxy = 'http://soap.doudouke.org:8082';
  private $cookie;
  private $obj;
  private $objref;
 
  function __construct() {
//     print "In constructor Auto\n";
//     printf("Class: %s\n", __class__);
    $this->soapclient = new SOAP_Client($this->proxy);
    $options = array('namespace' => $this->namespace,
		     'trace' => 1);
    $args = func_get_args(); //$args[0] is array of args.
//     print '<br>';
//     print_r($args[0]);
//     print '<br>';
    $param = array($this->className, 
		   'new', $args[0]);
    $ret = $this->soapclient->call('__call',
				   $param,
				   $options);
    $this->cookie = $ret[0];
    $this->objref = $ret[1];
    $this->obj = $ret[2];
  }
 
  function __destruct() {
//     print "Destroying " . $this->name . "\n";
    $this->DESTROY($this->cookie);
  }
 
  private function __call($m, $a) // Like AUTOLOAD in perl
  {
//     print "Method $m called:\n";
//     printf("With class %s\n", __class__);
//     printf("With subclass %s\n", $this->className);
    $options = array('namespace' => $this->namespace,
		     'trace' => 1);
    $ret = $this->soapclient->call('__call',
				   $param = array($this->className, 
						  $m, $this->cookie,
						  $a),
				   $options);
    return $ret;
  }
  function getcookie() {
    return $this->cookie;
  }
}
 
function __autoload($className)
{
       $names = explode('__', $className, 2);
       if(count($names) != 2) return;
       print "Autoload Class $className\n<br>";
       print "Name $names[0]\n<br>";
       eval(
       "class $className extends {$names[0]}
       {
         public \$className = $className;
	 function __construct() {
	  print \"In constructor Auto class\n\";
          printf(\"Class: %s\n\", __CLASS__);
          parent::__construct(func_get_args());
         }
 
       }"
       );
}
 
 
?>

require 'PerlPHPSoap.php';
 
 
$ppp = new PerlPHPSoap__Test(100);
 
echo "<pre>";
echo "Cookie:" . $ppp->getcookie(). "\n";
echo "</pre>";
echo "<br>\n";
 
$ret = $ppp->next();
echo "<pre>";
print_r($ret);
echo "</pre>";
echo "<br>\n";
 
 
 
?>

package PerlPHPSoap::Test;
use vars qw(@ISA $VERSION);
use PerlPHPSoap;
@ISA = qw(PerlPHPSoap);
 
use Data::Dumper;
 
BEGIN {
  print "BEGIN: PerlPHPSoap::Test\n";
  return 1;
}
 
sub new {
  my $self = shift;
  my $class = ref($self) || $self;
  print Dumper(@_);
  my $num = shift;
  print "New Test object num: $num\n";
  my $ret = bless {_num=>$num} => $class;
  return ($ret);
}
 
sub echo {
  my $self = shift;
  print "param: ", join(', ', @_), "\n";
  my $hash = {};
  $hash->{return_val} = 'cool';
  $hash->{param} = [@_];
  return ($hash);
}
 
sub next {
  print "param next: ", join(', ', @_), "\n";
  my $self = shift;
  print "next self: $self\n";
  print "param nest2: ", join(', ', @_), "\n";
  print "Cookie: ", $self->getcookie(), "\n";
  $self->{_num} = $self->{_num} + 1;
  print "Num: ", $self->{_num}, "\n";
  return ($self->{_num});
}
 
sub test_ret {
  print "test_ret param : ", join(', ', @_), "\n";
  my $self = shift;
  my $ret = shift;
  print Dumper($ret);
  return ('Ok');
}
 
sub DESTROY {
  my $self = shift;
  print "Destroy $self\n";
  return;
}
 
1;

Autoload Class PerlPHPSoap__Test
Name PerlPHPSoap
In constructor Auto class Class: PerlPHPSoap__Test

Cookie:45e9931f8ba3f8373d4759320040e549


101

The incrementing was done in Perl.

BEGIN: PerlPHPSoap::Test
$VAR1 = '100';
New Test object num: 100
param next: PerlPHPSoap::Test=HASH(0x86c4988)
next self: PerlPHPSoap::Test=HASH(0x86c4988)
param nest2: 
Cookie: 45e9931f8ba3f8373d4759320040e549
Num: 101
Destroy PerlPHPSoap::Test=HASH(0x86c4988)