Creating a Graphical Phonebook Application

This program uses a lot of the techniques we’ve already used to build a “full-function” maintenance program for the person and phone tables. It uses the Tk module to make it a cross-platform graphical application. If you know Tk well, you’ll find this application simple. But if you don’t know Tk well, you’ll have to pay close attention to the explanation of the code.

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

Lines 1–7 start in the usual way, with the addition of the Tk module.

08: my $Connection = DBI->connect    (‘DBI:mysql:BibleBook’, ‘bookuser’, ‘testpass’) 09:         or die "Can’t connect to database: $DBI::errstr";

Lines 8–9 connect to the database and get a database handle. We call the die method and print an error message if we can’t connect.

10: my %Fields = ( 11:     id           => {required => 1, label => ‘ID’         }, 12:     first_name   => {required => 1, label => ‘Forename’   }, 13:     last_name    => {required => 0, label => ‘Surname’    }, 14:     greeting     => {required => 0, label => ‘Greeting’   }, 15:     phone_type   => {required => 1, label => ‘Number Type’}, 16:     phone_number => {required => 1, label => ‘Number’     }, 17:     note         => {required => 0, label => ‘Note’       }, 18: );       19: my @Person_prompts = qw(first_name last_name greeting); 20: my @Phone_prompts  = qw(phone_type phone_number note); 21: my @Phone_cols     = (‘id’, @Phone_prompts); 22: my $Main_win; 23: my ($pr_lst, $ph_lst);

Lines 10–21 reuse some of the global variables code from the earlier command-line program that make the program easy to extend.

Line 22 is a new global variable, $Main_win, which holds the object representing the program’s main window.

Line 23 declares a couple variables that we’ll be using.

24: show_main_form(); 25: MainLoop(); 26: $Connection->disconnect(); 27: exit 0;

Line 24 calls the show_main_form subroutine to build and display the main program window.

Line 25 starts TK’s main event-loop. MainLoop() finishes when the user closes the main program window.

Line 26 cleanly disconnects us from the database.

Line 27 exits the program.

