Example 2. Code listing for skimpyforum.

use XML::LibXML;

# Read data file and store in DOM object whose ref is $doc
my $datafile = "/home/eray/forum.data";
my $parser = new XML::LibXML;               
my $doc = $parser->parse_file( $datafile );

# munch on the CGI query and format results in an HTML page
handle_query();

################################################################
                      CGI HANDLING ROUTINES
################################################################

sub handle_query {
#
# Decide what to do based on the action parameter 
# from the query string we received.
#
    my %params = get_params();

    # show a thread
    if( $params{action} eq 'show' ) {
        gen_page_thread( $params{thread} );

    # start a new thread
    } elsif( $params{action} eq 'start' ) {
        my $tid = add_thread( $params{title} );
        update_data();
        gen_page_thread( $tid );

    # post a message
    } elsif( $params{action} eq 'post' ) {
        add_post( $params{name}, $params{content}, $params{thread} );
        update_data();
        gen_page_thread( $params{thread} );

    # quote a post
    } elsif( $params{action} eq 'quote' ) {
        gen_page_quote( $params{thread}, $params{id} );

    # no action specified; show list of threads
    } else {
        gen_page_toc();
    }
}

sub get_params {
#
# Get parameters from CGI query or command line invocation and
# return as a hash table.
#
    # get query string from command line argument
    # or environment variable
    my $query = '';
    # command line
    if( @ARGV ) { $query = shift( @ARGV );
    # a "post" query
    } elsif( exists( $ENV{REQUEST_METHOD} ) and
             $ENV{REQUEST_METHOD} eq 'POST' ) {
        read( STDIN, $query, $ENV{CONTENT_LENGTH} );
    # a "get" query
    } elsif( exists( $ENV{QUERY_STRING} )) {
        $query = $ENV{QUERY_STRING};
    }

    # turn string into key-value hash
    my %pairs;
    foreach my $pair ( split( /&/, $query )) {
        my $name = $1 if( $pair =~ /^([^=]+)/ );
        $name = unescape( $name );
        my $val = $1 if( $pair =~ /([^=]+)$/ );
        $val = unescape( $val );
        $pairs{ $name } = $val;
    }
    return %pairs;
}

sub unescape {
#
# Translate escaped characters from CGI query string
# back into their original form.
#
    my $text = shift;
    $text =~ tr/+/ /;
    $text =~ s/%([\da-f][\da-f])/chr( hex($1) )/egi;
    return $text;
}

################################################################
                      XML PROCESSING ROUTINES
################################################################

sub update_data {
#
# Write data back to file.
#
    # add a datestamp just after root element start tag
    my $date = localtime;
    my $root = $doc->getDocumentElement;
    # remove previous datestamp
    foreach my $c ( $root->findnodes( 'comment()' )) {
        $c->getParentNode->removeChild( $c );
    }
    my $comment = $doc->createComment( " updated: $date " );
    $root->insertBefore( $comment, $root->getFirstChild );

    # output document object as string into our data file
    my $text = $doc->toString;
    if( open( F, ">$datafile" )) {
        $text =~ s/></>\n</g;
        $text =~ s/\n\s+/\n/g;
        print F $text;
        close F;
    } else {
        gen_page_error( "Could not update data file." );
    }
}

sub add_thread {
#
# Add a new thread.
#
    my $title = shift;    # title of the thread from query
    gen_page_error( "Need a valid title." ) unless( $title );

    # create new thread element and sub elements
    my $newthread = $doc->createElement( 'thread' );
    my $newtitle = $doc->createElement( 'title' );
    my $newtitletext = $doc->createTextNode( $title );

    # put the elements where they need to go
    $doc->getDocumentElement->appendChild( $newthread );
    $newthread->appendChild( $newtitle );
    $newtitle->appendChild( $newtitletext );

    # give thread a unique ID
    my $tid = highest_id_thread() +1;
    $newthread->setAttribute( 'num', $tid );
    return $tid;
}

