Art Gallery

#!/usr/bin/perl -T # Copyright (c) 1998 Moogle Stuffy, Inc. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # Input: # noframes: 1|0 # No frames? # cookie: Kupo!|0 # Set cookie? $|++; use lib qw(../lib); use CGI; my $q = new CGI; # Delete stray name/value pairs. my %keep = map {$_, 1} qw[noframes text sort size cookie]; for ($q->param) { $keep{$_} or $q->delete($_); } # Check 'preference' cookie. if ($q->param('cookie')) { # Set cookie = query. $q->delete('cookie'); my %pref = map {@_ = $q->param($_); $_, $#_ ? \@_ : $_[0]} $q->param; $cookie = $q->cookie( -name => 'LTM art preferences', -value => \%pref, -expires => '+1y', ); } else { # Set query = cookie || query. my %pref = $q->cookie('LTM art preferences'); $q = new CGI(\%pref) if %pref; } # Save query. my $query_string = $q->query_string; # Send HTML. if ($q->param('noframes')) { # Redirect to ./gallery.cgi my ($base_url) = map {m!^(.+)/!s} $q->url; print $q->redirect( -cookie => $cookie, -uri => "$base_url/gallery.cgi?$query_string", ); } else { # Print a frameset. my $art_side = $q->cookie('LTM art_side') || 'contents.cgi'; print $q->header(-cookie => $cookie) if $ENV{'SERVER_NAME'}; print < Art Gallery

Art Gallery
[stamps the back of your hand] "Please continue . . ." frames \| no frames

FRAMESET } END { my $q = new CGI; $q->query_string and return; use Fcntl; eval { open FH, "+< art.counter" or die "Can't open +<: $!"; flock FH, 2 or die "Can't flock: $!"; my $count = + 1; seek FH, 0, 0 or die "Can't seek: $!"; truncate FH, 0 or die "Can't truncate: $!"; print FH $count; close FH; } or print "\n\n"; eval { open FH, "+< art.referer" or die "Can't open +<: $!"; flock FH, 2 or die "Can't flock: $!"; local $/ = undef; my %referer = map {split /\t/, $_, 2} split /\n/, ; $referer{$ENV{HTTP_REFERER}}++; seek FH, 0, 0 or die "Can't seek: $!"; truncate FH, 0 or die "Can't truncate: $!"; print FH join "\n", map "$_\t$referer{$_}", keys %referer; close FH; } or print "\n\n"; } __END__ END { my $q = new CGI; $q->query_string and return; my ($count, %refer); use Tie::Cache; tie $count, 'Tie::Cache', 'art.counter'; $count++; untie $count; tie %referer, 'Tie::Cache', 'art.referer'; $referer{$ENV{HTTP_REFERER}}++; untie %referer; }