28: sub show_main_form {

Line 28 begins the show_main_form subroutine which is the largest single sub- routine in the program. It creates and displays the main window (with list boxes for people and phone numbers and buttons to add) and updates and deletes people and phone records. The buttons and list boxes are the jumping-off points for the rest of the code in the program.

29:     $Main_win = MainWindow->new(-title => ‘Perl/Tk PhoneBook’);

Line 29 creates the main window and gives it a title. A reference to the main window is stored in a global variable because it’s needed whenever we create a window.

30:     my $person_frame = $Main_win->Frame(); 31:     $pr_lst = $person_frame->Scrolled(‘Listbox’, 32:         -scrollbars => ‘oe’, -height => 10,  33:         -selectmode => ‘browse’); 34:     my $phone_frame = $Main_win->Frame(); 35:     $ph_lst = $phone_frame->Scrolled(‘Listbox’, 36:         -scrollbars => ‘oe’, -height => 4, 37:         -selectmode => ‘browse’);

Lines 30–37 create frames and list boxes for people and phone numbers. We use frames to group and control the placement of related widgets. The frames are children of the main window, the list boxes children of the frames. Tk list boxes don’t, by default, have scrollbars. We’ve used the Scrolled constructor to create a list box with a scrollbar attached. The scrollbar attribute ‘oe’ means the scrollbar is "optional"—only displayed when necessary—and is attached to the east (right-hand) side of the list box.

38:     my $person_add_b =            $person_frame->Button(-text => ‘Add Person’, 39:         -command => sub { 40:             show_person_form(‘Add Person’); 41:             fill_person_list(); 42:         } 43:     );

Line 38 creates a variable named $person_add_b and begins the code that will create an "Add Person" button in the $person_frame.

Line 39 declares an anonymous subroutine that gets executed whenever this button is pressed.

Line 40 is a call to the show_person_form subroutine. The "Add Person" text that is passed in the function call is used as the title of the window.

Line 41 is a call to the fill_person_list subroutine which fills the person listbox with data.

Line 42 ends the anonymous subroutine.

Line 43 ends the $person_add_b button declaration.

44:     my $person_upd_b =            $person_frame->Button(-text => ‘Update Person’, 45:         -state => ‘disabled’, 46:         -command => sub { 47:             show_person_form(‘Update Person’,  48:               $pr_lst->get(‘active’)); 49:             fill_person_list(); 50:         } 51:     );

Line 44 creates a variable named $person_upd_b and begins the code that will create an "Add Person" button in the $person_frame.

Line 45 sets the initial state of this button to be disabled.

Line 46 declares an anonymous subroutine that gets executed whenever this button is pressed.

Lines 47–48 are a call to the show_person_form subroutine. The "Update Person" text that is passed in the function call is used as the title of the window. The $pr_lst->get(‘active’) gets the "active" person in the list (the last person that was selected) and passes this value to the show_person_form subroutine so that when the new window pops up, it is pre-populated with the selected user’s data.

Line 49 is a call to the fill_person_list subroutine which fills the person listbox with data.

Line 50 ends the anonymous subroutine.

Line 51 ends the $person_upd_b button declaration.

52:     my $person_del_b =            $person_frame->Button(-text => ‘Delete Person’, 53:         -state => ‘disabled’, 54:         -command => sub { 55:             chk_del_person($pr_lst->get(‘active’)); 56:             fill_person_list(); 57:         } 58:     );

Line 52 creates a variable named $person_del_b and begins the code that will create a "Delete Person" button in the $person_frame.

Line 53 sets the initial state of this button to be disabled.

Line 54 declares an anonymous subroutine that gets executed whenever this button is pressed.

Line 55 is a call to the chk_del_person subroutine. The $pr_lst->get (‘active’) gets the "active" person in the list (the last person that was selected) and passes this value to the chk_del_person subroutine so that we can pop up a window to verify that the user really wants to delete this person.

Line 56 is a call to the fill_person_list subroutine, which fills the person listbox with data.

Line 57 ends the anonymous subroutine.

Line 58 ends the $person_del_b button declaration.

59:     my $phone_add_b = $phone_frame->Button(-text => ‘Add Phone’, 60:         -state => ‘disabled’, 61:         -command => sub { 62:             show_phone_form(‘Add Phone’); 63:         } 64:     );

Line 59 creates a variable named $phone_add_b and begins the code that will create an "Add Phone" button in the $phone_frame.

Line 60 sets the initial state of this button to be disabled.

Line 61 declares an anonymous subroutine that gets executed whenever this button is pressed.

Line 62 is a call to the show_phone_form subroutine. The "Add Phone" text that is passed in the function call is used as the title of the window. This subroutine call will display a blank "add phone" window.

Line 63 ends the anonymous subroutine.

Line 64 ends the $phone_add_b button declaration.

65:     my $phone_upd_b = $phone_frame->Button(-text => ‘Update Phone’, 66:         -state => ‘disabled’, 67:         -command => sub { 68:             show_phone_form(‘Update Phone’, $ph-lst->get($ph_lst->curselection())); 69:         } 70:     );

Line 65 creates a variable named $phone_upd_b and begins the code that will create an "Update Phone" button in the $phone_frame.

Line 66 sets the initial state of this button to be disabled.

Line 67 declares an anonymous subroutine that gets executed whenever this button is pressed.

Line 68 is a call to the show_phone_form subroutine. The "Update Phone" text that is passed in the function call is used as the title of the window. The $ph_lst->get($ph_lst->curselection()) gets the phone number in the list that is selected and passes this value to the show_phone_form subroutine so that when we can pop up the phone number editing window the data is pre-populated.

Line 69 ends the anonymous subroutine.

Line 70 ends the $phone_upd_b button declaration.

71:     my $phone_del_b = $phone_frame->Button(-text => ‘Delete Phone’, 72:         -state => ‘disabled’, 73:         -command => sub { 74:             chk_del_phone( 75:                       $ph_lst->get($ph_lst->curselection())); 76:             fill_phone_list($pr_lst->get($pr_lst->curselection())); 77:         } 78:     );

Line 71 creates a variable named $phone_del_b and begins the code that will create a "Delete Phone" button in the $phone_frame.

Line 72 sets the initial state of this button to be disabled.

Line 73 declares an anonymous subroutine that gets executed whenever this button is pressed.

Lines 74 and 75 are a call to the chk_del_phone subroutine. The $pr_lst->get($pr_lst->curselection()) and the $ph_lst->get ($ph_lst->curselection()) get the "active" person and phone number in the list and pass these values to the chk_del_phone subroutine so that we can pop up a window to verify that the user really wants to delete this phone number.

Line 76 is a call to the fill_phone_list subroutine, which fills the phone listbox with data.

Line 77 ends the anonymous subroutine.

Line 78 ends the $person_del_b button declaration.

79:     $person_frame->pack( -side => ‘top’, -fill => ‘both’, -expand => 1); 80:     $person_list->pack( -side => ‘top’, -fill => ‘both’, -expand => 1); 81:     foreach my $button ($person_add_b, $person_upd_b, $person_del_b) { 82:         $button->pack(-side => ‘left’); 83:     } 84:     $phone_frame->pack( -side => ‘top’, -fill => ‘both’, -expand => 1); 85:     $phone_list->pack( -side => ‘top’, -fill => ‘both’, -expand => 1); 86:     foreach my $button ($phone_add_b, $phone_upd_b, $phone_del_b) { 87:         $button->pack(-side => ‘left’); 88:     }

Lines 79–88 use the pack geometry manager to display the widgets we’ve created.

The packer works by placing each widget against one side of the parent widget, optionally expanding the child widget to fill a rectangle. The next widget is placed against one side of the (reduced) space in the parent widget.

89:     $Main_win->Button( -text => ‘Exit’, -command => sub { 90:             $Connection->disconnect(); 91:             $Main_win->withdraw(); 92:             exit 0; 93:         } )->pack();

Lines 89–93 create one more widget: a button that’s immediately packed at the bottom of the main window. This is our “Exit” button that ends the program.

94:     $pr_lst->bind( ‘<Button-1>’, 95:         sub { 96:             return  unless defined $pr_lst->curselection(); 97:             $person_upd_b->configure(-state => ‘active’); 98:             $person_del_b->configure(-state => ‘active’); 99:             $phone_add_b->configure(-state => ‘active’); 100:             fill_phone_list($pr_lst->get($pr_lst->curselection())); 101:         } 102:     );

Lines 94–102 bind actions—anonymous subroutines—to mouse clicks. A single click with the first mouse button on the list boxes checks whether anything has been selected and, if so, activates the buttons.

Line 94 binds these actions on the person list ($pr_lst object) to mouse button 1.

Line 95 declares an anonymous subroutine that is executed when an item on the person list listbox is clicked.

Line 96 returns unless a person was selected.

Lines 97–99 set the person update, person delete, and phone add buttons to their active state.

Line 100 populates the phone list with the selected persons phone numbers.

Line 101 ends the anonymous subroutine.

Line 102 ends the button 1 click declaration.

103:     $ph_lst->bind( ‘<Button-1>’, 104:         sub { 105:             return  unless defined $ph_lst->curselection(); 106:             $phone_upd_b->configure(-state => ‘active’); 107:             $phone_del_b->configure(-state => ‘active’); 108:         } 109:     );

Line 103 binds a button 1 single click to the phone list ($ph_lst object).

Line 104 declares an anonymous subroutine that is executed when an item on the phone list listbox is clicked.

Line 105 returns unless a phone number was selected.

Lines 106 and 107 set the phone update, and phone delete buttons to their active state.

Line 108 ends the anonymous subroutine.

Line 109 ends the button 1 click declaration.

110:     $pr_lst->bind( ‘<Double-Button-1>’, 111:         sub { 112:             return  unless defined $pr_lst->curselection(); 113:             show_person_form(‘Update Person’,  114:                         $pr_lst->get($pr_lst->curselection())); 115:             fill_person_list(); 116:             fill_phone_list($pr_lst->curselection()); 117:         } 118:     );

Line 110 binds these actions on the person list ($pr_lst object) to a mouse button 1 double-click.

Line 111 declares an anonymous subroutine that is executed when an item on the person list listbox is double-clicked.

Line 112 returns unless a person was selected.

Lines 113 and 114 calls the show_person_form subroutine and passes in the title "Update Person" and the current userid.

Line 115 populates the person list.

Line 116 populates the phone list with the selected person’s phone numbers.

Line 117 ends the anonymous subroutine.

Line 118 ends the button 1 double-click declaration.

119:     $ph_lst->bind( ‘<Double-Button-1>’, 120:         sub { 121:             return  unless defined $ph_lst->curselection(); 122:             show_phone_form(‘Update Phone’, $pr_lst->get(‘active’), 123:                         $ph_lst->get(‘active’)); 124:             fill_phone_list($ph_lst, $pr_lst->get(‘active’)); 125:         } 126:     ); 

Line 119 binds these actions on the phone list ($ph_lst object) to a mouse button 1 double-click.

Line 120 declares an anonymous subroutine that is executed when an item on the phone number list listbox is double-clicked.

Line 121 returns unless a person was selected.

Lines 122 and 123 calls the show_phone_form subroutine and passes in the title "Update Phone", the current userid, and the current phone list selection.

Line 124 populates the phone list with the selected person’s phone numbers.

Line 125 ends the anonymous subroutine.

Line 126 ends the button 1 double-click declaration.

So, a single click with the first mouse button on the list boxes checks whether anything has been selected and, if so, activates the buttons. Clicking a person also runs the subroutine to fill in the phone list box. Actually, the way list boxes work is that a click selects the nearest item so; if there are any items in the list box, clicking will select one of them.

A double click with the first button runs the update function on the selected item and refills the list box in case it has changed.

127:     fill_person_list(); 128:       return; 129: }

Line 127 fills the person list box for the first time before the subroutine returns to the main program.

Line 128 returns us to where the program called.

Line 129 ends this subroutine.

When the main program calls MainLoop(), the main form is displayed and the program waits for clicks on buttons or list boxes and runs the related code.

Most of the remaining functions are called from buttons or bind commands set up in show_main_form. The first of these is show_person_form. Its job is to draw the form for adding new person records or updating existing ones.

So, at this point, you have created the main program form, which should look something like Figure 14-1.


Figure 14-1: Main program form

130:  sub show_person_form{ 131:     my $label = shift; 132:     my $person = shift; 133:     my %person;

Line 130 begins the show_person_form subroutine.

Lines 131 and 132 declare a couple scalar variables and shift that values passed to this subroutine into them.

Line 133 declares a hash that we’ll be using.

134:     if ($person) { 135:         $person{‘id’} = get_person_id($person); 136:         my $sql = ‘SELECT * FROM person WHERE id = ?’; 137:         my $array_ref = $Connection->selectall_arrayref($sql, undef,  138:     $person{‘id’}); 139:         my $i = 1; 140:         foreach my $col ( @Person_prompts ) { 141:             $person{$col} = $array_ref->[0]->[$i]; 142:             $i++; 143:         } 144:     }

Line 134 checks to see if $person contains a value, if so, the code block is entered.

Line 135 sets the id key in the %person hash ($person{‘id’}) to the value returned by the call to the get_person_id subroutine.

Line 136 creates the SQL needed to get all of the data from the person table which matches the id value we pass to the placeholder.

Line 137 declares a variable named $array_ref which stores the result of the $Connection->selectall_arrayref call.

Line 138 continues line 137, the $person{‘id’} is the value that will replace the placeholder in the SQL statement.

Line 139 creates a scalar variable named $i that we’ll use for an array index counter.

Line 140 is a foreach loop that loops through each of the values in the @Person_prompts array. Each time through the loop, the current value is stored in the $col variable.

Line 141 sets $person{$col} to the value that was returned from the SQL call. $array_ref->[0]->[$i] is the current column value. We know this because since we searched on the primary key value in the table (the id field), there can only be one record returned to us, it will be at $array_ref->[0]. The extra ->[$i] will be each field from the record that was returned to us.

Line 142 increments the $i variable.

Line 143 ends for foreach loop.

Line 144 ends the if code block.

If the query fails (it shouldn’t, because the data we’re looking for comes from the database), we end up filling the person hash with undefined values. An alternative is to warn the user, asking him or her to try again.

145:     my $person_form = $Main_win->Toplevel( -title => $label );

Line 145 creates a new top-level window to hold the person add/update form.

146:     my $row = 0; 147:     my %entry;

Line 146 declares a variable named $row and sets it to 0.

Line 147 declares a hash named %entry.

148:     foreach my $col ( @Person_prompts ) { 149:         my $req = $Fields{$col}{‘required’} ? ‘*’ : ‘’;

Line 148 begins a foreach loop that loops through all of the values in @Person_prompts. Each time through the loop the current value gets stored in the $col variable.

Line 149 creates a variable named $req and, if the current field is a required field, stores a * into $req. If the field is not required, $req is set to an empty string.

150:         $person_form->Label( -text => "$Fields{$col}{‘label’}$req ")-> 151:           grid( -row => $row, -column => 0, -sticky => ‘e’);

Lines 150 and 151 create the field label for the current field and place it on the form.

152:         $entry{$col} = $person_form->Entry( -width => 20, 153:                 -textvariable => \$person{$col} )-> 154:             grid(-row => $row++, -column => 1, -sticky => ‘w’); 155:     }

Lines 152–154 create the text entry fields and place them on the form.

Line 155 closes the foreach loop which began on line 148.

156:     $person_form->Button( -text => ‘Close’, 157:         -command => sub { $person_form->withdraw() })-> 158:             grid(-row => $row, -column => 0, -sticky => ‘w’);

Lines 156–158 create a “Close" button on the form.

Line 157 sets the action for the button to the anonymous subroutine on this line — which simply closes the window. The action of the close button is a method call. It’s easier to put the call in an anonymous subroutine.

159:     $person_form->Button( -text => $label, 160:         -command => [ \&add_upd_person, $label, $person_form, \%entry])-> 161:             grid(-row => $row, -column => 1, -sticky => ‘w’);

Lines 159–161 create a button on the page, with the value from $label as the button label.

Line 160 sets the command for this button and passes the %entry hash so that the data can pre-populate the form.

162:     return; 163: } 

