File Coverage

blib/lib/Bio/GMOD/StandardURLs.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Bio::GMOD::StandardURLs;

use strict;
use vars qw/@ISA/;
use Bio::GMOD::Util::CheckVersions;
use Bio::GMOD::Util::Rearrange;
use LWP::UserAgent;
use XML::Simple;
use Data::Dumper;

@ISA = qw/Bio::GMOD Bio::GMOD::Util::CheckVersions/;

sub available_species {
  my ($self,@p) = @_;
  my ($expanded) = rearrange([qw/EXPANDED/],@p);
  my $config  = ($self->standard_urls) ? $self->standard_urls : $self->_parse_xml();

  my %species;
  my @species = @{$config->{species}};
  foreach (@species) {
    $species{$_->{binomial_name}} = $_->{short_name};
  }
  return \%species if $expanded;
  return (wantarray) ? ( sort values %species ) : (scalar keys %species);
}


sub releases {
  my ($self,@p)  = @_;
  my ($requested_species,$expanded,$status) = rearrange([qw/SPECIES EXPANDED STATUS/],@p);
  my $config  = ($self->standard_urls) ? $self->standard_urls : $self->_parse_xml();
  $status ||= 'available';
  my @available_releases;
  my @species = @{$config->{species}};
  foreach my $species (@species) {
    if ($requested_species) {
      next unless ($species->{short_name} eq $requested_species || $species->{binomial_name} eq $requested_species);
    }
    my @releases = _fetch_releases($species);
    foreach (@releases) {
      my $available = $_->{available};
      next if ($available eq 'yes' && $status eq 'unavailable');
      next if ($available ne 'yes' && $status eq 'available');
      if ($expanded) {
	push (@available_releases,[$_->{version},$_->{release_date},$_->{available}]);
      } else {
	push (@available_releases,$_->{version});
      }
    }
  }
  return @available_releases;
}

sub datasets {
  my ($self,@p) = @_;
  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__