#!/usr/bin/perl -T
# Funnel story script (funnel.cgi)
# Written 1996-05-10 by Andrew Pam of Serious Cybernetics
# Modified for HyperWave 1997-05-01 by Andrew Pam
# Modified for Apache 1997-07-26 by Andrew Pam
# Code cleanup 2007-12-18 by Andrwe Pam
# Based on ideas by Katherine Phelps of Glass Wings
# and Bek Oberin of Computing RJ
# Copyright (c) 1996-2007 Glass Wings
use strict;
use utf8;
use warnings;
# Get the filename of this script, minus the path
my ($script) = $0 =~ m/ ( [^\/]+ ) \z /x;
# Fetch the query string
$_ = $ENV{'QUERY_STRING'};
# Get the path info
my $path = $ENV{'PATH_TRANSLATED'} || q{};
$path .= '/' if $path =~ m{ [^\/] \z }x;
# Print the HTTP header
print "Content-type: text/html\n\n";
# Complain if invalid request method or query string
if ( ( $ENV{'REQUEST_METHOD'} ne 'GET' ) || !$_ ) {
print <<'EOF';
Error!
Form error
Please select "Back" to return to the previous page.
EOF
exit;
} ## end if ( ( $ENV{"REQUEST_METHOD"} ne "GET" ) ||...
# Parse the query string (non-digits, digits, one char, remaining chars)
my ( $file, $level, $choice, $remain ) = m/ \A ( \D* ) ( \d* ) ( .? ) ( .* ) \z /x;
# Remove the current page from the remaining choices
$remain =~ s/ $choice //x;
# Open the HTML file
my $fh;
if ( !open( $fh, '<', "$path$file$level$choice.htm" ) || eof($fh) ) {
print <<"EOF";
Error!
File error
Couldn't open "$path$file$level$choice.htm".
EOF
exit;
} ## end if ( !open( $fh, '<', "$path$file$level$choice.htm"...
# Override $path
$path = 'cgi-bin/';
# Read in entire file!
{
local $/;
$_ = <$fh>;
}
# At the start of a level, just print the whole file
if ( !$choice ) {
print;
}
# If there are no more choices
elsif ( !$remain ) {
# Omit all links in current level
s{ (?: \s* )? }{}gimox;
print;
} ## end elsif ( !$remain )
# Otherwise...
else {
# Omit all links not in this level
s{ (?: \s* )? }{}gimox;
# Omit all visited links in current level
s{ (?: \s* )? }{}gimox;
# Append unvisited link information to remaining links
s{ ( ) }{$1$remain$2}gimox;
print;
} ## end else [ if ( !$choice )
close($fh);