1package BookDB; 2 3use strict; 4use warnings; 5 6my $dbh; 7my $bind = ''; 8my $oldq = ''; 9 10sub new { 11 my $self = shift; 12 13 # create an attributes hash 14 my $atts = { 15 'sql' => undef, 16 'res' => [0], 17 }; 18 19 # create the object 20 bless $atts, $self; 21 $dbh = $atts; 22 return $atts; 23} 24 25use Data::Dumper; 26 27my @miles1 = ( 28 ['book1', 'Lawrence Miles'], 29 ['book2', 'Lawrence Miles'], 30 ['book3', 'Lawrence Miles'], 31 ['book4', 'Lawrence Miles'], 32 ['book5', 'Lawrence Miles'], 33 ['book6', 'Lawrence Miles'], 34 ['book7', 'Lawrence Miles']); 35my @miles2 = ( 36 {title=>'book1', author=>'Lawrence Miles'}, 37 {title=>'book2', author=>'Lawrence Miles'}, 38 {title=>'book3', author=>'Lawrence Miles'}, 39 {title=>'book4', author=>'Lawrence Miles'}, 40 {title=>'book5', author=>'Lawrence Miles'}, 41 {title=>'book6', author=>'Lawrence Miles'}, 42 {title=>'book7', author=>'Lawrence Miles'}); 43my @miles3 = ( 44 7, 45); 46my @lance = ( 47 {title=>'book1', author=>'Lance Parkin'}, 48 {title=>'book2', author=>'Lance Parkin'}, 49 {title=>'book3', author=>'Lance Parkin'}, 50 {title=>'book4', author=>'Lance Parkin'}, 51 {title=>'book5', author=>'Lance Parkin'}, 52 {title=>'book6', author=>'Lance Parkin'}, 53 {title=>'book7', author=>'Lance Parkin'}); 54my @magrs = ( 55 {title=>'book1', author=>'Paul Magrs'}, 56 {title=>'book2', author=>'Paul Magrs'}, 57 {title=>'book3', author=>'Paul Magrs'}); 58 59 60sub prepare { 61 shift; #print STDERR "\n#prepare=".Dumper(\@_); 62 $dbh->{sql} = shift; 63 $dbh->{cache} = shift; 64 $dbh 65} 66sub prepare_cached { 67 shift; #print STDERR "\n#prepare_cached=".Dumper(\@_); 68 $dbh->{sql} = shift; 69 $dbh->{cache} = shift; 70 $dbh 71} 72sub rebind { 73 shift; 74 $dbh->{sql} = $dbh->{cache}; 75} 76sub bind_param { 77 shift; 78#print STDERR "\n#bind_param(@_)\n"; 79 $bind = $_[1]; 80 return; 81} 82sub execute { 83 shift; 84 my $query = $dbh->{sql} || $oldq; 85 my $arg = @_ ? (scalar @_ > 1 ? $_[1] : $_[0]) : $bind; 86 87 $bind = $arg; 88 $oldq = $query; 89 return unless($query); 90 91 if($query =~ /select title,author from books where author/) { 92 if($arg && $arg =~ /Lawrence Miles/) { 93 $dbh->{array} = \@miles1; 94 $dbh->{hash} = \@miles2; 95 } 96 } 97 if($query =~ /select count(1) from books where author/) { 98 $dbh->{res} = \@miles3 if($arg && $arg =~ /Lawrence Miles/); 99 } 100 if($query =~ /select class,title,author from books where author/) { 101 if($arg && $arg =~ /Lance Parkin/) { 102 my @list = @lance; 103 $dbh->{hash} = \@list; 104 } 105 if($arg && $arg =~ /Paul Magrs/) { 106 $dbh->{hash} = \@magrs; 107 } 108 if($arg && $arg =~ /Lawrence Miles/) { 109 my @list = @miles2; 110 $dbh->{hash} = \@list; 111 } 112 } 113 $dbh->{Active} = 1; 114} 115sub fetchrow_hashref { 116 return shift @{$dbh->{hash}}} 117sub fetchall_arrayref { 118 return \@{$dbh->{array}}} 119sub fetchrow_array { 120 return (7)} 121 122sub finish { 123 $dbh->{Active} = 0; 124 $dbh->{sql} = undef; 125} 126 127sub can { 1 } 128 129DESTROY { } 130 131END { } 132 1331; 134