Bio-Das

 view release on metacpan or  search on metacpan

Das.pm  view on Meta::CPAN

                                  }
			       );


=head1 DESCRIPTION

Bio::Das provides access to genome sequencing and annotation databases
that export their data in Distributed Annotation System (DAS) format
version 1.5.  This system is described at http://biodas.org.  Both
unencrypted (http:) and SSL-encrypted (https:) DAS servers are
supported.  (To run SSL, you will need IO::Socket::SSL and Net::SSLeay
installed).

The components of the Bio::Das class hierarchy are:

=over 4

=item Bio::Das

This class performs I/O with the DAS server, and is responsible for
generating DAS requests.  At any time, multiple requests to different

Das/HTTP/Fetch.pm  view on Meta::CPAN

sub host             { shift->{host}             }  # mostly for debugging purposes
sub auth             { shift->{auth}             }
sub incoming_header  { shift->{incoming_header}  }  # buffer for header data


=item $mode = $fetcher->mode([$new_mode])

This misnamed method gets or sets the protocol, which is one of 'http'
for regular cleartext transactions or 'https' for transactions using
the encrypting SSL/TLS protocol.  Note that you must have
IO::Socket::SSL and its associated libraries in order to use SSL/TLS.

=cut

sub mode {
  my $self = shift;
  my $d    = $self->{mode};
  $self->{mode} = shift if @_;
  $d;
}

=item $mode = $fetcher->mode([$new_mode])

This misnamed method gets or sets the protocol, which is one of 'http'
for regular cleartext transactions or 'https' for transactions using
the encrypting SSL/TLS protocol.  Note that you must have
IO::Socket::SSL and its associated libraries in order to use SSL/TLS.

=cut

sub method   {
  my $self = shift;
  my $meth = uc $self->request->method;
  return 'GET' unless $meth;
  if ($meth eq 'AUTO') {
    return $self->outgoing_args ? 'POST' : 'GET';
  }

Das/HTTP/Fetch.pm  view on Meta::CPAN

=cut

# this is called to connect to remote host
sub connect {
  my $pack = shift;
  my ($mode,$host,$port) = @_;
  my $sock;
  if ($mode eq 'https') {
    load_ssl();
    $sock = IO::Socket::SSL->new(Proto => 'tcp',
				 Type => SOCK_STREAM,
				 SSL_use_cert => 0,
				 SSL_verify_mode => 0x00)
  } else {
    $sock = IO::Socket::INET->new(Proto => 'tcp',
				  Type  => SOCK_STREAM)
  }

  return unless $sock;
  $sock->blocking(0);

Das/HTTP/Fetch.pm  view on Meta::CPAN

  if ($self->mode eq 'https') {
    $self->complete_ssl_handshake($self->{socket}) || return $self->error("412 SSL error ".$self->{socket}->error);
  }

  $self->{formatted_request} ||= $self->format_request();

  warn "SENDING $self->{formatted_request}" if $self->debug;

  # Send the header and request.  Note that we have to respect
  # both IO::Socket EWOULDBLOCK errors as well as the dodgy
  # IO::Socket::SSL "SSL wants a write" error.
  my $bytes = syswrite($self->{socket},$self->{formatted_request});
  if (!$bytes) {
    return $self->status if $! == EWOULDBLOCK;  # still trying
    return $self->status if $self->{socket}->errstr =~ /SSL wants a write/;
    return $self->error("412 Communications error: $!");
  }
  if ($bytes >= length $self->{formatted_request}) {
    $self->status('reading header');
  } else {
    substr($self->{formatted_request},0,$bytes) = '';  # truncate and try again

Das/HTTP/Fetch.pm  view on Meta::CPAN

  }
}

=item $fetcher->load_ssl

This method performs initialization needed to use SSL/TLS transactions.

=cut

sub load_ssl {
  eval 'require IO::Socket::SSL' or croak "Must have IO::Socket::SSL installed to use https: urls: $@";

  # cheating a bit -- IO::Socket::SSL doesn't have this function, and needs to!
  eval <<'END' unless defined &IO::Socket::SSL::pending;
sub IO::Socket::SSL::pending {
  my $self = shift;
  my $ssl  = ${*$self}{'_SSL_object'};
  return Net::SSLeay::pending($ssl); # *
}
END

}

=item $fetcher->complete_ssl_handshake($sock)

Das/HTTP/Fetch.pm  view on Meta::CPAN

sub complete_ssl_handshake {
  my $self = shift;
  my $sock = shift;
  $sock->blocking(1);  # handshake requires nonblocking i/o
  my $result = $sock->connect_SSL($sock);
  $sock->blocking(0);
}

# necessary to define these methods so that IO::Socket::INET objects will act like
# IO::Socket::SSL objects.
sub IO::Socket::INET::pending { 0     }
sub IO::Socket::INET::errstr  { undef }


=head1 AUTHOR

Lincoln Stein <lstein@cshl.org>.

Copyright (c) 2001 Cold Spring Harbor Laboratory