Sample Script For Hypermart To Debug

 # --------------------------------------------------------  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/&/&amp;/g;
 s/</&lt;/g;
 s/>/&gt;/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?