#!/usr/local/bin/perl -w
# -------------------------------------------------------- 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.
# (This is a little test of modifying the source.)
# -------------------------------------------------------- InitialComments
#### Added two modules for the ?TieReplacement For dbmopen
use DB_File;
use Fcntl;
#### At least 4 hexsigns are patchmarkers -- FridemarPache
@path = split('/', "$ENV{SCRIPT_NAME}");
$ScriptName = pop(@path);
# -------------------------------------------------------- ScriptName
$DataBase = "/wikibase/pages/$ScriptName"; # didn't work on hypermart
chop($DataBase);
chop($DataBase); # got rid of 'pl'
$DataBase = ".".$DataBase."db"; # so it works
$?FridemarUrl="http://server2.hypermart.net/fridemar/";
# -------------------------------------------------------- DataBase
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 inconvenience. # corrected typo
EOF
die $msg;
}
# -------------------------------------------------------- AbortScript
$DefaultTitle = Front . Page;
# -------------------------------------------------------- DefaultTitle
#$linkWord = "[A-Z][a-z]+";
$linkWord = "[A-Z][a-z0-9]*[\_\.\-]?";
$LinkPattern = "($linkWord){2,}";
# -------------------------------------------------------- LinkPattern
# $DefaultRequest = browse;
$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
$RawInput =~ s/\+/ /g;
foreach $_ (split(/&/, $RawInput)) {
s/\%(..)/pack(C, hex($1))/ge;
s/$FieldSeparator//go;
($_, $CookedInput) = split (/=/, $_, 2);
$CookedInput{$_} = $CookedInput;
}
# -------------------------------------------------------- CookedInput
# $LogoUrl =' ';
$LogoUrl =$?FridemarUrl.'sig/datamlogo1.jpg';
#' ';
# -------------------------------------------------------- LogoUrl
$LogoImage = "<img src=\"$LogoUrl\" align=middle alt=\"What's that\?\nIt's data-music. \nMusic inspired by stock data.\">";
#<img src=" ">
# -------------------------------------------------------- LogoImage
#$ScriptUrl = "http://fridemar.hypermar ... -bin/$ScriptName";
$ScriptUrl = $?FridemarUrl."/cgi-bin/$ScriptName";
# -------------------------------------------------------- ScriptUrl
sub RetrievePage {
local($title) = pop(@_);
split($FieldSeparator, $db{$title} ||
"text${FieldSeparator}Describe $title here.");
}
# -------------------------------------------------------- RetrievePage
sub EscapeMetaCharacters {
s/&/&/g;
s/</</g;
s/>/>/g;
}
# -------------------------------------------------------- EscapeMetaCharacters
sub InPlaceUrl {
local($num) = (@_);
local($ref) = $InPlaceUrl[$num];
"<a href=\"$ref\">$ref</a>";
}
# -------------------------------------------------------- InPlaceUrl
$TranslationToken = $FieldSeparator;
# -------------------------------------------------------- TranslationToken
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) #uninitialized value !!?
{print "</$code[$#code]><$code>\n";
$code[$#code] = $code;}
}
# -------------------------------------------------------- EmitCode
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 ; # uninitialized value !!?
<form action="$ScriptName">
<input
type="text"
size="40"
name="search"
value="$CookedInput{value}">
<\/form>
EOF
# -------------------------------------------------------- SearchForm
sub PrintBodyText {
s/\\\n/ /g;
foreach (split(/\n/, $_)){
$InPlaceUrl=0;
while (s/\b((http)|(ftp)|(mailto)|(news)|(file)|(gopher)):[^\s\<\>\[\]"'\(\)]*[^\s\<\>\[\]"'\(\)\,\.\?]/$TranslationToken$InPlaceUrl$TranslationToken/) {
$InPlaceUrl[$InPlaceUrl++] = $&
}
$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/\b$LinkPattern\b/&AsAnchor($&)/geo;
s/\[(\d+)\]/&AsLink($1)/geo;
s/$TranslationToken(\d+)$TranslationToken/&InPlaceUrl($1)/geo;
s/\[Search\]/$SearchForm/;
print "$_\n";
}
&EmitCode("", 0);
}
# -------------------------------------------------------- PrintBodyText
sub HandleBrowse {
$title = $CookedInput{browse};
print <<EOF ;
<head>
<title>$title</title>
</head>
<body
background="Rosa_und_WeissA1B1.gif" bgcolor="#FFFFFF"
link="#FF0000" alink="#808080">
<h1><a href="http://www.data-music.com">$LogoImage </a>
<a href="$ScriptUrl\?search=$title">$title<\/a>
<\/h1>
EOF
%old = &RetrievePage($title);
$_ = $old{text};
&EscapeMetaCharacters;
&PrintBodyText;
print <<EOF ; # uninitialized value !!?
<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>
<p>
<p>
EOF
# <li> <a href="$ScriptUrl"\?RecentChanges">RecentChanges<\/a> in our forum
print "</body>";
}
# -------------------------------------------------------- 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/;
$convert = "checked"; # if $ENV{HTTP_USER_AGENT} =~ /WebExplorer/;
print <<EOF ;
<head>
<title>Edit $note$title</title>
</head>
<body background="Rosa_und_WeissA1B1.gif" bgcolor="#FFFFFF"
link="#FF0000" alink="#808080" >
<form method="POST" action="$ScriptUrl">
<h1>$note$title
<input type="submit" value=" Save ">
<input type="reset" value=" Reset ">
</h1>
<TEXTAREA NAME="text" ROWS=16 COLS=80 wrap=virtual>$_</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;
$results = Results;
$results = "for $&" if $pat =~ /\W+/;
print <<EOF ;
<head><title>Search $results</title></head>
<body
background="Rosa_und_WeissA1B1.gif" bgcolor="#FFFFFF"
link="#FF0000" alink="#808080">
EOF
#print "<h1>$LogoImage Search Results</h1>\n";
print "<h1> Search Results</h1>\n";
while (($key, $value) = each %db){
$n++;
%rec = split($FieldSeparator, $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
$LockDirectory = "./temp/$ScriptName"; # hypermart specific
chop($LockDirectory);
chop($LockDirectory);
chop($LockDirectory);
#$LockDirectory = "./tmp/$ScriptName";
# -------------------------------------------------------- LockDirectory
sub RequestLock {
local ($n) = 0;
while (mkdir($LockDirectory, 0755) == 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, ">$DataBase.wdb/$title");
print WDB $value;
close WDB;
$db{$title} = $value;
}
# -------------------------------------------------------- ReplacePage
sub ReleaseLock {
rmdir($LockDirectory);
}
# -------------------------------------------------------- ReleaseLock
######$SignatureUrl = " ";
# $SignatureUrl = " ";
$SignatureUrl = $?FridemarUrl."sig/thanks.gif";
# -------------------------------------------------------- SignatureUrl
sub HandlePost {
$title = $CookedInput{post};
&CookSpaces;
&RequestLock;
######dbmopen(%db, $DataBase , 0666)
######|| &AbortScript("can't open $DataBase for update\n");
######start of patch
# To create, read and write
###### chmod 0666 , $DataBase;
tie (%db, 'DB_File', $DataBase , O_RDWR|O_CREAT, 0666)
|| &AbortScript("cannot open $DataBase for update\n");
# chmod 0666 , </data1/hypermart.net/fridemar/wikibase/pages/*>;
####### end of patch
%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" unless $rc{text} =~ /$DateToday/;
$rc{text} .= "\t* $title . . . . . . $ENV{REMOTE_HOST}\n";
&ReplacePage(RecentChanges, *rc);
$anchor = &AsAnchor($title);
####dbmclose(db); # looks like a typo
####dbmclose(%db);
untie %db; # new for tie construct
&ReleaseLock;
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";
#######dbmopen(%db, $DataBase , 0666) || &AbortScript("can't open $DataBase");
# &DumpBinding(*CookedInput);
# &DumpBinding(*old);
# &DumpBinding(*ENV);
#### chmod 0666 , $DataBase;
tie (%db, 'DB_File', $DataBase , O_RDWR|O_CREAT, 0666)
|| &AbortScript("(HandleBrowse) Cannot open $DataBase for update\n");
$CookedInput{browse} && &HandleBrowse;
#$CookedInput{"browse"} && &HandleBrowse;
$CookedInput{edit} && &HandleEdit;
$CookedInput{copy} && &HandleEdit;
$CookedInput{links} && &HandleLinks;
$CookedInput{search} && &HandleSearch;
#close(LOCK);
untie %db ;
#####dbmclose (%db);
if ($ENV{REQUEST_METHOD} eq POST) {
$CookedInput{post} && &HandlePost;
};
# &DumpBinding(*CookedInput);
# &DumpBinding(*old);
# &DumpBinding(*ENV);
# -------------------------------------------------------- WikiInHyperPerl
# FromWhere: http://c2.com/cgi/wiki?ForthishWikiName , FridemarPache
# Visit me at http://server2.hypermart ... -bin/wikibase.pl?
|