Line 162 returns.

Line 163 ends this subroutine.

The person form should look similar to Figure 14-2.


Figure 14-2: Person form

The show_phone_form does the same job as show_person_form but has to do more checking.

164: sub show_phone_form { 165:     my $label = shift; 166:     my $person = get_person_id($pr_lst->get(‘active’)); 167:     my $phone = shift; 168:    my %phone;

Lines 165–168 declare some variables and use the shift function to read them in from the values passed to the subroutine.

Line 166 declares the $person variable and uses the get_person_id subroutine to get the value of the currently selected person.

169:     unless ($person) { 170:         $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 171:             -title => ‘Select a Person’, 172:             -message => ‘Please select a person and retry.’); 173:         return; 174:     }

Lines 169–174 confirm that a person item has been supplied. If not, the subroutine can’t do anything useful except tell the user and return. This should never happen, but it doesn’t hurt to check.

175:     if ($phone) { 176:         $phone =~ /^(.*?): (.*?), (.*)/; 177:         @phone{@Phone_prompts} = ($1, $2, $3); 178:     }

Lines 175–178 pick the phone information out of the phone list-box entry. The three fields the match operation selects are assigned to a hash slice that uses the

Phone_prompts array. This time, it just saves typing. If the format of the phone list-box entry changes, we’ll have to change the regular expression and the assignment.

