#!/usr/local/bin/perl
use strict;
########## USER MODIFICATION SECTION ##########
# See http://www.sfu.ca/~ajdelore/ for info
# Don't forget to change the path to perl, above
# The *real* path to read stylesheets from, without trailing slash
my $css_path="."; # Use same directory as script
# The name of the default stylesheet, without extension.
my $default_stylesheet = "style1";
# The script can either generate a redirect header (1) or
# show a 'stylesheet changed' page with a return link (0).
my $use_redirect = 1;
# When should the cookie expire?
# Cookie expiry code uses CGI.pm timestamp
# h = hours, d=days, M=months
# examples:
# +1d - expire in one day
# +3M - expire in three months
# now - expire right away
my $cookie_expiration = "+1d";
########## END USER MODIFICATIONS ##########
my $VERSION = "1.51";
use CGI qw(param cookie header);
# Check to see if the script is called with parameter
unless (param('setstyle')) {
# if the cookie is set, return the appropriate stylesheets
if (cookie('stylesheet')) {
my @stylesheets = split /\+/, cookie('stylesheet');
print header(-type=>'text/css');
foreach (@stylesheets) { print_stylesheet($_) }
}
# otherwise, set a cookie for the default and then send it
else {
my $cookie = cookie ( -name=>'stylesheet',
-value=>$default_stylesheet,
-expires=>$cookie_expiration );
print header (-type=>'text/css', -cookie=>$cookie);
print_stylesheet ($default_stylesheet);
}
}
else {
my $set_values = param('setstyle');
# check the supplied parameters for anything dodgy. if it looks bad,
# use the default instead.
unless ($set_values =~ /^(\w+\+?)?\w+$/ ) {$set_values=$default_stylesheet}
my $cookie = cookie ( -name=>'stylesheet',
-value=>$set_values,
-expires=>$cookie_expiration );
if ($use_redirect and $ENV{HTTP_REFERER}) {
print header ( -cookie=>$cookie, -location=>$ENV{HTTP_REFERER})
}
else {
print header (-type=>'text/html', -cookie=>$cookie);
print qq|
Stylesheet Changed
Your stylesheet has been set to $set_values.
Use your back button to return to the previous page. You
may need to refresh the page to see the new style.
|;
}
}
sub print_stylesheet {
# Function opens, reads, outputs, and closes a stylesheet.
# NOTE: This function deliberately does not use
# "or die" when opening the filehandle. Sending no
# stylesheet is preferable to causing a server error.
# Many thanks to the c.l.p.misc community for suggestions
# for improving this function.
local $_ = shift;
# avoid possible nasties
if ( /^(\w+)$/ ) {
if ( open ( STYLESHEET, "$css_path/$1.css" ) ) {
print while ;
}
}
} # END SUB: print_stylesheet