view release on metacpan or  search on metacpan

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

    $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
 Args    :

=cut

sub get_datasets {
  my ($self,$platform) = @_;

  my @lines = split /\n/, $self->_get_url( URL_PLATFORM . $platform->accession );

  my @datasets = ();

  foreach my $line ( @lines ) {
    my ($dataset_acc) = $line =~ /^\!Platform_series_id = (\S+?)\s*$/;
    next unless $dataset_acc;

    my $dataset = Bio::Expression::DataSet->new(
                                                -accession => $dataset_acc,
                                                -platform => $platform,
                                                -db => $self,
                                               );

    push @datasets, $dataset;
  }

  return @datasets;
}

sub fill_sample {
  my ( $self, $sample ) = @_;

  my @lines = split /\n/, $self->_get_url( URL_SAMPLE. $sample->accession );

  foreach my $line ( @lines ) {
    if ( my ($name) = $line =~ /^\!Sample_title = (.+?)\s*$/ ) {
      $sample->name( $name );
    }
    elsif ( my ($desc) = $line =~ /^\!Sample_characteristics.*? = (.+?)\s*$/ ) {
      $sample->description( $desc );
    }
    elsif ( my ($source_name) = $line =~ /^\!Sample_source_name.*? = (.+?)\s*$/ ) {
      $sample->source_name( $source_name );
    }
    elsif ( my ($treatment_desc) = $line =~ /^\!Sample_treatment_protocol.*? = (.+?)\s*$/ ) {
      $sample->treatment_description( $treatment_desc );
    }
  }
  return 1;
}

sub fill_dataset {
  my ( $self, $dataset ) = @_;