179:     elsif ($label =~ /Update/) { 180:         $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 181:             -title => ‘Select a Phone’, 182:             -message => ‘Please select a phone and retry.’); 183:         return; 184:     }

Lines 179–184 deal with the case of no phone item when we’re supposed to be updating. Again, this shouldn’t happen; if it does, we throw up a message box to tell the user and return to the main form.

185:     my $phone_form = $Main_win->Toplevel( -title => $label ); 186:     my $row = 0; 187:     my %entry; 188:     foreach my $col ( @Phone_prompts ) { 189:         my $req = $Fields{$col}{‘required’} ? ‘*’ : ‘’;       190:         $phone_form->Label( -text => "$Fields{$col}{‘label’}$req ")-> 191:             grid( -row => $row, -column => 0, -sticky => ‘e’);       192:         $entry{$col} = $phone_form->Entry( -width => 20, 193:                 -textvariable => \$phone{$col} )-> 194:             grid(-row => $row++, -column => 1, -sticky => ‘w’); 195:     } 196:     $phone_form->Button( -text => ‘Close’, 197:         -command => sub { $phone_form->withdraw() })-> 198:             grid(-row => $row, -column => 0, -sticky => ‘w’); 199:     $phone_form->Button( -text => $label, 200:         -command => [ \&add_upd_phone, $label, $phone_form, \%entry, 201:                 get_person_id($person) ])-> 202:             grid(-row => $row, -column => 1, -sticky => ‘w’);       203:     return; 204: }

