Parent Directory
| 
Revision Log
backport (sh002i): replace "SELECT *" with explicit list of fields to avoid problems when columns are ordered differently in the database. fixes bug #1033.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader$ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::DB::Schema::SQL; 18 use base qw(WeBWorK::DB::Schema); 19 20 =head1 NAME 21 22 WeBWorK::DB::Schema::SQL - support SQL access to all tables. 23 24 =cut 25 26 use strict; 27 use warnings; 28 use Carp qw(croak); 29 use WeBWorK::Debug; 30 31 use constant TABLES => qw(*); 32 use constant STYLE => "dbi"; 33 34 { 35 no warnings 'redefine'; 36 37 sub debug { 38 my ($self, @string) = @_; 39 WeBWorK::Debug::debug(@string) if $self->{params}->{debug}; 40 } 41 } 42 43 =head1 SUPPORTED PARAMS 44 45 This schema pays attention to the following items in the C<params> entry. 46 47 =over 48 49 =item tableOverride 50 51 Alternate name for this table, to satisfy SQL naming requirements. 52 53 =item fieldOverride 54 55 A reference to a hash mapping field names to alternate names, to satisfy SQL 56 naming requirements. 57 58 =back 59 60 =cut 61 62 ################################################################################ 63 # constructor for SQL-specific behavior 64 ################################################################################ 65 66 sub new { 67 my ($proto, $db, $driver, $table, $record, $params) = @_; 68 my $self = $proto->SUPER::new($db, $driver, $table, $record, $params); 69 70 ## override table name if tableOverride param is given 71 #$self->{table} = $params->{tableOverride} if $params->{tableOverride}; 72 73 # add sqlTable field 74 $self->{sqlTable} = $params->{tableOverride} || $self->{table}; 75 76 return $self; 77 } 78 79 ################################################################################ 80 # table access functions 81 ################################################################################ 82 83 sub count { 84 my ($self, @keyparts) = @_; 85 86 my $table = $self->{table}; 87 my $sqlTable = $self->{sqlTable}; 88 my @keynames = $self->sqlKeynames(); 89 90 croak "too many keyparts for table $table (need at most: @keynames)" 91 if @keyparts > @keynames; 92 93 my ($where, @where_args) = $self->makeWhereClause(@keyparts); 94 95 my $stmt = "SELECT COUNT(*) FROM `$sqlTable` $where"; 96 $self->debug("SQL-count: $stmt\n"); 97 98 $self->{driver}->connect("ro"); 99 100 my $sth = $self->{driver}->dbi()->prepare($stmt); 101 $sth->execute(@where_args); 102 my ($result) = $sth->fetchrow_array; 103 104 $self->{driver}->disconnect(); 105 106 return $result; 107 } 108 109 sub list($@) { 110 my ($self, @keyparts) = @_; 111 112 my $table = $self->{table}; 113 my $sqlTable = $self->{sqlTable}; 114 my @keynames = $self->sqlKeynames(); 115 my $keynames = join(", ", @keynames); 116 117 croak "too many keyparts for table $table (need at most: @keynames)" 118 if @keyparts > @keynames; 119 120 my ($where, @where_args) = $self->makeWhereClause(@keyparts); 121 122 my $stmt = "SELECT $keynames FROM `$sqlTable` $where"; 123 $self->debug("SQL-list: $stmt\n"); 124 125 $self->{driver}->connect("ro"); 126 127 my $sth = $self->{driver}->dbi()->prepare($stmt); 128 $sth->execute(@where_args); 129 my $result = $sth->fetchall_arrayref; 130 131 $self->{driver}->disconnect(); 132 133 croak "failed to SELECT: $DBI::errstr" unless defined $result; 134 return @$result; 135 } 136 137 sub exists($@) { 138 my ($self, @keyparts) = @_; 139 140 my $table = $self->{table}; 141 my $sqlTable = $self->{sqlTable}; 142 my @keynames = $self->sqlKeynames(); 143 144 croak "wrong number of keyparts for table $table (needs: @keynames)" 145 unless @keyparts == @keynames; 146 147 my ($where, @where_args) = $self->makeWhereClause(@keyparts); 148 149 my $stmt = "SELECT COUNT(*) FROM `$sqlTable` $where"; 150 $self->debug("SQL-exists: $stmt\n"); 151 152 $self->{driver}->connect("ro"); 153 154 my $sth = $self->{driver}->dbi()->prepare($stmt); 155 $sth->execute(@where_args); 156 my ($result) = $sth->fetchrow_array; 157 158 $self->{driver}->disconnect(); 159 160 croak "failed to SELECT: $DBI::errstr" unless defined $result; 161 return $result > 0; 162 } 163 164 sub add($$) { 165 my ($self, $Record) = @_; 166 167 my @realKeynames = $self->{record}->KEYFIELDS(); 168 my @keyparts = map { $Record->$_() } @realKeynames; 169 croak "(" . join(", ", @keyparts) . "): exists (use put)" 170 if $self->exists(@keyparts); 171 172 my $table = $self->{table}; 173 my $sqlTable = $self->{sqlTable}; 174 my @fieldnames = $self->sqlFieldnames(); 175 my $fieldnames = join(", ", @fieldnames); 176 my $marks = join(", ", map { "?" } @fieldnames); 177 178 my @realFieldnames = $self->{record}->FIELDS(); 179 my @fieldvalues = map { $Record->$_() } @realFieldnames; 180 @fieldvalues = map { (defined($_) and $_ eq "") ? undef : $_ } @fieldvalues; 181 182 my $stmt = "INSERT INTO `$sqlTable` ($fieldnames) VALUES ($marks)"; 183 $self->debug("SQL-add: $stmt\n"); 184 185 $self->{driver}->connect("rw"); 186 my $sth = $self->{driver}->dbi()->prepare($stmt); 187 my $result = $sth->execute(@fieldvalues); 188 $self->{driver}->disconnect(); 189 190 unless (defined $result) { 191 my @realKeynames = $self->{record}->KEYFIELDS(); 192 my @keyvalues = map { $Record->$_() } @realKeynames; 193 croak "(" . join(", ", @keyvalues) . "): failed to INSERT: $DBI::errstr"; 194 } 195 196 return 1; 197 } 198 199 sub get($@) { 200 my ($self, @keyparts) = @_; 201 202 return ($self->gets(\@keyparts))[0]; 203 } 204 205 sub gets($@) { 206 my ($self, @keypartsRefList) = @_; 207 208 my $table = $self->{table}; 209 my $sqlTable = $self->{sqlTable}; 210 my @keynames = $self->sqlKeynames(); 211 212 my @records; 213 $self->{driver}->connect("ro"); 214 foreach my $keypartsRef (@keypartsRefList) { 215 my @keyparts = @$keypartsRef; 216 217 croak "wrong number of keyparts for table $table (needs: @keynames)" 218 unless @keyparts == @keynames; 219 220 my ($where, @where_args) = $self->makeWhereClause(@keyparts); 221 222 my $fieldnames = join(", ", $self->sqlFieldnames); 223 my $stmt = "SELECT $fieldnames FROM `$sqlTable` $where"; 224 $self->debug("SQL-gets: $stmt\n"); 225 226 my $sth = $self->{driver}->dbi()->prepare($stmt); 227 $sth->execute(@where_args); 228 my $result = $sth->fetchrow_arrayref; 229 230 if (defined $result) { 231 my @record = @$result; 232 my $Record = $self->{record}->new(); 233 my @realFieldnames = $self->{record}->FIELDS(); 234 foreach (@realFieldnames) { 235 my $value = shift @record; 236 $value = "" unless defined $value; # promote undef to "" 237 $Record->$_($value); 238 } 239 push @records, $Record; 240 } else { 241 push @records, undef; 242 } 243 } 244 $self->{driver}->disconnect(); 245 246 return @records; 247 } 248 249 # getAll($userID, $setID) 250 # 251 # Returns all problems in a given set. Only supported for the problem and 252 # problem_user tables. 253 254 sub getAll { 255 my ($self, @keyparts) = @_; 256 my $table = $self->{table}; 257 my $sqlTable = $self->{sqlTable}; 258 259 croak "getAll: only supported for the problem_user table" 260 unless $table eq "problem" or $table eq "problem_user"; 261 262 my @keynames = $self->sqlKeynames(); 263 pop @keynames; # get rid of problem_id 264 265 my ($where, @where_args) = $self->makeWhereClause(@keyparts); 266 267 my $fieldnames = join(", ", $self->sqlFieldnames); 268 my $stmt = "SELECT $fieldnames FROM `$sqlTable` $where"; 269 $self->debug("SQL-getAll: $stmt\n"); 270 271 my @records; 272 273 $self->{driver}->connect("ro"); 274 275 my $sth = $self->{driver}->dbi()->prepare($stmt); 276 $sth->execute(@where_args); 277 my $results = $sth->fetchall_arrayref; 278 279 foreach my $result (@$results) { 280 if (defined $result) { 281 my @record = @$result; 282 my $Record = $self->{record}->new(); 283 my @realFieldnames = $self->{record}->FIELDS(); 284 foreach (@realFieldnames) { 285 my $value = shift @record; 286 $value = "" unless defined $value; # promote undef to "" 287 $Record->$_($value); 288 } 289 push @records, $Record; 290 } 291 } 292 $self->{driver}->disconnect(); 293 294 return @records; 295 } 296 297 sub put($$) { 298 my ($self, $Record) = @_; 299 300 my @realKeynames = $self->{record}->KEYFIELDS(); 301 my @keyparts = map { $Record->$_() } @realKeynames; 302 croak "(" . join(", ", @keyparts) . "): not found (use add)" 303 unless $self->exists(@keyparts); 304 305 my $table = $self->{table}; 306 my $sqlTable = $self->{sqlTable}; 307 my @fieldnames = $self->sqlFieldnames(); 308 my $fieldnames = join(", ", @fieldnames); 309 my $marks = join(", ", map { "?" } @fieldnames); 310 311 my @realFieldnames = $self->{record}->FIELDS(); 312 my @fieldvalues = map { $Record->$_() } @realFieldnames; 313 @fieldvalues = map { (defined($_) and $_ eq "") ? undef : $_ } @fieldvalues; 314 315 my ($where, @where_args) = $self->makeWhereClause(map { $Record->$_() } @realKeynames); 316 317 my $stmt = "UPDATE `$sqlTable` SET"; 318 while (@fieldnames) { 319 $stmt .= " " . (shift @fieldnames) . "=?"; 320 $stmt .= "," if @fieldnames; 321 } 322 $stmt .= " $where"; 323 $self->debug("SQL-put: $stmt\n"); 324 325 $self->{driver}->connect("rw"); 326 my $sth = $self->{driver}->dbi()->prepare($stmt); 327 my $result = $sth->execute(@fieldvalues, @where_args); 328 $self->{driver}->disconnect(); 329 330 unless (defined $result) { 331 croak "(" . join(", ", @keyparts) . "): failed to UPDATE: $DBI::errstr"; 332 } 333 334 return 1; 335 } 336 337 sub delete($@) { 338 my ($self, @keyparts) = @_; 339 340 return 0 unless $self->exists(@keyparts); 341 342 my $table = $self->{table}; 343 my $sqlTable = $self->{sqlTable}; 344 my @keynames = $self->sqlKeynames(); 345 346 croak "wrong number of keyparts for table $table (needs: @keynames)" 347 unless @keyparts == @keynames; 348 349 my ($where, @where_args) = $self->makeWhereClause(@keyparts); 350 351 my $stmt = "DELETE FROM `$sqlTable` $where"; 352 $self->debug("SQL-delete: $stmt\n"); 353 354 $self->{driver}->connect("rw"); 355 356 my $sth = $self->{driver}->dbi()->prepare($stmt); 357 my $result = $sth->execute(@where_args); 358 359 $self->{driver}->disconnect(); 360 croak "failed to DELETE: $DBI::errstr" unless defined $result; 361 362 return $result; 363 } 364 365 ################################################################################ 366 # utility functions 367 ################################################################################ 368 369 sub makeWhereClause($@) { 370 my ($self, @keyparts) = @_; 371 372 my @keynames = $self->sqlKeynames(); 373 374 my $where = ""; 375 my @used_keyparts; 376 377 my $first = 1; 378 while (@keyparts) { 379 my $name = shift @keynames; 380 my $part = shift @keyparts; 381 382 next unless defined $part; 383 384 $where .= " AND" unless $first; 385 # $where .= " BINARY $name=?"; 386 $where .= " $name=?"; ## Make lookups case insensitive. Otherwise 387 ## indices seem not to be used which slows things 388 ## down drastically. See 389 ## openwebwork-devel@lists.sourceforge.net discussion 390 push @used_keyparts, $part; 391 392 $first = 0; 393 } 394 395 my $clause = $where ? "WHERE$where" : ""; 396 397 return ($clause, @used_keyparts); 398 } 399 400 sub sqlKeynames($) { 401 my ($self) = @_; 402 my @keynames = $self->{record}->KEYFIELDS(); 403 return map { "`$_`" } map { $self->{params}->{fieldOverride}->{$_} || $_ } @keynames; 404 } 405 406 sub sqlFieldnames($) { 407 my ($self) = @_; 408 my @keynames = $self->{record}->FIELDS(); 409 return map { "`$_`" } map { $self->{params}->{fieldOverride}->{$_} || $_ } @keynames; 410 } 411 412 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |