← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to examples/biblio/biblio_soap.pl

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/biblio/biblio_soap.pl
1
 
#!/usr/bin/perl
2
 
#
3
 
# This was actually a part of the test suite - but because it starts
4
 
# an external process it was safer not to use it as a test (the process
5
 
# could be left running if an error occurs).
6
 
#
7
 
# It is an example of a TCP-based SOAP exchange.
8
 
#
9
 
 
10
 
use strict;
11
 
eval { require SOAP::Lite;
12
 
};
13
 
if( $@ ){
14
 
    die("must have SOAP::Lite installed to run this script");
15
 
}
16
 
 
17
 
use vars qw($NUMTESTS);
18
 
 
19
 
my $error;
20
 
 
21
 
BEGIN { 
22
 
    # to handle systems with no installed Test module
23
 
    # we include the t dir (where a copy of Test.pm is located)
24
 
    # as a fallback
25
 
    eval { require Test; };
26
 
    $error = 0;
27
 
    if( $@ ) {
28
 
        use lib 't';
29
 
    }
30
 
    use Test;
31
 
    plan tests => 10;
32
 
}
33
 
 
34
 
my $testnum;
35
 
my $verbose = 0;
36
 
 
37
 
use Bio::Biblio;
38
 
 
39
 
# --- launch a testing SOAP server
40
 
my ($pid, $port, $max_port);
41
 
$port = 4444;
42
 
$max_port = $port + 100;
43
 
if ($pid = fork) {
44
 
    # parent here
45
 
 
46
 
    sleep 1;
47
 
    my $biblio = new Bio::Biblio (-location => "tcp://localhost:$port",
48
 
                                  -namespace => 'soap_server');
49
 
    
50
 
    ok ($biblio->get_count, '43');
51
 
    ok ($biblio->get_by_id ('X'), 'X');
52
 
    ok ($biblio->find ('a,b','c,d')->get_collection_id, 'a,b,c,d');
53
 
    ok ($biblio->find (['x', 'y'], ['u', 'v'])->get_collection_id, 'x,y,u,v');
54
 
 
55
 
    ok ( eval { join (',', @{ $biblio->find ('AAA')->get_all_ids }) }, 'AAA'); print STDERR $@ if $@;
56
 
 
57
 
    ok ( eval { join (',', @{ $biblio->find ('XXX')->get_all }) }, 'XXX'); print STDERR $@ if $@;
58
 
 
59
 
    ok ( eval { $biblio->find (46)->has_next }, 1); print STDERR $@ if $@;
60
 
 
61
 
    ok ( eval { $biblio->find ('BBB')->get_next }, 'BBB'); print STDERR $@ if $@;
62
 
 
63
 
    ok ( eval { join (',', @{ $biblio->find ('CCC')->get_more (3) }) }, 'CCC,CCC,CCC'); print STDERR $@ if $@;
64
 
 
65
 
    ok ( eval { $biblio->find (46)->exists }, 0); print STDERR $@ if $@;
66
 
 
67
 
 
68
 
    # clean-up the running server
69
 
    kill 9, $pid if defined $pid;
70
 
    print "    SOAP server $pid killed\n";
71
 
 
72
 
} elsif (defined $pid) {
73
 
    # child here - a testing SOAP server
74
 
 
75
 
    package soap_server;
76
 
    use strict;
77
 
    use SOAP::Transport::TCP;
78
 
    my $daemon;
79
 
    while ($port < $max_port) {
80
 
        eval {
81
 
            $daemon = SOAP::Transport::TCP::Server
82
 
                -> new (LocalAddr => 'localhost', LocalPort => $port, Listen => 5, Reuse => 1)
83
 
                    -> dispatch_to('soap_server');
84
 
        };
85
 
        last unless $@;
86
 
        $port++;
87
 
    }
88
 
    print "    Contact to SOAP server at ", join(':', $daemon->sockhost, $daemon->sockport), " (server PID: $$)\n";
89
 
    $daemon->handle;
90
 
 
91
 
    sub getBibRefCount { shift;  return 43; }
92
 
    sub getById { shift; return shift; }
93
 
    sub find {
94
 
        my ($self, $keywords, $attrs) = @_;
95
 
        return join (',', (@{ $keywords }, @{ $attrs })) if $attrs;
96
 
        return join (',', @{ $keywords });
97
 
    }
98
 
    sub getAllIDs { shift; return [ shift ] }
99
 
    sub getAllBibRefs { shift; return [ shift ] }
100
 
    sub hasNext { return SOAP::Data->type (boolean => 'true'); }
101
 
    sub getNext { shift; return [ '1', shift]; }
102
 
    sub getMore {
103
 
        my ($self, $id, $how_many) = @_;
104
 
        my @result = ('1');
105
 
        push (@result, $id) for (1..$how_many);
106
 
        return \@result;
107
 
    }
108
 
    sub exists { return SOAP::Data->type (boolean => '0'); }
109
 
    sub destroy {}
110
 
 
111
 
    package main;
112
 
 
113
 
} else {
114
 
        # fork failed
115
 
        print STDERR "Testing SOAP services FAILED: $!.\n";
116
 
    }