package PunJab::Server::XMLRPC;use strict;use warnings;use POE;use POE::Filter::XML;use POE::Filter::XML::Node;use POE::Filter::XML::NS qw/ :JABBER :IQ /;use POE::Filter::XML::Utils;use XMLRPC::Lite;use PunJab::Util;use PunJab::Session;use PunJab::Server::HTTP;use POSIX qw(strftime);use Digest::MD5 qw(md5 md5_hex md5_base64);use Data::Uniqid qw ( suniqid uniqid luniqid );my %public_interfaces; # xmlrpc code adapted from POE::Component::Server::XMLRPCsub new {    shift;    my $config = shift;    my $alias  = shift;    $alias = "xmlrpc" if not defined $alias;    #$config->{'type'} = "xmlrpc_client";    PunJab::Server::HTTP->new($config,\&handler,undef,undef,'xmlrpc_web_server');        POE::Session->create	( inline_states =>	  { _start => sub {	      my $kernel = $_[KERNEL];	      if ($config->{debug}>0) {		  &debug("XMLRPC Server Session Started\n");   	      }	      $kernel->alias_set($alias);	  },	  publish => sub {	      my ($alias, $event) = @_[ARG0, ARG1];	      $public_interfaces{$alias}{$event} = 1;	  },	  rescind => sub {	      my ($alias, $event) = @_[ARG0, ARG1];	      delete $public_interfaces{$alias}{$event};	  },	         # send_xmlrpc    => \&send_xmlrpc,	},	  heap => { CONFIG => $config },	  options => { debug => $config->{'debug'}, trace => $config->{'debug'} }	  );        return undef;}### Handlers for the xmlrpc server. sub shutdown_service {    $_[KERNEL]->yield("shutdown");}sub handler(){    # taken and modified from POE::Component::XMLRPC::Server    my ($kernel,$sender, $heap,$request) = @_[KERNEL,SENDER, HEAP, ARG0];        if($request->isa('HTTP::Response'))     {	 	 _request_failed( $request,			  403,			  "Bad Request",			  "This was a response?",			  $sender,	       			  );	 	 return;     }    my $response = HTTP::Response->new();    $heap->{'stream_count'} = 0;    # Parse useful things from the request.        my $query_string = $request->uri->query();    unless (defined($query_string) and $query_string =~ /\bsession=(.+ $ )/x) {	_request_failed( $response,			 404,			 "Bad Session Request",			 "Session does not exist.",			 $sender,			 );	return;    }    my $session = $1;    my ($data,$method_name,$args);    my $http_method            = $request->method();    my $request_content_type   = $request->header('Content-Type');    my $request_content_length = $request->header('Content-Length');    my $debug_request          = $request->header('DebugRequest');    my $request_content        = $request->content();    eval {	$data                   = XMLRPC::Deserializer	    ->deserialize($request_content);    };                if (defined($data)) {	$method_name            = $data->valueof("methodName");	$args                   = $data->valueof("params");    }    unless ($request_content_type =~ /^text\/xml(;.*)?$/) {	_request_failed( $response,			 404,			 "Bad Content-Type Request",			 "Content-Type must be text/xml.",			 $sender,			 );		return;    }        unless (defined($method_name) and length($method_name)) {	_request_failed( $response,			 404,			 "Bad methodName Request",			 "methodName is required.",			 $sender,			 );	return;    }        unless ($method_name =~ /^(\S+)$/) {	_request_failed( $response,			 403,			 "Bad Request",			 "Unrecognized methodName: $method_name",			 $sender,			 );	return;    }    unless (exists $public_interfaces{$session}) {	_request_failed( $response,			 500,			 "Bad Request",			 "Unknown session: $session",			 $sender,			 );	return;  }        unless (exists $public_interfaces{$session}{$method_name}) {	# put xmlrpc routing code here. 	_request_failed( $response,			 500,			 "Bad Request",			 "Unknown method: $method_name",			 $sender,                   );	return;    }        eval {	XMLRPCTransaction->start($sender,				 $request,				 $response,				 $session, 				 $method_name,				 $args,				 );    };        if ($@) {	_request_failed( $response,			 500,			 "Application Faulted",			 "An exception fired while processing the request: $@",			 $sender,						 );	    }    return;}#sub send_xmlrpc {#    my ($kernel,$session,$heap,$ret_val,$xmlrpc_trans) = #	@_[KERNEL, SESSION, HEAP, ARG0, ARG1];  #    $xmlrpc_trans->return($ret_val);#}sub _request_failed {  my ($response, $fault_code, $fault_string, $result_description,$sender,$csid) = @_;  my $response_content = qq{<?xml version="1.0"?><methodResponse><fault><value><struct><member><name>faultCode</name><value><int>$fault_code</int></value></member><member><name>faultString</name><value><string>$fault_string</string></value></member></struct></value></fault></methodResponse>};  $response->code(200);  $response->header("Content-Type", "text/xml");  $response->header("Content-Length", length($response_content));  $response->content($response_content);  my $pb = $sender->postback( 'send_response', $response);  $pb->($response); # is there another way to do this?}package XMLRPCTransaction;sub TR_REQUEST  () { 0 }sub TR_RESPONSE () { 1 }sub TR_SESSION  () { 2 }sub TR_EVENT    () { 3 }sub TR_ARGS     () { 4 }sub TR_CLIENT   () { 5 }sub start(){  my ($type, $sender, $request, $response, $session,$event, $args, $csid) = @_;    my $self = bless    [ $request,      $response,      $session,      $event,      $args,      $sender->postback( 'send_response', $response),    ], $type;  $POE::Kernel::poe_kernel->post($session, $event, $self);  undef;}sub request {    my $self = shift;    return $self->[TR_REQUEST];}sub params(){  my $self = shift;  return $self->[TR_ARGS];}sub return(){    my $self = shift;        my $content;    eval {	$content = XMLRPC::Serializer->envelope(response => 'toMethod', @_);    };    if ($@) {	$content = XMLRPC::Serializer->envelope(response => 'toMethod', $@);    }    my $response = $self->[TR_RESPONSE];    $response->code(200);    $response->header("Content-Type", "text/xml");    $response->header("Content-Length", length($content));    $response->content($content);       $self->[TR_CLIENT]->($response);    return;}sub error {    my $self = shift;    my $content;    eval {	$content = XMLRPC::Serializer->envelope(response => 'fault', @_);    };    if ($@) {	$content = XMLRPC::Serializer->envelope(response => 'fault', $@);    }    my $response = $self->[TR_RESPONSE];     $response->code(200);    $response->header("Content-Type", "text/xml");    $response->header("Content-Length", length($content));    $response->content($content);    $self->[TR_CLIENT]->($response);    return;}sub auth {    my $self = shift;        my $content = qq{<?xml version="1.0"?><methodResponse><fault><value><struct><member><name>faultCode</name><value><int>403</int></value></member><member><name>faultString</name><value><string>@_</string></value></member></struct></value></fault></methodResponse>};    my $response = $self->[TR_RESPONSE];     $response->code(200);    $response->header("Content-Type", "text/xml");    $response->header("Content-Length", length($content));    $response->content($content);    $self->[TR_CLIENT]->($response);    return;}1;__END__