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: }