view release on metacpan or  search on metacpan

DSS.pm  view on Meta::CPAN

  # CONFIGURE FROM ARGUEMENTS
  # -------------------------

  # return unless we have arguments
  return undef unless @_;

  # grab the argument list
  my %args = @_;

  # Loop over the allowed keys and modify the default query options
  for my $key (qw / RA Dec Target Equinox Xsize Ysize Survey Format
                    URL Timeout Proxy / ) {
      my $method = lc($key);
      $self->$method( $args{$key} ) if exists $args{$key};
  }

}

# T I M E   A T   T H E   B A R  --------------------------------------------

=back

=begin __PRIVATE_METHODS__

=head2 Private methods

These methods are for internal use only.

=over 4

=item B<_make_query>

Private function used to make an DSS query. Should not be called directly,
since it does not parse the results. Instead use the querydb() assessor method.

=cut

sub _make_query {
   my $self = shift;

   # grab the user agent
   my $ua = $self->{USERAGENT};

   # clean out the buffer
   $self->{BUFFER} = "";

   # grab the base URL
   my $URL = $self->{QUERY};
   my $options = "";

   # loop round all the options keys and build the query
   foreach my $key ( keys %{$self->{OPTIONS}} ) {
      $options = $options . 
        "&$key=${$self->{OPTIONS}}{$key}" if defined ${$self->{OPTIONS}}{$key};
   }

   # build final query URL
   $URL = $URL . $options;

   # build request
   my $request = new HTTP::Request('GET', $URL);

   # grab page from web
   my $reply = $ua->request($request);

   # declare file name
   my $file_name;
   
   if ( ${$reply}{"_rc"} eq 200 ) {
      if ( ${${$reply}{"_headers"}}{"content-type"} 
            eq "application/octet-stream" ) {
            
         # mangle filename from $ENV and returned unique(?) filename   
         $file_name = ${${$reply}{"_headers"}}{"content-disposition"};
         my $start_index = index( $file_name, q/"/ );
         my $last_index = rindex( $file_name, q/"/ );
         $file_name = substr( $file_name, $start_index+1, 
                              $last_index-$start_index-1);
         
         $file_name = File::Spec->catfile( $self->{DATADIR}, $file_name);                       
         # Open output file
         unless ( open ( FH, ">$file_name" )) {
            croak("Error: Cannont open output file $file_name");
         }   

         # Needed for Windows (yuck!)
         binmode FH;
         
         # Write to output file
         my $length = length(${$reply}{"_content"});
         syswrite( FH, ${$reply}{"_content"}, $length );
         close(FH);
 
      }
   } else {
      croak("Error ${$reply}{_rc}: Failed to establish network connection");
   }
   
   return $file_name;
}


=item B<_dump_options>

Private function for debugging and other testing purposes. It will return
the current query options as a hash.

=cut

sub _dump_options {
   my $self = shift;

   return %{$self->{OPTIONS}};
}

=back

=end __PRIVATE_METHODS__

=head1 COPYRIGHT