A Complete Database Application in Perl

The database application in this article can add, delete, modify, and search records in under 350 lines of code. And actually, 121 lines of the script are HTML, so the total lines of Perl to make this database is only 222!
 

Previous articles in this series: Aug. 21:  Working with Data Files Sept. 4:  Searching a Data File Sept. 11:  Deleting Records from a Data File Sept. 25:  Modifying Data in the Data File

View the demo of this week's program.

Further articles in this series: Oct. 23:  Revisiting the Database Application

Simple Perl database 

I want to dedicate this program to all of those who still don't believe that Perl is a powerful language. Every day that I write Perl code, I am more sold on it. Not that I am a hard sell on Perl. What I mean is that I am learning more and more about this powerful language and find that I can do just about anything with it.

At my full-time job, (yes I do work for a living) they are almost entirely a Windows NT shop. I wasn't too excited about this at first but the more I program with Perl on NT, the more I like it. Now I don't want to start any operating system religious wars, I will stay neutral and say that I like anything that Perl runs on. :-)

Ok, enough about how great Perl is. You should already know how great it is. Let's get on to the program!

Diving in 

As always, I have numbered the lines of code, but the line numbers are not part of the program. You can also see the program without the line numbers. The line numbers simply make it easier for us to talk about the program.

1: #!/usr/local/bin/perl
2: ##########################
3: # Simple Database        #
4: # By Brent Michalski     #
5: ##########################

6: use CGI qw (:standard);
7: use CGI::Carp qw(fatalsToBrowser);

8: ## Change these 2 lines to make a new db!
9: @fields = ("name","email","phone","notes");
10: $database = "data/database.txt";

11: $q = new CGI;
12: print $q->header;

13: $field_count = @fields;
14: $colspan = $field_count+1;

15: $EXCLUSIVE = 2;
16: $UNLOCK    = 8;

17: $search_for   = $q->param(search_for);
18: $search_field = $q->param(search_field);
19: $action       = $q->param(action);
20: @keys         = $q->param(key);
21: $key_matches  = @keys;

22: $search_field = "all" if($search_field eq "");
23: $search_for   = '.'   if ($search_for eq "");

24: if($action =~ /add record/i){
25:  # Add the record passed from the add record page
26:   &add_record;
27:   $message="Record Added";
28:   &print_message($message);
29: }
30: elsif($action =~ /add/i){
31:  # Display the add record page
32:   &print_add_screen;
33: }
34: elsif($action =~ /modify record/i){
35:  # Display the results of the search
36:   &search_database($q->param(key));
37:   $count = @results;
38:   &no_match if($count < 1);         
39:   &print_modify_page;
40: }
41: elsif($action =~ /modify this record/i){
42:  # Modify the record that was passed
43:   &delete_records;
44:   &add_record;
45:   $message="Record Modified";
46:   &print_message($message);
47: }
48: elsif($action =~ /modify/i){
49:  # Search and display results for modification
50:   &search_database($search_for);
51:   $count = @results;
52:   if($count < 1){
53:     &no_match;
54:   }
55:   elsif($count == 1){
56:     &print_modify_page;
57:   }
58:   else {
59:     $caption="Modify Which Record?";
60:     $button_text="Modify Record";
61:     &multiple_match("RADIO","modify");
62:   }
63: }
64: elsif($action =~ /delete record/i){
65:  # Delete the record(s) that were passed
66:   &delete_records;
67:   $message="Record(s) Deleted";
68:   &print_message($message);
69: }
70: elsif($action =~ /delete/i){
71:  # Search and display results for modification
72:   &search_database($search_for);
73:   $count = @results;
74:   &no_match if($count < 1);
75:   $caption="Delete Which Record(s)?";
76:   $button_text="Delete Record(s)";
77:   &multiple_match("CHECKBOX","delete");
78: }
79: elsif($action =~ /search/i){
80:  # Search database and display the results
81:   &search_database($search_for);
82:   $count = @results;
83:   if($count > 0){
84:     $button_text = "Back to Database";
85:     $caption = "Search Results";
86:     &multiple_match;
87:   } else {
88:     &no_match;
89:   }
90: }
91: else { &print_default; }

92: exit;

93: ### Subroutines go below here.

94: sub add_record {
95:   $key   = time();
96:   $record=$key;
97:   foreach $field (@fields){
98:     ${$field}  = $q->param($field);
99:     ${$field}  = filter(${$field});
100:     $record   .= "\|${$field}";
101:   }
  
102:   unless (-e $database){
103:     open (DB, ">$database") ||
        die "Error creating database.  $!\n";
104:   } else {
105:     open (DB, ">>$database") ||
        die "Error opening database.  $!\n";
106:   }
107:    flock DB, $EXCLUSIVE;
108:    seek DB, 0, 2;
109:    print DB "$record\n";
110:    flock DB, $UNLOCK;
111:   close(DB);
112: } # End of add_record subroutine.

