view release on metacpan or  search on metacpan

lib/Bio/DB/Biblio/soap.pm  view on Meta::CPAN

    # make a hashtable from @args
    my %param = @args;
    @param { map { lc $_ } keys %param } = values %param; # lowercase keys

    # copy all @args into this object (overwriting what may already be
    # there) - changing '-key' into '_key'
    my $new_key;
    foreach my $key (keys %param) {
        ($new_key = $key) =~ s/^-/_/;
        $self->{ $new_key } = $param { $key };
    }

    # finally add default values for those keys who have default value
    # and who are not yet in the object
    $self->{'_location'} = $DEFAULT_SERVICE unless $self->{'_location'};
    $self->{'_namespace'} = $DEFAULT_NAMESPACE unless $self->{'_namespace'};
    $self->{'_destroy_on_exit'} = 1 unless defined $self->{'_destroy_on_exit'};
    unless ($self->{'_soap'}) {
        if (defined $self->{'_httpproxy'}) {
            $self->{'_soap'} = SOAP::Lite
                                  -> uri ($self->{'_namespace'})
                                  -> proxy ($self->{'_location'},
                                    proxy => ['http' => $self->{'_httpproxy'}]);
        } else {
            $self->{'_soap'} = SOAP::Lite
                                  -> uri ($self->{'_namespace'})
                                  -> proxy ($self->{'_location'});
        }
#       $self->{'_soap'}->soapversion (1.2);
    }
}

# -----------------------------------------------------------------------------

#
# objects representing query collections are being destroyed if they
# have attribute '_destroy_on_exit' set to true - which is a default
# value
#
sub DESTROY {
    my $self = shift;
    my $soap = $self->{'_soap'};
    my $destroy = $self->{'_destroy_on_exit'};
    return unless $destroy;
    my $collection_id = $self->{'_collection_id'};
    return unless $collection_id;

    # ignore all errors here
    eval {
        $soap->destroy (SOAP::Data->type (string => $collection_id));
    }
}

#
# some methods must be called with an argument containing a collection
# ID; here we return a proper error message explaining it
#
sub _no_id_msg {
    my $self = shift;
    my $package = ref $self;
    my $method = (caller(1))[3];
    my $strip_method = $method;
    $strip_method =~ s/^$package\:\://;

    return <<"END_OF_MSG";
Method '$method' works only if its object has a query collection ID.
Perhaps you need to use:
\tBio::Biblio->new(-collection_id => '1234567')->$strip_method;
or to obtain a collection ID indirectly from a query method:
\tBio::Biblio->new->find ('keyword')->$strip_method;
END_OF_MSG
}

#
# some methods do not work with older SOAP::Lite version; here we
#return message explaining it
#
sub _old_version_msg {
    my $self = shift;
    my $method = (caller(1))[3];

    return <<"END_OF_MSG";
Method '$method' works only with SOAP::Lite
version 0.52 and newer (the problem is with returning a boolean value from the server).
END_OF_MSG
}

#
# some controlled vocabulary methods needs two parameters; here we
# return message explaining it
#
sub _two_params_msg {
    my $self = shift;
    my $method = (caller(1))[3];

    return <<"END_OF_MSG";
Method '$method' expects two parameters: vocabulary name and a value.
END_OF_MSG
}

#
# some controlled vocabulary methods needs a vocabulary name; here we
# return message explaining it
#
sub _missing_name_msg {
    my $self = shift;
    my $method = (caller(1))[3];

    return <<"END_OF_MSG";
Method '$method' expects vocabulary name as parameter.
END_OF_MSG
}

#
# return a copy of a given array, with all its elements replaced
# with the SOAP-Data objects defining elements type as 'string'
#
sub _as_strings {
    my ($ref_input_array) = @_;
    my (@result) = map { SOAP::Data->new (type => 'string', value => $_) } @$ref_input_array;
    return \@result;
}

# ---------------------------------------------------------------------
#
#   Here are the methods implementing Bio::DB::BiblioI interface
#   (documentation is in Bio::DB::BiblioI)
#
# ---------------------------------------------------------------------

sub get_collection_id {
    my ($self) = @_;
    $self->{'_collection_id'};
}

sub get_count {
    my ($self) = @_;
    my $soap = $self->{'_soap'};
    my ($collection_id) = $self->{'_collection_id'};
    if ($collection_id) {
        $soap->getBibRefCountOfCollection (SOAP::Data->type (string => $collection_id))->result;
    } else {
        $soap->getBibRefCount->result;
    }
}

# try: 12368254 (it's a Bioperl article)
sub get_by_id {
    my ($self, $citation_id) = @_;
    $self->throw ("Citation ID is expected as a parameter of method 'get_by_id'.")
        unless $citation_id;
    my $soap = $self->{'_soap'};
    $soap->getById (SOAP::Data->type (string => $citation_id))->result;
}

sub find {
    my ($self, $keywords, $attrs) = @_;
    my (@keywords, @attrs);

    # $keywords can be a comma-delimited scalar or a reference to an array
    if ($keywords) {
        my $ref = ref $keywords;
        @keywords = split (/,/, $keywords) unless $ref;
        @keywords = @$keywords if $ref =~ /ARRAY/;
    }
    $self->throw ("No keywords given in 'find' method.\n")
        unless (@keywords);