view release on metacpan or  search on metacpan

lib/WSRF/Lite.pm  view on Meta::CPAN

			foreach ( $command eq 'autodispatch' ? 'UNIVERSAL' : @parameters ) {
				my $sub = "${_}::AUTOLOAD";
				defined &{*$sub}
				  ? ( \&{*$sub} eq \&{*SOAP::AUTOLOAD}
					? ()
					: Carp::croak
					  "$sub already assigned and won't work with DISPATCH. Died"
				  )
				  : ( *$sub = *SOAP::AUTOLOAD );
			}
		} elsif ( $command eq 'service' ) {
			foreach (
					  keys %{ SOAP::Schema->schema_url( shift(@parameters) )
							->parse(@parameters)->load->services
					  }
			  )
			{
				$_->export_to_level( 1, undef, ':all' );
			}
		} elsif ( $command eq 'debug' || $command eq 'trace' ) {
			SOAP::Trace->import( @parameters ? @parameters : 'all' );
		} elsif ( $command eq 'import' ) {
			local $^W;    # supress warnings about redefining
			my $package = shift(@parameters);
			$package->export_to_level( 1, undef,
									   @parameters ? @parameters : ':all' )
			  if $package;
		} else {
			Carp::carp
			  "Odd (wrong?) number of parameters in import(), still continue"
			  if $^W && !( @parameters & 1 );
			$soap = ( $soap || $pkg )->$command(@parameters);
		}
	}
}

sub DESTROY { SOAP::Trace::objects('()') }

sub new {
	my $self = shift;
	return $self if ref $self;
	unless ( ref $self ) {
		my $class = ref($self) || $self;

	   # Check whether we can clone. Only the SAME class allowed, no inheritance
		$self = ref($soap) eq $class ? $soap->clone : {
			_transport    => SOAP::Transport->new,
			_serializer   => WSRF::WSRFSerializer->new,
			_deserializer => WSRF::Deserializer->new,
			_packager     => SOAP::Packager::MIME->new,
			_schema       => undef,
			_wsaddress    => undef,
			_autoresult   => 0,
			_on_action    => sub { sprintf '"%s#%s"', shift || '', shift },
			_on_fault => sub {
				ref $_[1]                                    ? return $_[1]
				  : Carp::croak $_[0]->transport->is_success ? $_[1]
				  : $_[0]->transport->status;
			},
		};
		bless $self => $class;
		$self->on_nonserialized(    $self->on_nonserialized
								 || $self->serializer->on_nonserialized );
		SOAP::Trace::objects('()');
	}

	Carp::carp "Odd (wrong?) number of parameters in new()"
	  if $^W && ( @_ & 1 );
	while (@_) {
		my ( $method, $params ) = splice( @_, 0, 2 );
		$self->can($method)
		  ? $self->$method( ref $params eq 'ARRAY' ? @$params : $params )
		  : $^W && Carp::carp "Unrecognized parameter '$method' in new()";
	}

	return $self;
}

sub init_context {
	my $self = shift->new;
	$self->{'_deserializer'}->{'_context'} = $self;
	$self->{'_serializer'}->{'_context'}   = $self;
}

sub destroy_context {
	my $self = shift;
	delete( $self->{'_deserializer'}->{'_context'} );
	delete( $self->{'_serializer'}->{'_context'} );
}

# Naming? wsdl_parser
sub schema {
	my $self = shift;
	if (@_) {
		$self->{'_schema'} = shift;
		return $self;
	} else {
		if ( !defined $self->{'_schema'} ) {
			$self->{'_schema'} = SOAP::Schema->new;
		}
		return $self->{'_schema'};
	}
}

sub BEGIN {
	no strict 'refs';
	for my $method (qw(serializer deserializer)) {
		my $field = '_' . $method;
		*$method = sub {
			my $self = shift->new;
			if (@_) {
				my $context =
				  $self->{$field}->{'_context'};    # save the old context
				$self->{$field} = shift;
				$self->{$field}->{'_context'} =
				  $context;                         # restore the old context
				return $self;
			} else {
				return $self->{$field};
			}
		  }