File Coverage

blib/lib/WWW/PDB.pm
Criterion Covered Total %
statement 34 36 94.4
branch n/a
condition n/a
subroutine 12 12 100.0
pod n/a
total 46 48 95.8


line stmt bran cond sub pod time code
1             package WWW::PDB;
2              
3             =head1 NAME
4              
5             WWW::PDB - Perl interface to the Protein Data Bank
6              
7             =head1 SYNOPSIS
8              
9             use WWW::PDB qw(:all);
10              
11             # set directory for caching downloads
12             WWW::PDB->cache('/foo/bar');
13            
14             my $fh = get_structure('2ili');
15             print while <$fh>;
16            
17             my @pdbids = WWW::PDB->keyword_query('carbonic anhydrase');
18             for(@pdbids) {
19             my $citation = WWW::PDB->get_primary_citation_title($_),
20             my @chains = WWW::PDB->get_chains($_);
21             printf("%s\t%s\t[%s]\n", $_, $citation, join(', ', @chains));
22             }
23              
24             my $seq = q(
25             VLSPADKTNVKAAWGKVGAHAGEYGAEALERMFLSFPTTK
26             TYFPHFDLSHGSAQVKGHGKKVADALTAVAHVDDMPNAL
27             );
28             print WWW::PDB->blast($seq, 10.0, 'BLOSUM62', 'HTML');
29              
30             =head1 DESCRIPTION
31              
32             The Protein Data Bank (PDB) was established in 1971 as a repository of the
33             atomic coordinates of protein structures (Bernstein I, 1997). It
34             has since outgrown that role, proving invaluable not only to the research
35             community but also to students and educators (Berman I, 2002).
36              
37             L is a Perl interface to the Protein Data Bank. It provides
38             functions for retrieving files, optionally caching them locally.
39             Additionally, it wraps the functionality of the PDB's SOAP web services.
40              
41             =cut
42              
43 1     1   23016 use 5.006;
  1         5  
  1         38  
44 1     1   5 use strict;
  1         1  
  1         31  
45 1     1   6 use warnings;
  1         2  
  1         33  
46              
47 1     1   6 use Carp;
  1         1  
  1         112  
48 1     1   6 use Exporter;
  1         1  
  1         47  
49 1     1   23 use Fcntl;
  1         2  
  1         345  
50 1     1   6 use File::Path;
  1         2  
  1         59  
51 1     1   6 use File::Spec;
  1         1  
  1         25  
52 1     1   922 use IO::File;
  1         11159  
  1         313  
53 1     1   1291 use IO::Uncompress::Gunzip;
  1         51189  
  1         51  
54 1     1   1516 use Net::FTP;
  1         48487  
  1         63  
55 1     1   465 use SOAP::Lite;
  0            
  0            
