view release on metacpan or  search on metacpan

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

use Elive;
use Elive::Util;

=head1 NAME

Elive::Connection - Manage Elluminate Live SOAP connections.

=head1 DESCRIPTION

This is an abstract class for managing connections and related resources.

Most of the time, you'll be dealing with specific class instances; See L<Elive::Connection::SDK> L<Elive::Connection::API>.

=cut

__PACKAGE__->mk_accessors( qw{_url user pass _soap debug type timeout} );

=head1 METHODS

=cut

=head2 connect

    my $sdk_c1 = Elive::Connection->connect('http://someserver.com/test',
                                        'user1', 'pass1', debug => 1,
    );

    my $url1 = $sdk_c1->url;   #  'http://someserver.com/test'

    my $sdk_c2 =  Elive::Connection->connect('http://user2:pass2@someserver.com/test');
    my $url2 = $sdk_c2->url;   #  'http://someserver.com/test'

Establishes a logical SOAP connection.

=cut

sub connect {
    my ($class, $url, $user, $pass, %opt) = @_;
    #
    # default connection - for backwards compatibility
    #
    require Elive::Connection::SDK;
    return Elive::Connection::SDK->connect($url, $user => $pass, %opt);
}

sub _connect {
    my ($class, $url, $user, $pass, %opt) = @_;

    my $debug = $opt{debug}||0;

    $url =~ s{/$}{}x;

    my $uri_obj = URI->new($url);

    my $userinfo = $uri_obj->userinfo;

    if ($userinfo) {

	#
	# extract and remove any credentials from the url
	#

	my ($uri_user, $uri_pass) = split(':',$userinfo, 2);

	if ($uri_user) {
	    if ($user && $user ne $uri_user) {
		carp 'ignoring user in URI scheme - overridden';
	    }
	    else {
		$user = URI::Escape::uri_unescape($uri_user);
	    }
	}

	if ($uri_pass) {
	    if ($pass && $pass ne $uri_pass) {
		carp 'ignoring pass in URI scheme - overridden';
	    }
	    else {
		$pass = URI::Escape::uri_unescape($uri_pass);
	    }
	}
    }

    my $uri_path = $uri_obj->path;

    $pass = '' unless defined $pass;

    my @path = File::Spec::Unix->splitdir($uri_path);

    shift (@path)
	if (@path && !$path[0]);

    pop (@path)
	if (@path && $path[-1] eq 'webservice.event');

    #
    # normalise the connection url by removing suffixes. The following
    # all reduce to http://mysite/myinst:
    # -- http://mysite/myinst/webservice.event
    # -- http://mysite/myinst/v2
    # -- http://mysite/myinst/v2/webservice.event
    # -- http://mysite/myinst/default
    # -- http://mysite/myinst/default/webservice.event
    #
    # there's some ambiguity, an instance named v1 ... v9 will cause trouble!
    #

    pop(@path)
        if (@path && $path[-1] =~ m{^v(\d+)$});

    $uri_obj->path(File::Spec::Unix->catdir(@path));

    my $soap_url = $uri_obj->as_string;

    #
    # remove any embedded credentials
    #
    $soap_url =~ s{\Q${userinfo}\E\@}{} if $userinfo;

    my $self = {};
    bless $self, $class;

    $self->url($soap_url);
    $self->user($user);
    $self->pass($pass);
    $self->debug($debug);
    $self->timeout($opt{timeout});

    return $self
}

sub _check_for_errors {
    my $class = shift;
    my $som = shift;

    die "No response from server\n"
	unless $som;

    die $som->fault->{ faultstring }."\n" if ($som->fault);

    my $result = $som->result;
    my @paramsout = $som->paramsout;

    warn YAML::Syck::Dump({result => $result, paramsout => \@paramsout})
	if ($class->debug);

    my @results = ($result, @paramsout);

    foreach my $result (@results) {
	next unless Scalar::Util::reftype($result);
    
	#
	# Look for Elluminate-specific errors
	#
	if ($result->{Code}
	    && (my $code = $result->{Code}{Value})) {

	    #
	    # Elluminate error!
	    #
	
	    my $reason = $result->{Reason}{Text};
	    my @stack_trace;

	    my $stack = $result->{Detail}{Stack};

	    if ($stack && (my $trace = $stack->{Trace})) {
		@stack_trace = (Elive::Util::_reftype($trace) eq 'ARRAY'
			       ? @$trace
			       : $trace);

	    }

	    my %seen;

	    my @error = grep {$_ && !$seen{$_}++} ($code, $reason, @stack_trace);