#! /usr/bin/perl -w
# $Id: soap_client.pl,v 1.10 2009/05/21 16:51:44 madden Exp $
# ===========================================================================
#
#                            PUBLIC DOMAIN NOTICE
#               National Center for Biotechnology Information
#
#  This software/database is a "United States Government Work" under the
#  terms of the United States Copyright Act.  It was written as part of
#  the author's official duties as a United States Government employee and
#  thus cannot be copyrighted.  This software/database is freely available
#  to the public for use. The National Library of Medicine and the U.S.
#  Government have not placed any restriction on its use or reproduction.
#
#  Although all reasonable efforts have been taken to ensure the accuracy
#  and reliability of the software and data, the NLM and the U.S.
#  Government do not and cannot warrant the performance or results that
#  may be obtained by using this software or data. The NLM and the U.S.
#  Government disclaim all warranties, express or implied, including
#  warranties of performance, merchantability or fitness for any particular
#  purpose.
#
#  Please cite the author in any work or product based on this material.
#
# ===========================================================================
#
# Author:  Christiam Camacho
#
# File Description:
#   Demo SOAP client in perl which accesses the NCBI BLAST Web Service
#
# ===========================================================================

use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use SOAP::Lite;
use HTTP::Cookies;

use constant BLAST_WS => 
    "http://www.ncbi.nlm.nih.gov/blast/netblast/blastws.cgi";
use constant NCBI_XML_NAMESPACE => "http://www.ncbi.nlm.nih.gov";
use constant CLIENT_ID => 'Demo SOAP Perl client developed by NCBI';

pod2usage({-exitval => 1, -verbose => 2}) if (@ARGV == 0);

my ($arg_submit_lite,
    $arg_submit,
    $arg_check_status,
    $arg_get_results,
    $arg_get_simple_results,
    $arg_get_strategy,
    $arg_get_dbs,
    $arg_get_matrices,
    $arg_get_options,
    $arg_get_tasks,
    $arg_get_programs,
    $arg_get_sequences,
    $arg_verbose);

exit(1) unless (GetOptions("test_submission_lite"       => \$arg_submit_lite,
                           "test_submission"            => \$arg_submit,
                           "check_status=s"             => \$arg_check_status,
                           "get_results=s"              => \$arg_get_results,
                           "get_simple_results=s"       => \$arg_get_simple_results,
                           "get_search_strategy=s"      => \$arg_get_strategy,
                           "get_databases=s"            => \$arg_get_dbs,
                           "get_matrices"               => \$arg_get_matrices,
                           "get_options"                => \$arg_get_options,
                           "get_tasks"                  => \$arg_get_tasks,
                           "get_programs"               => \$arg_get_programs,
                           "get_sequences"              => \$arg_get_sequences,
                           "verbose"                    => \$arg_verbose));

SOAP::Lite->import(+trace => [qw(all -objects -transport -method -trace)]) 
    if ($arg_verbose);

my $soap = SOAP::Lite
    -> readable(1)
    -> uri(NCBI_XML_NAMESPACE)
    -> proxy(BLAST_WS, cookie_jar => &setup_cookie_jar());

# Check RID status
if ($arg_check_status) {
    my $rid = $arg_check_status;
    my $payload = SOAP::Data->name('request-id' => $rid);
    my $result = 
        $soap->call(SOAP::Data->name('Blast4-get-search-status-request')
                             ->uri(NCBI_XML_NAMESPACE)
                             => $payload);
    print_fault_information($result) if ($result->fault);
    print "Status=" . $result->result . "\n";
    exit;
}

# Get the search results
if ($arg_get_results) {
    $soap->outputxml("1");
    my $rid = $arg_get_results;
    my $payload = SOAP::Data->name('request-id' => $rid);
    my $result =
        $soap->call(SOAP::Data->name('Blast4-get-search-results-request')
                             ->uri(NCBI_XML_NAMESPACE)
                             => $payload);
    my $fname = "results.xml";
    open(OUT, ">$fname") or die "Failed to open $fname: $!\n";
    print OUT $result;
    close(OUT);
    print "Results can be found in $fname\n";
    exit;
}