56              
57             use constant {
58             BOOLEAN => 0,
59             DOUBLE => 1,
60             INT => 2,
61             SELF => 3,
62             STRING => 4,
63             };
64              
65             our @ISA = qw(Exporter);
66             our $VERSION = '0.00_03';
67             $VERSION = eval $VERSION;
68              
69             our %EXPORT_TAGS = (
70             file => [qw(get_structure get_structure_factors)],
71             status => [qw(get_status is_current is_obsolete is_unreleased
72             is_model is_unknown)],
73             );
74             our @EXPORT_OK = map {@$_} values %EXPORT_TAGS;
75             $EXPORT_TAGS{all} = \@EXPORT_OK;
76              
77             my($uri, $proxy, $ftp, $cache, $soap);
78              
79             =head1 FUNCTIONS
80              
81             =head2 CUSTOMIZATION
82              
83             Let's start with some functions that let you customize how the module does
84             its job. You probably won't play with any of these very often (if at all)
85             except for C, which is recommended for anyone that expects to do
86             extensive work with a set of files: that way you don't waste resources
87             downloading them each time.
88              
89             =over 4
90              
91             =item WWW::PDB->ftp( [ $HOST ] )
92              
93             Returns the host name for the PDB FTP archive, first setting it to $FTP if
94             it's specified. Default value is F.
95              
96             =cut
97              
98             sub ftp {
99             return $ftp = $_[1] ? $_[1] : $ftp || 'ftp.wwpdb.org';
100             }
101              
102             =item WWW::PDB->cache( [ $DIR ] )
103              
104             Returns the local cache directory, first setting it to $DIR if it's
105             specified. If C, the module will look for files here first and
106             also use the directory to store any downloads.
107              
108             =cut
109              
110             sub cache {
111             $cache = $_[1] if $_[1];
112             return $cache;
113             }
114              
115             =item WWW::PDB->ns( [ $URI ] )
116              
117             Returns the namespace URI for the PDB web services, first setting it to $URI
118             if it's specified. Default value is http://www.pdb.org/pdb/services/pdbws.
119              
120             =cut
121              
122             sub ns {
123             my $tmp = $uri;
124             $uri = $_[1] ? $_[1] : $uri || 'http://www.pdb.org/pdb/services/pdbws';
125             $_[0]->soap->ns($uri) unless $tmp && $tmp eq $uri;
126             return $uri;
127             }
128              
129             =item WWW::PDB->proxy( [ $URI ] )
130              
131             Returns the proxy for the PDB web services, first setting it to $URI if it's
132             specified. Default value is http://www.pdb.org/pdb/services/pdbws.
133              
134             =cut
135              
136             sub proxy {
137             my $tmp = $proxy;
138             $proxy = $_[1] ? $_[1] : $proxy || 'http://www.pdb.org/pdb/services/pdbws';
139             $_[0]->soap->proxy($proxy) unless $tmp && $tmp eq $proxy;
140             return $proxy;
141             }
142              
143             =item WWW::PDB->soap( [ $CLIENT ] )
144              
145             Returns the client L object used by this module to talk to
146             the PDB's SOAP interface, first setting it to $CLIENT if it's specified.
147             It's best not to access it directly, but if you must, this is how.
148              
149             =cut
150              
151             sub soap {
152             return $soap = $_[1] ? $_[1] : $soap ||
153             SOAP::Lite->ns($_[0]->ns)->proxy($_[0]->proxy);
154             }
155              
156             =back
157              
158             =head2 FILE RETRIEVAL
159              
160             Each of the following functions takes a PDB ID as input and returns a file
161             handle (or C on failure). You can import these into your namespace
162             with the C tag, as in C.
163              
164             =over 4
165              
166             =item get_structure( $PDBID )
167              
168             Retrieves the structure in PDB format.
169              
170             =cut
171              
172             sub get_structure {
173             unshift @_, __PACKAGE__ # add the package name unless already there
174             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
175              
176             my $class = shift;
177             my $pdbid = lc(shift);
178             return $pdbid =~ /^.(..).$/
179             ? $class->_get_file(qw(pub pdb data structures divided pdb), $1,
180             "pdb${pdbid}.ent.gz") : undef;
181             }
182              
183             =item get_structure_factors( $PDBID )
184              
185             Retrieves the structure factors file.
186              
187             =cut
188              
189             sub get_structure_factors {
190             unshift @_, __PACKAGE__ # add the package name unless already there
191             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
192              
193             my $class = shift;
194             my $pdbid = lc(shift);
195             return $pdbid =~ /^.(..).$/
196             ? $class->_get_file(qw(pub pdb data structures divided
197             structure_factors), $1, "r${pdbid}sf.ent.gz") : undef;
198             }
199              
200             =back
201              
202             =head2 PDB ID STATUS
203              
204             The following functions deal with the status of PDB IDs. You can import
205             them into your namespace with the C tag:
206             C.
207              
208             =over 4
209              
210             =item get_status( $PDBID )
211              
212             Finds the status of the structure with the given $PDBID. Return is in
213             C.
214              
215             =cut
216              
217             sub get_status {
218             unshift @_, __PACKAGE__ # add the package name unless already there
219             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
220              
221             return 'UNKNOWN' if length($_[1]) != 4;
222             my $class = shift;
223             my $pdbid = _to_string(shift);
224             my $ret = $class->_call(
225             'getIdStatus', $pdbid
226             );
227             return $ret;
228             }
229              
230             =item is_current( $PDBID )
231              
232             Checks whether or not the specified $PDBID corresponds to a current
233             structure. Implemented for orthogonality, all this does is check
234             if C returns C.
235              
236             =cut
237              
238             sub is_current {
239             my $class = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__;
240             return $class->get_status(@_) eq 'CURRENT';
241             }
242              
243             =item is_obsolete( $PDBID )
244              
245             Checks whether or not the specified $PDBID corresponds to an obsolete
246             structure. This is actually defined by the PDB web services interface.
247              
248             =cut
249              
250             sub is_obsolete {
251             unshift @_, __PACKAGE__ # add the package name unless already there
252             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
253              
254             my $class = shift;
255             my $pdbid = _to_string(shift);
256             my $ret = $class->_call(
257             'isStructureIdObsolete', $pdbid
258             );
259             return $ret;
260             }
261              
262             =item is_unreleased( $PDBID )
263              
264             Checks whether or not the specified $PDBID corresponds to an unreleased
265             structure. Implemented for orthogonality, all this does is check
266             if C returns C.
267              
268             =cut
269              
270             sub is_unreleased {
271             my $class = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__;
272             return $class->get_status(@_) eq 'UNRELEASED';
273             }
274              
275             =item is_model( $PDBID )
276              
277             Checks whether or not the specified $PDBID corresponds to a model
278             structure. Implemented for orthogonality, all this does is check
279             if C returns C.
280              
281             =cut
282              
283             sub is_model {
284             my $class = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__;
285             return $class->get_status(@_) eq 'MODEL';
286             }
287              
288             =item is_unknown( $PDBID )
289              
290             Checks whether or not the specified $PDBID is unknown. Implemented
291             for orthogonality, all this does is check if C returns
292             C.
293              
294             =cut
295              
296             sub is_unknown {
297             my $class = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__;
298             return $class->get_status(@_) eq 'UNKNOWN';
299             }
300              
301             =back
302              
303             =head2 PDB WEB SERVICES
304              
305             The following methods are the interface to the PDB web services.
306              
307             =over 4
308              
309             =item blast( $SEQUENCE , $CUTOFF , $MATRIX , $OUTPUT_FORMAT )
310              
311             =item blast( $PDBID , $CHAINID, $CUTOFF , $MATRIX , $OUTPUT_FORMAT )
312              
313             =item blast( $SEQUENCE , $CUTOFF )
314              
315             =item blast( $PDBID , $CHAINID , $CUTOFF )
316              
317             Performs a BLAST against sequences in the PDB and returns the output of
318             the BLAST program. XML is used if the output format is unspecified.
319              
320             =cut
321              
322             sub _blast_pdb {
323             my($class, $sequence, $cutoff, $matrix, $output_format) =
324             _wrap(\@_ => [SELF, STRING, DOUBLE, STRING, STRING]);
325              
326             my $ret = $class->_call(
327             'blastPDB', $sequence, $cutoff, $matrix, $output_format
328             );
329             return $ret;
330             }
331              
332             sub _blast_structure_id_pdb {
333             my $class = shift;
334              
335             # I keep getting "ERROR: No Results Found" using the PDB's 5 argument
336             # form of blastPDB. Here's a workaround:
337             my $seq = $class->get_sequence(shift, shift);
338             return $class->blast($seq, @_);
339              
340             # my($class, $pdbid, $chainid, $cutoff, $matrix, $output_format) =
341             # _wrap(\@_ => [SELF, STRING, STRING, DOUBLE, STRING, STRING]);
342             # my $ret = $class->_call(
343             # 'blastPDB', $pdbid, $chainid, $cutoff, $matrix, $output_format
344             # );
345             # return $ret;
346             }
347              
348             sub _blast_query_xml {
349             my($class, $sequence, $cutoff) = _wrap(\@_ => [SELF, STRING, DOUBLE]);
350             my $ret = $class->_call(
351             'blastQueryXml', $sequence, $cutoff
352             );
353             return $ret;
354             }
355              
356             sub _blast_structure_id_query_xml {
357             my($class, $pdbid, $chainid, $cutoff)
358             = _wrap(\@_ => [SELF, STRING, STRING, DOUBLE]);
359             my $ret = $class->_call(
360             'blastStructureIdQueryXml', $pdbid, $chainid, $cutoff
361             );
362             return $ret;
363             }
364              
365             sub blast {
366             unshift @_, __PACKAGE__ # add the package name unless already there
367             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
368              
369             my $class = shift;
370             my $ret;
371             my $c = scalar(@_);
372             if ($c == 4) { $ret = $class->_blast_pdb(@_) }
373             elsif($c == 5) { $ret = $class->_blast_structure_id_pdb(@_) }
374             elsif($c == 2) { $ret = $class->_blast_query_xml(@_) }
375             elsif($c == 3) { $ret = $class->_blast_structure_id_query_xml(@_) }
376             else { confess 'Called blast with unexpected number of arguments' }
377             return $ret;
378             }
379              
380             =item fasta( $SEQUENCE , $CUTOFF )
381              
382             =item fasta( $PDBID , $CHAINID , $CUTOFF )
383              
384             Takes a sequence or PDB ID and chain identifier and runs FASTA using the
385             specified cut-off. The results are overloaded to give PDB IDs when used
386             as strings, but they can also be explicitly probed for a C or
387             FASTA C:
388              
389             printf("%s %s %s\n", $_, $_->pdbid, $_->cutoff)
390             for $pdb->fasta("2ili", "A");
391              
392             =cut
393              
394             sub _fasta_query {
395             my $class = shift;
396             my $sequence = _to_string(shift);
397             my $cutoff = _to_double(shift);
398             my $ret = $class->_call(
399             'fastaQuery', $sequence, $cutoff
400             );
401             return $ret;
402             }
403              
404             sub _fasta_structure_id_query {
405             my($class, $pdbid, $chainid, $cutoff)
406             = _wrap(\@_ => [SELF, STRING, STRING, DOUBLE]);
407             my $ret = $class->_call(
408             'fastaStructureIdQuery', $pdbid, $chainid, $cutoff
409             );
410             return $ret;
411             }
412              
413             sub fasta {
414             unshift @_, __PACKAGE__ # add the package name unless already there
415             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
416              
417             my $class = shift;
418             my $c = scalar(@_);
419             my $ret;
420             if ($c == 2) { $ret = $class->_fasta_query(@_) }
421             elsif($c == 3) { $ret = $class->_fasta_structure_id_query(@_) }
422             else { confess 'Called fasta with unexpected number of arguments' }
423             $_ = bless(\"$_", 'WWW::PDB::_FastaResult') for @$ret;
424             return wantarray ? @$ret : $ret;
425             }
426              
427             =item get_chain_length( $PDBID , $CHAINID )
428              
429             Returns the length of the specified chain.
430              
431             =cut
432              
433             sub get_chain_length {
434             unshift @_, __PACKAGE__ # add the package name unless already there
435             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
436              
437             my $class = shift;
438             my $pdbid = _to_string(shift);
439             my $chainid = _to_string(shift);
440             my $ret = $class->_call(
441             'getChainLength', $pdbid, $chainid
442             );
443             return $ret;
444             }
445              
446             =item get_chains( $PDBID )
447              
448             Returns a list of all the chain identifiers for a given structure, or a
449             reference to such a list in scalar context.
450              
451             =cut
452              
453             sub get_chains {
454             unshift @_, __PACKAGE__ # add the package name unless already there
455             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
456              
457             my $class = shift;
458             my $pdbid = _to_string(shift);
459             my $ret = $class->_call(
460             'getChains', $pdbid
461             );
462             return wantarray ? @$ret : $ret;
463             }
464              
465             =item get_cif_chain( $PDBID , $CHAINID )
466              
467             Converts the specified author-assigned chain identifier to its mmCIF
468             equivalent.
469              
470             =cut
471              
472             sub get_cif_chain {
473             unshift @_, __PACKAGE__ # add the package name unless already there
474             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
475              
476             my $class = shift;
477             my $pdbid = _to_string(shift);
478             my $chainid = _to_string(shift);
479             my $ret = $class->_call(
480             'getCifChain', $pdbid, $chainid
481             );
482             return $ret;
483             }
484              
485             =item get_cif_chain_length( $PDBID , $CHAINID )
486              
487             Returns the length of the specified chain, just like C,
488             except it expects the chain identifier to be the mmCIF version.
489              
490             =cut
491              
492             sub get_cif_chain_length {
493             unshift @_, __PACKAGE__ # add the package name unless already there
494             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
495              
496             my $class = shift;
497             my $pdbid = _to_string(shift);
498             my $chainid = _to_string(shift);
499             my $ret = $class->_call(
500             'getCifChainLength', $pdbid, $chainid
501             );
502             return $ret;
503             }
504              
505             =item get_cif_chains( $PDBID )
506              
507             Returns a list of all the mmCIF chain identifiers for a given structure, or
508             a reference to such a list in scalar context.
509              
510             =cut
511              
512             sub get_cif_chains {
513             unshift @_, __PACKAGE__ # add the package name unless already there
514             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
515              
516             my $class = shift;
517             my $pdbid = _to_string(shift);
518             my $ret = $class->_call(
519             'getCifChains', $pdbid
520             );
521             return wantarray ? @$ret : $ret;
522             }
523              
524             =item get_cif_residue( $PDBID , $CHAINID , $RESIDUEID )
525              
526             Converts the specified author-assigned residue identifier to its mmCIF
527             equivalent.
528              
529             =cut
530              
531             sub get_cif_residue {
532             unshift @_, __PACKAGE__ # add the package name unless already there
533             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
534              
535             my $class = shift;
536             my $pdbid = _to_string(shift);
537             my $chainid = _to_string(shift);
538             my $residueid = _to_string(shift);
539             my $ret = $class->_call(
540             'getCifResidue', $pdbid, $chainid, $residueid
541             );
542             return $ret;
543             }
544              
545             =item get_current_pdbids( )
546              
547             Returns a list of the identifiers (PDB IDs) corresponding to "current"
548             structures (i.e. not obsolete, models, etc.), or a reference to such a
549             list in scalar context.
550              
551             =cut
552              
553             sub get_current_pdbids {
554             unshift @_, __PACKAGE__ # add the package name unless already there
555             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
556              
557             my $class = shift;
558             my $ret = $class->_call(
559             'getCurrentPdbIds'
560             );
561             return wantarray ? @$ret : $ret;
562             }
563              
564             =item get_ec_nums( @PDBIDS )
565              
566             =item get_ec_nums( )
567              
568             Retrieves the Enzyme Classification (EC) numbers associated with the
569             specified PDB IDs or with all PDB structures if called with no arguments.
570              
571             =cut
572              
573             sub get_ec_nums {
574             unshift @_, __PACKAGE__ # add the package name unless already there
575             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
576              
577             my $class = shift;
578             my $ret;
579             if(@_) {
580             my @pdbids = map(_to_string($_), map { ref($_) ? @$_ : $_ } @_);
581             $ret = $class->_call(
582             'getEcNumsForStructures', \@pdbids
583             );
584             }
585             else {
586             $ret = $class->_call(
587             'getEcNums'
588             );
589             }
590             $_ = bless(\"$_", 'WWW::PDB::_EcNumsResult') for @$ret;
591             return wantarray ? @$ret : $ret;
592             }
593              
594             =item get_entities( $PDBID )
595              
596             Returns a list of the entity IDs for a given structure, or a reference
597             to such a list in scalar context.
598              
599             =cut
600              
601             sub get_entities {
602             unshift @_, __PACKAGE__ # add the package name unless already there
603             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
604              
605             my $class = shift;
606             my $pdbid = _to_string(shift);
607             my $ret = $class->_call(
608             'getEntities', $pdbid
609             );
610             return $ret && wantarray ? @$ret : $ret;
611             }
612              
613             =item get_genome_details( )
614              
615             Retrieves genome details for all PDB structures.
616              
617             =cut
618              
619             sub get_genome_details {
620             unshift @_, __PACKAGE__ # add the package name unless already there
621             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
622              
623             my $class = shift;
624             my $ret = $class->_call(
625             'getGenomeDetails'
626             );
627             return $ret && wantarray ? @$ret : $ret;
628             }
629              
630             =item get_kabsch_sander( $PDBID , $CHAINID )
631              
632             Finds secondary structure for the given chain.
633              
634             =cut
635              
636             sub get_kabsch_sander {
637             unshift @_, __PACKAGE__ # add the package name unless already there
638             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
639              
640             my $class = shift;
641             my $pdbid = _to_string(shift);
642             my $chainid = _to_string(shift);
643             my $ret = $class->_call(
644             'getKabschSander', $pdbid, $chainid
645             );
646             return $ret;
647             }
648              
649             =item get_obsolete_pdbids( )
650              
651             Returns a list of the identifiers (PDB IDs) corresponding to obsolete
652             structures, or a reference to such a list in scalar context.
653              
654             =cut
655              
656             sub get_obsolete_pdbids {
657             unshift @_, __PACKAGE__ # add the package name unless already there
658             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
659              
660             my $ret = shift->_call(
661             'getObsoletePdbIds'
662             );
663             return $ret && wantarray ? @$ret : $ret;
664             }
665              
666             =item get_primary_citation_title( $PDBID )
667              
668             Finds the title of the specified structure's primary citation (if it has
669             one).
670              
671             =cut
672              
673             sub get_primary_citation_title {
674             unshift @_, __PACKAGE__ # add the package name unless already there
675             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
676              
677             my $class = shift;
678             my $pdbid = _to_string(shift);
679             my $ret = $class->_call(
680             'getPrimaryCitationTitle', $pdbid
681             );
682             return $ret;
683             }
684              
685             =item get_pubmed_ids( )
686              
687             Retrieves the PubMed IDs associated with all PDB structures.
688              
689             =cut
690              
691             sub get_pubmed_ids {
692             unshift @_, __PACKAGE__ # add the package name unless already there
693             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
694              
695             my $ret = shift->_call(
696             'getPubmedIdForAllStructures'
697             );
698             return $ret && wantarray ? @$ret : $ret;
699             }
700              
701             =item get_pubmed_id( $PDBID )
702              
703             Retrieves the PubMed ID associated with the specified structure.
704              
705             =cut
706              
707             sub get_pubmed_id {
708             unshift @_, __PACKAGE__ # add the package name unless already there
709             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
710              
711             my $class = shift;
712             my $pdbid = _to_string(shift);
713             my $ret = $class->_call(
714             'getPubmedIdForStructure', $pdbid
715             );
716             return $ret;
717             }
718              
719             =item get_release_dates( @PDBIDS )
720              
721             Maps the given PDB IDs to their release dates.
722              
723             =cut
724              
725             sub get_release_dates {
726             unshift @_, __PACKAGE__ # add the package name unless already there
727             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
728              
729             my $class = shift;
730             my @pdbids = map(_to_string($_), map { ref($_) ? @$_ : $_ } @_);
731             my $ret = $class->_call(
732             'getReleaseDates', \@pdbids
733             );
734             return $ret && wantarray ? @$ret : $ret;
735             }
736              
737             =item get_sequence( $PDBID , $CHAINID )
738              
739             Retrieves the sequence of the specified chain.
740              
741             =cut
742              
743             sub get_sequence {
744             unshift @_, __PACKAGE__ # add the package name unless already there
745             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
746              
747             my $class = shift;
748             my $pdbid = _to_string(shift);
749             my $chainid = _to_string(shift);
750             my $ret = $class->_call(
751             'getSequenceForStructureAndChain', $pdbid, $chainid
752             );
753             return $ret;
754             }
755              
756             =item get_space_group( $PDBID )
757              
758             Returns the space group of the specified structure (the
759             C field according to the mmCIF dictionary).
760              
761             =cut
762              
763             sub get_space_group {
764             unshift @_, __PACKAGE__ # add the package name unless already there
765             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
766              
767             my $class = shift;
768             my $pdbid = _to_string(shift);
769             my $ret = $class->_call(
770             'getSpaceGroupForStructure', $pdbid
771             );
772             return $ret;
773             }
774              
775             =item homology_reduction_query( @PDBIDS , $CUTOFF )
776              
777             Reduces the set of PDB IDs given as input based on sequence homology.
778              
779             =cut
780              
781             sub homology_reduction_query {
782             unshift @_, __PACKAGE__ # add the package name unless already there
783             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
784              
785             my $class = shift;
786             my $cutoff = _to_int(int(pop));
787             my @pdbids = map(_to_string($_), map { ref($_) ? @$_ : $_ } @_);
788             my $ret = $class->_call(
789             'homologyReductionQuery', \@pdbids, $cutoff
790             );
791             return $ret && wantarray ? @$ret : $ret;
792             }
793              
794             =item keyword_query( $KEYWORD_EXPR [, $EXACT_MATCH [, $AUTHORS_ONLY ] ] )
795              
796             Runs a keyword query with the specified expression. Search can be made
797             stricter by requiring an exact match or restricting the search to
798             authors. Both boolean arguments are optional and default to false. Returns
799             a list of PDB IDs or a reference to such a list in scalar context.
800              
801             =cut
802              
803             sub keyword_query {
804             unshift @_, __PACKAGE__ # add the package name unless already there
805             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
806              
807             my $class = shift;
808             my $keyword = _to_string(shift);
809             my $exact_match = _to_boolean(shift);
810             my $authors_only = _to_boolean(shift);
811             my $ret = $class->_call(
812             'keywordQuery', $keyword, $exact_match, $authors_only
813             );
814             return $ret && wantarray ? @$ret : $ret;
815             }
816              
817             =item pubmed_abstract_query( $KEYWORD_EXPR )
818              
819             Runs a keyword query on PubMed Abstracts. Returns a list of PDB IDs or
820             a reference to such a list in scalar context.
821              
822             =cut
823              
824             sub pubmed_abstract_query {
825             unshift @_, __PACKAGE__ # add the package name unless already there
826             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
827              
828             my $class = shift;
829             my $keyword = _to_string(shift);
830             my $ret = $class->_call(
831             'pubmedAbstractQuery', $keyword
832             );
833             return $ret && wantarray ? @$ret : $ret;
834             }
835              
836             =back
837              
838             =head3 UNTESTED
839              
840             The following methods are defined by the PDB web services interface, so
841             they are wrapped here, but they have not been tested.
842              
843             =over 4
844              
845             =item get_annotations( $STATE_FILE )
846              
847             Given a string in the format of a ViewState object from Protein
848             Workshop, returns another ViewState object.
849              
850             =cut
851              
852             sub get_annotations {
853             unshift @_, __PACKAGE__ # add the package name unless already there
854             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
855              
856             my $class = shift;
857             my $state_file = _to_string(shift);
858             my $ret = $class->_call(
859             'getAnnotations', $state_file
860             );
861             return $ret;
862             }
863              
864             =item get_atom_site( $PDBID )
865              
866             Returns the first atom site object for a structure.
867              
868             =cut
869              
870             sub get_atom_site {
871             unshift @_, __PACKAGE__ # add the package name unless already there
872             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
873              
874             my $class = shift;
875             my $pdbid = _to_string(shift);
876             my $ret = $class->_call(
877             'getAtomSite', $pdbid
878             );
879             return $ret;
880             }
881              
882             =item get_atom_sites( $PDBID )
883              
884             Returns the atom site objects for a structure.
885              
886             =cut
887              
888             sub get_atom_sites {
889             unshift @_, __PACKAGE__ # add the package name unless already there
890             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
891              
892             my $class = shift;
893             my $pdbid = _to_string(shift);
894             my $ret = $class->_call(
895             'getAtomSites', $pdbid
896             );
897             return $ret;
898             }
899              
900             =item get_domain_fragments( $PDBID , $CHAINID , $METHOD )
901              
902             Finds all structural protein domain fragments for a given structure.
903              
904             =cut
905              
906             sub get_domain_fragments {
907             unshift @_, __PACKAGE__ # add the package name unless already there
908             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
909              
910             my $class = shift;
911             my $pdbid = _to_string(shift);
912             my $chainid = _to_string(shift);
913             my $method = _to_string(shift);
914             my $ret = $class->_call(
915             'getDomainFragments', $pdbid, $chainid, $method
916             );
917             return $ret && wantarray ? @$ret : $ret;
918             }
919              
920             =item get_first_struct_conf( $PDBID )
921              
922             Finds the first struct_conf for the given structure.
923              
924             =cut
925              
926             sub get_first_struct_conf {
927             unshift @_, __PACKAGE__ # add the package name unless already there
928             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
929              
930             my $class = shift;
931             my $pdbid = _to_string(shift);
932             my $ret = $class->_call(
933             'getFirstStructConf', $pdbid
934             );
935             return $ret;
936             }
937              
938             =item get_first_struct_sheet_range( $PDBID )
939              
940             Finds the first struct_sheet_range for the given structure.
941              
942             =cut
943              
944             sub get_first_struct_sheet_range {
945             unshift @_, __PACKAGE__ # add the package name unless already there
946             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
947              
948             my $class = shift;
949             my $pdbid = _to_string(shift);
950             my $ret = $class->_call(
951             'getFirstStructSheetRange', $pdbid
952             );
953             return $ret;
954             }
955              
956             =item get_struct_confs( $PDBID )
957              
958             Finds the struct_confs for the given structure.
959              
960             =cut
961              
962             sub get_struct_confs {
963             unshift @_, __PACKAGE__ # add the package name unless already there
964             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
965              
966             my $class = shift;
967             my $pdbid = _to_string(shift);
968             my $ret = $class->_call(
969             'getStructConfs', $pdbid
970             );
971             return $ret;
972             }
973              
974             =item get_struct_sheet_ranges( $PDBID )
975              
976             Finds the struct_sheet_ranges for the given structure.
977              
978             =cut
979              
980             sub get_struct_sheet_ranges {
981             unshift @_, __PACKAGE__ # add the package name unless already there
982             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
983              
984             my($class, $pdbid) = _wrap(\@_ => [SELF, STRING]);
985             my $ret = $class->_call(
986             'getStructSheetRanges', $pdbid
987             );
988             return $ret;
989             }
990              
991             =item get_structural_genomics_pdbids( )
992              
993             Finds info for structural genomics structures.
994              
995             =cut
996              
997             sub get_structural_genomics_pdbids {
998             unshift @_, __PACKAGE__ # add the package name unless already there
999             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
1000              
1001             my $class = _wrap(\@_ => [SELF]);
1002             my $ret = $class->_call(
1003             'getStructureGenomicsPdbIds'
1004             );
1005             return $ret && wantarray ? @$ret : $ret;
1006             }
1007              
1008             =item xml_query( $XML )
1009              
1010             Runs any query that can be constructed, pretty much.
1011              
1012             =cut
1013              
1014             sub xml_query {
1015             unshift @_, __PACKAGE__ # add the package name unless already there
1016             unless defined($_[0]) && UNIVERSAL::isa($_[0], __PACKAGE__);
1017              
1018             my($class, $xml) = _wrap(\@_ => [SELF, STRING]);
1019             my $ret = $class->_call(
1020             'xmlQuery', $xml
1021             );
1022             return $ret && wantarray ? @$ret : $ret;
1023             }
1024              
1025             =back
1026              
1027             =cut
1028              
1029             ################################################################################
1030              
1031             sub _get_file {
1032             my($class, @dir) = @_;
1033             my $file = pop @dir;
1034             my($dir, $local_path, $store, $fh);
1035             if($class->cache) {
1036             $dir = File::Spec->catfile($class->cache, @dir);
1037             $local_path = File::Spec->catfile($dir, $file);
1038             }
1039             unless($class->cache && ($store = new IO::File($local_path))) {
1040             my $ftp;
1041             if( ($ftp = new Net::FTP($class->ftp, Debug => 0)) # connect
1042             && $ftp->login(qw(anonymous -anonymous@)) # login
1043             && $ftp->cwd(join('', map("/$_", @dir))) # chdir
1044             ) {
1045             # store in temporary file unless there's a cache
1046             $store = IO::File->new_tmpfile unless $class->cache # cache exists
1047             && File::Path::mkpath($dir) # mkdir
1048             && ($store = new IO::File($local_path, '+>')); # create file
1049            
1050             # seek to start if successful get otherwise delete file
1051             if($ftp->get($file => $store)) {
1052             seek($store, 0, SEEK_SET);
1053             }
1054             else {
1055             undef $store;
1056             $class->cache and unlink $local_path;
1057             }
1058            
1059             # clean up
1060             $ftp->quit;
1061             }
1062             }
1063            
1064             # if file stored, decompress it
1065             if($store) {
1066             $fh = IO::File->new_tmpfile;
1067             IO::Uncompress::Gunzip::gunzip($store => $fh);
1068             seek($fh, 0, SEEK_SET);
1069             close $store;
1070             }
1071            
1072             return $fh;
1073             }
1074              
1075             sub _call {
1076             my $result = shift->soap->call(@_);
1077             confess $result->faultstring if $result->fault;
1078             return $result->result;
1079             }
1080              
1081             sub _wrap {
1082             my @data = @{shift()};
1083             my @type = @{shift()};
1084             return map {
1085             my $type = shift @type;
1086             if($type == BOOLEAN) {
1087             $_ = SOAP::Data->type(boolean => ($_ ? 1 : 0));
1088             }
1089             elsif($type == DOUBLE) {
1090             $_ = SOAP::Data->type(double => $_);
1091             }
1092             elsif($type == INT) {
1093             $_ = SOAP::Data->type('int' => $_);
1094             }
1095             elsif($type == STRING) {
1096             $_ = SOAP::Data->type(string => $_);
1097             }
1098             $_} @data;
1099             }
1100              
1101             sub _to_int {
1102             my $var = shift;
1103             return SOAP::Data->type('int' => $var);
1104             }
1105              
1106             sub _to_string {
1107             my $var = shift;
1108             return SOAP::Data->type(string => $var);
1109             }
1110              
1111             sub _to_boolean {
1112             my $var = shift;
1113             return SOAP::Data->type(boolean => ($var ? 1 : 0));
1114             }
1115              
1116             sub _to_double {
1117             my $var = shift;
1118             return SOAP::Data->type(double => $var);
1119             }
1120              
1121             ################################################################################
1122              
1123             package WWW::PDB::_FastaResult;
1124              
1125             use overload '""' => sub { shift->pdbid };
1126              
1127             sub pdbid {
1128             return substr(${$_[0]}, 0, 4);
1129             }
1130              
1131             sub cutoff {
1132             return substr(${$_[0]}, 5);
1133             }
1134              
1135             ################################################################################
1136              
1137             package WWW::PDB::_EcNumsResult;
1138              
1139             use overload '""' => sub { scalar shift->ec };
1140              
1141             sub pdbid {
1142             return substr(${$_[0]}, 0, 4);
1143             }
1144              
1145             sub chainid {
1146             return substr(${$_[0]}, 5, 1);
1147             }
1148              
1149             sub ec {
1150             local $_ = substr(${$_[0]}, 7);
1151             return wantarray ? split(', ', $_) : $_;
1152             }
1153              
1154             ################################################################################
1155              
1156             1;
1157              
1158             __END__