view release on metacpan or  search on metacpan

Ace/Browser/AceSubs.pm  view on Meta::CPAN

=item DoRedirect($object)

This subroutine immediately redirects to the default display for the
Ace::Object indicated by $object and exits the script.  It must be
called before PrintTop() or any other HTML-generating code.  It
differs from AceRedirect() in that it generates a fast redirect
without alerting the user.

This function is not exported by default.

=cut

# redirect to the URL responsible for an object
sub DoRedirect {
    my $obj = shift;
    print redirect(Object2URL($obj));
    Apache->exit(0) if defined &Apache::exit;
    exit(0);
}

=item $footer = Footer()

This function returns the contents of the footer as a string, but does 
not print it out.  It is not exported by default.

=cut

# Contents of the HTML footer.  It gets printed immediately before the </BODY> tag.
# The one given here generates a link to the "feedback" page, as well as to the
# privacy statement.  You may or may not want these features.
sub Footer {
  if (my $footer = Configuration()->Footer) {
    return $footer;
  }
  my $webmaster = $ENV{SERVER_ADMIN} || 'webmaster@sanger.ac.uk';

  my $obj_name =  escape(param('name'));
  my $obj_class = escape(param('class')) || ucfirst url(-relative=>1);
  my $referer   = escape(self_url());
  my $name      = get_symbolic();

  # set up the feedback link
  my $feedback_link = Configuration()->Feedback_recipients &&
      $obj_name &&
	  (url(-relative=>1) ne 'feedback') ?
    a({-href=>ResolveUrl("misc/feedback/$name","name=$obj_name;class=$obj_class;referer=$referer")},
      "Click here to send data or comments to the maintainers")
      : '';

  # set up the privacy statement link
  my $privacy_link = ( Configuration()->Print_privacy_statement &&
		       url(-relative=>1) ne PRIVACY()) 
    ?
      a({ -href=>ResolveUrl(PRIVACY."/$name") },'Privacy Statement')
	: '';

  my ($home,$label) = @{Configuration()->Home};
  my $hlink = $home ? a({-href=>$home},$label) : '';

  # Either generate a pointer to ACeDB home page, or the copyright statement.
  my $clink = Configuration()->Copyright ? a({-href=>Configuration()->Copyright,-target=>"_new"},'Copyright Statement')
                                       : qq(<A HREF="http://stein.cshl.org/AcePerl">AcePerl Home Page</A>);


  return <<END;
<TABLE WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
<TR CLASS="technicalinfo">
    <TD  CLASS="small" VALIGN="TOP">
    $hlink<br>$clink
    </TD>
    <TD  CLASS="small" ALIGN=RIGHT VALIGN=TOP><p><strong>$feedback_link</strong><br>
    $privacy_link<br>
    <A HREF="mailto:$webmaster"><address>$webmaster</address></A><br>
    </TD>
</TR>
</TABLE>
END
}

=item $object = GetAceObject()

This function is called by display scripts to return the
Ace::Object.that the user wishes to view.  It automatically opens or
refreshes the database, and performs the request using the values of the
"name" and "class" CGI variables.

If a single object is found, the function returns it as the function
result.  If no objects are found, it returns undef.  If more than one
object is found, the function invokes AceMultipleChoices() and exits
the script.

=cut

# open database, return object requested by CGI parameters
sub GetAceObject {
  my $db = OpenDatabase() ||  AceError("Couldn't open database."); # exits
  my $name  = param('name') or return;
  my $class = param('class') or return;
  my @objs = $db->fetch($class => $name);
  if (@objs > 1) {
    AceMultipleChoices($name,'',\@objs);
    Apache->exit(0) if defined &Apache::exit;
    exit(0);
  }
  return $objs[0];
}

=item $html = Header()

This subroutine returns the boilerplate at the top of the HTML page as 
a string, but does not print it out.  It is not exported by default.

=cut

sub Header {
  my $config = Configuration();
  my $dbname = get_symbolic();

  return unless my $searches = $config->Searches;
  my $banner                 = $config->Banner;