Apache-SetWWWTheme
view release on metacpan or search on metacpan
SetWWWTheme.pm view on Meta::CPAN
# SetWWWTheme.pm - perl source for Apache::SetWWWTheme
#
# Copyright (C) 2000 Chad Hogan <chogan@uvastro.phys.uvic.ca>
# Copyright (C) 2000 Joint Astronomy Centre
#
# All rights reserved.
#
# This file is part of Apache::SetWWWTheme
#
# Apache::SetWWWTheme is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.
#
# Apache::SetWWWTheme is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Apache::SetWWWTheme; see the file gpl.txt. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
package Apache::SetWWWTheme;
use strict;
use Carp;
use vars qw($VERSION);
use Apache::Constants ':common';
use Apache::File ();
use HTML::WWWTheme;
$VERSION = '1.06';
##################################################
my $r; # request object variable
my $Theme; # Theme object!
my $blankgif = ""; # the location of the blank gif. or png. Whatever.
my $allowbodymod; #
my ($nextlink, $lastlink, $uplink, $BGCOLOR); # vars we use to customize the page
my ($alink, $link, $text, $vlink); # <BODY> stuff
my @infolinks; # array to contain the links in the infobar
my $usenavbar; # flag that tells if we use the top and bottom navbar
my $serverconfig; # name of the server config file
my $localconfig; # name of the local config file
my $shortlocal; # short name of local config file
my $allowsidebartoggle; # flag set by server to allow turning on/off the sidebar
my $allowBGCOLOR; # flag set by the server to allow the local config to
# change the background color. HTML pages can *never*
# override the background color.
my $nosidebar; # flag set to turn off the sidebar. $allownosidebar
# must be set to use this.
my $allowbgpicture; # let us put in a background gif or something. I put this in
# so you could kill off animated bgs and other junk
my $bgpicture; # used to set the bg picture for the produced page.
#
my $allowsidebarmod; # sidebar modification variables...
my $sidebartop; #
my $sidebarmenutitle; #
my @sidebarmenulinks; #
my $nosidebarextras; #
my $morelinkstitle; #
my $sidebarsearchbox; #
my $sidebarcolor; #
my $sidebarwidth; #
my $searchtemplate; # a search template
my $topbar; #
my $bottombar; #
my @topbottomlinks; #
my $filename; #
my $printable; #
my $printabletag = "printable"; # what we tack on for the QUERY_STRING GET data
my $printableuri; #
##################################################
sub handler
{
$r = shift; # get request object
$Theme = new HTML::WWWTheme(); # grab our theme object.
my $content_type;
$content_type = $r->content_type() || return DECLINED;
# we only want to deal with html files
return DECLINED unless $content_type eq 'text/html';
$filename = $r->filename; # get the filename we're looking for
unless (-e $r->finfo) # Apache does a stat() and puts the results in finfo,
# this is faster than testing the filename.
{
$r->log_error("File does not exist: $filename");
return NOT_FOUND;
}
unless (-r _) # after finfo is used, it goes to perl's _ filehandle
{
$r->log_error("File permissions deny access: $filename");
( run in 0.464 second using v1.01-cache-2.11-cpan-df04353d9ac )