view release on metacpan or  search on metacpan

t/Elive/MockConnection.pm  view on Meta::CPAN

package t::Elive::MockConnection;
use warnings; use strict;

=head1 NAME

t::Elive::MockConnection

=head1 DESCRIPTION

A partial emulation of the SOAP connection and database backend.

=cut

use parent 'Elive::Connection::SDK';

use Elive;
use Elive::Entity;
use Elive::Entity::User;
use Elive::Entity::ServerDetails;

use YAML::Syck;

use t::Elive::MockSOM;

__PACKAGE__->mk_accessors( qw{mockdb server_details_id} );

sub connect {
    goto \&_connect;
}

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

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

    $url ||= 'http://elive_mock_connection';
    $url =~ s{/$}{};                    # lose trailing '/'
    $url =~ s{/webservice\.event$}{};   # lose endpoint
    $url =~ s{/v[1-9]$}{};                  # lose adapter path

    if ($url =~ s{^(\w+)://(.*)\@}{$1://}) {  # lose/capture credentials

	my ($_user, $_pass) = split(':', $2, 2);

	$user ||= $_user;
	$pass ||= $_pass if $_pass;
    }

    $self->url($url);

    $self->user($user);
    $self->user('test_user') unless $self->user;

    $self->pass($pass);
    $self->pass('test_pass') unless $self->pass;

    $self->debug($opt{debug})
	if defined $opt{debug};

    $self->mockdb({});

    Elive::Entity::User->insert(
	{loginName => $self->user,
	 loginPassword => $self->pass,
	 role => {roleId => 0},
	},
	connection => $self,
	);

    #
    # Pretend that we can insert a server details record. Just for the
    # purposes of our mockup
    #
    local($self->known_commands->{createServerDetails}) = 'c';

    my $server_details = Elive::Entity::ServerDetails->insert(
	{
	 version => '9.6.0',
	 alive => 1,
	},
	connection => $self,
	);

    $self->server_details_id( $server_details->serverDetailsId );

    return $self;
}

sub call {
    my $self = shift;
    my $cmd = shift;

    my %params = @_;

    my $known_commands = $self->known_commands;
    $self->check_command($cmd);

    my $entities = Elive::Entity->entities;
    my %collections =
	(map {@$_}
	 grep {$_[0]}