Bio/DB/SeqVersion/gi.pm

   1 #
   2 # BioPerl module for Bio::DB::SeqVersion::gi
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Brian Osborne
   7 #
   8 # Copyright Brian Osborne 2006
   9 #
  10 # You may distribute this module under the same terms as Perl itself
  11 #
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::DB::SeqVersion::gi - interface to NCBI Sequence Revision History page
  17
  18 =head1 SYNOPSIS
  19
  20 Do not use this module directly, use Bio::DB::SeqVersion.
  21
  22     use Bio::DB::SeqVersion;
  23
  24     my $query = Bio::DB::SeqVersion->new(-type => 'gi');
  25
  26     # all GIs, which will include the GI used to query
  27     my @all_gis = $query->get_all(2);
  28
  29     # the most recent GI, which may or may not be the GI used to query
  30     my $live_gi = $query->get_recent(2);
  31
  32     # get all the visible data on the Sequence Revision page
  33     my $array_ref = $query->get_history(11111111);
  34
  35 These methods can also take accession numbers as arguments, just like
  36 the Sequence Revision page itself.
  37
  38 =head1 DESCRIPTION
  39
  40 All sequence entries at GenBank are identified by a pair of
  41 identifiers, an accession and a numeric identifier, and this number is
  42 frequently called a GI number (B<G>enInfo B<I>dentifier). The accession
  43 is stable, but each new version of the sequence entry for the accession
  44 receives a new GI number (see L<http://www.ncbi.nlm.nih.gov/Sitemap/sequenceIDs.html>
  45 for more information on GenBank identifiers). One accession
  46 can have one or more GI numbers and the highest of these is the most recent,
  47 or "live", GI.
  48
  49 Information on an accession and its associated GI numbers is available at
  50 the Sequence Revision History page at NCBI,
  51 L<http://www.ncbi.nlm.nih.gov/entrez/sutils/girevhist.cgi>, this information is
  52 not available in file format. This module queries the Web page and retrieves GI
  53 numbers and related data given an accession (e.g. NP_111111, A11111, P12345) or
  54 a GI number (e.g. 2, 11111111) as query.
  55
  56 =head1 FEEDBACK
  57
  58 =head2 Mailing Lists
  59
  60 User feedback is an integral part of the evolution of this and other
  61 Bioperl modules. Send your comments and suggestions preferably to one
  62 of the Bioperl mailing lists.  Your participation is much appreciated.
  63
  64   bioperl-l@bioperl.org                  - General discussion
  65   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  66
  67 =head2 Support
  68
  69 Please direct usage questions or support issues to the mailing list:
  70
  71 I<bioperl-l@bioperl.org>
  72
  73 rather than to the module maintainer directly. Many experienced and
  74 reponsive experts will be able look at the problem and quickly
  75 address it. Please include a thorough description of the problem
  76 with code and data examples if at all possible.
  77
  78 =head2 Reporting Bugs
  79
  80 Report bugs to the Bioperl bug tracking system to help us keep track
  81 the bugs and their resolution.  Bug reports can be submitted via the
  82 web:
  83
  84   https://redmine.open-bio.org/projects/bioperl/
  85
  86 =head1 AUTHOR - Brian Osborne
  87
  88 Email E<lt> osborne at optonline dot net E<gt>
  89
  90 =head1 CONTRIBUTORS
  91
  92 Torsten Seemann - torsten.seemann AT infotech.monash.edu.au
  93
  94 =head1 APPENDIX
  95
  96 The rest of the documentation details each of the object
  97 methods. Internal methods are usually preceded with a _
  98
  99 =cut
 100
 101 # Let the code begin...
 102
 103 package Bio::DB::SeqVersion::gi;
 104 use strict;
 105 use HTML::TokeParser;
 106 use Data::Dumper;
 107 use base qw(Bio::DB::SeqVersion);
 108
 109 # Private class variables
 110
 111 my $URL = 'http://www.ncbi.nlm.nih.gov/nuccore/%s?report=girevhist';
 112
 113 =head2 new
 114
 115  Title   : new
 116  Usage   : $gb = Bio::DB::SeqVersion::gi->new
 117  Function: Creates a new query object
 118  Returns : New query object
 119
 120 =cut
 121
 122 sub new {
 123     my ( $class, @args ) = @_;
 124     my $self = $class->SUPER::new(@args);
 125     $self->_initialize;
 126     return $self;
 127 }
 128
 129 =head2 get_all
 130
 131  Title   : get_all
 132  Usage   : my @gis = $q->get_all(2)
 133  Function: Get all GI numbers given a GI number
 134  Returns : An array of GI numbers, earliest GI number is the 0 element
 135  Args    : A single GI number (string)
 136
 137 =cut
 138
 139 sub get_all {
 140     my ( $self, $id ) = @_;
 141     my ( @arr, $ref );
 142     $id eq $self->{_last_id}
 143       ? $ref = $self->{_last_result}
 144       : $ref = $self->get_history($id);
 145     for my $row ( @{$ref} ) {
 146         push @arr, $$row[0];
 147     }
 148     @arr;
 149 }
 150
 151 =head2 get_recent
 152
 153  Title   : get_recent
 154  Usage   : my $newest_gi = $q->get_recent(2)
 155  Function: Get most recent GI given a single GI
 156  Returns : String
 157  Args    : A single GI number (string)
 158
 159 =cut
 160
 161 sub get_recent {
 162     my ( $self, $id ) = @_;
 163     my $ref;
 164     $id eq $self->{_last_id}
 165       ? $ref = $self->{_last_result}
 166       : $ref = $self->get_history($id);
 167     $ref->[0]->[0];
 168 }
 169
 170 =head2 get_history
 171
 172  Title   : get_history
 173  Usage   : my $ref = $query_obj->get_history()
 174  Function: Queries the NCBI Revision page, gets the data from the HTML table
 175  Returns : Reference to an array of arrays where element 0 refers to the most
 176            recent version and the last element refers to the oldest version.
 177            In the second dimension the elements are:
 178
 179            0      GI number
 180            1      Version
 181            2      Update Date
 182            3      Status
 183
 184            For example, to get the GI number of the first version:
 185
 186            $ref->[$#{@$ref}]->[0]
 187
 188            To get the Update Date of the latest version:
 189
 190            $ref->[0]->[2]
 191
 192  Args    : One identifier (string)
 193
 194 =cut
 195
 196 sub get_history {
 197     my ( $self, $id ) = @_;
 198     my $html = $self->_get_request($id);
 199     my ($ref, $status)  = $self->_process_data($html);
 200
 201     # store the very last result in case some other methods
 202     # are called using the same identifier
 203     $self->{_last_result} = $ref;
 204     $self->{_last_id}     = $id;
 205     $ref;
 206 }
 207
 208 =head2 _get_request
 209
 210  Title   : _get_request
 211  Usage   : my $url = $self->_get_request
 212  Function: GET using NCBI Revision page URL, uses Root::HTTPget
 213  Returns : HTML
 214  Args    : One identifier (string)
 215
 216 =cut
 217
 218 sub _get_request {
 219     my ( $self, $id ) = @_;
 220
 221     $self->throw("Must specify a single id to query") if ( !$id || ref($id) );
 222
 223     my $url = sprintf( $URL, $id );
 224     my $response = $self->get($url);
 225     if ( not $response->is_success ) {
 226         $self->throw( "Can't query $url: " . $response->status_line . "\n" ."ID likely does not exist");
 227     }
 228     $self->debug( "Response is:\n", $response->content, "\n" );
 229     return $response->content;
 230 }
 231
 232 =head2 _process_data
 233
 234  Title   : _process_data
 235  Usage   : $self->_process_data($html)
 236  Function: extract data from HTML
 237  Args    : HTML from Revision History page
 238  Returns : reference to an array of arrays
 239
 240 =cut
 241
 242 sub _process_data {
 243     my ( $self, $html ) = @_;
 244     my @table = ();
 245     my $count = 0;
 246     my ($table, $status);
 247
 248     my $p = HTML::TokeParser->new(\$html);
 249     while (my $token = $p->get_tag('td')) {
 250         #print Dumper $token;
 251         print $p->get_text."\n";;
 252     }
 253     #if ($html =~ /Current\s+status:\s+([a-z]+)<\/div>(<table.+)/xms) {
 254     #    ($status, $table) = ($1, $2);
 255     #} else {
 256     #    $self->throw("Could not parse 'Revision history' HTML table: \n$html")
 257     #}
 258     #my (@rows) = $table =~ /<tr>(.+?)<\/tr>/g;
 259     #shift @rows;    # get rid of header
 260     #for my $row (@rows) {
 261     #    my (@arr) = $row =~ />([^<>]+)/g;
 262     #    $table[$count] = \@arr;
 263     #    $count++;
 264     #}
 265     #$self->throw("Bad table data: \n".join("\n",@rows)) unless @table > 1;
 266     print Dumper \@table;
 267     \@table, $status;
 268 }
 269
 270 1;
 271
 272 __END__