Lines 185–204 create a form and buttons in the same way as show_person_form.

The phone from should look like Figure 14-3.


Figure 14-3: Phone form

 205: sub fill_pr_lst {

Line 205 begins the fill_pr_lst subroutine, which gets a list box, deletes any items in it, and fills it with data from the person table.

206:     my $sql = ‘SELECT id,last_name,first_name FROM person ‘ 207:         . ‘ORDER by last_name,first_name’;

Lines 206 and 207 define the SQL query, hard coded this time.

208:     my $ptr = $Connection->selectall_hashref($sql, undef);

Line 208 executes the query and fetches all the data, once again in the form of a reference to an array of hashes. If the fetch fails, it returns undef.

209:     $pr_lst->delete(0, ‘end’); 210:     $pr_lit->insert(‘end’, map { sprintf "%4d: %-s",  211:                   $_->{id}, "$_->{last_name}, $_->{first_name}" } @{$ptr} ); 212: }

Line 209 deletes any values already in the list-box.

Lines 210–211 inserts into the list-box the result of the query. Since the insert method can add a list of items, we’ve used map to generate the list. map runs sprintf on each element of the list we get from dereferencing $plist_ref. Each element is a hash, so it is dereferenced again ($_->{id}) to get the actual values.

Line 212 ends the fill_pr_lst subroutine.

213: sub fill_ph_lst { 214:     my $person_id = get_person_id( shift ); 215:     my $sql = ‘SELECT phone_type,phone_number,note FROM phone ‘ 216:         . ‘WHERE id = ? ‘ 217:         . ‘ORDER by phone_type’; 218:     my $ptr = $Connection->selectall_arrayref($sql, undef, $person_id); 219:     $ph_lst->delete(0, ‘end’); 220:     $ph_lst->insert(‘end’, map { 221:                 "$_->[0]: $_->[1], $_->[2] "} @{$ptr} ); 222:     return; 223: }

Lines 213–223 repeat the functionality for the phone list box. This time, we’re interested only in numbers for a particular person’s ID. Code in the show_phone_form subroutine depends on the format of the string added to the list box, so this shouldn’t be changed separately.

224: sub get_person_id { 225:     my $person = shift; 226:     $person =~ /^\s*(\d+):?/; 227:     return $1; 228: }

Lines 224–228 define a helper function that gets passed the person data from the person list-box. Then, on line 226, we filter out everything but the person ID.

The add_upd_person and add_upd_phone subroutines run from the confirm button on the corresponding form.

229: sub add_upd_person { 230:     my $label       = shift; 231:     my $person_form = shift; 232:     my $id       = shift; 233:     my $form_entry  = shift;

Line 229 begins the add_upd_person subroutine.

Lines 230–233 declare several scalar variables and load them with the values that were passed to the subroutine.

234:     my (%person, $sql); 235:     my $missing_fields = 0;

Lines 234–235 define a hash to store the person data, a scalar for the SQL statement, and a flag to set if required fields are missing.

236:     foreach my $col ( @Person_prompts ) { 237:         $person{$col} = $form_entry->{$col}->get(); 238:         $missing_fields = 1 239:             if $Fields{$col}{‘required’} && ! length $person{$col}; 240:     }

Lines 236–240 get the values from the entry widgets and store them in the person hash. If the field is required and has zero length we set the $missing_fields flag to 1. This curious construction exists because the get() method returns a zero length, but defined, string when the field is empty. A test for defined always succeeds; a test for "Truth" fails with an input of 0, which might be a valid value.

241:     if ($missing_fields) { 242:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 243:                 -title => ‘Required Fields Missing’, 244:                 -message => "Please fill fields marked ‘*’"); 245:             return; 246:     } 

Lines 241–246 display a message box if there are missing fields. The immediate return means that the person form stays active and the user can correct his or her entry.