sub add_post {
#
# Take form data and add a new post to the specified thread.
#
    my( $name,          # name of user submitting post
        $content,       # content of post
        $tid            # ID of thread to append it to
        ) = @_;

    # remove breakline elements
    $content =~ s/\n/<br\/>/g;

    # find which thread to append to
    my @nodes = $doc->findnodes( "//thread[\@num='$tid']" );
    my $thread = shift( @nodes );

    # test for errors
    gen_page_error( "Incomplete information." ) 
        unless( $name and $content and $thread );

    # create a new post element and its subelements
    my $newpost = $doc->createElement( 'post' );
    my $newfrom = $doc->createElement( 'from' );
    my $newdate = $doc->createElement( 'date' );
    my $newcon = $doc->createElement( 'content' );
    my $newfromtext = $doc->createTextNode( $name );
    my $time = localtime;
    my $newdatetext = $doc->createTextNode( $time );
    my $newcontext =  $doc->createTextNode( $content );

    # put elements where they need to go
    $thread->appendChild( $newpost );
    $newpost->appendChild( $newfrom );
    $newpost->appendChild( $newdate );
    $newpost->appendChild( $newcon );
    $newfrom->appendChild( $newfromtext );
    $newdate->appendChild( $newdatetext );
    $newcon->appendChild( $newcontext );

    # assign a unique ID number to the post
    $newpost->setAttribute( 'id', highest_id_post() +1 );
}

sub highest_id_post {
#
# Return the value of the highest post ID.
#
    my @ids = ();
    foreach my $id( $doc->findnodes( '//post/@id' )) {
        my $idval = $id->findvalue( '.' );
        $ids[ $idval ] = 1;
    }
    return $#ids;
}


sub highest_id_thread {
#
# Return the value of the highest thread ID.
#
    my @ids = ();
    foreach my $id( $doc->findnodes( '//thread/@num' )) {
        my $idval = $id->findvalue( '.' );
        $ids[ $idval ] = 1;
    }
    return $#ids;
}

################################################################
                      HTML GENERATION ROUTINES
################################################################

sub gen_page_toc {
#
# Generate a table of contents for threads.
#
    # output beginning of page
    gen_page_start();
    print <<END;
<div class='ss'>
<h1>All the threads</h1>
END

    # generate an entry for each thread
    foreach my $thread ( $doc->findnodes( '//thread' )) {
        gen_entry_thread( $thread );
    }

    # create a form for adding a new thread
    print <<END;
</div>
<div class="s">
<h3>Add a thread</h3>
<form action="/cgi-bin/skimpyforum" method="POST">
<input name="action" type="hidden" value="start" />
Thread title: <input name="title" size="64" value="Excitin' Stuff"/>
<input type="submit" value="Create"/>
</form>
END
    gen_page_end();
}

sub gen_entry_thread {
#
# Output a piece of HTML representing an entry in the thread TOC.
#
    my $thread = shift;      # thread element ref
    my $title = $thread->findvalue( 'title' );
    my $num = $thread->findvalue( '@num' );
    print <<END;
<h3><a href="/cgi-bin/skimpyforum?action=show&thread=$num">$title</a></h3>
END
}

sub gen_page_thread {
#
# Generate a page for a thread with all posts in order.
#
    my $tid = shift;      # thread ID

    # test for thread existance
    my $title = $doc->findvalue( "//thread[\@num='$tid']/title" );
    gen_page_error( "Thread not found" ) unless( $title );

    # output beginning of page
    gen_page_start();
    print "<div class='s'>\n<h2>Thread: $title</h2>\n";

    # generate an entry for each post
    foreach my $post ( $doc->findnodes( "//thread[\@num='$tid']/post" )) {
        gen_entry_post( $post );
    }

    # create a form for submitting a new post
    print <<END;
</div>
<div class="s">
<h3>Post a message</h3>
<form action="/cgi-bin/skimpyforum" method="POST">
<input name="action" type="hidden" value="post" />
<input name="thread" type="hidden" value="$tid" />
Your name: <input name="name" size="32" value="The Big Labowski"/>
<br />
<textarea name="content" rows="8" cols="60">
Put yer message in <b>here</b>, bub.
</textarea>
<br />
<input type="submit" value="Submit!"/>
</form>
</div>
END
    gen_page_end();
}

