view release on metacpan or  search on metacpan

Bio/DB/Expression/geo.pm  view on Meta::CPAN

Internal methods are usually preceded with a '_'.  Methods are
in alphabetical order for the most part.

=cut


# Let the code begin...

package Bio::DB::Expression::geo;
use strict;
use base qw(Bio::DB::Expression);

use Bio::Expression::Contact;
use Bio::Expression::DataSet;
use Bio::Expression::Platform;
use Bio::Expression::Sample;

use constant URL_PLATFORMS => 'https://www.ncbi.nlm.nih.gov/geo/browse/?view=platforms';
use constant URL_PLATFORM => 'https://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?form=text&view=full&acc=';
use constant URL_DATASET => 'https://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?form=text&view=full&acc=';
use constant URL_SAMPLE => 'https://www.ncbi.nlm.nih.gov/projects/geo/query/acc.cgi?form=text&view=full&acc=';

=head2 _initialize()

 Usage   : $obj->_initialize(%arg);
 Function: Internal method to initialize a new Bio::DB::Expression::geo object
 Returns : true on success
 Args    : Arguments passed to new()

=cut

sub _initialize {
  my($self,%arg) = @_;

  foreach my $arg (keys %arg){
    my $marg = $arg;
    $marg =~ s/^-//;
    $self->$marg($arg{$arg}) if $self->can($marg);
  }

  return 1;
}

=head2 get_platforms()

 Usage   :
 Function:
 Example :
 Returns : a list of Bio::Expression::Platform objects
 Args    :

=cut

sub get_platforms {
  my ($self,@args) = @_;

  my $doc = $self->_get_url( URL_PLATFORMS );
  $doc =~ s!^.+?>Release date<.+?</tr>(.+)</table>!$1!gs;

  my @platforms = ();
  my @records = split m!</tr>\s+<tr>!, $doc;

  foreach my $record ( @records ) {
    my ($platform_acc,$name,$tax_acc,$contact_acc,$contact_name) =
      $record =~ m!acc\.cgi\?acc=(.+?)".+?<td.+?>(.+?)<.+?<td.+?>.+?<.+?<td.+?>.+?href=".+?id=(.+?)".+?<td.+?OpenSubmitter\((\d+?)\).+?>(.+?)<!s;
    next unless $platform_acc;

    my $platform = Bio::Expression::Platform->new(
                                                  -accession => $platform_acc,
                                                  -name => $name,
                                                  -_taxon_id => $tax_acc,
                                                  -contact => Bio::Expression::Contact->new(
                                                                                            -source => 'geo',
                                                                                            -accession => $contact_acc,
                                                                                            -name => $contact_name,
                                                                                            -db => $self
                                                                                           ),
                                                  -db => $self,
                                                 );
    push @platforms, $platform;
  }

  return @platforms;
}

=head2 get_samples()

 Usage   :
 Function:
 Example :
 Returns : a list of Bio::Expression::Sample objects
 Args    :

=cut

sub get_samples {
  my ($self,@args) = @_;
  $self->throw_not_implemented();
}

=head2 get_contacts()

 Usage   :
 Function:
 Example :
 Returns : a list of Bio::Expression::Contact objects
 Args    :

=cut

sub get_contacts {
  my ($self,@args) = @_;
  $self->throw_not_implemented();
}

=head2 get_datasets()

 Usage   : $db->get_datasets('accession');
 Function:
 Example :
 Returns : a list of Bio::Expression::DataSet objects