—package
Jabber::JAX::Component;
use
strict;
# Ensure that the build directory exists
BEGIN { `
mkdir
/tmp/_Inline`
if
! -d
'/tmp/_Inline'
}
$VERSION
=
'0.02'
;
use
Jabber::JAX::Packet;
# Inline config for the build of the C++ components
# requires libjax, libjudo, and libbedrock from the JECLs
# force my header files to come first because they clash
# badly with perls
'AUTO_INCLUDE'
=> [
undef
,
'#include <unistd.h>'
,
'#include <gen_component.h>'
,
' extern "C" {'
,
'#include "EXTERN.h"'
,
'#include "perl.h"'
,
'#include "XSUB.h"'
,
'#include "INLINE.h"'
,
' }'
],
'CC'
=>
'g++3'
,
'LD'
=>
'g++3'
,
'DIRECTORY'
=>
'/tmp/_Inline'
,
'INC'
=>
'-I/usr/local/jax/include '
.
'-I/usr/local/include -I'
.abs_path(
'..'
).
' '
.
' -I'
.abs_path(
'.'
),
'LIBS'
=>
'-L/usr/local/jax/lib -lbedrock -ljudo -ljax '
.
'-lresolv -lnsl -lpthread -lresolv '
.
'-lnsl -lpthread'
,
'CCFLAGS'
=>
'-DHAVE_CONFIG_H -D_REENTRANT '
.
'-D_POSIX_PTHREAD_SEMANTICS -D__USE_MALLOC'
,
;
# Config for Inline::MakeMaker
#use Inline C=> 'DATA',
# NAME => 'Jabber::JAX::Component',
# VERSION => '0.02';
=head1 NAME
Jabber::JAX::Component - Perl wrapper for the Jabber JECL Library creates the Jabber Compoent Connection Object
=head1 SYNOPSIS
use Jabber::JAX::Component;
my $c = new Jabber::JAX::Component(
component => "echocomp",
secret => "mysecret",
host => "localhost",
port => "7000",
handler =>
sub {
my ( $rc, $p ) = @_;
my $e = $p->getElement();
my $to = $e->getAttrib('to');
$e->putAttrib('to', $e->getAttrib('from'));
$e->putAttrib('from', $to);
$rc->deliver( $p );
}
);
$c->start();
=head1 DESCRIPTION
Jabber::JAX::Component is yet another perl implementation for writing
Jabber components. How it differs is that it is a wrapper for the
high performance JECL libraries for writing components in C++.
Jabber::JAX::Component is the complement for the jax::RouterConnection C++ object
( see the jax.h header file for a description ). It creates a basic connection object for a component to a jaber server with a thread pool ( currently 10 ), and provides the framework for embedding a perl callback subroutine to handle each incoming packet. See the gen_component.h header file for more details.
To run this you should use perl 5.6.x ( the standard one supplied with RH 7.1 works ) - what ever one you use it MUST NOT be compiled with threads ( no -Dusethread -Duseithreads ) - check perl -V, and you need to get the JECL libraries from http://jabber.tigris.org ( check them out of CVS instead of downloading the tgz files ). The only catch with the libraries are the dependencies ( explained within the library README doco ) - this requires the g++ >= 3.0.x. At the time of writting this can be obtained from http://www.redhat.com in the RH 7.2 beta download section ( yay - GO RedHat ! ).
=head1 PROGRAMMING
Further to the SYNOPSIS above - the basic structure for programming with these perl packages is as follows:
The Jabber::JAX::Component object takes a subroutine reference for the parameter 'handler'. This subroutine is then called on receipt of every packet by the Jabber component, and passed two arguements ( well three really - but the last - the stringified xml is temporary until the judo::Element object is finalised ).
The First argument is $rc - a reference to the RouterConnection ( Jabber::JAX::Component ). It has only two methods that you should use and that is deliver, which is passed a Jabber::JAX::Packet object, for delivery, and stop which will shutdown the component.
The second argument is $p a reference to the current inbound packet ( Jabber::JAX::Packet ). Use the $p->getElement() method to return a Jabber::Judo::Element object for easy manipulation of the XML packet.
Don't forget to create the corresponding entry int the jabber.xml config file such as:
<service id='echocomp'>
<accept>
<ip/>
<port>7000</port>
<secret>mysecret</secret>
</accept>
</service>
=head1 VERSION
very new
=head1 AUTHOR
Piers Harding - but DizzyD ( author of JECL ) is the real star
=head1 SEE ALSO
Jabber::JAX::Packet, Jabber::JAX::Component, Jabber::JAX::Client, Jabber::Judo::Element
=cut
# Create a component profile
# passing in all the connection information
# and the name of the callback routine for handling the packet
sub
new {
my
$proto
=
shift
;
my
$class
=
ref
(
$proto
) ||
$proto
;
my
$self
= {
component
=>
"echocomp"
,
secret
=>
"secret"
,
host
=>
"localhost"
,
port
=>
"7000"
,
@_
};
if
(
exists
$self
->{server}){
if
(
$self
->{server} =~ /:/ ){
(
$self
->{host},
$self
->{port} ) =
split
( /:/,
$self
->{server});
}
else
{
$self
->{host} =
$self
->{server};
$self
->{port} =
'7000'
;
# ? not sure what this should be
}
}
die
"must supply 'component' parameter to Jabber::JAX::Component"
unless
exists
$self
->{component};
die
"must supply 'secret' parameter to Jabber::JAX::Component"
unless
exists
$self
->{secret};
die
"must supply 'host' or 'server' parameter"
.
" to Jabber::JAX::Component"
unless
exists
$self
->{host};
die
"must supply 'port' or 'server' parameter"
.
" to Jabber::JAX::Component"
unless
exists
$self
->{port};
die
"must supply 'handler' parameter to Jabber::JAX::Component"
unless
exists
$self
->{handler};
# create the object and return it
bless
(
$self
,
$class
);
return
$self
;
}
# This calls into the JECL libraries - sets up the component
# to run and never returns
sub
start {
my
$self
=
shift
;
# we never come back from here
runComponent(
$self
->{component},
$self
->{secret},
$self
->{host},
$self
->{port},
"Jabber::JAX::Component::ComponentHandler"
,
$self
);
}
# Wrapper for the callback subroutine that the user passes
sub
ComponentHandler {
my
$self
=
shift
;
my
$router
=
shift
;
my
$packet
=
shift
;
my
$xml
=
shift
;
# create a Router object to pass for access to the
# deliver function
my
$class
=
'Jabber::JAX::Component'
;
my
$rc
= {
'ROUTER'
=>
$router
};
bless
(
$rc
,
$class
);
# create a Packet object to give access to the
# incoming xml packet
my
$class
=
'Jabber::JAX::Packet'
;
my
$p
= {
'PACKET'
=>
$packet
};
bless
(
$p
,
$class
);
# Call the subroutine reference passing
# the Router, Packet and the stringified XML ( not really necessary )
my
@result
= &{
$self
->{handler}}(
$rc
,
$p
,
$xml
);
return
@result
;
}
sub
getElement {
my
$self
=
shift
;
my
$class
=
'Jabber::Judo::Element'
;
my
$e
= {
ELEMENT
=> get_element(
$self
->{PACKET} )
};
die
"Could not create a Element object "
unless
$e
->{ELEMENT};
bless
(
$e
,
$class
);
return
$e
;
}
sub
toString {
my
$self
=
shift
;
return
to_string(
$self
->{PACKET} );
}
sub
deliver {
my
$self
=
shift
;
my
$packet
=
shift
->_packet();
return
punt(
$self
->{ROUTER},
$packet
);
}
sub
stop {
my
$self
=
shift
;
return
component_stop(
$self
->{ROUTER} );
}
1;
__DATA__
__CPP__
using namespace std;
// Constructor
GenComponentController::GenComponentController(const std::string& serviceid,
const std::string& password,
const std::string& hostname,
unsigned int port, bool outgoing_dir,
const std::string& perl_func,
void* my_self)
: _id(serviceid), _password(password), _hostname(hostname),
_port(port), _tpool(1), _watcher(_tpool, 10),
_router(_watcher, *this, outgoing_dir, 0),
_perl_func(perl_func),
_my_self(my_self)
{
// Create an address struct, passing the hostname we want to
// connect to, a standard SRV identifier, and a default port
// to use (in case the SRV lookup doesn't get us a port)
bedrock::net::Address addr(_hostname, "_jabber._tcp", _port);
// Start the router connection
_router.connect(_id, _password, addr);
}
// Router event callbacks
void GenComponentController::onRouterConnected()
{
cerr << "[jax::RouterConnection] Router is now connected." << endl;
}
void GenComponentController::onRouterDisconnected()
{
cerr << "[jax::RouterConnection] Router is now disconnected." << endl;
bedrock::Application::stop(1, "Router connection lost");
//bedrock::Application::exit(1, "Router connection lost - exiting");
}
void GenComponentController::onRouterError()
{
cerr << "[jax::RouterConnection] Router error occurred." << endl;
_router.disconnect();
}
void GenComponentController::onRouterPacket(jax::Packet* packet)
{
// Generic packet handler
// Call registered perl subroutine
// Test for a deliver/follow on action and return
int result;
SV* res;
std::string xml;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
// pointer to the calling object instance
XPUSHs((SV*)_my_self);
// Pointer to the router instance to be plugged into
// an object for calling use
SV* obj_ref = newSViv(0);
SV* obj = newSVrv(obj_ref, NULL);
sv_setiv(obj, (IV) ((MyRouterConnection*)&_router));
SvREADONLY_on(obj);
XPUSHs((SV*)obj_ref);
// Pointer to the current incoming packet
SV* packet_ref = newSViv(0);
SV* packet_obj = newSVrv(packet_ref, NULL);
sv_setiv(packet_obj, (IV) packet);
SvREADONLY_on(packet_obj);
XPUSHs((SV*)packet_ref);
// scalar of the XML to string
xml = packet->toString();
XPUSHs(sv_2mortal(newSVpv( xml.data(),
xml.length() )));
PUTBACK;
result = perl_call_pv(_perl_func.data(), G_ARRAY | G_EVAL );
if(SvTRUE(ERRSV)) fprintf(stderr, "perl call errored: %s", SvPV(ERRSV,PL_na));
SPAGAIN;
if ( result > 0 ){
res = POPs;
};
PUTBACK;
FREETMPS;
pop_scope(); // is the part of LEAVE that we want
}
int runComponent(char* cid,
char* sec,
char* host,
int prt,
char* pfunc,
SV* myself)
{
string component_id = cid;
string secret = sec;
bool outgoing = true;
string jabberd_ip = host;
unsigned int jabberd_port = prt;
string perl_func = pfunc;
void* my_self = myself;
int retval;
cerr << "[jax::RouterConnection] Starting component..." <<endl;
cerr << "\tComponent ID : " << component_id <<endl;
cerr << "\tJabberd IP : " << jabberd_ip << endl;
cerr << "\tJabberd Port : " << jabberd_port << endl << endl;
GenComponentController genComp(component_id,
secret,
jabberd_ip,
jabberd_port,
outgoing,
perl_func,
my_self);
bedrock::Application::start();
}
SV* to_string(SV* obj) {
std::string s = ((Packet*) SvIV(SvRV(obj)))->toString();
return newSVpv( s.data(), s.length() );
}
SV* punt(SV* obj, SV* pkt) {
((MyRouterConnection*) SvIV(SvRV(obj)))->deliver( ((Packet*) SvIV(SvRV(pkt))) );
return newSViv(1);
}
SV* component_stop(SV* obj) {
// stop it!
((MyRouterConnection*) SvIV(SvRV(obj)))->disconnect();
return newSViv(1);
}