1  #! /usr/local/bin/perl -w
  2  
  3  #############################################################################
  4  #  
  5  #   File:    database.pl
  6  #
  7  #   Input:   data from the HTML form database0.html
  8  #
  9  #   Output:  a Web page containing the search results
 10  #
 11  #   From the HTML page database0.html, the user may choose to list the
 12  #   complete database or search the database for a specific search string.
 13  #   (Note:  Regular expressions are accepted in the search string.)
 14  #
 15  #   A typical entry in the database file looks like:
 16  #
 17  #     <record>
 18  #     name: Tom Scavo; email: trscavo@npac.syr.edu;
 19  #     platform: PowerMac; TeXapp: Textures;
 20  #     </record>
 21  #
 22  #   that is, key-value pairs are separated by a colon (:) while
 23  #   fields are terminated by semicolons (;).
 24  #
 25  #############################################################################
 26  #  
 27  #   Initialization
 28  #
 29  #############################################################################
 30  
 31  $EOL = "\015\012";
 32  $DBFILE = "register.db";       # flat-file database
 33  $HTMLFILE = "database0.html";  # HTML doc with form
 34  $HOSTPATH = "http://www.npac.syr.edu/projects/tutorials/CGI/examples/basic";
 35  
 36  #############################################################################
 37  #  
 38  #   Library Routines
 39  #
 40  #############################################################################
 41  
 42  require "ReadParse.pl" || die "error loading ReadParse.pl\n";
 43  
 44  #############################################################################
 45  #  
 46  #   Main Routines
 47  #
 48  #############################################################################
 49  
 50  ReadData() &&
 51  ProcessData();
 52  
 53  #############################################################################
 54  #  
 55  #   Input
 56  #
 57  #############################################################################
 58  
 59  sub ReadData {
 60    # ReadParse returns an associative array of key-value pairs:
 61    %IN = ReadParse();
 62    return 1;
 63  }
 64  
 65  #############################################################################
 66  #  
 67  #   Processing
 68  #
 69  #############################################################################
 70  
 71  # On the HTML form, there are submit buttons called 'browse' and 'search'.
 72  # This routine determines which button was pressed and acts accordingly.
 73  # If the user presses the 'search' button, but forgets to type a search
 74  # string, this routine simply reloads the HTML page.
 75  sub ProcessData {
 76    if ( defined($IN{'browse'}) ) {
 77      BrowseDatabase();
 78    } elsif ( defined($IN{'search'}) ) {
 79      if ( defined($IN{'searchString'}) ) {
 80        $SEARCHSTRING = $IN{'searchString'};
 81        SearchDatabase();
 82      } else {
 83        print "Location: $HOSTPATH/$HTMLFILE", "$EOL$EOL";
 84      }
 85    } else {
 86      die "Error in database.pl\n";
 87    }
 88    return 1;
 89  }
 90  
 91  # Construct an HTML page that displays the entire database:
 92  sub BrowseDatabase {
 93    my ($record, $name, $email, $platform, $TeXapp, %foo);
 94    
 95    # Read the database and construct the body of an ordered list:
 96    open (DB, "$DBFILE") || die "Unable to open $DBFILE\n";
 97    # Obtain a shared lock:
 98  #   flock (DB, 1) || die "Unable to lock $DBFILE\n";
 99    $BODY = "";
100    while ( $record = <DB> ) {
101      chomp($record);
102      if ( $record eq '<record>' ) {
103        # pre-process this record:
104        # (no pre-processing required)
105      } elsif ( $record eq '</record>' ) {
106        # post-process this record:
107        $name = $foo{'name'};
108        $email = $foo{'email'};
109        $platform = $foo{'platform'};
110        $TeXapp = $foo{'TeXapp'};
111        $BODY .= '  <LI>';
112        $BODY .= "$name  $EOL  &lt;<A HREF=\"mailto:$email\">$email</A>&gt; <BR>$EOL";
113        $BODY .= "  platform = $platform; TeXapp = $TeXapp";
114        $BODY .= " <P>$EOL";
115      } else {
116        # process this record:
117        while ( $record =~ /(\w*): ([^;]*);/ ) {
118          $foo{$1} = $2;
119          $record = $';
120        }
121      }
122    }
123    # Release the lock:
124  #   flock (DB, 8) || die "Unable to unlock $DBFILE\n";
125    close (DB) || die "Unable to close $DBFILE\n";
126  
127    if ( $BODY eq "" ) {
128      $BODY = '  No records in database!';
129    }
130    
131    PrintDatabase();
132    return 1;
133  }
134  
135  # Construct an HTML page that displays a portion of the database:
136  sub SearchDatabase {
137    my ($record, $name, $email, $platform, $TeXapp, %foo);
138    my ($isMatch, $noMatch);
139  
140    $noMatch = 1;
141  
142    # Read the database and construct the body of an ordered list:
143    open (DB, "$DBFILE") || die "Unable to open $DBFILE\n";
144    # Obtain a shared lock:
145  #   flock (DB, 1) || die "Unable to lock $DBFILE\n";
146    $BODY = "";
147    while ( $record = <DB> ) {
148      chomp($record);
149      if ( $record eq '<record>' ) {
150        # pre-process this record
151      } elsif ( $record eq '</record>' ) {
152        # post-process this record:
153        $isMatch = 0;
154        foreach $key ( keys(%foo) ) {
155          if ( $foo{$key} =~ /$SEARCHSTRING/i ) {
156            $isMatch = 1;
157            last;
158          }
159        }
160        if ( $isMatch ) {
161          $noMatch = 0;
162          $name = $foo{'name'};
163          $email = $foo{'email'};
164          $platform = $foo{'platform'};
165          $TeXapp = $foo{'TeXapp'};
166          $BODY .= '  <LI>';
167          $BODY .= "$name  $EOL  &lt;<A HREF=\"mailto:$email\">$email</A>&gt; <BR>$EOL";
168          $BODY .= "  platform = $platform; TeXapp = $TeXapp";
169          $BODY .= " <P>$EOL";
170        }
171      } else {
172        # process this record:
173        while ( $record =~ /(\w*): ([^;]*);/ ) {
174          $foo{$1} = $2;
175          $record = $';
176        }
177      }
178    }
179    # Release the lock:
180  #   flock (DB, 8) || die "Unable to unlock $DBFILE\n";
181    close (DB) || die "Unable to close $DBFILE\n";
182    
183    if ( $noMatch ) {
184      $BODY = '  No matches found!';
185    }
186  
187    PrintSearchResults();
188    return 1;
189  }
190  
191  #############################################################################
192  #  
193  #   Print HTML pages
194  #
195  #############################################################################
196  
197  sub PrintDatabase {
198    print qq{Content-type: text/html$EOL$EOL
199  <HTML>
200  <HEAD>
201  <TITLE>Alpha LaTeX Database</TITLE>
202  </HEAD>
203  <BODY BGCOLOR="#FFFFFF">
204  
205  <H1>Alpha LaTeX Registered Users</H1>
206  
207  <OL>
208  $BODY
209  </OL>
210  
211  <P><HR><P>
212  
213  Return to
214  <A HREF="$HOSTPATH/$HTMLFILE">HTML form</A>
215  
216  </BODY>
217  </HTML>
218  };
219  
220  }  # end PrintDatabase
221  
222  sub PrintSearchResults {
223    print qq{Content-type: text/html$EOL$EOL
224  <HTML>
225  <HEAD>
226  <TITLE>Alpha LaTeX Database</TITLE>
227  </HEAD>
228  <BODY BGCOLOR="#FFFFFF">
229  
230  <H1>Alpha LaTeX Registered Users</H1>
231  
232  searchString = $SEARCHSTRING
233  
234  <OL>
235  $BODY
236  </OL>
237  
238  <P><HR><P>
239  
240  Return to
241  <A HREF="$HOSTPATH/$HTMLFILE">HTML form</A>
242  
243  </BODY>
244  </HTML>
245  };
246  
247  }  # end PrintSearchResults