Putting the Pieces Together

We have covered the main parts of a program that interact with a database. But up to this point, our user interface has been a bit minimalistic. Our next application uses the Tk libraries to draw the screens. This application is by far our most complex yet. It weighs in at almost 150 lines of code! This is a comprehensive example that should bring together all of the concepts we have covered so far.

Note 

I originally used the Curses library to create the user interface for this program. After pumping out over 300 lines of code and getting it working how I wanted it to, I discovered that it would not run properly on a Windows system. So I had to rewrite the user-interface portion of the program! The database access stayed the same, so that code was salvageable. The new program, using Tk, is over 150 lines shorter than the Curses program, and it has a much nicer user interface. I tested this on a Windows 98 box with a current ActiveState Perl installation and on a Linux box-both ran fine and looked great.

Please note that the next program uses Tk. Since this is a database book, not a Tk book, we don't focus as much on the Tk aspect of the program so if you aren't familiar with Tk, you can safely skim those parts of the program.

Let's dive in and create a GUI database application.

01: #!/usr/bin/perl -w 02: # 03: # program 5-4 04: # Chapter 5 05: # Listing 4 06: # 07: use strict; 08: use DBI; 09: use Tk; 

Line 1 should be very familiar by now. It tells the system where to find Perl and turns on warnings.

Lines 2-6 are simply comments about the program.

Line 7 calls the strict pragma to force better programming style.

Line 8 loads the DBI module so that this program can talk to the database.

Line 9 loads the Tk module. We use Tk for our user interface. Tk is a toolkit for creating graphical interfaces that work in Unix and/or Linux and Windows.

10: my $conn = DBI->connect ("DBI:mysql:BibleBook","bookuser","testpass") 11:       or die("Cannot connect: $DBI::errstr\n"); 12: my ($sql, @keys, $record);

Lines 10-11 form a single Perl statement that tries to create an object of class DBI that represents a connection to the database. If the connection cannot be made, our call to DBI->connect will fail, and we will abort the program by using die.

Line 12 declares some variables that we globally use throughout the program.

13: my %fields =  14:     (‘isbn'   => "ISBN: "   , ‘title'     => "Title: "   ,  15:      ‘author' => "Author: " , ‘price'     => "Price: "   , 16:      ‘format' => "Format: " , ‘publisher' => "Publisher: ", 17:      ‘pubdate'=> "Pub. Date: " ); 18: my @order = qw(isbn title author publisher format pubdate price);

Lines 13-17 create a hash called %fields. This hash is used to translate between the database field names and a more pleasing form that we display to the user. The key fields of the %fields hash are the same as the database row names; the values of the %fields hash are displayed to the user.

Line 18 creates an array called @order. This array contains the field names of the database table in the order that we want them to appear on the user-interface windows.

19: Start_TK_Interface(); 20: exit;

Line 19 calls the Start_Tk_Interface subroutine. This subroutine is responsible for creating the GUI windows as well as processing all of the input.

Line 20 ends the program! Yep, that is it! Well, except for the subroutines that do all of the work. They are coming up next.

21: #----------------------------------------------------- 22: # Database Routines 23: sub Get_Record {

Lines 21-22 are just comments that make it easier to determine what the following section of the program does.

Line 23 begins the Get_Record subroutine. This subroutine is used to get a record from the database.

24:  my $isbn   = shift; 25:  my $sql    = qq(SELECT * FROM library WHERE isbn = $isbn); 26:  my $hdl_search = $conn->prepare($sql);

Line 24 creates a scalar variable called $isbn and uses the shift function to set it to the value passed to the subroutine.

Line 25 creates a scalar variable called $sql and stores a newly created SQL SELECT statement in it.

Line 26 calls the prepare function on the $sql statement and creates a variable named $hdl_search, which is a handle to the prepared-search SQL statement.

27:     $hdl_search->execute; 28:     $record = $hdl_search->fetchrow_hashref; 29:     return($record); 30: }

