Jamila - Perl extension for JSON Approach to Make Integration Linking Applications

Jamila documentation Contained in the Jamila distribution.

Index

Code Index:

NAME

Top

Jamila - Perl extension for JSON Approach to Make Integration Linking Applications

SYNOPSIS

Top

 1. Receive Mode:
 1.1 Perl sample(testJamila.pl)
  #!/usr/bin/perl
  use strict;
  package Smp;
  sub echo($$)
  {
    my($sClass, $sPrm) = @_;
    return "Welcome to Jamila! ( $sPrm )";
  }
  package main;
  use Jamila;
  Jamila->proc('Smp');

 1.2 Call from JavaScript
  var oJmR  = new Jamila(
                       '/cgi-bin/jamila/testJamila.pl',
                       null, null,
                       function(sMsg) { alert("ERROR:" + sMsg);});
 alert(oJmR.call('echo', 'Call FROM JavaScript' ));

 var oLocal = {
    echo: function (sPrm) { return "LOCAL CALL:" + sPrm;},
 };
 var oJmL  = new Jamila(oLocal,
                       null, null,
                       function(sMsg) { alert("ERROR:" + sMsg);});
 alert(oJmL.call('echo', 'Call FROM JavaScript(LOCAL)' ));

 2. Call Mode:
  use strict;
  package SmpLocal;
  sub echo($$)
  {
    my($sClass, $sPrm) = @_;
    return "LOCAL: Welcome to Jamila! ( $sPrm )";
  }

  package main;
  use Jamila;
  use Data::Dumper;
  #(1) Call Remote
  my $oJm = Jamila->new(
    'http://hippo2000.atnifty.com/cgi-bin/jamila/testJamila.pl');
  print $oJm->call('echo', 'Test for Remote') . "\n";

  #(2) Call Local
  my $oJmL = Jamila->new(bless {}, 'SmpLocal');
  print $oJmL->call('echo', 'How is local?') . "\n";

DESCRIPTION

Top

Jamila is yet another RPC using JSON and HTTP(CGI). Jamila stands for JSON Approach to Make Integration Linking Applications.

Jamila has 2 modes; recieve and call.

proc

 Jamila->proc(I<$sModule>);

In receive mode, this is the only method to call. When this method is called, Jamila will get parameters from CGI parameters. And it will call the function specified in a parameter.

new

 I<$oJml> = Jamila->new(I<$sUrl>);

Constructor for call mode. You can set $sUrl as a URL or a local object.

call

 I<$oJml>->call(I<$sUrl>);

If you set a URL in "new" method, "call" will POST to that URL. If you set a local object in "new" method, "call" will perform a function of the specified object.

SEE ALSO

Top

This distribution has sample HTML + JavaScript and perl script.

- 1. Put jamila.html and Jamila.js into a htdocs/jamila directory. - 2. Put testJamila.pl into a cgi-bin/jamila directory. And set to run that script. - 3. Run perl function from jamila.html

AUTHOR

Top

KAWAI,Takanori <kwitknr@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2009 by KAWAI,Takanori

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available.

Jamila documentation Contained in the Jamila distribution. 
package Jamila;
use strict;
use warnings;
use utf8;
use CGI;
use JSON;
use LWP;
our $oCgi;
our $VERSION = '0.03';

#--------------------------------------------------------------------
# _disp: display about processing class
#--------------------------------------------------------------------
sub _disp($$$)
{
  my ($sClass, $sUrl, $sMod) = @_;
  binmode STDOUT, ':utf8';
  print "Content-Type: text/html\n\n";
  print<<EOD;
<HTML>
<HEAD>
<TITLE>$sClass ($sMod) </TITLE>
</HEAD>
<BODY>
<H1>This is $sClass !</H1>
for : $sMod at $sUrl
</BODY>
</HTML>
EOD
}
#--------------------------------------------------------------------
# proc
#--------------------------------------------------------------------
sub proc($$)
{
  my($sClass, $sMod) = @_;
  $oCgi = new CGI();
  my $sPrm = $oCgi->param('_prm');
  #1. No '_prm' means default display
  return $sClass->_disp($oCgi->url(), $sMod) if(!defined($sPrm) || $sPrm eq '');

  #2. _RAW_
  utf8::decode($sPrm); #become with utf8-flag
  my $oRes = '';
  my $sMsg = '';

  if($sPrm eq '_RAW_')
  {
    my $sMethod = '_raw_' . ($oCgi->param('_method') || '');
    eval
    {
      $oRes = $sMod->$sMethod($oCgi);
    };
    return unless($@);
    $sMsg = $@;
  }
  else
  {
    if($sPrm)
    {
      my $raData = from_json($sPrm);
      my ($sMethod, @aPrm) = @$raData;
      if(substr($sMethod, 0, 1) ne '_')
      {
        eval
        {
          $oRes = $sMod->$sMethod(@aPrm);
        };
        if($@)
        {
          eval
          {
            eval "require $sMod; import $sMod;";
            $oRes = $sMod->$sMethod(@aPrm);
          };
          if($@)
          {
            $sMsg = $@;
            $oRes = '';
          }
        }
      }
      else
      {
        $sMsg = "Jamila:: can't call $sMethod";
      }
    }
    else
    {
      $sMsg = 'Jamila:: NO PARAM';
    }
  }
  binmode STDOUT, ':utf8';
  print "Content-Type: text/plain; charset=UTF-8\n\n" . 
      to_json({
                error  => $sMsg,
                result => $oRes,
              });
}
#---------------------------------------------------------------------
# new : mainly for request
#---------------------------------------------------------------------
sub new($$)
{
  my($sClass, $sUrl) = @_;
  my $oUa = LWP::UserAgent->new();
  $oUa->env_proxy();
  return
    bless {
      URL => $sUrl,
      _lwpUa => $oUa,
      }, $sClass;
}
#---------------------------------------------------------------------
# _buildParam : for request
#---------------------------------------------------------------------
sub _buildParam($%)
{
    my($oSelf, %hParam) = @_;
    my $sPrm = '';
    if(%hParam)
    {
        while(my($sKey, $sVal) = each(%hParam))
        {
            $sPrm .= '&' if($sPrm ne '');
            $sVal = ($sVal)? URI::Escape::uri_escape_utf8($sVal) : '';
            $sPrm .= "$sKey=$sVal";
        }
    }
    return $sPrm;
}
#---------------------------------------------------------------------
# call : 
#---------------------------------------------------------------------
sub call($@)
{
  my($oSelf, @aPrm) = @_;
  if(ref($oSelf->{URL}) ne '')
  {
    my $sFunc = shift(@aPrm);
    return $oSelf->{URL}->$sFunc(@aPrm);
  }
  else
  {
    my %hPrm;
    if(@aPrm)
    {
      $hPrm{_prm} = to_json(\@aPrm);
    }
    my $sPrm = $oSelf->_buildParam(%hPrm);
    my $oReq = new HTTP::Request('POST', $oSelf->{URL});
    $oReq->header('Content-Type',  
          'application/x-www-form-urlencoded; charset=UTF-8');
    $oReq->header('Accept-Charset',  'UTF-8');
    $oReq->add_content($sPrm . "\x0d\x0a");
    my $oRes = $oSelf->{_lwpUa}->request($oReq);
    if ($oRes->is_success)
    {
        my $rhRes = from_json($oRes->content);
        die($rhRes->{error}) if($rhRes->{error});
        return $rhRes->{result};
    }
    else
    {
        die($oRes->as_string);
    }
  }
}
1;
__END__