#!/usr/bin/perl
# --------------------------------------------------------  PerlInterpreter
# PerlInterpreter must be the first line of the file.
#
# Copyright (c) 1995, Cunningham & Cunningham, Inc.
#
# This program has been generated by the HyperPerl
# generator.  The source hypertext can be found
# at http://c2.com/cgi/wikibase.  This program belongs
# to Cunningham & Cunningham, Inc., is to be used 
# only by agreement with the owner, and then only
# with the understanding that the owner cannot be 
# responsible for any behaviour of the program or
# any damages that it may cause.
# --------------------------------------------------------  InitialComments
$ScriptName = $ENV{SCRIPT_NAME};
# --------------------------------------------------------  ScriptName
sub AbortScript {
local ($msg) = @_;
print <<EOF ;
<h3>The Wiki Wiki Server Can't Process Your Request</h3>
$msg<p>
This information has been logged.<br>
We are sorry for any inconvenince.
EOF
die $msg;
}
# --------------------------------------------------------  AbortScript
$DefaultTitle = Front . Page;
# --------------------------------------------------------  DefaultTitle
$linkWord = "[A-Z][a-z]+";
$LinkPattern = "($linkWord){2,}";
# --------------------------------------------------------  LinkPattern
$DefaultRequest = browse;
# --------------------------------------------------------  DefaultRequest
if ($ENV{REQUEST_METHOD} eq GET){
$RawInput = $ENV{QUERY_STRING} || $DefaultTitle;
$RawInput =~ s/^($LinkPattern)/$DefaultRequest=$1/; 
} 
if ($ENV{REQUEST_METHOD} eq POST){
read(STDIN, $RawInput, $ENV{CONTENT_LENGTH});
} 
# --------------------------------------------------------  RawInput
$FieldSeparator = "\263";
# --------------------------------------------------------  FieldSeparator
foreach $_ (split(/&/, $RawInput)) {
s/\+/ /g;
s/\%(..)/pack(C, hex($1))/geo;
s/$FieldSeparator//g;
($_, $CookedInput) = split (/=/, $_, 2);
$CookedInput{$_} = $CookedInput;
}
# --------------------------------------------------------  CookedInput
sub RetrievePage {
local($title) = pop(@_);
split($FieldSeparator, $db{$title} || 
"text${FieldSeparator}Describe $title here.");
}
# --------------------------------------------------------  RetrievePage
sub EscapeMetaCharacters {
s/&/&amp;/g;
s/</&lt;/g;
s/>/&gt;/g;
}
# --------------------------------------------------------  EscapeMetaCharacters
sub EmitCode {
($code, $depth) = @_;
while (@code > $depth) 
{local($_) = pop @code; 
print "</$_>\n"}
while (@code < $depth) 
{push (@code, ($code)); 
print "<$code>\n"}
if ($code[$#code] ne $code)
{print "</$code[$#code]><$code>\n";
$code[$#code] = $code;}
}
# --------------------------------------------------------  EmitCode
$HostName = "c2.com";
# --------------------------------------------------------  HostName
$ScriptUrl = "http://$HostName$ScriptName";
# --------------------------------------------------------  ScriptUrl
sub AsAnchor {
local($title) = pop(@_);
defined $db{$title}
? "<a href=\"$ScriptUrl\?$title\">$title<\/a>"
: "$title<a href=\"$ScriptUrl\?edit=$title\">?<\/a>";
}
# --------------------------------------------------------  AsAnchor
sub AsLink {
local($num) = (@_);
local($ref) = $old{"r$num"};
defined $ref
? ($ref =~ /\.gif$/ 
? "<img src=\"$ref\">" 
: "<a href=\"$ref\">[$num]<\/a>")
: "[$num]";
}
# --------------------------------------------------------  AsLink
$SearchForm = <<EOF ;
<form>
<input 
type="text" 
size="40" 
name="search" 
value="$CookedInput{value}">
<\/form>
EOF
# --------------------------------------------------------  SearchForm
sub PrintBodyText {
s/\\\n/ /g;
foreach (split(/\n/, $_)){
$code = "";
s/^\s*$/<p>/                  && ($code = '...');             
s/^(\t+)(.+):\t/<dt>$2<dd>/   && &EmitCode(DL, length $1);
s/^(\t+)\*/<li>/              && &EmitCode(UL, length $1);
s/^(\t+)\d+\.?/<li>/          && &EmitCode(OL, length $1);
/^\s/                        && &EmitCode(PRE, 1);
$code                         || &EmitCode("", 0);
s/'{3}(.*)'{3}/<strong>$1<\/strong>/g;
s/'{2}(.*)'{2}/<em>$1<\/em>/g;
s/^-----*/<hr>/;
s/$LinkPattern/&AsAnchor($&)/geo;
s/\[(\d+)\]/&AsLink($1)/geo;
s/\[Search\]/$SearchForm/;
print "$_\n";
}
&EmitCode("", 0);
}
# --------------------------------------------------------  PrintBodyText
sub HandleBrowse {
$title = $CookedInput{browse};
print <<EOF ;
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
EOF
%old = &RetrievePage($title);
$_ = $old{text};
&EscapeMetaCharacters;
&PrintBodyText;
print <<EOF ;
<hr>
<a href="$ScriptUrl\?edit=$title">Edit Text<\/a> of this page 
(last edited $old{date})<br>
<a href="$ScriptUrl\?FindPage&value=$title">Find Page<\/a> by browsing or searching<br>
</body>
EOF
}
# --------------------------------------------------------  HandleBrowse
sub HandleEdit {
$title = $CookedInput{edit} || $CookedInput{copy};
$title =~ /^$LinkPattern$/ || &AbortScript("edit: improper name: $title");
%old = &RetrievePage($title);
$_ = $CookedInput{copy} ? $old{copy} : $old{text};
$note = 'Copy of ' if $CookedInput{copy};
s/\r\n/\n/g;
&EscapeMetaCharacters;
$convert = "checked" if $ENV{HTTP_USER_AGENT} =~ /WebExplorer/;  
print <<EOF ;
<head>
<title>Edit $note$title</title>
</head>
<body>
<form method="POST" action="$ScriptUrl">
<h1>$note$title 
<input type="submit" value=" Save ">
<input type="reset" value=" Reset ">
</h1>
<TEXTAREA NAME="text" ROWS=12 COLS=60>$_</TEXTAREA><br>
<input type="checkbox" name="convert" value="tabs" $convert>
I can't type tabs. 
Please <a href="$ScriptUrl?ConvertSpacesToTabs">ConvertSpacesToTabs</a>
for me when I save.<p>
<a href="$ScriptUrl?GoodStyle">GoodStyle</a> tips for editing.<br>
<a href="$ScriptUrl?links=$title">EditLinks</a> to other web servers.<br>
EOF
print <<EOF  if $old{copy} && !$CookedInput{copy};
<a href="$ScriptUrl?copy=$title">EditCopy</a> from previous author.<br>
EOF
print <<EOF ;
<input type="hidden" size=1 name="post" value="$title">
</form>
</body>
EOF
}
# --------------------------------------------------------  HandleEdit
sub HandleLinks {
$title = $CookedInput{links};
$title =~ /^$LinkPattern$/ || &AbortScript("link: improper name: $title");
%old = &RetrievePage($title);
print <<EOF ;
<head><title>$title Links</title></head>
<body><form method="POST" action="$ScriptUrl">
<h1>$title Links 
<input type="submit" value=" Save ">
<input type="reset" value=" Reset "></h1>
[1] <input type="text" size=55 name="r1" value="$old{r1}"><br>
[2] <input type="text" size=55 name="r2" value="$old{r2}"><br>
[3] <input type="text" size=55 name="r3" value="$old{r3}"><br>
[4] <input type="text" size=55 name="r4" value="$old{r4}"><p>
Type the full URL (http:// ...) for each reference cited in the text.<p>
<input type="hidden" size=1 name="post" value="$title"></form>
EOF
}
# --------------------------------------------------------  HandleLinks
sub HandleSearch  {
local($m, $n, @rec);
$pat = $CookedInput{search};
$pat =~ s/[+?.*()[\]{}|\\]/\\$&/g;
print "<head><title>Search Results</title></head>\n";
print "<body><h1>Search Results</h1>\n";
while (($key, $value) = each %db){
$n++;
%rec = split($SEP, $value);
if ($key =~/\b\w*($pat)\w*\b/i ||
$rec{text} =~ /\b\w*($pat)\w*\b/i){
$m++;
print "<a href=\"$ScriptUrl\?$key\">$key<\/a> . . . . . .  $&<br>\n";
}
}
$m = $m || No;
print "<hr>$m pages found out of $n pages searched.</body>";
}
# --------------------------------------------------------  HandleSearch
sub CookSpaces {
$CookedInput{text} =~ s/ {3,8}/\t/g
if $CookedInput{convert};
}
# --------------------------------------------------------  CookSpaces
@path = split('/', $ScriptName);
$LockDirectory = "/tmp/".pop(@path); 
# --------------------------------------------------------  LockDirectory
sub RequestLock {
local ($n) = 0;
while (mkdir($LockDirectory, 0555) == 0) {
$! = 17 || &AbortScript("can't make $LockDirectory: $!\n");  # EEXIST == 17 is OK, try later.
$n++ < 30 || &AbortScript("timed out waiting for $LockDirectory\n");
sleep(1);
}
}
# --------------------------------------------------------  RequestLock
sub BackupCopy {
$old{copy} = $old{text} 
if $old{host} && $old{host} ne $ENV{REMOTE_HOST};
}
# --------------------------------------------------------  BackupCopy
($sec, $min, $hour, $mday, $mon, $year) = localtime($^T);
$DateToday = (January, February, March, April, May, June, July, 
August, September, October, November, December)[$mon]
. " " . $mday . ", " . ($year+1900);
# --------------------------------------------------------  DateToday
sub ReplacePage {
local($title, *page) = @_;
local($value, @value);
$page{date} = $DateToday;
$page{host} = $ENV{REMOTE_HOST};
$page{agent} = $ENV{HTTP_USER_AGENT};
$page{rev}++;
@value = %page;
$value = join($FieldSeparator, @value);
open (WDB, ">$DBM.wdb/$title");
print WDB $value;
close WDB;
$db{$title} = $value;
}
# --------------------------------------------------------  ReplacePage
sub ReleaseLock {
rmdir($LockDirectory);
}
# --------------------------------------------------------  ReleaseLock
$SignatureUrl = "http://c2.com/sig/ward.gif";
# --------------------------------------------------------  SignatureUrl
sub HandlePost {
$title = $CookedInput{post};
&CookSpaces;
&RequestLock;
dbmopen(%db, $DBM , 0666) || &AbortScript("can't open $DBM for update\n");
%old = &RetrievePage($title);
&BackupCopy;
for (keys(%CookedInput)) {
next if /post/ || /form/ || /title/;
$old{$_} = $CookedInput{$_} if $CookedInput{$_};
}
&ReplacePage($title, *old);
%rc = &RetrievePage(RecentChanges);
$rc{text} =~ s/\t\* $title.*\n//;
$rc{text} .= "\n$DateToday\n\n" unless $rc{text} =~ /$DateToday/;
$rc{text} .= "\t* $title . . . . . . $ENV{REMOTE_HOST}\n";
&ReplacePage(RecentChanges, *rc);
dbmclose(db);
&ReleaseLock;
$anchor = &AsAnchor($title);
print <<EOF ;
<head><title>Thanks for $title Edits</title></head>
<body>
Thank you for editing $anchor.<br>
Your careful attention to detail is much appreciated.<br>
<img src="$SignatureUrl"><br>
p.s. Be sure to <em>Reload</em> your old pages.<br>
</body>
EOF
}
# --------------------------------------------------------  HandlePost
sub DumpBinding {
local(*dict) = @_;
print "<hr><dl>\n";
for (keys(%dict)){print "<dt>$_<dd>$dict{$_}\n";}
print "</dl><hr>\n";
}
# --------------------------------------------------------  DumpBinding
# InitialComments
print "Content-type: text/html\n\n";
$DBM = "/usr/ward/$ScriptName"; 
dbmopen(%db, $DBM , 0666) || &AbortScript("can't open $DBM");
$CookedInput{browse} && &HandleBrowse;
$CookedInput{edit}   && &HandleEdit;
$CookedInput{copy}   && &HandleEdit;
$CookedInput{links}  && &HandleLinks;
$CookedInput{search} && &HandleSearch;
dbmclose (%db);
if ($ENV{REQUEST_METHOD} eq POST) {
$CookedInput{post}   && &HandlePost;
}
# &DumpBinding(*CookedInput);
# &DumpBinding(*old);
# &DumpBinding(*ENV);
# --------------------------------------------------------  WikiInHyperPerl