113: sub print_add_screen{
114:   print<<HTML;
115:    <HTML><HEAD><TITLE>Add a Record</TITLE></HEAD>
116:     <BODY BGCOLOR="#FFFFFF">
117:      <CENTER><FONT SIZE=5 FACE="ARIAL">
118:       Add a Record
119:      </FONT></CENTER>
120:      <P>
121:      <FORM ACTION="database.cgi" METHOD=POST>
122:       <CENTER><TABLE BORDER=1 CELLSPACING=0>
123: HTML
124:   foreach $field (@fields){
125:        print<<HTML;
126:         <TR>
127:          <TD BGCOLOR="e0e0e0"><B>\u$field:</B></TD>
128:          <TD><INPUT TYPE=TEXT NAME="$field"></TD>
129:         </TR>
130: HTML
131:   } # End of foreach.
132:       print<<HTML;
133:        <TR>
134:         <TD COLSPAN=2 BGCOLOR="e0e0e0">
135:          <CENTER>
136:           <INPUT TYPE=SUBMIT NAME=action
        VALUE="Add Record">
137:          </CENTER>
138:         </TD>
139:        </TR>
140:       </TABLE></CENTER>
141:      <P>
142:     </FONT>
143:    </BODY></HTML>
144: HTML
145: } # End of print_add_screen subroutine.

146: sub delete_records{
147:   $tempfile="$database.tmp";

148:   open (DB,   $database)    or
        die "Error opening file: $!\n";
149:   open (TEMP, ">$tempfile") or
        die "Error opening file: $!\n";
150:   flock TEMP, $EXCLUSIVE;

151:   while(<DB>){
152:     $match="";
153:     ($key,$rest)=split(/\|/);
154:     foreach $current (@keys){
155:       if($current == $key){$match=1;}
156:     } # End of foreach loop.
157:    print TEMP $_ unless ($match == 1);
158:   } # End of while loop.
  
159:   flock DB, $EXCLUSIVE;
160:    unlink($database) or
        die "Error deleting file! $!\n;
161:    rename($tempfile,$database) or
        die "Error renaming file! $!\n;
162:   flock DB, $UNLOCK;
163:   flock TEMP, $UNLOCK;

164:   close(TEMP);
165:   close(DB);
166: } # End of subroutine.

167: sub print_modify_page{
168:   ($key,@field_vals) = split(/\|/, $results[0]); 
169:   $fs="<FONT SIZE=2 FACE=ARIAL>";
170:   $fc="</FONT>";

171:   print $q->start_html(
        -TITLE=>'Modify Record',
        -BGCOLOR=>'white'),
172:         $q->start_form;

173:   print<<HTML;
174:    <CENTER><FONT SIZE=5 FACE=ARIAL>
175:     Modify Record
176:    </FONT></CENTER>
177:    <HR WIDTH=75%>
178:    <INPUT TYPE=HIDDEN NAME=key value="$key">
179:    <CENTER>
180:     <TABLE BORDER=1 CELLSPACING=0>
181: HTML

182:   $x=0;
183:   foreach $field (@fields){
184:     print<<HTML;
185:      <TR BGCOLOR="e0e0e0">
186:       <TD>$fs<B>\u$field:</B>$fc</TD>
187:       <TD><INPUT TYPE=TEXT NAME="$field"
        VALUE="$field_vals[$x]" SIZE=40></TD>
188:      </TR>
189: HTML
190:     $x++;
191:   } # End of foreach.

192: print<<HTML;
193:      <TR BGCOLOR="efefef">
194:       <TD COLSPAN=2>
195:        <CENTER>
196:         <INPUT TYPE=SUBMIT NAME=action
        VALUE="Modify This Record">
197:        </CENTER>
198:       </TD>
199:      </TR>
200:     </TABLE>
201:    </CENTER>
202:    <P><HR WIDTH=75%>
203:   </BODY></HTML>
204: HTML
205: }

