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