247:     if ($label =~ /^Add/) { 248:         $sql = ‘INSERT INTO person(‘ 249:             . join(‘,’, @Person_prompts) . ‘) VALUES(‘ 250:             . join(‘,’, map {‘?’} @Person_prompts) . ‘)’; 251:         unless ( $Connection->do( $sql, undef, 252:                            @person{@Person_prompts}) ) { 253:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 254:                 -title => ‘Error Adding Person’, 255:                 -message => "$DBI::errstr, please correct and retry."); 256:             return; 257:         } 258:   }

Line 247 checks to see if $label begins with "Add". If so, the code block is entered.

Lines 248–250 create the SQL statement needed to insert a person into the database.

Lines 251–257 are the SQL do statement that actually executes the SQL statement. If an error occurs, then this code block is entered and we display a message box informing the user of the problem. Once again, an immediate return leaves the person form visible.

Line 258 ends the if portion of this if..else block.

259:     else {  # assume we’re updating 260:         $sql = ‘UPDATE person SET ‘ 261:             . join(‘,’, map {"$_ = ?"} @Person_prompts) 262:             . ‘ WHERE id = ?’; 263:         unless ( $Connection->do($sql, undef,  264:                 @person{@Person_prompts}, $id) ) { 265:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 266:                 -title => ‘Error Updating Person’, 267:                 -message => "$DBI::errstr, please correct and retry."); 268:             return; 269:         } 270:     }

Lines 259–270 performs the same basic function as the block above where we inserted a new person. In this block, however, we are updating an existing person.

271:     fill_pr_list(); 272:     $person_form->withdraw(); 273:    return; 274: }

Line 271 calls the fill_pr_list subroutine to refresh the person list-box with the new, updated information.

Line 272 removes the person form, since the operation has succeeded.

Line 273 returns us to where the subroutine was called.

Line 274 ends the add_upd_person subroutine.

275: sub add_upd_phone { 276:     my (%phone, $sql); 277:     my $missing_fields = 0; 278:     my $label      = shift; 279:     my $phone_form = shift; 280:     my $form_entry = shift; 281:     $phone{‘id’}   = shift;

Line 275 begins the add_upd_phone subroutine.

Lines 276–277 define a hash to store the person data, a scalar for the SQL statement, and a flag to set if required fields are missing.

Lines 278–281 declare several scalar variables and load them with the values that were passed to the subroutine.

282:     foreach my $col ( @Phone_prompts ) { 283:         $phone{$col} = $form_entry->{$col}->get(); 284:         $missing_fields = 1 285:             if $Fields{$col}{‘required’} && ! length $phone{$col}; 286:     }

Lines 282–286 get the values from the entry widgets and store them in the phone hash. If the field is required and has zero length we set the $missing_fields flag to 1.

This curious construction exists because the get() method returns a zero length, but defined, string when the field is empty. A test for defined always succeeds; a test for "Truth" fails with an input of 0, which might be a valid value.

287:     if ($missing_fields) { 288:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 289:                 -title => ‘Required Fields Missing’, 290:                 -message => "Please fill fields marked ‘*’"); 291:             return; 292:     } 

Lines 287–292 display a message box if there are missing fields. The immediate return means that the person form stays active and the user can correct his or her entry.

293:     if ($label =~ /^Add/) { 294:         $sql = ‘INSERT INTO phone(‘ 295:             . join(‘,’, @Phone_cols) . ‘) VALUES(‘ 296:             . join(‘,’, map {‘?’} @Phone_cols) . ‘)’; 297:         unless ( $Connection->do($sql, undef, @phone{@Phone_cols}) ) { 298:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 299:                 -title => ‘Error Adding Phone’, 300:                 -message => "$DBI::errstr, please correct and retry."); 301:             return; 302:         } 303:     }

Line 293 checks to see if $label begins with "Add". If so, the code block is entered.

Lines 294–296 create the SQL statement needed to insert a phone number into the database.

Lines 297–302 are the SQL do statement that actually executes the SQL statement. If an error occurs, then this code block is entered and we display a message box informing the user of the problem. Once again, an immediate return leaves the phone form visible.

Line 303 ends the if portion of this if..else block.

