view release on metacpan or  search on metacpan

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

package Ace::Browser::AceSubs;

=head1 NAME

Ace::Browser::AceSubs - Subroutines for AceBrowser

=head1 SYNOPSIS

  use Ace;
  use Ace::Browser::AceSubs;
  use CGI qw(:standard);
  use CGI::Cookie;

  my $obj = GetAceObject() || AceNotFound();
  PrintTop($obj);
  print $obj->asHTML;
  PrintBottom();

=head1 DESCRIPTION

Ace::Browser::AceSubs exports a set of routines that are useful for
creating search pages and displays for AceBrowser CGI pages. See
http://stein.cshl.org/AcePerl/AceBrowser.

The following subroutines are exported by default:

  AceError
  AceMissing
  AceNotFound
  Configuration
  DoRedirect
  GetAceObject
  Object2URL
  ObjectLink
  OpenDatabase
  PrintTop
  PrintBottom
  Url

The following subroutines are exported if explicitly requested:

  AceAddCookie
  AceInit
  AceHeader
  AceMultipleChoices
  AceRedirect
  DB_Name
  Footer
  Header
  ResolveUrl
  Style
  Toggle
  TypeSelector

To load the default subroutines load the module with:

   use Ace::Browser::AceSubs;

To bring in a set of optionally routines, load the module with:

   use Ace::Browser::AceSubs qw(AceInit AceRedirect);

To bring in all the default subroutines, plus some of the optional
ones:

   use Ace::Browser::AceSubs qw(:DEFAULT AceInit AceRedirect);

There are two main types of AceBrowser scripts:

=over 4

=item display scripts

These are called with the CGI parameters b<name> and b<class>,
corresponding to the name and class of an AceDB object to display.
The subroutine GetAceObject() will return the requested object, or
undef if the object does not exist.

To retrieve the parameters, use the CGI.pm param() method:

  $name  = param('name');
  $class = param('class');


=item search scripts

These are not called with any CGI parameters on their first
invocation, but can define their own parameter lists by creating
fill-out forms.  The AceBrowser system remembers the last search
performed by a search script in a cookie and regenerates the CGI
parameters the next time the user selects that search script.

=back

=head1 SUBROUTINES

The following sections describe the exported subroutines.

=over 4

=cut

use strict;
use Ace::Browser::SiteDefs;
use Ace 1.76;
use CGI qw(:standard escape);
use CGI::Cookie;
use File::Path 'mkpath';

use vars qw/@ISA @EXPORT @EXPORT_OK $VERSION %EXPORT_TAGS 
  %DB %OPEN $HEADER $TOP @COOKIES
  $APACHE_CONF/;

require Exporter;
@ISA = qw(Exporter);
$VERSION = 1.21;

######################### This is the list of exported subroutines #######################
@EXPORT = qw(
	     GetAceObject AceError AceNotFound AceMissing DoRedirect
	     OpenDatabase Object2URL Url
	     ObjectLink Configuration PrintTop PrintBottom);
@EXPORT_OK = qw(AceRedirect Toggle ResolveUrl AceInit AceAddCookie
		AceHeader TypeSelector Style AcePicRoot
		Header Footer DB_Name AceMultipleChoices);
%EXPORT_TAGS = ( );

use constant DEFAULT_DATABASE  => 'default';
use constant PRIVACY           => 'misc/privacy';  # privacy/cookie statement
use constant SEARCH_BROWSE     => 'search';   # a fallback search script
my %VALID;  # cache for get_symbolic() lookups

=item AceError($message)

This subroutine will print out an error message and exit the script.
The text of the message is taken from $message.

=cut

sub AceError {
    my $msg = shift;
    PrintTop(undef,undef,'Error');
    print CGI::font({-color=>'red'},$msg);
    PrintBottom();
    Apache->exit(0) if defined &Apache::exit;
    exit(0);
}

=item AceHeader()

This function prints the HTTP header and issues a number of cookies
used for maintaining AceBrowser state.  It is not exported by default.

=cut

=item AceAddCookie(@cookies)

This subroutine, which must be called b<after> OpenDatabase() and/or
GetAceObject() and b<before> PrintTop(), will add one or more cookies
to the outgoing HTTP headers that are emitted by AceHeader().  
Cookies must be CGI::Cookie objects.

=cut

sub AceAddCookie {
   push @COOKIES,@_;  # add caller's to our globals
}

################## canned header ############
sub AceHeader {

  my %searches = map {$_=>1} Configuration()->searches;
  my $quovadis = url(-relative=>1);

  my $db = get_symbolic();

  my $referer  = referer();
  $referer =~ s!^http://[^/]+!! if defined $referer;
  my $home = Configuration()->Home->[0] if Configuration()->Home;

  if ($referer && $home && index($referer,$home) >= 0) {
    my $bookmark = cookie(
			  -name=>"HOME_${db}",
			  -value=>$referer,
			  -path=>'/');
    push(@COOKIES,$bookmark);
  }

  if ($searches{$quovadis}) {
    Delete('Go');
    my $search_name = "SEARCH_${db}_${quovadis}";
    my $search_data = cookie(-name  => $search_name,
			     -value => query_string(),
			     -path=>'/',
			    );
    my $last_search = cookie(-name=>"ACEDB_$db",
			     -value=>$quovadis,
			     -path=>'/');
    push(@COOKIES,$search_data,$last_search);
  }

  print @COOKIES ? header(-cookie=>\@COOKIES,@_) : header(@_);

  @COOKIES = ();
  $HEADER++;
}

=item AceInit()

This subroutine initializes the AcePerl connection to the configured
database.  If the database cannot be opened, it generates an error
message and exits.  This subroutine is not exported by default, but is 
called by PrintTop() and Header() internally.

=cut

# Subroutines used by all scripts.
# Will generate an HTTP 'document not found' error if you try to get an 
# undefined database name.  Check the return code from this function and
# return immediately if not true (actually, not needed because we exit).
sub AceInit   {
  $HEADER   = 0;
  $TOP      = 0;
  @COOKIES  = ();