Parent Directory
| 
Revision Log
fixed new implementations of "get" -- they need to return a single item, not a list of items!
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::DB::Schema::SQL; 7 use base qw(WeBWorK::DB::Schema); 8 9 =head1 NAME 10 11 WeBWorK::DB::Schema::SQL - support SQL access to all tables. 12 13 =cut 14 15 use strict; 16 use warnings; 17 use Carp qw(croak); 18 19 use constant TABLES => qw(*); 20 use constant STYLE => "dbi"; 21 22 ################################################################################ 23 # constructor for SQL-specific behavior 24 ################################################################################ 25 26 sub new { 27 my ($proto, $db, $driver, $table, $record, $params) = @_; 28 my $self = $proto->SUPER::new($db, $driver, $table, $record, $params); 29 30 # override table name if tableOverride param is given 31 $self->{table} = $params->{tableOverride} if $params->{tableOverride}; 32 33 return $self; 34 } 35 36 ################################################################################ 37 # table access functions 38 ################################################################################ 39 40 sub list($@) { 41 my ($self, @keyparts) = @_; 42 43 my $table = $self->{table}; 44 my @keynames = $self->sqlKeynames(); 45 my $keynames = join(", ", @keynames); 46 47 croak "too many keyparts for table $table (need at most: @keynames)" 48 if @keyparts > @keynames; 49 50 my $stmt = "SELECT $keynames FROM $table "; 51 $stmt .= $self->makeWhereClause(@keyparts); 52 $self->debug("SQL-list: $stmt\n"); 53 54 $self->{driver}->connect("ro"); 55 my $result = $self->{driver}->dbi()->selectall_arrayref($stmt); 56 $self->{driver}->disconnect(); 57 croak "failed to SELECT: $DBI::errstr" unless defined $result; 58 return @$result; 59 } 60 61 sub exists($@) { 62 my ($self, @keyparts) = @_; 63 64 my $table = $self->{table}; 65 my @keynames = $self->sqlKeynames(); 66 67 croak "wrong number of keyparts for table $table (needs: @keynames)" 68 unless @keyparts == @keynames; 69 70 my $stmt = "SELECT COUNT(*) FROM $table "; 71 $stmt .= $self->makeWhereClause(@keyparts); 72 $self->debug("SQL-exists: $stmt\n"); 73 74 $self->{driver}->connect("ro"); 75 my ($result) = $self->{driver}->dbi()->selectrow_array($stmt); 76 $self->{driver}->disconnect(); 77 croak "failed to SELECT: $DBI::errstr" unless defined $result; 78 return $result > 0; 79 } 80 81 sub add($$) { 82 my ($self, $Record) = @_; 83 84 my @realKeynames = $self->{record}->KEYFIELDS(); 85 my @keyparts = map { $Record->$_() } @realKeynames; 86 croak "(" . join(", ", @keyparts) . "): exists (use put)" 87 if $self->exists(@keyparts); 88 89 my $table = $self->{table}; 90 my @fieldnames = $self->sqlFieldnames(); 91 my $fieldnames = join(", ", @fieldnames); 92 my $marks = join(", ", map { "?" } @fieldnames); 93 94 my @realFieldnames = $self->{record}->FIELDS(); 95 my @fieldvalues = map { $Record->$_() } @realFieldnames; 96 97 my $stmt = "INSERT INTO $table ($fieldnames) VALUES ($marks)"; 98 $self->debug("SQL-add: $stmt\n"); 99 100 $self->{driver}->connect("rw"); 101 my $sth = $self->{driver}->dbi()->prepare($stmt); 102 my $result = $sth->execute(@fieldvalues); 103 $self->{driver}->disconnect(); 104 105 unless (defined $result) { 106 my @realKeynames = $self->{record}->KEYFIELDS(); 107 my @keyvalues = map { $Record->$_() } @realKeynames; 108 croak "(" . join(", ", @keyvalues) . "): failed to INSERT: $DBI::errstr"; 109 } 110 111 return 1; 112 } 113 114 sub get($@) { 115 my ($self, @keyparts) = @_; 116 # 117 # my $table = $self->{table}; 118 # my @keynames = $self->sqlKeynames(); 119 # 120 # croak "wrong number of keyparts for table $table (needs: @keynames)" 121 # unless @keyparts == @keynames; 122 # 123 # my $stmt = "SELECT * FROM $table "; 124 # $stmt .= $self->makeWhereClause(@keyparts); 125 # $self->debug("SQL-get: $stmt\n"); 126 # 127 # $self->{driver}->connect("ro"); 128 # my $result = $self->{driver}->dbi()->selectrow_arrayref($stmt); 129 # $self->{driver}->disconnect(); 130 # # $result comes back undefined if there are no matches. hmm... 131 # return undef unless defined $result; 132 # 133 # my @record = @$result; 134 # my $Record = $self->{record}->new(); 135 # my @realFieldnames = $self->{record}->FIELDS(); 136 # foreach (@realFieldnames) { 137 # $Record->$_(shift @record); 138 # } 139 # 140 # return $Record; 141 return ($self->gets(\@keyparts))[0]; 142 } 143 144 sub gets($@) { 145 my ($self, @keypartsRefList) = @_; 146 147 my $table = $self->{table}; 148 my @keynames = $self->sqlKeynames(); 149 150 my @records; 151 $self->{driver}->connect("ro"); 152 foreach my $keypartsRef (@keypartsRefList) { 153 my @keyparts = @$keypartsRef; 154 155 croak "wrong number of keyparts for table $table (needs: @keynames)" 156 unless @keyparts == @keynames; 157 158 my $stmt = "SELECT * FROM $table "; 159 $stmt .= $self->makeWhereClause(@keyparts); 160 $self->debug("SQL-get: $stmt\n"); 161 my $result = $self->{driver}->dbi()->selectrow_arrayref($stmt); 162 163 if (defined $result) { 164 my @record = @$result; 165 my $Record = $self->{record}->new(); 166 my @realFieldnames = $self->{record}->FIELDS(); 167 foreach (@realFieldnames) { 168 $Record->$_(shift @record); 169 } 170 push @records, $Record; 171 } else { 172 push @records, undef; 173 } 174 } 175 $self->{driver}->disconnect(); 176 177 return @records; 178 } 179 180 sub put($$) { 181 my ($self, $Record) = @_; 182 183 my @realKeynames = $self->{record}->KEYFIELDS(); 184 my @keyparts = map { $Record->$_() } @realKeynames; 185 croak "(" . join(", ", @keyparts) . "): not found (use add)" 186 unless $self->exists(@keyparts); 187 188 my $table = $self->{table}; 189 my @fieldnames = $self->sqlFieldnames(); 190 my $fieldnames = join(", ", @fieldnames); 191 my $marks = join(", ", map { "?" } @fieldnames); 192 193 my @realFieldnames = $self->{record}->FIELDS(); 194 my @fieldvalues = map { $Record->$_() } @realFieldnames; 195 196 my $stmt = "UPDATE $table SET"; 197 while (@fieldnames) { 198 $stmt .= " " . (shift @fieldnames) . "=?"; 199 $stmt .= "," if @fieldnames; 200 } 201 $stmt .= " "; 202 $stmt .= $self->makeWhereClause(map { $Record->$_() } @realKeynames); 203 $self->debug("SQL-put: $stmt\n"); 204 205 $self->{driver}->connect("rw"); 206 my $sth = $self->{driver}->dbi()->prepare($stmt); 207 my $result = $sth->execute(@fieldvalues); 208 $self->{driver}->disconnect(); 209 210 unless (defined $result) { 211 croak "(" . join(", ", @keyparts) . "): failed to UPDATE: $DBI::errstr"; 212 } 213 214 return 1; 215 } 216 217 sub delete($@) { 218 my ($self, @keyparts) = @_; 219 220 return 0 unless $self->exists(@keyparts); 221 222 my $table = $self->{table}; 223 my @keynames = $self->sqlKeynames(); 224 225 croak "wrong number of keyparts for table $table (needs: @keynames)" 226 unless @keyparts == @keynames; 227 228 my $stmt = "DELETE FROM $table "; 229 $stmt .= $self->makeWhereClause(@keyparts); 230 $self->debug("SQL-delete: $stmt\n"); 231 232 $self->{driver}->connect("rw"); 233 my $result = $self->{driver}->dbi()->do($stmt); 234 $self->{driver}->disconnect(); 235 croak "failed to DELETE: $DBI::errstr" unless defined $result; 236 237 return $result; 238 } 239 240 ################################################################################ 241 # utility functions 242 ################################################################################ 243 244 sub makeWhereClause($@) { 245 my ($self, @keyparts) = @_; 246 247 my @keynames = $self->sqlKeynames(); 248 my $where; 249 my $first = 1; 250 while (@keyparts) { 251 unless (defined $keyparts[0]) { 252 shift @keynames; 253 shift @keyparts; 254 next; 255 } 256 $where .= " AND" unless $first; 257 $where .= " " . (shift @keynames); 258 $where .= "='" . (shift @keyparts) . "'"; 259 $first = 0; 260 } 261 262 return $where ? "WHERE$where" : ""; 263 } 264 265 sub sqlKeynames($) { 266 my ($self) = @_; 267 my @keynames = $self->{record}->KEYFIELDS(); 268 return map { $self->{params}->{fieldOverride}->{$_} || $_ } 269 @keynames; 270 } 271 272 sub sqlFieldnames($) { 273 my ($self) = @_; 274 my @keynames = $self->{record}->FIELDS(); 275 return map { $self->{params}->{fieldOverride}->{$_} || $_ } 276 @keynames; 277 } 278 279 sub debug($@) { 280 my ($self, @string) = @_; 281 282 if ($self->{params}->{debug}) { 283 warn @string; 284 } 285 } 286 287 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |