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