Program Listings

Listings 5-1 to 5-4 contain the complete and uninterrupted code examples from this chapter.

Listing 5-1: Simple add

01: #!/usr/bin/perl -w 02: # 03: # program 5-1 04: # Chapter 5 05: # Listing 1 06: # 07: use strict; 08: use DBI; 09: my $conn = DBI->connect ("DBI:mysql:BibleBook","bookuser","testpass")  10:     or die("Cannot connect: $DBI::errstr"); 11: my ($sql, %book, @keys); 12: Get_Data(); 13: Execute_Transaction(); 14: sub Get_Data{ 15:     $book{‘isbn'}      = Get_Input("Enter ISBN #"); 16:     $book{‘title'}     = Get_Input("Enter Book Title"); 17:     $book{‘author'}    = Get_Input("Enter Book Author"); 18:     $book{‘price'}     = Get_Input("Enter Book Price"); 19:     $book{‘format'}    = Get_Input("Enter Book Format"); 20:     $book{‘publisher'} = Get_Input("Enter Book Publisher"); 21:     $book{‘pubdate'}   = Get_Input("Enter Publish Date"); 22:     $book{‘notes'}     = Get_Input("Enter Notes"); 23:     return 1; 24: } 25: sub Get_Input { 26:     print $_[0], ":\n"; 27:     return scalar <STDIN>; 28: } 29: sub Execute_Transaction{ 30:     @keys = keys   %book; 31:     @vals = values %book; 32:     chomp(@vals); 33:     @vals = map{$conn->quote($_)} @vals; 34:     $sql = "INSERT INTO library (" 35:            . join(", ", @keys) 36:            . ") VALUES (" 37:            . join(", ", @vals) 38:            . ")"; 39:   my $query = $conn->prepare($sql); 40:   $query->execute or die("\nError executing SQL statement! $DBI::errstr"); 41:     print "Record added to database.\n"; 42:     return 1; 43: }

Listing 5-2: Simple update

01: #!/usr/bin/perl -w 02: # 03: # program 5-2 04: # Chapter 5 05: # Listing 2 06: # 07: use strict; 08: use DBI; 09: my $conn->connect ("DBI:mysql:BibleBook","bookuser","testpass")  10:       or die("Cannot connect: $DBI::errstr"); 11: my $old_isbn; 12: my $book = Get_Data(); 13: Change_Record($book); 14: sub Get_Data{ 15:     my %book; 16:     $old_isbn        = Get_Input("Enter ISBN of Book to Modify"); 17:     $book{isbn}      = Get_Input("Enter ISBN (even if not changed)"); 18:     $book{title}     = Get_Input("Enter Book Title"); 19:     $book{author}    = Get_Input("Enter Book Author"); 20:     $book{price}     = Get_Input("Enter Book Price"); 21:     $book{format}    = Get_Input("Enter Book Format"); 22:     $book{publisher} = Get_Input("Enter Book Publisher"); 23:     $book{pubdate}   = Get_Input("Enter Publish Date"); 24:     $book{notes}     = Get_Input("Enter Notes") 25: return(\%book); 26: }  27: sub Get_Input { 28:     print $_[0], ":\n"; 29:     return scalar <STDIN>; 30: } 31: sub Change_Record{ 32:     my $book = shift; 33: my @keys = keys   %$book; 34:     my @vals = values %$book; 35:     chomp (@vals);     36:     @vals = map{$conn->quote($_)} @vals; 37: my $sql = "UPDATE library SET "; 38:     my $counter = 0; 39:     foreach my $key (@keys){ 40:         $sql .= "$key = ‘$vals[$counter]', "; 41:         $counter++; 42:     } 43:     $sql =~ s{, $}{ WHERE isbn = ‘$old_isbn'};     44:     my $query = $conn->do($sql)  45:         or die("\nError executing SQL statement! $DBI::errstr"); 46:    print "Record information updated in the database...\n"; 47:    return; 48: }

Listing 5-3: Simple delete

01: #!/usr/bin/perl -w 02: # 03: # program 5-3 04: # Chapter 5 05: # Listing 3 06: # 07: use strict; 08: use DBI; 09: my $conn = DBI->connect("DBI:mysql:BibleBook","bookuser","testpass")  10:     or die("Cannot connect: $DBI::errstr"); 11: Delete_Record(Get_ISBN()); 12: sub Get_ISBN{ 13:     print "Delete ISBN #:\n"; 14:     $isbn      = <STDIN>; 15:     chomp($isbn); 16:     return($isbn); 17: } 18: sub Delete_Record{ 19:     my $result = $conn->do("DELETE FROM library WHERE isbn = ‘$isbn'") 20:         or die("\nError executing SQL statement! $DBI::errstr"); 21:     if($result){ 22:         print "Record deleted from database.\n"; 23:     } 24:     else { 25:         print "Record NOT DELETED! $DBI::errstr\n"; 26:     } 27:    return; 28: }