206: sub multiple_match{
207:   print $q->start_html(
        -TITLE=>'Match Results',
        -BGCOLOR=>'white');
208:   print<<HTML;
209:    <FONT SIZE=6 FACE=ARIAL>
210:     <CENTER>$caption</CENTER>
211:    </FONT>
212:    <FONT FACE=ARIAL>
213:     <CENTER>There were $count matches</CENTER>
214:    </FONT>
215:    <FORM METHOD=POST>
216:    <HR WIDTH=75%>
217:    <P>
218:    <CENTER><TABLE BORDER=1 CELLSPACING=0>
219:     <TR BGCOLOR="#e0e0e0">
220: HTML

221:   if($_[1] =~ /(modify|delete)/){
222:     print "<TD ALIGN=CENTER>";
223:     print "<FONT SIZE=2 FACE=ARIAL>
        <B>Select</B></FONT></TD>";
224:   }

225:   foreach $field (@fields){
226:     print "<TD ALIGN=CENTER>";
227:     print "<FONT SIZE=2 FACE=ARIAL>
        <B>\u$field</B></FONT></TD>";
228:   } # End of foreach

229:   print "</TR>";

230:   foreach $record (@results){
231:     ($key,@field_vals) = split(/\|/, $record); 

232:     print "<TR BGCOLOR=\"#efefef\">";

233:     if($_[1] =~ /(modify|delete)/){
234:        print "<TD ALIGN=CENTER>
        <FONT SIZE=2 FACE=ARIAL>";
235:        print "<INPUT TYPE=$_[0] NAME=key
        VALUE=$key>";
236:        print "</FONT></TD>";
237:     } # End of if.
     
238:     for($x=0;$x<$field_count;$x++){
239:       $item = &check_empty($field_vals[$x]);
240:       print "<TD><FONT SIZE=2 FACE=ARIAL>
        $item</FONT></TD>";
241:     }
242:      print "</TR>";
243:   } # End of foreach loop.

244:   print<<HTML;
245:   <TR BGCOLOR="#e0e0e0">
246:    <TD COLSPAN=$colspan ALIGN=CENTER>
247:     <INPUT TYPE=SUBMIT NAME=action
        VALUE="$button_text">
248:    </TD>
249:   </TR>
250:  </TABLE>
251: </FORM></BODY></HTML>
252: HTML
253: } # End of multiple_match subroutine.

254: sub no_match{
255:   print $q->start_html(
        -TITLE=>'No Match',
        -BGCOLOR=>'white');
256:   print "<H2><CENTER>
        There was no match for <I>$search_for</I>, ";
257:   print "please hit <B>back</B>
        and try again.</CENTER></H2>";
258:   print $q->end_html;
259:   exit;
260: } # End of no_match subroutine.

261: sub search_database{
262:   my $search_for = $_[0];
263:   open(DB, $database) or
        die "Error opening file: $!\n";
264:     while(<DB>){
265:       if($search_field =~ /all/i){
266:         if(/$search_for/oi){push @results, $_};
267:       } else {
268:         ($key,@field_vals) = split(/\|/, $_);
269:         if($field_vals[$search_field] =~
        /$search_for/oi){push @results, $_};
270:       } # End of else.
271:     } # End of while.
272:   close (DB);
273: } # End of search_database subroutine.

274: sub print_default {
275:  print<<HTML;
276:    <HTML><HEAD>
277:    <TITLE>Simple Database Main Screen</TITLE>
278:   </HEAD><BODY BGCOLOR="#FFFFFF">
 
279:   <FORM METHOD="post" ACTION="database.cgi">
280:   <CENTER><FONT SIZE=4 FACE="ARIAL"><B>
281:    The Simple Database
282:   </B></FONT></CENTER><P>
  
283:   <CENTER>
284:    <TABLE BORDER=1 WIDTH="75%"
        BGCOLOR="#e0e0e0" CELLSPACING="0">
285:    <TR> 
286:     <TD COLSPAN=2>
287:      <CENTER><FONT FACE="ARIAL" SIZE=2>
288:       To <I>add</I> a record, click on the Add
289:       button. To <I>search/modify/delete</I>
290:       records, enter the text in the box below and 
291:       choose the field to search on. Then click to 
        appropriate button.
292:      </FONT></CENTER>
293:     </TD>
294:    </TR><TR> 
295:     <TD><FONT FACE="ARIAL" SIZE=2><B>
        Search For:</B></FONT></TD>
296:     <TD><INPUT TYPE="text" NAME="search_for"
        SIZE="40"></TD>
297:    </TR><TR> 
298:     <TD><FONT FACE="ARIAL" SIZE=2><B>
        Search On:</B></FONT></TD>
299:     <TD><FONT FACE="ARIAL" SIZE=2> 
300:      <INPUT TYPE="radio" NAME="search_field"
        VALUE="all" CHECKED>All 
301: HTML

302:   $x=0;
303:   foreach $field (@fields){
304:     print "<INPUT TYPE=radio NAME=search_field
        VALUE=$x>\u$field";
305:     $x++;
306:   }

307:   print<<HTML;
308:     </FONT></TD>
309:    </TR><TR> 
310:     <TD COLSPAN=2> 
311:      <CENTER> 
312:       <INPUT TYPE="submit" NAME="action"
        VALUE="   Add   ">
313:       <INPUT TYPE="submit" NAME="action"
        VALUE="Search">
314:       <INPUT TYPE="submit" NAME="action"
        VALUE="Modify">
315:       <INPUT TYPE="submit" NAME="action"
        VALUE="Delete">
316:      </CENTER>
317:     </TD>
318:   </TR>
319:  </TABLE></FORM></BODY></HTML>
320: HTML
321: } # End of print_default subroutine.

322: sub filter{
323:   $temp = $_[0];
324:   $temp =~ s/\|//; # Remove pipe symbols in text.
325:   return ($temp);
326: }

327: sub print_message{
328:   print<<HTML;
329:     <HTML><BODY BGCOLOR="#FFFFFF" TEXT=ARIAL>
330:      <FONT SIZE=6><CENTER>$_[0]</CENTER></FONT>
        <HR WIDTH=75%>
331:      <P>
332:      <FONT SIZE=5><CENTER>
333:       Back To <A HREF="database.cgi">
        Main Database Screen</A>
334:      </CENTER></FONT>
335:     </BODY></HTML>
336: HTML
337: }

338: sub check_empty{
339:   $r_val = $_[0];
340:   if($r_val =~ /^\s*$/){$r_val=" "}

341:   return($r_val);
342: }

Line-by-line explanation 

Lines 2-5: Comments. Comments begin with a # and continue until the end of the line.

Line 6: Loads the CGI.pm module into the program. The argument in the qw/:standard/ imports the standard functions into the script. These functions are part of the CGI.pm module.

Line 7: Loads the Carp package. Carp is part of the standard CGI.pm distribution and it allows you to get more graceful error messages. By using Carp fatalsToBrowser, we get most of the error messages on the browser rather than getting the nasty "500 Internal Server Error". Using the Carp package is a very valuable debugging tool, I recommend using it.

Line 8: Another comment, and a very important one too. From this point forward, I will not be commenting on the comments. Just remember that anything after the # on a line is treated as a comment by Perl.

Line 9: Creates an array with the elements that you want to have in your database. To make a new database, just change these to the field names you want in the new database, and then change the line below..

Line 10: This variable stores the location of the database file. The database file is simply a pipe-delimited text file. 

The database file is in a different directory than the programs because the directory where the database file is located must be writable. When we modify or delete records we create a temporary file. If the directory is not writable by the "Web" user, then the attempt to create a file will fail. Putting the database file in a separate subdirectory is much safer. If the program directory had full rights, anyone could modify the program - that would be bad.

Line 11: Creates a new CGI object and calls it $q.

Line 12: Prints the standard header for CGI scripts. The header tells the Web server what kind of data it is sending. This line is equivalent to the following line: 

print "Content-type: text/html\n\n";

Lines 15-16: Create variables that we will use with the flock statement. They will be used to lock the files in exclusive mode and to unlock the files. We could skip this and just use the numbers, but when you are reading through the program a month or two from now, it will be harder to remember what the 2 or 8 actually mean.

Lines 17-20: Get the information from the calling Web page and store the results in the appropriate variables. Since we can only modify one record at a time, but initially have the possibility of several matches, we read the keys information into an array. Doing this allows us to traverse the array and present the user with a page that allows them to choose the record to modify or delete.

Line 21: Counts the number of matches in the @keys array and stores the value in $key_matches. This will be used when we delete multiple records.

Line 22: Sets $search_field to all if the user didn't put anything.

Line 23: Stores a period (.) in the $search_for variable if nothing was passed from the calling Web page. The period matches everything in a regular expression and we use a regular expression in the search subroutine to check for matches. 

Line 24: The first of many if..elsif..elsestatements that determine what action to take. This one checks to see if the $action variable had add record in the text. We get the $action variable from the value of the button on the calling Web page. 

Notice that we used a regular expression (REGEX) to determine what value $action stored. Perl's REGEX engine is extremely fast and powerful so we'll use this for the variable tests.

Line 26: Calls the add_record subroutine.

Line 27: Creates a variable called $message and sets it to Record Added. This gets displayed on the screen, along with other information, by the subroutine below.

Line 28: Calls the print_message subroutine. This subroutine prints some information to the user to let them know that the database did something.

Line 29: Ends the if($action =~ /add record/i) portion of the if..elsif..else block.

