Program Listings

Listings 14-1 to 14-3 show the complete and uninterrupted code for the applications in this chapter.

Listing 14-1: Command-line phonebook code

01: #!/usr/bin/perl -w 02: # 03: # program 14-1, Chapter 14, Listing 1 04: #       05: use DBI; 06: use strict; 07: my $Connection = DBI->connect     (‘DBI:mysql:test’,’bookuser’,’testpass’) 08:     or die "Can’t connect to database\nError: $DBI::errstr\nExiting"; 09: my $Query_statement = undef; 10: my $Person_insert_statement = undef; 11: my $Phone_insert_statement = undef; 12: my %Fields = ( 13:     id           => {required => 1, label => ‘ID’         }, 14:     first_name   => {required => 1, label => ‘First Name’   }, 15:     last_name    => {required => 0, label => ‘Last Name’    }, 16:     greeting     => {required => 0, label => ‘Greeting’   }, 17:     phone_type   => {required => 1, label => ‘Number Type’}, 18:     phone_number => {required => 1, label => ‘Number’     }, 19:     note         => {required => 0, label => ‘Note’       }, 20: ); 21: my @Person_prompts = qw(first_name last_name greeting); 22: my @Phone_prompts = qw(phone_type phone_number note); 23: my @Phone_cols = (‘id’, @Phone_prompts); 24: while ( my %person = input_person() ) { 25:     while ( my %phone = input_phone() ) { 26:         $phone{id} = $person{id}; 27:         add_phone( %phone ); 28:     } 29: } 30: $Connection->disconnect; 31: exit 0; 32: sub input_person { 33:     my %person;       34:     print "Enter person details, (Fields marked with * are required).\nTo exit program, hit CTRL-D.\n"; 35:     foreach my $col ( @Person_prompts ) { 36:         my $req = $Fields{$col}{‘required’} ? ‘*’ : ‘’; 37:         print "$Fields{$col}{‘label’}$req:\t"; 38:         my $line = <STDIN>; 39:         return    unless defined $line;    # no input 40:         chomp( $line ); 41:         if ( $Fields{$col}{‘required’} and $line !~ /\S+/ ) { 42:             warn "Required field missing, please re-enter\n"; 43:             return; 44:         } 45:         $person{$col} = $line; 46:     } 47:     unless ( defined($person{id} = get_person_id(%person)) ) { 48:         $person{id} = add_person( %person ); 49:         return undef    unless $person{id}; 50:     } 51:     return %person; 52: } 53: sub get_person_id { 54:     my %person = @_; 55:     my $person_query_sql = qq(SELECT * FROM person  56:        WHERE first_name = ? AND last_name = ?); 57:     $Query_statement ||= $Connection->prepare( $person_query_sql ) 58:         or die "Can’t prepare query\nError: $DBI::errstr\nExiting"; 59:     if ($Query_statement->execute($person{first_name},$person{last_name})){ 60:         my $href = $Query_statement->fetchrow_hashref(); 61:         return undef    unless $href; 62:         return $href->{id}; 63:     } 64:     else { 65:         warn "Can’t execute query\nError: $DBI::errstr"; 66:         return; 67:     } 68: } 69: sub add_person { 70:     my %person = @_; 71:     my $person_insert_sql = ‘INSERT INTO person(‘ 72:         . join(‘,’, @Person_prompts) . ‘) VALUES( 73:         . join(‘,’, map {‘?’} @Person_prompts) . ‘)’; 74:     $Person_insert_statement ||= $Connection->prepare($person_insert_sql) 75:         or die "Can’t prepare insert: $DBI::errstr"; 76:     unless ($Person_insert_statement->execute(@person{@Person_prompts})) { 77:         warn "Can’t execute insert: $DBI::errstr"; 78:         return undef; 79:     } 80:     # and return the id    ***MySQL specific attribute**** 81:     return $Person_insert_statement->{‘mysql_insertid’}; 82: } 83: sub input_phone { 84:     my %phone;       85:     print "Enter phone details, (Fields marked with * are required)\n"; 86:     foreach my $col ( @Phone_prompts ) { 87:         my $req = $Fields{$col}{‘required’} ? ‘*’ : ‘’; 88:         print "$Fields{$col}{‘label’}$req:\t"; 89:         my $line = <STDIN>; 90:         return    unless defined $line;    # no input 91:         chomp( $line ); 92:         if ( $Fields{$col}{‘required’} and $line !~ /\S+/ ) { 93:             warn "Required field missing, please re-enter\n"; 94:             return; 95:         } 96:         $phone{$col} = $line; 97:     } 98:     return %phone; 99: } 100: sub add_phone { 101:     my %phone = @_; 102:     my $phone_insert_sql = ‘INSERT INTO phone(‘ 103:         . join(‘,’, @Phone_cols) . ‘) VALUES(‘ 104:         . join(‘,’, map {‘?’} @Phone_cols) . ‘)’;       105:     $Phone_insert_statement ||= $Connection->prepare($phone_insert_sql) 106:         or die "Can’t prepare insert\nError: $DBI::errstr\nExiting";       107:     $Phone_insert_statement->execute(@phone{@Phone_cols}) 108:         or warn "Can’t execute insert\nError: $DBI::errstr"; 109: }

Listing 14-2: Phone number lookup program

