#!/usr/local/bin/perl
use strict;
my $VERSION = "1.4.2";
########## USER MODIFICATION SECTION ##########
# The *real* path to read stylesheets from.
# File extensions of .css for stylesheets are assumed.
# It must not include trailing backslash.
my $css_path="."; # Use same directory as script
# The name of the default stylesheet, without extension.
my $default_stylesheet = "style1";
# 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 ##########
use CGI qw(param cookie header);
# Check to see if the script is called with parameter
my $set_values = param ('setstyle');
unless ($set_values) {
# 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 {
# set the cookie and produce a page to get back to whence they came.
my $cookie = cookie ( -name=>'stylesheet',
-value=>$set_values,
-expires=>$cookie_expiration );
print header (-type=>"text/html", -cookie=>$cookie);
print <<END_PAGE;
<html>
<head>
<title>Stylesheet Changed</title>
</head>
<body>
<p>
Your stylesheet has been set to <em>$set_values</em>.
You may need to reload your browser to view the new stylesheet.
</p>
<p><a href="$ENV{'HTTP_REFERER'}">Back</a></p>
</body>
</html>
END_PAGE
}
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;
# strip possible nasties like '../../'
if ( /(\w+)$/ ) {
if ( open ( STYLESHEET, "$css_path/$1.css" ) ) {
print while <STYLESHEET>;
}
}
} # END SUB: print_stylesheet
__END__
=head1 NAME
Cssfile
=head1 README
Allows user-selectable stylesheets using CGI and cookies.
Full documentation at http://www.sfu.ca/~ajdelore/cssfile/
=head1 PREREQUISITES
This script runs under C<strict> and requires the C<CGI> module.
=head1 AUTHOR
Anthony DeLorenzo (ajdelore@sfu.ca)
=pod SCRIPT CATEGORIES
CGI
Web
=cut