Lines 30-33: Checks to see if $action contained add. If so, we enter the block and call the print_add_screen subroutine.

Order is very important in the if..elsif..else block. If we had moved this block up and made it the first one, then every time we checked for add we would have a match - even if it was supposed to be "add record"! When doing a block like this, always watch what you are matching and match the longest expressions first.

Line 34: Checks to see if $action contains modify record. If it does, then we enter the block of code. If not, we skip it and move on to the next.

Line 36: Calls the search_database subroutine and passes it the value stored in the parameter key that was passed from the calling Web page. I know that I am safe using the value in key because the only way to get to this function is through a radio button on a page that this program generated. 

Line 37: Counts how many matches the search found, and stores the number in the variable called $count.

Line 38: Calls the no_match subroutine if there were no matches. The &no_match subroutine exits the program when it is finished so if it gets called, none of the other code in this block will get called.

Line 39: Calls the print_modify_page subroutine. There must have been at least one match for us to get here. Actually, there should never be more than one match because we can get to this spot one of two ways. By having only one match from a search OR by clicking a radio button from the multiple match screen. Radio buttons are mutually exclusive so there can only be one chosen at a time. But, if you have multiple records with the same key, then all bets are off because the program has no way of dealing with multiple records having the same key. 

Line 40: Closes the elsif($action =~ /modify record/i) block.

Line 41: Checks to see if $action contains modify this record. If it does, then we enter the block of code. If not, we skip it and move on to the next. The difference between this one and the last one on line 34 is that this is the block that gets called if the user has already chosen the record to modify and they have entered the new information in the form. This routine gets called when we are actually ready to make the changes to the database.

Line 43: Calls the delete_records subroutine. We passed the key of the record to modify in from the Web. The key was in the form as a hidden element. We then want to delete the record because we are going to re-write it with the new information.

Line 44: Calls the add_records subroutine. The record we are adding to the database at this point is the record we just modified. We pass the new, updated, information from the Web page.

Line 45: Sets the variable $message to Record Modified.

Line 46: Calls the print_message subroutine to inform the user that they successfully modified the database.

Line 47: Closes the elsif($action =~ /modify this record/i) block.

Line 48: Checks to see if $action contains modify. If it does, we enter the block of code. Notice again that I put the shortest match last. That way we try to match the longer strings first, otherwise this one would have matched all three $action variables for matching.

Line 50: Calls the search_database subroutine which searches the database for whatever value is stored in the $search_for variable.

Line 51: Counts the number of matches the search found and stores the results in $count.

Line 52: Checks to see if count was less than one. If so, we didn't find any matches so we execute the code in the block.

Line 53: Calls the no_match subroutine to inform the user that their match failed.

Line 54: Closes the if ($count < 1) block.

Line 55: If the count was not less than 1, we now check to see if $count was equal to 1. If so, we execute the code in the block. Remember that to check the value of a number, we use the double equal ==. If you are checking the value of a string, you would use eq.

Line 56: Calls the print_modify_page subroutine. This is the subroutine that displays the selected record on the screen for editing.

Line 57: Closes the if ($count == 1) block.

Line 58: If $count wasn't less than 1 and it wasn't equal to 1, it must be more than 1. So, we create an else block that handles this situation. If the if and the elsifs don't evaluate to true, the else is executed. In Perl, you are allowed to have an if..elsif conditional without an else.

Line 59: Sets the variable $caption to Modify Which Record.

Line 60: Sets the variable $button_text to Modify Record.

Line 61: Calls the multiple_match subroutine. It passes 2 strings to the subroutine. The first, RADIO, is the type of selection that we show on the HTML page. For modifying, we only want to be able to modify one record at a time - so we use a radio button. Further down, in the delete subroutine, we pass CHECKBOX because multiple record deletes are allowed.

Lines 62-63: Close the else block and the elsif($action =~ /modify/i) block.

Line 64: Checks to see if $action contains delete record. If it does, we enter the block of code. 

Line 66: Calls the delete_records subroutine. This subroutine will then delete any records whose keys are in the array @key that we read in from the calling Web page.

Line 67: Sets the variable $message to "Record(s) Deleted"

Line 68: Calls the print_message subroutine to inform the user that they successfully deleted the records.

Line 69: Close the elsif($action =~ /delete record/i) block.

Line 70: Checks to see if $action contains delete. If it does, we enter the block of code. 

Line 72: Calls the search_database subroutine and passes it the value that is stored in $search_for.

Line 73: Counts the number of matches we found and stores them in $count.

Line 74: Calls the no_match subroutine if there was less than one match.

