view release on metacpan or  search on metacpan

GMOD/StandardURLs.pm  view on Meta::CPAN

  my ($requested_species,$release) = rearrange([qw/SPECIES RELEASE/],@p);
  my $config  = ($self->standard_urls) ? $self->standard_urls : $self->_parse_xml();
  $release ||= $self->get_current($requested_species);
  $release = $self->get_current($requested_species) if $release eq 'current';

  my @species = @{$config->{species}};
  my @supported_datasets = $self->supported_datasets;
  my $short_name;
  my $root = $config->{mod}->{mod_url};
  foreach (@species) {
    next unless ($_->{short_name} eq $requested_species || $_->{binomial_name} eq $requested_species);
    $short_name = $_->{short_name};
    my @releases = _fetch_releases($_);
    foreach (@releases) {
      next unless $_->{version} eq $release;
      my %urls = map { $_ => "$root/genome/$short_name/$release/$_" } @supported_datasets;
      return \%urls;
    }
  }
}


sub supported_datasets {
  my $self = shift;
  my $config  = ($self->standard_urls) ? $self->standard_urls : $self->_parse_xml();
  my @datasets = keys %{$config->{mod}->{supported_datasets}};
  return @datasets;
}


sub get_current {
  my ($self,$requested_species) = @_;
  my $config  = ($self->standard_urls) ? $self->standard_urls : $self->_parse_xml();
  my @species = @{$config->{species}};
  foreach (@species) {
    next unless ($_->{short_name} eq $requested_species || $_->{binomial_name} eq $requested_species);
    my @releases = _fetch_releases($_);
    my $most_recent = $releases[-1]->{version};
    return $most_recent;
  }
}

sub fetch {
  my ($self,@p) = @_;
  my ($species,$dataset,$release,$url) = rearrange([qw/SPECIES DATASET RELEASE URL/],@p);
  my $config  = ($self->standard_urls) ? $self->standard_urls : $self->_parse_xml();
  my $version = $self->biogmod_version;
  my $ua = LWP::UserAgent->new();
  $ua->agent("Bio::GMOD::StandardURLs.pm/$version");
  my $root = $config->{mod}->{mod_url};

  $species = $self->get_shortname($species);
  unless ($url) {
    $release ||= $self->get_current($species);
    $release = $self->get_current($species) if $release eq 'current';
    $self->logit(-msg=>"You must specify a species, dataset, and release") unless ($species && $dataset && $release);
    $url = "$root/genome/$species/$release/$dataset";
  }

  # Does this work?
  my $request = HTTP::Request->new('GET',$url);
  my $response = $ua->request($request);
  $self->logit(-msg=>"Couldn't fetch $url: $!") unless $response->is_success;

  if ($response->is_success) {
    my $content = $response->content();
    return $content;
  }
  return 0;
}

# Accessors
sub standard_urls { return shift->{standard_urls}; }

sub get_shortname {
  my ($self,$species) = @_;
  my $config  = ($self->standard_urls) ? $self->standard_urls : $self->_parse_xml();
  my @species = @{$config->{species}};
  foreach (@species) {
    return $_->{short_name} if ($_->{short_name} eq $species);
    return $_->{short_name} if ($_->{binomial_name} eq $species);
  }
}

# Parse the standard URLs XML
sub _parse_xml {
  my $self = shift;
  my $adaptor = $self->adaptor;
  my $standard_urls = $adaptor->standard_urls_xml;
  my $version = $self->biogmod_version;
  my $ua = LWP::UserAgent->new();
  $ua->agent("Bio::GMOD::StandardURLS.pm/$version");
  my $request = HTTP::Request->new('GET',$standard_urls);

  my $response = $ua->request($request);
  die "Couldn't fetch $standard_urls: $!\n" unless $response->is_success;

  my $content = $response->content;
  my $config = XMLin($content);

  # Cache the content for multiple requests
  $self->{standard_urls} = $config;
  return $config;
}


sub _fetch_releases {
  my $species = shift;
  my @releases;
  if (ref $species->{release} eq 'ARRAY') {
    @releases = @{$species->{release}};
  } else {
    my %release = %{$species->{release}};
    push @releases,\%release;
  }
  return @releases;
}



1;


__END__


=pod

=head1 NAME

Bio::GMOD::StandardURLs - Discover and fetch Standard URLs from MODs

=head1 SYNPOSIS

  my $mod = Bio::GMOD::StandardURLS->new(-mod => 'WormBase');
  my @species  = $mod->available_species;

=head1

This module provides a programmatic interface to the common URLs
provided by Model Organism Databases. These URLs simplify the
retrieval of common datasets from using standard URLs.  The full
specification is described at the end of this document.

=head1 PUBLIC METHODS

=over 4

=item $mod->available_species();

Fetch a list of available species available by the Standard URL
mechanism at the current MOD.  Called in array context, returns a list
of species in the form "G_species" (e.g. C_elegans). These abbreviated