Listing 5-4: Comprehensive example

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; 10: my $conn = DBI->connect ("DBI:mysql:BibleBook","bookuser","testpass") 11:    or die("Cannot connect: $DBI::errstr"); 12: my ($sql, @keys, $record); 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); 19: Start_Tk_Interface(); 20: exit; 21: #----------------------------------------------------- 22: # Database Routines 23: sub Get_Record { 24:     my $isbn       = shift; 25:     my $sql        = qq(SELECT * FROM library WHERE isbn = $isbn); 26:     my $hdl_search = $conn->prepare($sql); 27:     $hdl_search->execute; 28:     $record = $hdl_search->fetchrow_hashref; 29:     return($record); 30: } 31: sub Delete_Record { 32:     my $isbn  = shift; 33:     $sql      = qq(DELETE FROM library WHERE isbn = ‘$isbn'); 34:     my $query = $conn->prepare($sql); 35:     $query->execute or die("\nError executing SQL statement! $DBI::errstr"); 36:     return 1; 37: } 38: sub Update_Record { 39:     my $form   = shift; 40:     my $caller = shift; 41:     $caller    -> withdraw(); 42:     my $isbn = $form->{‘isbn'}->get(); 43:     my @keys = keys %$form; 44:     my @vals = map { $$form{$_}->get() } @keys; 45:     my $counter = 0; 46:     $sql  = qq{UPDATE library SET }; 47:     foreach my $k (@keys){ 48:         $sql .= qq{$k = "$vals[$counter]", }; 49:         $counter++; 50:     } 51:     $sql  =~ s/\, $//; 52:     $sql .=  " WHERE isbn = ‘$isbn'"; 53:     my $query = $conn->prepare($sql); 54:     $query->execute or die("\nError executing SQL statement! $DBI::errstr"); 55:     return 1; 56: } 57: sub Add_Record { 58:     my $form   = shift; 59:     my $caller = shift; 60:     $caller    -> withdraw(); 61:     my @keys = keys %$form; 62:     my @vals = map { $conn->quote($$form{$_}->get()) } @keys; 63:     $sql  = "INSERT INTO library ("  64:             . join(", ", @keys)  65:             . ") VALUES (" 66:             . join(", ", @vals) 67:             . ")"; 68:     my $query = $conn->prepare($sql); 69:     $query->execute or die("\nError executing SQL statement! $DBI::errstr"); 70:     return 1; 71: } 72: #------------------------------------------------------ 73: # Tk Interface Routines 74: my $MainWin; 75: sub Start_Tk_Interface { 76:     $MainWin = MainWindow->new(-title => "Choose a Database Action"); 77:     $MainWin->MoveToplevelWindow(100,100); 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']); 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'); 90:     MainLoop(); 91: } 92: sub tk_Choose_Dialog { 93:     my $type = shift; 94:     my $top_win = $MainWin->Toplevel(-title => "Choose Record"); 95:     $top_win->MoveToplevelWindow(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'); 100:     my $button = $top_win->Button( 101:         -text    => "$type Record", 102:         -command => [\&tk_Edit_or_Delete, $top_win, $type, $isbn] ); 103:     $button-> grid(-row => 1, -column => 1); 104:     return 1; 105: } 106: sub tk_Edit_or_Delete { 107:     my $caller = shift; 108:     my $type   = shift; 109:     my $isbn   = shift()->get(); 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: } 115: sub tk_Add_Record_Dialog { 116:     my ($record, $isbn, %form); 117:     my $type = shift; 118:     my $row  = 0; 119:     my $top_win = $MainWin->Toplevel(-title => "Add/Edit a Record"); 120:     $top_win->MoveToplevelWindow(110,110); 121:     if($type =~ /edit/){ 122:         $isbn   = shift; 123:         $record = Get_Record($isbn); 124:     } 125:     foreach my $field (@order){ 126:         my $text = $record->{$field}; 127:         $top_win->Label(-text => $fields{$field}) ->  128:           grid(-row => $row, -column => 0, -sticky => ‘w'); 129:         $form{$field}  = $top_win->Entry 130:             (-width => 50, -textvariable => \$text) ->  131:              grid(-row=> $row, -column=> 1, -sticky=> ‘e'); 132:         $row++; 133:     } 134:     my $button;  135:     if($type =~ /edit/i){ 136:         $button = $top_win->Button( 137:           -text    => ‘Edit Record', 138:           -command => [\&Update_Record,\%form, $top_win] ); 139:     } 140:     else { 141:         $button = $top_win->Button( 142:           -text    => ‘Add Record', 143:           -command => sub{ Add_Record(\%form, $top_win)} ); 144:     } 145:     $button-> grid(-row => $row, -column => 1); 146:     return 1; 147: }