Line 75: Sets the value in $caption to Delete Which Record(s).

Line 76: Sets the value in $button_text to Delete Record(s).

Line 77: Calls the multiple_match subroutine and passes it CHECKBOX and delete. CHECKBOX and delete are used in the subroutine.

Line 78: Closes the elsif($action =~ /delete/i) block.

Line 79: Checks to see if $action contains search If it does, we enter the block of code. 

Line 81: Calls the search_database subroutine and passes it the value that is stored in $search_for.

Line 82: Counts the number of matches we found and stores them in $count.

Line 83: Checks to see if $count is greater than 0. If so, we execute the code inside the block.

Line 84: Sets the value in $button_text to Back to Database.

Line 85: Sets the value in $caption to Search Results.

Line 86: Calls the multiple_match subroutine. This time we do not pass it any values.

Line 87: Begins an else block in case the above condition failed. Meaning, if there weren't more than 0 matches, we go here.

Line 88: Calls the no_match subroutine.

Lines 89-90: Close the else and the elsif($action =~ /search/i) blocks.

Line 91: An else that gets called if none of the above match. In the case, we call the print_default subroutine which prints the default page for the database.

Line 92: Once we get to this point, we are done with the program. We have gone through all possible conditions and displayed the appropriate page(s) to the user by now. Below this line are all of the functions that perform the various database tasks.

Line 94: Begins the add_record function.

Line 95: Grabs the system time. We use this as the key field in the database. 

A key field is a unique field that aids us greatly when searching for data. On a busy site, you would want to implement a different method for obtaining a key because this method is not truly unique. For example, if two people click the submit button at the exact same time, they would most likely get identical keys since time is stored in seconds. The value returned by time is actually the number of seconds since January 1, 1970.

I recommend using the time combined with some random numbers or characters embedded in the key.

Line 96: Sets the value of $record to the value we just stored in $key. 

Generally, I keep the key field in the first position of the record. I find it easier to work with in that position because I always know exactly what position it is in. Now that we have the key field in the record, we can continue adding to the $record variable until we have the complete record.

Line 97: Begins a foreach loop that iterates through the array @fields and stores the current value in $field each time through the loop.

Line 98: This is a tricky one. It takes the value from $field and creates a new variable by that name. In that variable, we store the value that was passed from the Web page from the variable of the same name.

For example. In the @fields array we have name, email, phone. the first time through this loop, $field contains the value name. We create a variable called $name. To do this, we use ${$field}. To Perl, this looks like ${name}, which is actually the same as $name. We really didn't need the curly braces but I put them in to separate things and make them a bit clearer.

Then, we set the variable $name to the value that was passed from the Web page by setting it to $q->param($field). To Perl this looks like $q->param(name).

Line 99: Calls the filter subroutine, passing the value that we just brought in above. The filter subroutine simply takes the value we pass it, removes any characters we don't want it to contain, and then returns the value we passed it minus the values we didn't want it to have. the filter subroutine is very simple; it only filters out the pipe "|" symbol. We filter out the pipe symbol because that is what we use to separate the fields in the records. If we didn't filter them out and someone put them into a record, it would confuse the database and you would get strange results.

Line 100: We take the $record variable and append the new field onto it. I placed a pipe symbol in front of the field because that is what we are using as a field separator.

Line 101: Closes the while loop. We keep looping and appending the fields onto the $record variable until we have gone through all of the fields.

Line 102: This begins an unless block. An unless block does the same thing as if you write if(!(something)). It means if not something, then do what is inside of the block. unless sounds so much more positive though, doesn't it?

The -e $database means if the file whose name is contained in the variable $database EXISTS, then return TRUE. Since we used unless, we only execute the code in the block if the return value was FALSE so if TRUE is returned, we do not execute the code in the block. 

Line 103: If we got here, then the database file must not have existed. So we open the database file using the single > sign. This means create the file and open it in write mode. When you use the single > sign and the file already exists, it wipes the file clean and starts over. This is obviously not what we want to happen if the database file already exists.

On the end of the statement, we put || die "Error creating database. $!\n";. This causes the program to terminate and tell us what the error was. With a die statement, the error is stored in Perl's special variable called $! - so we display it to see. This helps us in debugging the programs.

Whenever you are dealing with files, always use a die statement. There are times when you will want to open a file and for some reason it doesn't open properly. Your program may run fine, but what you expected to be written to the file is not there. If you had put in a die statement, the program would immediately tell you that there is a problem.

Line 104: Closes the first block from the unless condition and provides us with an else option. This is where the program goes if the database file already exists.

