Webbook: An Address Book for the World Wide Web (Web Techniques, Apr 1996)

#!/usr/local/bin/perl
# WebBook/Lite:
# This is a cut-down version of Simson Garfinkel's WebBook program, 
# specially developed for Web Techniques, April 1996.
#

# Define globals

$database = "/tmp/WebBook.data";
$max_entry = 450;

# Get Started:
if (!$standalone) {
    print "Content-type:text/html\n\n";
    &main;
    exit(0);
}

#################################################################
# CGI Interface Library. Taken from cgi-lib.pl. (C) 1994 Steven E. Brenner.
# For more information, see:
#     http://www.bio.cam.ac.uk/web/form.html       
#     http://www.seas.upenn.edu/~mengwong/forms/   
#

# ReadParse: Returns TRUE if there was input, FALSE if there was no input.

sub ReadParse {
  local (*in) = @_ if @_;
  local ($i, $key, $val);

  # Read in text
  if (&MethGet) {
    $in = $ENV{'QUERY_STRING'};
  } elsif (&MethPost) {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }

  @in = split(/[&;]/,$in); 

  foreach $i (0 .. $#in) {
    # Convert plus's to spaces
    $in[$i] =~ s/\+/ /g;

    # Split into key and value.  
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

    # Convert %XX from hex numbers to alphanumeric
    $key =~ s/%(..)/pack("c",hex($1))/ge;
    $val =~ s/%(..)/pack("c",hex($1))/ge;

    # Associate key and value
    $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
    $in{$key} .= $val;

  }

  return length($in); 
}

#
# Handle Post and Get methods:
#
sub MethGet  {  return ($ENV{'REQUEST_METHOD'} eq "GET"); }
sub MethPost {  return ($ENV{'REQUEST_METHOD'} eq "POST");}

#
# Return my URL
#
sub MyURL  {
  local ($port);
  $port = ":" . $ENV{'SERVER_PORT'} if  $ENV{'SERVER_PORT'} != 80;
  return  'http://' . $ENV{'SERVER_NAME'} .  $port . $ENV{'SCRIPT_NAME'};
}

################################################################
#
# WebBook starts here
#

sub main {

    dbmopen(%DB,$database,0666);

    &get_command;
}

sub get_command {

    if(&ReadParse(*input)) {
    $action = $input{'action'};
    $name   = $input{'name'};
    }
    
    $myurl = &MyURL;

    #
    # Decode the action
    #
    if($action eq "search"){        &do_search($name); return; }
    if($action eq "edit"){          &do_edit($name);   return; }
    if($action eq "save_entry"){    &do_save_entry;    return; }
    if($action eq "delete_entry"){  &do_delete_entry;  return; }

    if($action){
    print "<title>Error</title><h1>Unknown command '${action}'</h1>";
    return;
    }

    # Default - display an info message
    &do_info;
}


sub display_search_field {
    print <<XX;
        <center><h2>WebBook Search</h2></center>
        <form method=post action="$myurl">
        Search for: <input type=text size="16" name="name">
        <input type=submit name="search-type" value="find name">
        <input type=submit name="search-type" value="full-text">
        <input type=hidden name="action" value="search">
        </form>
        <hr>
        <form method=post action="$myurl">
        Alternatively, you may create a 
        <input type=submit value="new entry">
        <input type=hidden value="edit" name="action">
        <input type=hidden value=""     name="name">
        </form>
    <hr>
XX
}

#
# Searching:
# Return a list of matching names
# If an argument is provided, only print the matches.
#

sub find_names {
    local($to_match)  = $_[0];
    local($full_text) = $_[1];
    local(@list)      = keys %DB;
    local(@matched,$name);
    $num = @list;
    
    return sort @list if ($to_match eq ""); # no search string, return all
    
    foreach $name (@list){
    $_ = $name . ($full_text ? $DB{$name} : "");
    push(@matched,$name) if(m/$to_match/io);
    }

    return sort @matched;
}

sub do_search {

    local($stext) = $_[0];          # What we are searching for
    local($stype) = $input{'search-type'} eq "full-text";

    &display_search_field;

    local(@list);
    local($ent);
    local($escaped_name);
    

    @list = &find_names($stext,$full_text);

    print "<h1>$stype search for $stext</h1>\n";
    print "<ul>";
    
    foreach $_ (@list){
    
    $escaped_name = $_;
    $escaped_name =~ s/ /+/g;
        
    print "<li><big><a href=
                 \"$myurl?action=edit&name=$escaped_name\">$_</a></big><br>\n";

    print "<ul>";
    $ent = $DB{$_};
        
        # Now escape the various things in HTML tags
        
    $ent =~ s/&/&/g;
        $ent =~ s/</</g;
        
    # Note: the following four substitutions must be done in order
        
    # 1. Catch the URLs
    $ent =~ s#((http:|mailto:|ftp:)//[^ \n\t]*)#<a href="$1">$1</a>#g;
        
    # 2. Catch the email addresses
    $ent =~ s#([a-z0-9_.]*@[a-z0-9_.]*)# <a href="mailto:$1">$1</a>#gi;
        
    # 3. Now change newlines to <br>'s
    $ent =~ s/\n/<br>\n/g;
        
    print "$ent</ul><p>";
    }
    print "</ul>";
    print "<hr><i>To change an entry, click on the entry's name.</i>";
}

sub do_edit {

    local($ent) = $DB{$name};

    if($name eq ""){
    print "<h1>Create a new entry</h1>";
    }
    else{
    print "<h1>Edit $name</h1>";
    }
    print <<XX;
    <form method=post>
    <input type=text    name="name"     value="$name" size="60" ><br>
    <input type=hidden  name="old-name" value="$name">
    <input type=hidden  name="action"   value="save_entry">
    <textarea name="entry" rows=8 cols=60>$ent</textarea><br>
    <input type=submit  value="save"> Save your changes<br>
    </form>
XX
}

#
# Called to save-entry an entry
#
sub do_save_entry {
    $old_name = $input{'old-name'};
    $entry    = $input{'entry'};

    if(($size=length($entry)) > $max_entry){
    print <<XX;
    <h1>That entry is too big!</h1>
    Sorry, but this version of WebBook cannot accept entries that are 
    longer than <b>$max_entry</b> characters.<br> Your entry is 
        <b>$size</b> characters.
    Please hit the "back" button on
    your browser and shorten it.
XX
    return;
    }

    if($name eq ""){
    print <<XX;
    <title>Illegal name</title><h1>Illegal name</h1>
    Please specify a name.
XX
        return;
    }

    if(($old_name eq "") && ($DB{$name} ne "")){
    print <<XX;
    <title>WebBook error</title>
    <h1>Name in Use!</h1>
    There is already an entry by that name. Click the <b>back</b>
    button on your browser and change it.
XX
        return;
    }

    delete $DB{$old_name};
    $DB{$name} = $entry;
    
    &do_search($name);  # Display the new name
}

sub do_info {
    $num = scalar keys %DB;
    print <<XX;
<title>WebBook</title>
<h1>WebBook</h1>
Welcome to WebBook! You can search $num entries on this server.
<hr>
XX
    &display_search_field;
}

1;