304:     else {  # assume we’re updating 305:         $sql = ‘UPDATE phone SET ‘ 306:             . join(‘,’, map {"$_ = ?"} @Phone_prompts) 307:             . ‘ WHERE id = ? AND phone_type = ?’; 308:         unless ( $Connection->do($sql, undef, @phone{@Phone_prompts},  309:                 $phone{‘id’}, $phone{‘phone_type’}) ) { 310:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 311:                 -title => ‘Error Updating Phone’, 312:                 -message => "$DBI::errstr, please correct and retry."); 313:             return; 314:         } 315:     }        316:     fill_pr_lst(); 317:     fill_ph_lst($phone{‘id’}); 318:     $phone_form->withdraw(); 319:     return; 320: }

Lines 304–320 performs the same basic function as the block above where we inserted a new phone number. In this block, however, we are updating an existing phone number.

The chk_del_person and chk_del_phone subroutines below are called when the Delete buttons on the main window are pressed. Both prompt for confirmation before attempting the delete.

321: sub chk_del_person { 322:     my $person = shift; 323:     my $person_id = get_person_id($person);

Line 321 begins the chk_del_person subroutine.

Line 322 creates a scalar variable named $person and uses the shift function to store the value passed to the subroutine into it.

Line 323 uses the get_person_id subroutine to extract the person ID from the value passed to it. This value is then stored in the $person_id variable.

324:     my $button = $Main_win->messageBox(-icon => ‘question’,  325:         -type => ‘YesNo’, -title => ‘Delete Person’, 326:         -message => "Delete $person and related phone numbers?");

Lines 324–326 display a message window with Yes and No buttons. The return value of the messageBox method is the label on the button pressed.

327:     if ($button eq ‘Yes’) {

Line 327 looks for the Yes button.

328:         eval { 329:             my $sql = ‘DELETE FROM phone where id = ?’; 330:             $Connection->do($sql, undef, $person_id)  331:                 or die $DBI::errstr; 332:             $sql = ‘DELETE FROM person where id = ?’; 333:             $Connection->do($sql, undef, $person_id)  334:                 or die $DBI::errstr; 335:         };

Lines 328–335 delete all the phone numbers for the person ID and delete the person. Both the SQL commands die on errors, but the surrounding eval catches die. This means that if the first delete fails, we don’t attempt the second.

336:         if ($@) { 337:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 338:                 -title => ‘Error Deleting Person’, 339:                 -message => $DBI::errstr); 340:         } 341:     } 342:     return; 343: } 

Lines 336–343 check whether eval has failed by looking at $@. If either of the delete commands has failed, $@ will hold the message from die. We then display an error message to the user to tell them that the delete failed.

The delete confirmation window should look something like Figure 14-4.


Figure 14-4: Delete confirmation window

If the program has used transactions (and the DBMS supported them), this is where it issues a rollback to undo changes to the database. Since we’re not using transactions, the program just shows the error in another message window.

344: sub chk_del_phone { 345:     my $person = shift; 346:     my $phone = shift; 347:     my $person_id = get_person_id($person);       348:     $phone =~ /^(.*?):/; 349:     my $phone_type = $1;       350:     my $button = $Main_win->messageBox(-icon => ‘question’,  351:         -type => ‘YesNo’, -title => ‘Delete Phone’, 352:         -message => "Delete the number $phone for $person?");       353:     if ($button eq ‘Yes’) { 354:         eval { 355:             my $sql = ‘DELETE FROM phone where id = ? AND phone_type = ?’; 356:             $Connection->do($sql, undef, $person_id, $phone_type)  357:                 or die $DBI::errstr; 358:         }; 359:         if ($@) { 360:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 361:                 -title => ‘Error Deleting Phone Number’, 362:                 -message => $DBI::errstr); 363:         } 364:     } 365:     return; 366: }

Lines 344–366 delete the selected phone record. This subroutine is almost identical to the chk_del_person subroutine.

Lines 348–349 get the phone_type out of the phone list-box entry.

That completes the phonebook program—a cross-platform application to maintain person and phone tables in fewer than 400 lines of code!



Perl Database Programming
Perl Database Programming
ISBN: 0764549561
EAN: 2147483647
Year: 2001
Pages: 175

Similar book on Amazon

flylib.com © 2008-2017.
If you may any questions please contact us: flylib@qtcs.net