Line 105: Opens the database file in append mode. To open a file in append mode you use the double >>. In append mode, the file must have previously existed - any data in the file will stay there and any new data will be appended onto the end of the file. 

In both cases we used DB as the filehandle for the database. A filehandle is simply a name that you refer to the file as until you close it.

Line 106: Closes the unless (-e $database) block. 

Line 107: Locks the database in "exclusive" mode so that nobody else can modify the database until we are done with it.

Line 108: Seeks to the end of the database file, just in case someone else did some modifications to it before we were able to lock it.

Line 109: Prints the modified record to the database.

Line 110: Unlocks the database, now others can use it.

Line 111: Closes the database.

Line 112: Closes the add_record subroutine.

Line 113: Begins the print_add_screen subroutine. This subroutine is the input screen a user sees when they want to add a new record.

Line 114: Begins a here document. A here document simply prints out text until it encounters the terminator that you specify. The terminator must be flush to the left side of the program and be on the line by itself. Why it was named a here document escapes me. To me the name is confusing. I would have called it a print block.

Lines 115-122: Simply print out HTML for the Add a Record screen.

Line 123: Terminates the here document.

Line 124: Begins a foreach loop that is used to display all of the input blocks. Each title and input name is gathered from the @fields array.

Lines 125-129: A here document that prints out the HTML for the input fields. Notice on line 127 I put a \u in front of the variable name. The \u makes the character following it upper-case. I put it in to make the input form look better.

Line 130: Terminates the here document.

Line 131: Ends the foreach $field (@fields) loop.

Lines 132-143: A here document that prints out the rest of the HTML for the Add a Record page.

Line 144: Terminates the here document.

Line 145: Closes the print_add_screen subroutine.

Lines 146-166: Are identical to the delete_records subroutine subroutine in my earlier Deleting Records from a Data File article, except on lines 148 and 149 I added error checking to make sure the files opened without any errors.

Line 167: Begins the print_modify_page subroutine. This subroutine displays the page that contains the data for the one item you are modifying.

Line 168: Splits the first record in @results. The first record is the record we want to modify. It should also be the only record in the array.

We store the first item split out in the $key variable. The rest of the fields in the database go into the array @field_vals.

Lines 169-170: Sets a few variables that we'll use later to save us some typing.

Lines 171-172: Use the functions from CGI.pm to print out the beginning HTML tags and the start of the page.

Lines 173-181: A here document containing the HTML for the top part of the Modify Record screen. We store the $key in a hidden form element so we can keep track of the record we are modifying.

Line 182: Initializes $x to 0.

Line 183: Begins a foreach loop that goes through each element in @fields and displays them as a form so the user can modify the information.

Lines 184-189: A here document containing the HTML for the body of the Modify Record screen. Each row we create contains the name and an input box for the data. The input box contains the current value of the information when the screen is displayed.

Line 190: Increments $x.

Line 191: Ends the foreach loop.

Lines 192-204: A here document containing the HTML for the bottom part of the Modify Record screen. 

Line 205: Ends the print_modify_page subroutine.

Line 206: Begins the multiple_match subroutine.

Line 207: Uses the start_html function from CGI.pm to begin an HTML document and give it a title and background color.

Lines 208-220: A here document that prints out the page heading information for the Multiple Match screen. Notice on line 210 we use the variable $caption that we set before this subroutine was called.

Line 221: When parameters are passed to a subroutine, they are stored in an array called @_. On this line we are checking to see if the second item passed, $_[1], was modify or delete. If it was, we execute the code inside of the block.

Lines 222-223: If modify or deletewas passed, then we have an extra column to add to the table. This extra column allows the user to select which item(s) they are going to modify or delete. These 2 lines are the extra HTML needed for the new column and it's header.

Line 224: Closes the if($_[1] =~ /(modify|delete)/) block.

Line 225: Begins a foreach loop that goes through each item in the @fields array and prints out a header for the table. 

Lines 226-227: Print out the header for the table.

Line 228: Closes the foreach $field (@fields) loop.

Line 229: Prints out a </TR>, this ends the header row for the table.

Line 230: Begins a foreach loop that goes through each item in the @results array and prints it in the nice, neat table. Since we included a variable name, ($record), in the foreach statement, each time through the loop the $record variable gets set to the current value of @results.

Line 231: Splits the record into the various fields. This enables us to easily use the variables in the printout below.

Line 232: Prints the table row information for the row we are beginning.

Line 233: Check to see if the second item passed to the subroutine, $_[1], was modify or delete. If it was, we execute the code inside of the block.

Lines 234-236: If modify or deletewas passed, then we have an extra column in the table. This extra column allows the user to select which item(s) they are going to modify or delete. These 2 lines are the extra HTML needed for the extra column. 

