view release on metacpan or  search on metacpan

GMOD/Adaptor.pm  view on Meta::CPAN

package Bio::GMOD::Adaptor;

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

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

sub new {
  my ($self,$overrides) = @_;
  my $adaptor = bless {},$self;
  eval {"require $self"} or $self->logit(-msg => "Couldn't require the $self package: $!",-die => 1);

  # Is a defaults script available?
  # This should be converted to XML
  if ($adaptor->defaults_cgi) {
    my $ua      = LWP::UserAgent->new();
    my $version = $self->biogmod_version;
    $ua->agent("Bio::GMOD.pm/$version");
    my $request = HTTP::Request->new('GET',$adaptor->defaults_cgi);
    my $response = $ua->request($request);

    if ($response->is_success) {
      # Parse out the content and store the defaults in the object
      my $content = $response->content;
      my @lines = split("\n",$content);
      foreach (@lines) {
	next if /^\#/;  # ignore comments
	my ($key,$val) = split("=");
	$adaptor->{defaults}->{lc($key)} = $val;
      }
      $adaptor->{status} = "SUCCESS";
    } else {
      # Couldn't fetch the defaults script - maybe working offline

      # Until fully tested, let's require that you be online.
      # WiMax is coming anyways, right ;)

      $adaptor->logit(-msg => "Couldn't fetch defaults script:\n\t"
		      . $response->status_line .
		      "\n\tYou may be working offline. Defaults will be populated from adaptor object",
		      # -die=>1
		     );
    }
  }

  # Override some of the defaults if requested
  foreach my $key (keys %$overrides) {
    my $value = $overrides->{$key};
    next unless $value;
    $adaptor->{defaults}->{lc($key)} = $value;
  }

  my @defaults = $self->defaults;

  # Finally, fetch the values hardcoded in the Adaptor::*
  foreach my $key (@defaults) {
    next if defined $adaptor->{defaults}->{lc($key)};
    $key = lc ($key);
    my $hard_coded = $adaptor->$key;
    next unless $hard_coded;
    $adaptor->{defaults}->{$key} = $hard_coded;
  }
  return $adaptor;
}

# Generically accept parameters, loading them into the adaptor object.
sub parse_params {
  my ($self,@p) = @_;
  return unless @p;
  my %params = @p;
  foreach my $key (keys %params) {
    my $value = $params{$key};
    # strip of leading hypens.
    # Some may have two coming from @ARGV and command line
    $key =~ s/^\-\-{0,1}//;
    # next if defined $self->{defaults}->{lc($key)};
    $self->{defaults}->{lc($key)} = $value;
  }
}