Line 27 uses the execute method on the $hdl_search handle. This executes the SQL statement against the database.

Line 28 calls the fetchrow_hashref function to get a value from the returned results. The result of this is stored in the $record scalar. Since all of our searches are done on ISBN, there should only be one match per ISBN search.

Line 29 returns $record, a reference to the hash containing the record data.

Line 30 closes the Get_Record subroutine.

This next subroutine is pretty short, so we'll just take a look at the whole thing without splitting it up.

31: sub Delete_Record { 32:     my $isbn  = shift; 33:     $sql    = qq(DELETE FROM library WHERE isbn = ‘$isbn'); 34:     my $query = $connection->prepare($sql); 35:     $query->execute or die("\nError executing             SQL statement! $DBI::errstr"); 36:     return 1; 37: }

Line 31 begins the Delete_Record subroutine. This subroutine does exactly what its name says: it deletes a record from the database.

Line 32 creates a scalar variable called $isbn and uses the shift function to set it to the value passed to the subroutine when the subroutine is called.

Line 33 creates an SQL statement intended to delete a record from the database.

Note 

This program does not have any real error checking. It would be a good idea here to allow only the text that you want in this box. On any production system, make sure that you always check the values that the users enter.

Line 34 prepares the SQL statement and stores the prepared query in a handle named $query.

Line 35 calls the execute function to run the query. If an error occurs, die is called, and the program exits and prints the error message.

Line 36 returns a true value from the subroutine.

Line 37 ends the Delete_Record subroutine.

38: sub Update_Record { 39:     my $form   = shift; 40:     my $caller = shift; 41:     $caller    -> withdraw();

Line 38 begins the Update_Record subroutine. This subroutine is used to update an existing record in the database.

Lines 39-40 declare scalar variables and shifts in a value passed to the subroutine. The $form variable is a reference to a hash containing references to the Tk form fields. So $form is a reference to a hash of references, yikes! Don't worry though; I'll break it down for you. The $caller variable is a handle to the window that calls

this subroutine. We need the handle so that we can close the window. If we don't close the window, we will end up with a new window for each action, and our screen will soon be full of windows.

Line 41 uses the withdraw function to remove the calling window from the display.

42:     my $isbn = $form->{‘isbn'}->get();

Line 42 gets the isbn that has been entered on the form.

The get() method comes from the Tk modules Entry object, which comes from the form that the user enters the data into. The %form hash contains a reference to each of the fields on the user entry form.

This concept is hard to grasp at first, so let me break it down even further.

Our database field names are isbn, title, author, and so on. When we create the form that the user can enter data on, we do so like this.

$form{$field} = $top_win->Entry(-object modifiers...);

This is in a loop, with $field changing each time through to the next database form field. $top_win is a reference to the window being created/displayed. Entry is an object in the Tk class created for entering text.

So we end up with a hash that looks something like this:

$form{isbn} = $ref_to_entry_field, $form{title} = $ref_to_title_field, etc...

Let s get back to the code on Line 42. We are setting $isbn to whatever is returned from the get() method on the right side.

$form->{‘isbn'} is how we de-reference the hash to get the value stored in the isbn key. Then, at the same time, we make a call to get() by using ->get(). This causes the get() method to be performed on the de-referenced value in the field.

Or, if you prefer the super-short explanation: Line 42 gets the value that is entered in the isbn field on the form.

This code can also been written on 2 lines, like this:

 my $foo = $form->{‘isbn'}; $isbn   = $foo->get(); 43:     my @keys = keys %$form; 

Line 43 stores all of the keys in the %$form hash into an array named @keys. This is done so that we can easily loop through the values in later code.

44:     my @vals = map { $$form{$_}->get() } @keys;

Line 44 is a fairly complex line that does a lot of work for us! The map function is used to perform something on an entire array.

Here is what this line looks like without the map function.

 Foreach my $key (@keys){     Push @vals $$form{$key}->get(); } 

So Line 44 stores all of the values into an array named @vals. We need the keys and values stored in two arrays in their proper order. The next few lines of code from the program use the join function to create the SQL statement to add a record. We want the data to go into the proper fields in the database, so we must make sure @keys and @vals are in the same order.

45:     my $counter = 0; 46:     $sql  = qq{UPDATE library SET };

Line 45 creates a scalar variable named $counter and sets it to an initial value of 0.

Line 46 begins the creation of the SQL statement we use to update the data in the database.

47:     foreach my $k (@keys){ 48:         $sql .= qq{$k = "$vals[$counter]", }; 49:         $counter++; 50:     }

Line 47 begins a foreach loop that traverses through the @keys array. Each time through the loop, the current value of @keys is stored in the scalar variable $k.

Line 48 appends some text to the $sql variable. The text appended is the current key and its associated value. Each time through the loop, the text added to the $sql variable looks something like this:

 Title = "Perl Database Programming ",  

Line 49 increments the variable named $counter. We use this variable to keep the keys and values synchronized-the first key is value 0, then value 1, and so on.

Line 50 closes the foreach loop that begins on Line 47.

51:     $sql  =~ s/\, $//; 52:     $sql .=  " WHERE isbn = ‘$isbn'";

Line 51 gets rid of the comma and space at the end of the value stored in $sql. Each time through the preceding loop, we add the current value plus a comma and a space. The final time through the loop also adds a comma and a space, but we don't need that one. This line takes care of removing the extra characters.

Line 52 appends the final text to the $sql variable. We now should have a complete, valid SQL statement stored in $sql. The SQL statement will look something like this:

UPDATE library SET format = "Hardcover", publisher = "Wiley", title = "Brent's Book", author = "Brent", isbn = "123999", price = "20.99", pubdate = "01-01-2001" WHERE isbn = ‘123456' 53:     my $query = $conn->prepare($sql); 54:     $query->execute or die("\nError executing SQL            statement! $DBI::errstr "); 55:     return 1; 56: }

Line 53 creates a scalar variable named $query and stores a reference to the prepared SQL statement in it. The $conn->prepare($sql) is a call to the prepare method of the DBI, which gets an SQL statement ready for execution.

Line 54 executes the SQL statement. If there is a problem executing the SQL statement, die is called; the program terminates and prints an error message.

Line 55 returns a true value from the subroutine.

Line 56 ends the subroutine.

57: sub Add_Record { 58:     my $form   = shift; 59:     my $caller = shift; 60:     $caller    -> withdraw();

Line 57 begins the Add_Record subroutine. This subroutine is called to add records to the database.

Line 58 shifts in a reference to the hash that stores all of the form data and stores the reference in a new my variable named $form.

Line 59 shifts in a reference to the window that calls this subroutine and stores the reference in a new my variable named $caller.

Line 60 uses the withdraw() method to close the window that calls this subroutine.

61:     my @keys = keys %$form; 62:     my @vals = map { $conn->quote($$form{$_}->get())  } @keys;

Line 61 reads all of the keys from the %$form hash and stores them in an array named @keys.

Line 62 uses the map function to get all of the form values, execute the quote function on them, and to store them in the @vals array. For each value in the %$form hash, the map function calls the get() method to retrieve the value from the form.

63:     $sql  = "INSERT INTO library ("  64:             . join(", ", @keys)  65:             . ") VALUES (" 66:             . join(", ", @vals) 67:             . ")";

Lines 63-67 are actually one line of Perl code! Notice that there is no semicolon until the end of Line 67.

These lines are used to create the SQL statement needed to insert new records into the database. The join function saves a lot of work. By using join, we are able to take all of the values in the @keys array and the @vals array and concatenate them into one string.

The first join uses a comma and space to join all of the values in @keys. These values do not have to be quoted, since they are the field names in the database table.

The second join does the same thing as the first, except for the @vals instead of the @keys.

These two arrays must have their values stored in the same order so that the correctkey=value relationship is maintained. Lines 61 and 62 take care of this for us.

Notice the dots, .'s, at the beginning of Lines 64-67. The dot is the concatenation operator in Perl, for joining the many strings we have here into one large string.

68:     my $query = $conn->prepare($sql); 69:     $query->execute or die("\nError executing SQL             statement! $DBI::errstr"); 70:     return 1; 71: }

Line 68 calls the prepare method on the $sql variable and stores the reference returned in the variable named $query.

Line 69 executes the query. If an error occurs when the query executes, the program will hit die; then the program will exit, and an error message will be printed.

Line 70 returns a true value from the subroutine.

Line 71 ends this subroutine.

72: #------------------------------------------------------ 73: # Tk Interface Routines 74: my $MainWin;

Lines 72-73 are simply comments that let people looking at the code know that the Tk routines are below these lines.

Line 74 declares a variable named $MainWin that we'll be using in the next several subroutines. This variable contains a reference to a new MainWindow object.

75: sub Start_Tk_Interface { 76:     $MainWin = MainWindow->new(-title => "Choose a Database           Action"); 77:     $MainWin->MoveToplevelWindow(100,100);

Line 75 begins a subroutine named Start_Tk_Interface. This subroutine creates the first window you see and handles the button-pushes that may occur within that window.

Line 76 creates a new MainWindow object and stores a reference to this new object in the $MainWin variable. This line also sets the window's title to Choose a Database Action.

Line 77 moves this new window to the (X,Y) position of (100,100) on the user's screen. You can put what values you like here, but 100,100 is a safe place. Make sure you don't put the window completely out of the user's view! Use values you know are within the user's desktop.

78:    my $button1 = $MainWin->Button(-text => ‘Add Record', 79:               -command => [\&tk_Add_Record_Dialog, ‘add']); 80:    my $button2 = $MainWin->Button(-text => ‘Edit Record', 81:               -command => [\&tk_Choose_Dialog, ‘Edit']); 82:    my $button3 = $MainWin->Button(-text => ‘Delete Record', 83:               -command => [\&tk_Choose_Dialog, ‘Delete']); 84:    my $button4 = $MainWin->Button(-text => ‘Quit', 85:               -command => [$MainWin => ‘destroy']); 

Lines 78-85 create the buttons that appear on the main window and associate each button with a sub to be called when it is clicked.

Line 78 creates a my variable called $button1. This variable stores a reference to the button object that is created with the $MainWin->Button call. This line also sets the text of the button to "Add Record".

Line 79 is a continuation of line 78. This line uses the -command attribute to specify that when this button is clicked, Tk should call tk_Add_Record_Dialog(‘add').

Lines 80-83 do the same as the previous description, with the exception that a different subroutine is called and a different value is passed based upon the clicked button.

Line 84 is just like the preceding lines.

Line 85 calls the destroy method on the Main Window. This causes the main window and all subordinate windows to close. This exits the program.

86:     $button1 -> grid(-row => 0, -column => 0,                            -padx => 10, -sticky => ‘w'); 87:     $button2 -> grid(-row => 0, -column => 1,                            -padx => 10, -pady   => 40 ); 88:     $button3 -> grid(-row => 0, -column => 2,                            -padx => 10); 89:     $button4 -> grid(-row => 0, -column => 3,                            -padx => 10, -sticky => ‘e');

Lines 86-89 are used to position the buttons in the window. The grid method is one way to position items when programming a Tk application. Using grid to lay out the page causes the page to be divided into a logical table of rows and columns.

The row attribute tells the program in which row to put this item. The column attribute tells the program with which column this item should be positioned.

The padx attribute tells the program to pad 10 pixels on each side of the item. The pady attribute tells the program to pad the specified number of pixels on the top and bottom of the item.

The sticky attribute takes an argument of n, s, e, or w. These are compass directions that correspond to where this item should remain anchored. Passing an argument of w causes the item to be anchored on the left side of the window.

90:     MainLoop(); 91: } 

Line 90 calls the MainLoop function. This function is part of all Perl Tk applications. It keeps the program running in a loop and allows events such as button clicks to take place and be handled appropriately. By appropriately, I mean by the subroutines passed as they are in Lines 78-85.

Line 91 ends this subroutine.

92: sub tk_Choose_Dialog { 93:     my $type = shift;

Line 92 begins the tk_Choose_Dialog window. This creates the window that has the user enter the isbn and then calls the tk_Edit_or_Delete function to handle either updating or deleting the book whose isbn matches.

Line 93 creates a new scalar variable named $type and shifts in the value passed via the subroutine call. This can be either Edit or Delete. The button name is based upon this value. What happens to this record is also based upon this value.

94:     my $top_win = $MainWin->Toplevel(-title =>             "Choose Record"); 95:     $top_win->MoveToplevelWindow(110,110);

Line 94 creates a new top-level window with a title of Choose Record. A top-level window means the window is displayed.

Line 95 moves this new window to the (X,Y) position (110,110).

96:     $top_win->Label(-text => ‘ISBN: ‘) ->  97:         grid(-row => 0, -column => 0, -sticky => ‘w'); 98:     my $isbn = $top_win->Entry(-width => 20) ->  99:         grid(-row => 0, -column => 1, -sticky => ‘e');

Line 96 adds a label to the new window. This label is the ISBN: to the left of the text entry field on the window.

Line 97 positions this new label and anchors it to the left of the window with sticky => ‘w'.

Lines 98-99 add a text-entry field to the window and anchor it to the right side of the window. Line 98 also takes a return value and stores it in the $isbn variable. This allows us to gain access to the text in this text-entry field.

100:     my $button = $top_win->Button( 101:         -text    => "$type Record", 102:         -command => [\&tk_Edit_or_Delete, $top_win,                            $type, $isbn] ); 

Line 100 creates a new button on this window and stores a reference to this new button in the $button variable.

Line 101 sets the text on this new button to the value in the $type variable (Edit or Delete) and appends Record onto it as well. This causes the button to either say Edit Record or Delete Record.

Line 102 sets this button to call the tk_Edit_or_Delete subroutine when it is clicked. This line also passes some values to the subroutine it calls.

103:     $button-> grid(-row => 1, -column => 1); 104:     return 1; 105: }

Line 103 positions the button in row 1, column 1.

Line 104 returns a true value from this subroutine.

Line 105 ends this subroutine.

106: sub tk_Edit_or_Delete { 107:     my $caller = shift; 108:     my $type   = shift; 109:     my $isbn   = shift()->get();

Line 106 creates the tk_Edit_or_Delete subroutine.

Line 107 creates a new my variable named $caller and shifts in the first value passed to this subroutine.

Line 108 creates a new my variable named $type and shifts in the second value passed to this subroutine.

Line 109 creates a new my variable named $isbn and calls the get() function on the value we are shifting in to this variable. We shift in the third value passed to this subroutine, and we call the get() function on it at the same time.

110:    $caller->withdraw(); 111:    Delete_Record($isbn)             if($type eq ‘Delete'); 112:    tk_Add_Record_Dialog("edit", $isbn) if($type eq ‘Edit'); 113:    return 1; 114: } 

Line 110 calls the withdraw method on the window referenced in the $caller variable. This causes the window that calls this subroutine to close.

Line 111 calls the Delete_Record subroutine and passes $isbn to it so that the proper item is deleted from the database. The if statement at the end of this line checks to see if the value stored in $type is equal to Delete. This line will be executed only if the if statement's condition is true.

Line 112 calls the tk_Add_Record_Dialog subroutine and passes "edit" and $isbn to it so that the proper item is selected and displayed for editing. The if statement at the end of this line checks to see it the value stored in $type is equal to Edit. This line will be executed only if the if statement is true.

Line 113 returns a true value from this subroutine.

Line 114 ends this subroutine.

115: sub tk_Add_Record_Dialog { 116:     my ($record, $isbn, %form); 117:     my $type = shift; 118:     my $row  = 0;

Line 115 begins the tk_Add_Record_Dialog. This dialog is used to gather information about a book from the user so that it may be added to the database.

Line 116 declares some variables that we'll be using in this subroutine.

Line 117 declares a variable named $type and shifts in the first values passed to this subroutine.

Line 118 creates a new variable named $row and initializes it to a value of 0.

119:     my $top_win = $MainWin->Toplevel(-title =>             "Add/Edit a Record"); 120:     $top_win->MoveToplevelWindow(110,110);

Line 119 creates a new top-level window and sets its title to Add/Edit a Record.

Line 120 positions this new top-level window at (X,Y) position (110,110).

121:     if($type =~ /edit/){ 122:         $isbn   = shift; 123:         $record = Get_Record($isbn); 124:     }

Line 121 checks to see if the variable $type contains the word edit. If so, the program enters the block; if not, the program continues from Line 125.

Line 122 shifts in the next value passed to this subroutine and stores the value in $isbn.

Line 123 calls the Get_Record subroutine and passes it $isbn. The results of the function are stored in the $record variable. $record will contain a reference to a hash that contains the values of the record if the Get_Record subroutine finds a matching record.

Line 124 closes this if block.

125:     foreach my $field (@order){ 126:         my $text = $record->{$field};

Line 125 begins a foreach loop that traverses through the @orders array and stores the current value in $field each time through the loop. This loop creates most of the form fields in this new window.

Line 126 creates a new variable named $text and stores the value of the current field in it.

127:         $top_win->Label(-text => $fields{$field}) ->  128:           grid(-row => $row, -column => 0, -sticky => ‘w');

Line 127 creates a label for each text-entry field on this form.

Line 128 positions this label in the current row of column 0 and anchors it to the left side of the window.

129:         $form{$field}  = $top_win->Entry 130:             (-width => 50, -textvariable => \$text) ->  131:              grid(-row=> $row, -column=> 1, -sticky=> ‘e'); 132:         $row++; 133:     }

Lines 129-131 create the text-entry field for each item on this form. Line 131 positions this new field and anchors the field to the right side of the window.

Line 132 increments the $row variable.

Line 133 closes this foreach loop.

134:     my $button;  135:     if($type =~ /edit/i){ 

Line 134 creates a new variable called $button.

Line 135 is an if statement that checks to see if the value stored in $type contains edit. If so, this block of code is entered. If not, this block of code is skipped.

136:         $button = $top_win->Button( 137:           -text    => ‘Edit Record', 138:           -command => [\&Update_Record,\%form, $top_win] ); 139:     }

Line 136 creates a new button on the window and stores a reference to it in $button.

Line 137 sets the text of this new button to Edit Record.

Line 138 sets up the action of this button to call the Update_Record subroutine when pressed and passes the subroutine a reference to the %form hash and $top_win.

140:     else { 141:         $button = $top_win->Button( 142:           -text    => ‘Add Record', 143:           -command => sub{ Add_Record(\%form, $top_win)} ); 144:     }

Line 140 is the else part of the if..else that begins on Line 135.

Line 141 creates a new button on this form and stores a reference to it in $button.

Line 142 sets the text of the button to Add Record.

Line 143 tells the program to call the Add_Record subroutine if this button is clicked. It also passes a reference to the %form hash and $top_win variable.

Line 144 closes this if..else block.

145:     $button-> grid(-row => $row, -column => 1); 146:     return 1; 147: }

Line 145 positions the button in column 1 and at the current value of $row.

Line 146 returns a true value from this subroutine.

Line 147 ends this subroutine.

Wow, a GUI database application in fewer than 150 lines of code! This small appli- cation has a lot of potential for becoming a full-featured database GUI with error checking and extra features. Don't be afraid to expand it and even add features to it.