On line 235, we specify INPUT TYPE=$_[0].... Remember that when we called this subroutine, the first thing we passed it was RADIO or CHECKBOX. This is what determines what type of HTML input field is displayed.

Line 237: Closes the if($_[1] =~ /(modify|delete)/) block.

Line 238: Begins a for loop that prints out the fields on the screen in the table. It loops from 0 to $field_count. Remember that in line 231 we stored the values into an array called @field_vals. This is where we are getting the data from for the current record.

Line 239: Creates a variable called $itemwhich holds the current field for the record we are handling. We call a function named &check_empty which takes the current field and, if it is blank, sets the value to " ". We do this to make sure there are no lines with just whitespace (tabs, spaces, line feeds, carriage returns) and replaces them with a single space. This makes the database tables display much nicer.

Line 240: Prints the current item out. Notice that we are not printing a whole row here, only a <TD> element. We need to keep looping to get the whole row.

Line 241: Ends the for loop.

Line 242: Prints the closing </TR> tag.

Line 243: Ends the foreach loop that puts the matched data into the table.

 Lines 244-252: Begins another here document, this one is used to finish off the table and the HTML page that the data is displayed in.

Line 253: Ends the multiple_match subroutine.

Lines 254-260: Are identical to the no_match subroutine in the Deleting Records from a Data File script, lines 77-82.

Lines 261-273: Are identical to the search_database subroutine in the Searching a Data File article with the exception of lines 265, 268 and 269, which I explain below.

Line 265: Begins an if ... else statement. This is the if portion and checks to see if the value of $search_field is equal to all. If it is, then we do whatever is in its block. Otherwise, we jump down to the else statement and execute what is in its block. We use eq here because we are comparing strings. 

Line 268: Takes the current record and splits it at the pipe symbols into the respective fields. The split function works on the $_ variable by default so we don't have to specify it.

Line 269: This checks to see if the value in the $field_vals[$search_field] matches the value in $search_for. The $search_field value is a number corresponding to the field number in the record.

The i on the end tells Perl to ignore case and the o tells Perl not to recompile the expression inside the forward slashes each time through the loop. This can increase the speed of searches if you are searching a lot of records.

If we had a successful match, then we execute the code inside of the if statement's block. We tell it to: push @results, $_. This means push the value that is currently in $_ onto the end of the @results array. The @results array is where we store the successful matches.

Line 274: Begins the print_default subroutine. This is what gets printed if none of the conditions are matched at the beginning of the program.

Lines 275-301: Begins a here document to print out the top part of the HTML page.

Line 302: Sets $x to 0.

Line 303: Begins a foreach loop that goes through each item in the @fields array.

Line 304: Prints the current field to the page along with a radio button that the user can click to search on a specific field.

Line 305: Increments $x.

Line 306: Ends the foreach loop.

Lines 307-320: A here document that prints out the rest of the default Web page.

Line 321: Ends the foreach loop that puts the matched data into the table.

 Line 322: Begins the filter subroutine.

Line 323: Sets a variable called $temp to the value of what we passed to the subroutine.

Line 324: Removes any pipe symbols from the $temp variable. Since we used the pipe symbol as the field delimiter in the database, any pipe symbols in the records, other than the ones we put if for the database, will cause erratic results.

Line 325: Returns the $temp variable from the subroutine.

Line 326: Ends the filter subroutine.

Line 327: Begins the print_message subroutine.

Lines 328-336: Begins a here document that prints out some information to the user letting them know that the database did something and provides them with a link out.

Line 337: Ends the print_message subroutine.

Line 338: Begins the check_empty subroutine. This subroutine is used to see if a field contains nothing but whitespace.

Line 339: Sets a variable called $r_val to the value of what we passed to the subroutine.

Line 340: Uses a regular expression to see if the value we passed contained only whitespace (tab, line-feed, carriage-return, space). In the regular expression, we have: ^\s+$. The ^ means match at the beginning of the string. The \s means match any whitespace. The + means match it one or more times. And finally, the $ means match at the end of the string.

So what we are saying is match a line that contains at least one whitespace character, and nothing else on the line. 

Line 341: Returns the $temp variable from the subroutine.

Line 342: Ends the check_empty subroutine.

Wrapping it up 

This article has been HUGE so I am not going to babble on any more here.

I have been "tweaking" this code so make sure you check out my site to see what modifications I have made to it.

See you next week!

Source Code for a Complete Database Application in Perl
View and download the source of this week's article.

Next: Handling Files with Filehandles
Prev: Modifying Data in the Data File