[[Perl PHP Soap]]
 
Piste: » Perl PHP Soap
Vous êtes ici: danjer » Publications Techniques de Danjer » Perl PHP Soap
Table des matières

english version

Perl PHP Soap

I had a dream

C’est plus fort que moi j’aime pas le PHP et j’aime le Perl car j’ai la Perl Philosophy. C’est de l’ostracisme pur et dur. Pourtant ce sont des langages qui ont la même racine. Finalement c’est à croire que les langages informatiques sont comme les humains, plus ils sont proche plus ils se détestent.

Avec des mots pleins d’innocence, je dirais :

  • Le PHP, surtout la version 5 c’est trop de la balle pour faire des pages web et ça fait de l’objet.
  • Mais le Perl c’est encore plus de la balle, pour faire d’autres trucs !

Donc j’ai fais un rêve... Un rêve ou le perl et le php cohabite, chacun en restant à ce qu’il sait le mieux faire.

Et Dieu inventa Soap.

Alors, j’ai rêvé de PerlPHPSoap...

PerlPHPSoap

  1. En Perl on peut ecrire un serveur Soap en 4 lignes.
  2. En PHP on peut faire du Soap et faire des methodes virtuelles.

Alors pourquoi ne pas appeler un objet Perl depuis PHP ?

Graph

Le serveur SOAP

Avec un gargage collector qui permet de vide les objets non-utilises 

#!/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;

Perl

Ce module gere les cookies des objets pour les retrouver et charge dynamiquement les modules a utiliser. 

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;

PHP

Permet d’appeler depuis php des objets PERL. 

<?
 
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());
         }
 
       }"
       );
}
 
 
?>

Exemple

PHP

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";
 
 
 
?>

Perl

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;

Sortie

Web

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

Cookie:45e9931f8ba3f8373d4759320040e549


101

L’incrementation c’est faite dans Perl.

Serveur Soap

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)
 
tech/perlphpsoap.txt · Dernière modification: 2006/11/27 23:21
 
Recent changes RSS feed Valid XHTML 1.0 Valid CSS Driven by DokuWiki Powered by Lescampeurs