sub gen_entry_post {
#
# Generate a formatted entry from post data.
#
    my $post = shift;   # reference to post element

    # gather all the information
    my $name = $post->findvalue( 'from' );
    my $date = $post->findvalue( 'date' );
    my $con = $post->findvalue( 'content' );
    my $tid = $post->findvalue( 'ancestor::thread/@num' );
    my $id = $post->findvalue( '@id' );

    # output as HTML
    print <<END;
<div class="ss">
<table border="0">
<tr>
<td width="100" align="left"><b>$name</b></td>
<td width="200" align="right"><font size="2">$date</font></td>
<td width="200" align="right"><font size="2" color="gray">ID: $id</font></td>
</tr>
</table>
<div class="sss">
$con
</div>
<font size="2">
<a href="/cgi-bin/skimpyforum?action=quote&thread=$tid&id=$id">Quote</a> -
<a href="/cgi-bin/skimpyforum">Top</a>
</font>
</div>

END
}

sub gen_page_quote {
#
# Generate a special page for entering a post with quote
# from another post.
#
    my( $tid,    # ID of thread to insert post
        $id      # ID of post to quote
        ) = @_;

    # find data on the quoted post
    my $title = $doc->findvalue( "//thread[\@num='$tid']/title" );
    my $quote = $doc->findvalue( "//post[\@id='$id']/content" );
    my $name = $doc->findvalue( "//post[\@id='$id']/from" );

    # assemble the quote to put in textbox
    $quote = "$name blurted out:\n$quote";
    $quote =~ s/<br\s*\/>\n?//g;
    $quote =~ s/\n/\n> /g;

    # generate the page, with form inside
    gen_page_start();
    print <<END;
<div class='s'>
<h3>Post a message</h3>
<form action="/cgi-bin/skimpyforum" method="POST">
<input name="action" type="hidden" value="post" />
<input name="thread" type="hidden" value="$tid" />
Thread: $title
<br />
<input name="name" size="32" value="The Big Labowski"/>
<br />
<textarea name="content" rows="8" cols="60">
$quote
</textarea>
<br />
<input type="submit" value="Submit!"/>
</form>
</div>
END
    gen_page_end();
}

sub gen_page_start {
#
# Generate the start of an HTML page, with CSS style and everything.
#
    print "Content-type: text/html\n\n";
    print <<END;
<html>
<head>
<title>Skimpy Forum</title>
<style>
body {
  background-color: tan;
  color: black;
}
.s {
  margin: .5em;
  padding: .5em;
  border: thick solid brown;
  background-color: wheat;
}
.ss {
  margin: .5em;
  padding: .5em;
  border: thin solid brown;
  background-color: wheat;
}
.sss {
  margin: .5em;
  padding: .5em;
  background-color: #eebb99;
}
h1 {
  color: black;
  font-size: large;
  font-family: sans-serif;
}
h2 { 
  color: brown;
  font-size: medium;
  font-family: sans-serif;
}
h3 { 
  color: black; 
  font-size: small;
  font-family: sans-serif;
}
</style>
</head>
<body>
<h1>Skimpy Forum</h1>
END
}

sub gen_page_end {
#
# Generate the end of an HTML page.
#
    print <<END;
</body>
</html>
END
}

sub gen_page_error {
#
# Generate a page in the event of an error, telling what went wrong.
#
    my $msg = shift;    # message to print
    my $program = $0;
    $program =~ s|.*/([^/]+)$|$1|;    # get short name
    gen_page_start();
    print <<END;
<div class="ss">
<h3>Error!</h3>
<div class="sss">
<h4>Message from CGI program '$program':</h4>
<p>$msg</p>
</div>
<p><a href="/cgi-bin/skimpyforum">Go to top</a></p>
</div>
END
    gen_page_end();
    exit;
}