Bio-Das-ProServer
3 results

 view release on metacpan or  search on metacpan

lib/Bio/Das/ProServer.pm  view on Meta::CPAN 


sub response_dsn {
  my ($heap, $request) = @_;
  my $config  = $heap->{'self'}->{'config'};
  my $resp    = _substitute( $heap, $WRAPPERS->{'dsn'}->{'open'} );
  for my $adaptor (sort { lc $a->dsn cmp lc $b->dsn } grep { defined $_ } $config->adaptors()) {
    $resp .= $adaptor->das_dsn();
  }
  $resp .= $WRAPPERS->{'dsn'}->{'close'};
  my $response = HTTP::Response->new(200);
  $response->content_type( _content_type($request, 'application/xml', 'text/xml') );
  $response->content($resp);
  return $response;
}

sub response_sources {
  my ($heap, $request, $call) = @_;
  # Note that structure of 'sources' call has two formats (baseuri/das/sources or baseuri/das/<dsn>)
  my $config  = $heap->{'self'}->{'config'};
  my %data;
  grep {
    defined $_ &&
    (!$call || $call eq $_->dsn || $call eq $_->source_uri || $call eq $_->version_uri) &&
    ($data{$_->source_uri}{$_->version_uri} = $_);
  } $config->adaptors();

  my $resp = _substitute( $heap, $WRAPPERS->{'sources'}->{'open'}, $call );
  while (my ($s_uri, $s_data) = each %data) {
    my @versions = keys %{$s_data};
    if(!scalar @versions) {
      next;
    }

    for my $i (0..(scalar @versions -1)) {
      eval {
        $resp .= $s_data->{$versions[$i]}->das_sourcedata({
                                                           'skip_open'  => $i > 0,
                                                           'skip_close' => $i+1 < scalar @versions,
                                                          });
      } or do {
        carp "Error generating source data for '$versions[$i]':\n$EVAL_ERROR\n";
      };
    }
  }
  $resp .= $WRAPPERS->{'sources'}->{'close'};

  my $response = HTTP::Response->new(200);
  $response->content_type( _content_type($request, 'application/xml', 'text/xml') );
  $response->content($resp);
  return $response;
}

sub response_homepage {
  my ($heap, $request) = @_;
  my $config  = $heap->{'self'}->{'config'};
  my $response = HTTP::Response->new(200);
  $response->content_type( _content_type($request, 'application/xhtml+xml', 'text/html', 'application/xml', 'text/xml') );
  my $content = _substitute( $heap, q(<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="%baseuri/das/homepage.xsl"?>
) );
  $content .= q(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
  <head>
    <title>Welcome to ProServer</title>
    <style type="text/css">
html,body{background:#ffc;font-family:helvetica,arial,sans-serif}
thead{background-color:#700;color:#fff}
thead th{margin:0;padding:2px}
a{color:#a00;}a:hover{color:#aaa}
.cite ul{list-style:none;padding:0;margin:0;}.cite li{display:inline;font-style:oblique;padding-right:0.5em}
.cite{margin-bottom:1em}
.footer_links{font-size:small;text-align:center;}
    </style>
  </head>
  <body>
  <div id="homepage_content">
  <div id="heading"><h1>Welcome to ProServer</h1></div>
  <div id="mainbody">
<p><i>Core by Roger Pettett &copy; Genome Research Ltd.</i></p>
<div class="cite">
<b>ProServer: A simple, extensible Perl DAS server.</b>
<ul><li>Finn RD,</li><li>Stalker JW,</li><li>Jackson DK,</li><li>Kulesha E,</li><li>Clements J,</li><li>Pettett R.</li></ul>
Bioinformatics 2007; <a href="http://bioinformatics.oxfordjournals.org/cgi/content/abstract/btl650v1">doi: 10.1093/bioinformatics/btl650</a>; PMID: 17237073
</div>
);

  $content .= sprintf q(<p>You can view a list of data sources available from this server via a <a href="%s/das/sources">SOURCES</a> or <a href="%1$s/das/dsn">DSN</a> request.</p>)."\n", ## no critic
              $config->server_url();

  $content .= '<h3>Server Maintainer:</h3>';
  my $maintainer = $config->{'maintainer'};
  if ($maintainer) {
    $content .= qq(<p><a href="mailto:$maintainer">$maintainer</a></p>\n);
  } else {
    $content .= qq(<p>This server has no configured maintainer.</p>\n);
  }

  $content .= '<h3>DAS Version:</h3>';
  $content .= '<p>'.$config->das_version.'</p>';

  $content .= '<h3>Loaded modules:</h3><ul>';
  for my $module ((map { 'Bio::Das::'.$_ }                                      sort keys %Bio::Das::),
                  (map { 'Bio::Das::ProServer::'.$_ }                           sort keys %Bio::Das::ProServer::),
                  (map { 'Bio::Das::ProServer::Authenticator::'.$_ }            sort keys %Bio::Das::ProServer::Authenticator::),
                  (map { 'Bio::Das::ProServer::SourceAdaptor::'.$_ }            sort keys %Bio::Das::ProServer::SourceAdaptor::),
                  (map { 'Bio::Das::ProServer::SourceAdaptor::Transport::'.$_ } sort keys %Bio::Das::ProServer::SourceAdaptor::Transport::),
                  (map { 'Bio::Das::ProServer::SourceHydra::'.$_ }              sort keys %Bio::Das::ProServer::SourceHydra::),
                 ) {

    if($module !~ /::$/mxs) {
      next;
    }

    my $cpkg  = substr $module, 0, -2;
    my $str   = $cpkg->VERSION;
    $str || next;
    $content .= qq(<li>$cpkg v$str</li>\n);
  }

  $content .= qq(
</ul>



( run in 2.622 seconds using v1.01-cache-2.11-cpan-df04353d9ac )