view release on metacpan or  search on metacpan

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

    p("This page will automatically display the requested object in",
	   "one seconds",a({-href=>$destination},'Click on this link'),
	'to load the page immediately.'),
    end_html();
    Apache->exit(0) if defined &Apache::exit;
    exit(0);
}

=item $configuration = Configuration()

The Configuration() function returns the Ace::Browser::SiteDefs object
for the current session.  From this object you can retrieve
information from the configuration file.

=cut

# get the configuration object for this database
sub Configuration {
  my $s = get_symbolic()||return;
  return Ace::Browser::SiteDefs->getConfig($s);
}

=item $name = DB_Name()

This function returns the symbolic name of the current database, for
example "default".

=cut

*DB_Name = \&get_symbolic;

=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.