view release on metacpan or  search on metacpan

lib/AMF/Connection.pm  view on Meta::CPAN

package AMF::Connection;

use AMF::Connection::Message;
use AMF::Connection::MessageBody;
use AMF::Connection::OutputStream;
use AMF::Connection::InputStream;

use LWP::UserAgent;
use HTTP::Cookies;

#use Data::Dumper; #for debug

use Carp;
use strict;

our $VERSION = '0.32';

our $HASMD5 = 0;
{
local $@;
eval { require Digest::MD5; };
$HASMD5 = ($@) ? 0 : 1 ;
};

our $HASUUID;
{
local $@;
eval { require Data::UUID; };
$HASUUID = ($@) ? 0 : 1 ;
}

our $HAS_LWP_PROTOCOL_SOCKS;
{
local $@;
eval { require LWP::Protocol::socks };
$HAS_LWP_PROTOCOL_SOCKS = ($@) ? 0 : 1 ;
}

sub new {
	my ($proto, $endpoint) = @_;
        my $class = ref($proto) || $proto;

	my $self = {
		'endpoint' => $endpoint,
		'headers' => [],
		'http_headers' => {},
		'http_cookie_jar' => new HTTP::Cookies(),
		'response_counter' => 0,
		'encoding' => 0, # default is AMF0 encoding
		'ua'	=> new LWP::UserAgent(),
		'append_to_endpoint' => ''
		};

	$self->{'ua'}->cookie_jar( $self->{'http_cookie_jar'} );

        return bless($self, $class);
	};

# plus add paramters, referer, user agent, authentication/credentials ( see also SecureAMFChannel stuff ), 
# plus timezone on retunred dates to pass to de-serializer - see AMF3 spec saying "it is suggested that time zone be queried independnetly as needed" - unelss local DateTime default to right locale!

# we pass the string, and let Storable::AMF to parse the options into a scalar - see Input/OutputStream and Storable::AMF0 documentation

sub setInputAMFOptions {
	my ($class, $options) = @_;

	$class->{'input_amf_options'} = $options;
	};

sub setOutputAMFOptions {
	my ($class, $options) = @_;

	$class->{'output_amf_options'} = $options;
	};

# useful when input and output options are the same
sub setAMFOptions {
	my ($class, $options) = @_;

	$class->setInputAMFOptions ($options);
	$class->setOutputAMFOptions ($options);
	};

sub getInputAMFOptions {
	my ($class) = @_;

	return $class->{'input_amf_options'};
	};

sub getOutputAMFOptions {
	my ($class) = @_;

	return $class->{'output_amf_options'};
	};

sub setEndpoint {
	my ($class, $endpoint) = @_;

	$class->{'endpoint'} = $endpoint;
	};

sub getEndpoint {
	my ($class) = @_;

	return $class->{'endpoint'};
	};

sub setHTTPProxy {
	my ($class, $proxy) = @_;

	if(	($proxy =~ m!^socks://(.*?):(\d+)!) &&
		(!$HAS_LWP_PROTOCOL_SOCKS) ) {
		croak "LWP::Protocol::socks is required for SOCKS support";
		};

	$class->{'http_proxy'} = $proxy;

	$class->{'ua'}->proxy( [qw(http https)] => $class->{'http_proxy'} );
	};

lib/AMF/Connection.pm  view on Meta::CPAN

sub setUserAgent {
	my ($class, $ua) = @_;

	croak "Not a valid User-Agent $ua"
		unless( ref($ua) and $ua->isa("LWP::UserAgent") and $ua->can("post") );

	# the passed UA might have a different agent and cookie jar settings
	$class->{'ua'} = $ua;

	# make sure we set the proxy if was already set
	# NOTE - we do not re-check SOCKS support due we assume the setHTTPProxy() was called earlier
	$class->{'ua'}->proxy( [qw(http https)] => $class->{'http_proxy'} )
		if( exists $class->{'http_proxy'} and defined $class->{'http_proxy'} );

	# copy/pass over cookies too
	$class->{'ua'}->cookie_jar( $class->{'http_cookie_jar'} );
	};

sub setHTTPCookieJar {
	my ($class, $cookie_jar) = @_;

	croak "Not a valid cookies jar $cookie_jar"
		unless( ref($cookie_jar) and $cookie_jar->isa("HTTP::Cookies") );

	# TODO - copy/pass over the current cookies (in-memory by default) if any set
	$class->{'http_cookie_jar'}->scan( sub { $cookie_jar->set_cookie( @_ ); } );

	$class->{'http_cookie_jar'} = $cookie_jar;

	# tell user agent to use new cookie jar
        $class->{'ua'}->cookie_jar( $class->{'http_cookie_jar'} );
	};

sub getHTTPCookieJar {
        my ($class) = @_;
		
	return $class->{'http_cookie_jar'};
	};

# send "flex.messaging.messages.RemotingMessage"

sub call {
	my ($class, $operation, $arguments, $destination) = @_;

	my @call = $class->callBatch ({ "operation" => $operation,
					"arguments" => $arguments,
					"destination" => $destination });

	return (wantarray) ? @call : $call[0];
	};

sub callBatch {
	my ($class, @batch) = @_;

	my $request = new AMF::Connection::Message;
	$request->setEncoding( $class->{'encoding'} );

	# add AMF any request headers
	map { $request->addHeader( $_ ); } @{ $class->{'headers'} };

	# TODO - prepare HTTP/S request headers based on AMF headers received/set if any - and credentials

	foreach my $call (@batch)
          {
	    next
              unless (defined $call && ref ($call) =~ m/HASH/
		      && defined $call->{'operation'} && defined $call->{'arguments'});

	    my $operation = $call->{'operation'};
	    my $arguments = $call->{'arguments'};

	    my $body = new AMF::Connection::MessageBody;
	    $class->{'response_counter'}++;
	    $body->setResponse( "/".$class->{'response_counter'} );

	    if( $class->{'encoding'} == 3 ) { # AMF3
		$body->setTarget( 'null' );

		my (@operation) = split('\.',$operation);
		my $method = pop @operation;
		my $service = join('.',@operation);
		my $destination = (defined $call->{'destination'}) ? $call->{'destination'} : $service;

		my $remoting_message = $class->_brew_flex_remoting_message( $service, $method, {}, $arguments, $destination);

		$body->setData( [ $remoting_message ] ); # it seems we need array ref here - to be checked
	    } else {
		$body->setTarget( $operation );
		$body->setData( $arguments );
		};

	    $request->addBody( $body );
          }

	my $request_stream = new AMF::Connection::OutputStream($class->{'output_amf_options'});

	# serialize request
	$request->serialize($request_stream);

	#use Data::Dumper;
	#print STDERR Dumper( $request );

	# set any extra HTTP header
	map { $class->{'ua'}->default_header( $_ => $class->{'http_headers'}->{$_} ); } keys %{ $class->{'http_headers'} };

	my $http_response = $class->{'ua'}->post(
		$class->{'endpoint'}.$class->{'append_to_endpoint'}, # TODO - check if append to URL this really work for HTTP POST
		Content_Type => "application/x-amf",
		Content => $request_stream->getStreamData()
		);

	croak "HTTP POST error: ".$http_response->status_line."\n"
		unless($http_response->is_success);

	my $response_stream = new AMF::Connection::InputStream( $http_response->decoded_content, $class->{'input_amf_options'});
	my $response = new AMF::Connection::Message;
	$response->deserialize( $response_stream );

	#print STDERR Dumper( $response )."\n";

	# process AMF response headers