# Get simple search results
if ($arg_get_simple_results) {
    $soap->outputxml("1");
    my $rid = $arg_get_simple_results;

    my $payload = SOAP::Data->value(
        SOAP::Data->name('request-id' => $rid),
        SOAP::Data->name('result-types' => '64')
                         )->uri(NCBI_XML_NAMESPACE);
    my $result =
        $soap->call(SOAP::Data->name('Blast4-get-search-results-request')
                             ->uri(NCBI_XML_NAMESPACE)
                             => $payload);
    my $fname = "results.xml";
    open(OUT, ">$fname") or die "Failed to open $fname: $!\n";
    print OUT $result;
    close(OUT);
    print "Results can be found in $fname\n";
    exit;
}

# Get the search strategy
if ($arg_get_strategy) {
    $soap->outputxml("1");
    my $rid = $arg_get_strategy;
    my $payload = SOAP::Data->name('request-id' => $rid);
    my $result =
        $soap->call(SOAP::Data->name('Blast4-get-search-strategy-request')
                             ->uri(NCBI_XML_NAMESPACE)
                             => $payload);
    my $fname = "search_strategy.xml";
    open(OUT, ">$fname") or die "Failed to open $fname: $!\n";
    print OUT $result;
    close(OUT);
    print "Search strategy are saved in $fname\n";
    exit;
}

# Get list of available databases
if ($arg_get_dbs) {
    $soap->outputxml("1");
    my $result = invoke_blast4_request("get-databases");
    open(OUT, ">$arg_get_dbs") or die "Failed to open $arg_get_dbs: $!\n";
    print OUT $result;
    close(OUT);
    print "Databases are saved in $arg_get_dbs\n";
    exit;
}

# Submit a search using the "lite" approach
if ($arg_submit_lite) {

    my $seqdata =
"ACCTCCACTAGCTTTGTTTGTAGTGATGCTCTGTAGCACCACTGGGAAGCCCTTTAATGAATGTGCCTTTCCGCAAATCACACACACACAAATACACTTATAGAAACAAGGTGATTTTCTTGAAATAATAAAACAAAATTTGGAAGAAGATTTTTACTGTCTTAGGAAAAGTAAGGCATTGGAAGGTGGCTAGGTATGACATATGAAGTTGCATTTTAAAACTGGAATTGGACAACTGATATTCAGTGATATTTATGCTACTACCTTCTAGAATCGAGAGCATGCACCCCACTCTGTACTCTTGCCTGGAGAATCCATGATGAGAGCCTGGTAGGCTGCAGTCCATGGGGTCACACAGAGTCGGACATGACTGAGCGACTTCACTTTCACTTTTCAATTTCATGCATTGGAGCCGGAAATGGCAACCCACTCCAGTGTTCTTGCCTGGAGAATCCCAGGGATGGGGAAGCCTGGTGGGCTGCTGTCTATGGGGTCGCAGAGAGTCAGACACGACTGAAGTGACTTAGCAGCAACCTTCTGGAATAAACGCCTCAGGCTTTAAACTCTGGCTTGACCATTCACTAGCCATGGGATCCACTAGAGTCGACCTGCAGGCATGCAAGC";

    my $search_lite = SOAP::Data->value(
        SOAP::Data->name('query' => $seqdata),
        SOAP::Data->name('database-name' => 'nt'),
        SOAP::Data->name('options' => 
                         \SOAP::Data->value(
        SOAP::Data->name('Blast4-options-lite' =>
                         \SOAP::Data->name('task' => 'blastn'))
                         )))->uri(NCBI_XML_NAMESPACE);

    my $result = 
        $soap->call(SOAP::Data->name('Blast4-queue-search-request-lite')
                          ->uri(NCBI_XML_NAMESPACE)
                          => $search_lite);
    print_fault_information($result) if ($result->fault);
    print "RID=" . $result->result . "\n";
    exit;
}

# Submit a search using the Blast4-queue-search-request structure
if ($arg_submit) {
    my $queries = 
        SOAP::Data->name('queries' => \
           SOAP::Data->name('Blast4-queries' => \
                SOAP::Data->name('seq-loc-list' => \
                     SOAP::Data->name('Seq-loc' => \
                          SOAP::Data->name('whole' => \
                               SOAP::Data->name('Seq-id' => \
                                    SOAP::Data->name('gi' => '555')))))));
                            
    my $subject = SOAP::Data->name('subject' => \
                       SOAP::Data->name('Blast4-subject' => \
                                SOAP::Data->name('database' => 'ecoli')));

    my $payload = SOAP::Data->value(
        SOAP::Data->name('program' => 'blastn'),
        SOAP::Data->name('service' => 'plain'),
        SOAP::Data->name('queries' => $queries),
        SOAP::Data->name('subject' => $subject)
                         )->uri(NCBI_XML_NAMESPACE);

    my $result = 
        $soap->call(SOAP::Data->name('Blast4-queue-search-request')
                          ->uri(NCBI_XML_NAMESPACE)
                          => $payload);
    print_fault_information($result) if ($result->fault);
    print "RID=" . $result->result . "\n";
    exit;
}

# Get the available scoring matrices
if ($arg_get_matrices) {
    my $result = invoke_blast4_request("get-matrices");
    print_fault_information($result) if ($result->fault);

    if ($result->match('//name')) {
        print "Supported BLAST matrices:\n";
        my @names = $result->valueof('//name');
        # Use dataof to retrieve attribute as explained in
        # www.soaplite.com/2003/05/how_to_access_a.html
        my @types = $result->dataof('//Blast4-residue-type');
        for (my $i = 0; $i < @names && $i < @types; $i++) {
            my $mol_type = $types[$i]->attr->{'value'};
            print $i+1 . ". $names[$i] ($mol_type)\n";
        }
    }
        
    exit;
}

# Get the supported algorithm options 
if ($arg_get_options) {
    my $result = invoke_blast4_request("get-parameters");
    print_fault_information($result) if ($result->fault);

    if ($result->match('//name')) {
        print "Supported BLAST options:\n";
        my @names = $result->valueof('//name');
        my @types = $result->valueof('//type');
        for (my $i = 0; $i < @names && $i < @types; $i++) {
            print $i+1 . ". $names[$i] ($types[$i])\n";
        }
    }

    exit;
}

# Get the supported tasks
if ($arg_get_tasks) {
    my $result = invoke_blast4_request("get-paramsets");
    print_fault_information($result) if ($result->fault);

    if ($result->match('//name')) {
        print "Supported BLAST tasks:\n";
        my @names = $result->valueof('//name');
        my @doc = $result->valueof('//documentation');
        for (my $i = 0; $i < @names && $i < @doc; $i++) {
            print $i+1 . ". $names[$i]: $doc[$i]\n";
        }
    }

    exit;
}

# Get the supported programs
if ($arg_get_programs) {
    my $result = invoke_blast4_request("get-programs");
    print_fault_information($result) if ($result->fault);

    if ($result->match('//Blast4-program-info')) {
        my @program_info_structs = $result->valueof('//Blast4-program-info');

        print "Supported BLAST programs:\n";
        for (my $i = 0; $i < @program_info_structs; $i++) {
            my %soap_data = %{$program_info_structs[$i]};
            print "\tProgram: $soap_data{'program'}\n";
            if (ref($soap_data{'services'}) eq "ARRAY") {
                my @services = @{$soap_data{'services'}};
                print "\tServices: " . shift @services;
                print ", $_" foreach (@services);
            } else {
                print "\tServices: $soap_data{'services'}";
            }
            print "\n";
        }
    }

    exit;
}

# Retrieve sequence data
if ($arg_get_sequences) {
    $soap->outputxml("1");
    my $db = SOAP::Data->name('database' => \
             SOAP::Data->name('Blast4-database' => \
                SOAP::Data->value(
                SOAP::Data->name('name' => 'nt',
                SOAP::Data->name('type' => \
                     SOAP::Data->name("Blast4-residue-type")
                        ->attr({'value'=>"nucleotide"}))))));
    my $seq_ids = SOAP::Data->name('seq-ids' => \SOAP::Data->value(
                       SOAP::Data->name('Seq-id' => \
                            SOAP::Data->name('gi' => '555')),
                       SOAP::Data->name('Seq-id' => \
                            SOAP::Data->name('gi' => '556'))));

    my $payload = SOAP::Data->value($db, $seq_ids);
    my $result =
        $soap->call(SOAP::Data->name('Blast4-get-sequences-request')
                             ->uri(NCBI_XML_NAMESPACE)
                             => $payload);
    my $fname = "sequences.xml";
    open(OUT, ">$fname") or die "Failed to open $fname: $!\n";
    print OUT $result;
    close(OUT);
    print "Sequences can be found in $fname\n";
    exit;
}

# Print the SOAP fault message, argument must be a SOAP::SOM object
sub print_fault_information {
    my $som = shift;
    die $som->faultstring . "\n";
}

# Auxiliary function to build a Blast4-request structure
sub invoke_blast4_request
{
    my $method = shift;

    my $request = 
         SOAP::Data->value(
            SOAP::Data->name('ident' => CLIENT_ID),
            SOAP::Data->name('body' => 
                 \SOAP::Data->value(
                    SOAP::Data->name('Blast4-request-body' =>
                         \SOAP::Data->value(SOAP::Data->name($method)))
                                   )
                            )
            );

    my $result = $soap->call(SOAP::Data->name('Blast4-request')
                             ->uri(NCBI_XML_NAMESPACE)
                             => $request);
    return $result;
}

# Set up a routing cookie for internal NCBI use
sub setup_cookie_jar 
{
    # To send requests to test system, change the value below to 0
    use constant USE_PRODUCTION => 1;
    my %rest;
    my $cookie_jar = HTTP::Cookies->new;
    my $maxage = 1;
    my $discard = 0;
    my $secure = 0;
    my $path_spec = 0;
    my $port = "80";
    my $domain = ".nlm.nih.gov";
    my $path = "/";
    my $key = "NCBITESTBLAST";
    # If the value mismatches the configuration, request will stop by error 510
    # (Not extended)
    my $value = "blastq";   
    my $version = "1.0";
    if (USE_PRODUCTION) {
        $cookie_jar->set_cookie($version, $key, $value, $path, $domain, $port,
                                $path_spec, $secure, $maxage, $discard, \%rest);
    }
    return $cookie_jar;
}

__END__

=head1 NAME

B<soap_client.pl> - Demo Perl client to access the BLAST web service.

=head1 SYNOPSIS

soap_client.pl [-test_submission_lite] [-test_submission]
               [-check_status RID] [-get_results RID] 
               [-get_simple_results RID] 
               [-get_search_strategy RID] 
               [-get_databases output_file] 
               [-get_matrices] [-get_options] [-get_tasks] 
               [-get_programs] [-get_sequences] [-verbose]

=head1 OPTIONS

=over 2

=item B<--test_submission_lite>

Submit Blast4 LITE request

=item B<--test_submission>

Submit regular Blast4 request

=item B<--check_status RID>

Check status of a given RID

=item B<--get_results RID>

Get results for a given RID

=item B<--get_simple_results RID>

Get simple results for a given RID

=item B<--get_search_strategy RID>

Get the search strategy for a given RID

=item B<--get_databases output_file>

Output file with available databases

=item B<--get_matrices>

Get supported matrices

=item B<--get_options>

Get supported options

=item B<--get_tasks>

Get supported tasks

=item B<--get_programs>

Get supported programs

=item B<--get_sequences>

Get sequence data for gi 555

=item B<--verbose>

Show communication log


=head1 EXIT CODES

This script returns 0 on success and a non-zero value on errors.

=head1 BUGS

Please report them to <blast-help@ncbi.nlm.nih.gov>

=head1 COPYRIGHT

See PUBLIC DOMAIN NOTICE included at the top of this script.

=cut