view release on metacpan or  search on metacpan

lib/Astro/SIMBAD/Client/WSQueryInterfaceService.pm  view on Meta::CPAN

  ## TRW vvvv
  ## my ($self, $method) = (shift, shift);
  my ($self, $method, $simbad, @parm) = @_;
  $simbad or Carp::croak 'Astro::SIMBAD::Client object not specified';
  ## my $name = UNIVERSAL::isa($method => 'SOAP::Data') ? $method->name : $method;
  my $name = eval {$method->isa('SOAP::Data')} ? $method->name : $method;
  ## TRW ^^^^
  my %method = %{$methods{$name}};
  ## TRW vvvv
  $method{endpoint} or Carp::croak "No server address (proxy) specified";
  my $endpoint = $simbad->__build_url( $method{endpoint} );
  ## $self->proxy($method{endpoint} || Carp::croak "No server address (proxy) specified") 
  $self->proxy( $endpoint )
    unless $self->proxy;
  ## TRW ^^^^
  my @templates = @{$method{parameters}};
  my @parameters = ();
## TRW  foreach my $param (@_) {
  foreach my $param (@parm) {	## TRW
    if (@templates) {
      my $template = shift @templates;
## TRW      my ($prefix,$typename) = SOAP::Utils::splitqname($template->type);
      my (undef,$typename) = SOAP::Utils::splitqname($template->type); ## TRW
      my $method = 'as_'.$typename;
      # TODO - if can('as_'.$typename) {...}
      my $result = $self->serializer->$method($param, $template->name, $template->type, $template->attr);
      push(@parameters, $template->value($result->[2]));
    } else {
      push(@parameters, $param);
    }
  }

## TRW  $self->endpoint($method{endpoint})
## TRW       ->ns($method{namespace})
## TRW      ->on_action(sub{qq!"$method{soapaction}"!});

## vvv TRW

if ($self->can ('ns')) {
    $self->endpoint($endpoint)
	->ns($method{namespace})
	->on_action (sub{$method{soapaction}});
} else {
    $self->endpoint($endpoint)
	->envprefix ('soap')
	->uri($method{namespace})
	->on_action (sub{$method{soapaction}});
}

## ^^^ TRW

if ($self->serializer->can ('register_ns')) {	## TRW
$self->serializer->register_ns("http://schemas.xmlsoap.org/wsdl/soap/","wsdlsoap");
  $self->serializer->register_ns("http://schemas.xmlsoap.org/wsdl/","wsdl");
  $self->serializer->register_ns("http://uif.simbad.cds","intf");
  $self->serializer->register_ns("http://uif.simbad.cds","impl");
  $self->serializer->register_ns("http://schemas.xmlsoap.org/soap/encoding/","soapenc");
  $self->serializer->register_ns("http://xml.apache.org/xml-soap","apachesoap");
  $self->serializer->register_ns("http://www.w3.org/2001/XMLSchema","xsd");
}	## TRW
  my $som = $self->SUPER::call($method => @parameters); 
  if ($self->want_som) {
      return $som;
  }
  ## TRW vvvv
  ## UNIVERSAL::isa($som => 'SOAP::SOM') ? wantarray ? $som->paramsall : $som->result : $som;
  return eval {$som->isa('SOAP::SOM')} ? wantarray ? $som->paramsall : $som->result : $som;
  ## TRW ^^^^
}

sub BEGIN {
  no strict 'refs';
  for my $method (qw(want_som)) {
    my $field = '_' . $method;
    *$method = sub {
      my $self = shift->new;
      @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
    }
  }
}

no strict 'refs';
for my $method (@EXPORT_OK) {
## TRW  my %method = %{$methods{$method}};
  *$method = sub {
    ## TRW vvvv
    ## my $self = UNIVERSAL::isa($_[0] => __PACKAGE__) 
    my $self = eval {$_[0]->isa(__PACKAGE__)}
    ## TRW ^^^^
      ? ref $_[0] ? shift # OBJECT
                  # CLASS, either get self or create new and assign to self
                  : (shift->self || __PACKAGE__->self(__PACKAGE__->new))
      # function call, either get self or create new and assign to self
      : (__PACKAGE__->self || __PACKAGE__->self(__PACKAGE__->new));
    $self->_call($method, @_);
  }
}

sub AUTOLOAD {
  my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
  return if $method eq 'DESTROY' || $method eq 'want_som';
  die "Unrecognized method '$method'. List of available method(s): @EXPORT_OK\n";
}

1;