01: #!/usr/bin/perl -w 02: #  03: # program 14-2, Chapter 14, Listing 2 04: #      05: use DBI; 06: use strict; 07: # check the user gave a search term 08: my $name = shift(@ARGV); 09: unless ($name) { 10:     die "$0: please supply a name! 11: usage:      $0 name 12: example:    $0 Smith\n"; 13: } 14: # connect to DBMS and get a database handle 15: my $dsn = ‘DBI:mysql:BibleBook’; 16: my $connection = DBI->connect($dsn, ‘bookuser’, ‘testpass’) 17:     or die "Can’t connect to database: $dsn\nError: $DBI::errstr\nExiting"; 18: $name =~ /(\w+)/; 19: $name = $connection->quote("%$1%"); 20: # prepare the statement and get a statement handle 21: my $sql = <<EOS; 22: SELECT first_name,last_name,greeting,phone_type,phone_number,note 23: FROM person, phone 24: WHERE person.id = phone.id 25: AND (first_name   LIKE $name 26:      OR last_name LIKE $name 27:      OR greeting  LIKE $name) 28: EOS 29: my $query = $connection->prepare($sql) 30:     or die "$0: can’t prepare ‘$sql’\nError: $DBI::errstr\nExiting";      31: # run the query 32: $query->execute(); 33: # get/display the results 34: my $current_name = ‘’; 35: while (my @data = $query->fetchrow()) { 36:     if ($current_name ne "$data[0] $data[1]") { 37:         print "$data[0] $data[1] ($data[2])\n"; 38:         $current_name = "$data[0] $data[1]"; 39:     } 40:     print "\t$data[3]: $data[4]\t$data[5]\n"; 41: } 42: # tidy up 43: $query->finish(); 44: $connection->disconnect(); 45: exit 0;

Listing 14-3: Graphical phonebook 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; 08: my $Connection = DBI->connect    (‘DBI:mysql:BibleBook’, ‘bookuser’, ‘testpass’) 09:         or die "Can’t connect to database: $DBI::errstr"; 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); 24: show_main_form(); 25: MainLoop(); 26: $Connection->disconnect(); 27: exit 0; 28: sub show_main_form { 29:     $Main_win = MainWindow->new(-title => ‘Perl/Tk PhoneBook’); 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’); 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:     ); 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:     ); 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:     ); 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:     ); 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:     ); 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:     ); 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:     } 89:     $Main_win->Button( -text => ‘Exit’, -command => sub { 90:             $Connection->disconnect(); 91:             $Main_win->withdraw(); 92:             exit 0; 93:         } )->pack(); 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:     ); 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:     ); 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:     ); 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:     ); 127:     fill_person_list(); 128:       return; 129: } 130:  sub show_person_form{ 131:     my $label = shift; 132:     my $person = shift; 133:     my %person; 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:     } 145:     my $person_form = $Main_win->Toplevel( -title => $label ); 146:     my $row = 0; 147:     my %entry; 148:     foreach my $col ( @Person_prompts ) { 149:         my $req = $Fields{$col}{‘required’} ? ‘*’ : ‘’; 150:         $person_form->Label( -text => "$Fields{$col}{‘label’}$req ")-> 151:           grid( -row => $row, -column => 0, -sticky => ‘e’); 152:         $entry{$col} = $person_form->Entry( -width => 20, 153:                 -textvariable => \$person{$col} )-> 154:             grid(-row => $row++, -column => 1, -sticky => ‘w’); 155:     } 156:     $person_form->Button( -text => ‘Close’, 157:         -command => sub { $person_form->withdraw() })-> 158:             grid(-row => $row, -column => 0, -sticky => ‘w’); 159:     $person_form->Button( -text => $label, 160:         -command => [ \&add_upd_person, $label, $person_form, \%entry])-> 161:             grid(-row => $row, -column => 1, -sticky => ‘w’); 162:     return; 163: } 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; 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:     } 175:     if ($phone) { 176:         $phone =~ /^(.*?): (.*?), (.*)/; 177:         @phone{@Phone_prompts} = ($1, $2, $3); 178:     } 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:     } 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: } 205: sub fill_pr_lst { 206:     my $sql = ‘SELECT id,last_name,first_name FROM person ‘ 207:         . ‘ORDER by last_name,first_name’; 208:     my $ptr = $Connection->selectall_hashref($sql, undef); 209:     $pr_lst->delete(0, ‘end’); 210:     $pr_lit->insert(‘end’, map { sprintf "%4d: %-s",  211:                   $_->{id}, "$_->{last_name}, $_->{first_name}" } @{$ptr} ); 212: } 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: } 224: sub get_person_id { 225:     my $person = shift; 226:     $person =~ /^\s*(\d+):?/; 227:     return $1; 228: } 229: sub add_upd_person { 230:     my $label       = shift; 231:     my $person_form = shift; 232:     my $id       = shift; 233:     my $form_entry  = shift; 234:     my (%person, $sql); 235:     my $missing_fields = 0; 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:     } 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:     } 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:   } 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:     } 271:     fill_pr_list(); 272:     $person_form->withdraw(); 273:    return; 274: } 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; 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:     } 287:     if ($missing_fields) { 288:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 298:                 -title => ‘Required Fields Missing’, 290:                 -message => "Please fill fields marked ‘*’"); 291:             return; 292:     } 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:     } 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: } 321: sub chk_del_person { 322:     my $person = shift; 323:     my $person_id = get_person_id($person); 324:     my $button = $Main_win->messageBox(-icon => ‘question’,  325:         -type => ‘YesNo’, -title => ‘Delete Person’, 326:         -message => "Delete $person and related phone numbers?"); 327:     if ($button eq ‘Yes’) { 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:         }; 336:         if ($@) { 337:             $Main_win->messageBox(-icon => ‘error’, -type => ‘OK’, 338:                 -title => ‘Error Deleting Person’, 339:                 -message => $DBI::errstr); 340:         } 341:     } 342:     return; 343: } 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: }