#!/usr/local/bin/perl 

use strict;

my $VERSION = "1.5";

########## USER MODIFICATION SECTION ##########

# 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 ##########

use CGI qw(param cookie header);
use subs qw(print_stylesheet);

# 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|
    <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>|;
  }
}

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 <STYLESHEET>;
      }
  }
} # END SUB: print_stylesheet

__END__

=head1 NAME

Cssfile

=head1 README

Allows user-selectable stylesheets in web pages 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 SCRIPT CATEGORIES

  Web
  CGI

=head1 AUTHOR

  Anthony DeLorenzo
  ajdelore@sfu.ca

=cut
