Parent Directory
| 
Revision Log
Revision 4123 - (view) (download) (as text)
| 1 : | sh002i | 874 | ################################################################################ |
| 2 : | sh002i | 1663 | # WeBWorK Online Homework Delivery System |
| 3 : | sh002i | 3972 | # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ |
| 4 : | sh002i | 4123 | # $CVSHeader$ |
| 5 : | sh002i | 1663 | # |
| 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 : | sh002i | 874 | ################################################################################ |
| 16 : | |||
| 17 : | package WeBWorK::DB::Schema::SQL; | ||
| 18 : | sh002i | 1167 | use base qw(WeBWorK::DB::Schema); |
| 19 : | sh002i | 874 | |
| 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 : | sh002i | 915 | use Carp qw(croak); |
| 29 : | sh002i | 3485 | use WeBWorK::Debug; |
| 30 : | sh002i | 874 | |
| 31 : | sh002i | 1167 | use constant TABLES => qw(*); |
| 32 : | use constant STYLE => "dbi"; | ||
| 33 : | sh002i | 874 | |
| 34 : | sh002i | 3485 | { |
| 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 : | sh002i | 2586 | =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 : | sh002i | 874 | ################################################################################ |
| 63 : | sh002i | 1167 | # constructor for SQL-specific behavior |
| 64 : | sh002i | 874 | ################################################################################ |
| 65 : | |||
| 66 : | sh002i | 1167 | sub new { |
| 67 : | sh002i | 931 | my ($proto, $db, $driver, $table, $record, $params) = @_; |
| 68 : | sh002i | 1167 | my $self = $proto->SUPER::new($db, $driver, $table, $record, $params); |
| 69 : | |||
| 70 : | sh002i | 2691 | ## override table name if tableOverride param is given |
| 71 : | #$self->{table} = $params->{tableOverride} if $params->{tableOverride}; | ||
| 72 : | sh002i | 1167 | |
| 73 : | sh002i | 2691 | # add sqlTable field |
| 74 : | $self->{sqlTable} = $params->{tableOverride} || $self->{table}; | ||
| 75 : | |||
| 76 : | sh002i | 874 | return $self; |
| 77 : | } | ||
| 78 : | |||
| 79 : | ################################################################################ | ||
| 80 : | # table access functions | ||
| 81 : | ################################################################################ | ||
| 82 : | |||
| 83 : | sh002i | 1664 | sub count { |
| 84 : | my ($self, @keyparts) = @_; | ||
| 85 : | |||
| 86 : | my $table = $self->{table}; | ||
| 87 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 88 : | sh002i | 1664 | my @keynames = $self->sqlKeynames(); |
| 89 : | |||
| 90 : | croak "too many keyparts for table $table (need at most: @keynames)" | ||
| 91 : | if @keyparts > @keynames; | ||
| 92 : | |||
| 93 : | sh002i | 2851 | my ($where, @where_args) = $self->makeWhereClause(@keyparts); |
| 94 : | |||
| 95 : | my $stmt = "SELECT COUNT(*) FROM `$sqlTable` $where"; | ||
| 96 : | sh002i | 1664 | $self->debug("SQL-count: $stmt\n"); |
| 97 : | |||
| 98 : | $self->{driver}->connect("ro"); | ||
| 99 : | sh002i | 2851 | |
| 100 : | my $sth = $self->{driver}->dbi()->prepare($stmt); | ||
| 101 : | $sth->execute(@where_args); | ||
| 102 : | my ($result) = $sth->fetchrow_array; | ||
| 103 : | |||
| 104 : | sh002i | 1664 | $self->{driver}->disconnect(); |
| 105 : | sh002i | 1669 | |
| 106 : | sh002i | 2851 | return $result; |
| 107 : | sh002i | 1664 | } |
| 108 : | |||
| 109 : | sh002i | 904 | sub list($@) { |
| 110 : | sh002i | 874 | my ($self, @keyparts) = @_; |
| 111 : | |||
| 112 : | my $table = $self->{table}; | ||
| 113 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 114 : | sh002i | 904 | my @keynames = $self->sqlKeynames(); |
| 115 : | sh002i | 874 | my $keynames = join(", ", @keynames); |
| 116 : | |||
| 117 : | sh002i | 915 | croak "too many keyparts for table $table (need at most: @keynames)" |
| 118 : | sh002i | 904 | if @keyparts > @keynames; |
| 119 : | |||
| 120 : | sh002i | 2851 | my ($where, @where_args) = $self->makeWhereClause(@keyparts); |
| 121 : | |||
| 122 : | my $stmt = "SELECT $keynames FROM `$sqlTable` $where"; | ||
| 123 : | sh002i | 915 | $self->debug("SQL-list: $stmt\n"); |
| 124 : | sh002i | 904 | |
| 125 : | sh002i | 874 | $self->{driver}->connect("ro"); |
| 126 : | sh002i | 2851 | |
| 127 : | my $sth = $self->{driver}->dbi()->prepare($stmt); | ||
| 128 : | $sth->execute(@where_args); | ||
| 129 : | my $result = $sth->fetchall_arrayref; | ||
| 130 : | |||
| 131 : | sh002i | 874 | $self->{driver}->disconnect(); |
| 132 : | sh002i | 2851 | |
| 133 : | sh002i | 915 | croak "failed to SELECT: $DBI::errstr" unless defined $result; |
| 134 : | sh002i | 904 | return @$result; |
| 135 : | sh002i | 874 | } |
| 136 : | |||
| 137 : | sh002i | 904 | sub exists($@) { |
| 138 : | sh002i | 874 | my ($self, @keyparts) = @_; |
| 139 : | |||
| 140 : | my $table = $self->{table}; | ||
| 141 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 142 : | sh002i | 904 | my @keynames = $self->sqlKeynames(); |
| 143 : | sh002i | 874 | |
| 144 : | sh002i | 915 | croak "wrong number of keyparts for table $table (needs: @keynames)" |
| 145 : | sh002i | 904 | unless @keyparts == @keynames; |
| 146 : | sh002i | 874 | |
| 147 : | sh002i | 2851 | my ($where, @where_args) = $self->makeWhereClause(@keyparts); |
| 148 : | |||
| 149 : | my $stmt = "SELECT COUNT(*) FROM `$sqlTable` $where"; | ||
| 150 : | sh002i | 915 | $self->debug("SQL-exists: $stmt\n"); |
| 151 : | sh002i | 874 | |
| 152 : | $self->{driver}->connect("ro"); | ||
| 153 : | sh002i | 2851 | |
| 154 : | my $sth = $self->{driver}->dbi()->prepare($stmt); | ||
| 155 : | $sth->execute(@where_args); | ||
| 156 : | my ($result) = $sth->fetchrow_array; | ||
| 157 : | |||
| 158 : | sh002i | 874 | $self->{driver}->disconnect(); |
| 159 : | sh002i | 2851 | |
| 160 : | sh002i | 915 | croak "failed to SELECT: $DBI::errstr" unless defined $result; |
| 161 : | sh002i | 904 | return $result > 0; |
| 162 : | sh002i | 874 | } |
| 163 : | |||
| 164 : | sub add($$) { | ||
| 165 : | my ($self, $Record) = @_; | ||
| 166 : | |||
| 167 : | sh002i | 904 | my @realKeynames = $self->{record}->KEYFIELDS(); |
| 168 : | my @keyparts = map { $Record->$_() } @realKeynames; | ||
| 169 : | sh002i | 915 | croak "(" . join(", ", @keyparts) . "): exists (use put)" |
| 170 : | sh002i | 904 | if $self->exists(@keyparts); |
| 171 : | |||
| 172 : | sh002i | 874 | my $table = $self->{table}; |
| 173 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 174 : | sh002i | 904 | my @fieldnames = $self->sqlFieldnames(); |
| 175 : | sh002i | 874 | my $fieldnames = join(", ", @fieldnames); |
| 176 : | my $marks = join(", ", map { "?" } @fieldnames); | ||
| 177 : | sh002i | 904 | |
| 178 : | my @realFieldnames = $self->{record}->FIELDS(); | ||
| 179 : | my @fieldvalues = map { $Record->$_() } @realFieldnames; | ||
| 180 : | jj | 3590 | @fieldvalues = map { (defined($_) and $_ eq "") ? undef : $_ } @fieldvalues; |
| 181 : | sh002i | 904 | |
| 182 : | sh002i | 2691 | my $stmt = "INSERT INTO `$sqlTable` ($fieldnames) VALUES ($marks)"; |
| 183 : | sh002i | 915 | $self->debug("SQL-add: $stmt\n"); |
| 184 : | sh002i | 874 | |
| 185 : | $self->{driver}->connect("rw"); | ||
| 186 : | sh002i | 1167 | my $sth = $self->{driver}->dbi()->prepare($stmt); |
| 187 : | sh002i | 874 | my $result = $sth->execute(@fieldvalues); |
| 188 : | $self->{driver}->disconnect(); | ||
| 189 : | |||
| 190 : | unless (defined $result) { | ||
| 191 : | sh002i | 904 | my @realKeynames = $self->{record}->KEYFIELDS(); |
| 192 : | my @keyvalues = map { $Record->$_() } @realKeynames; | ||
| 193 : | sh002i | 915 | croak "(" . join(", ", @keyvalues) . "): failed to INSERT: $DBI::errstr"; |
| 194 : | sh002i | 874 | } |
| 195 : | |||
| 196 : | return 1; | ||
| 197 : | } | ||
| 198 : | |||
| 199 : | sh002i | 904 | sub get($@) { |
| 200 : | my ($self, @keyparts) = @_; | ||
| 201 : | sh002i | 1771 | |
| 202 : | sh002i | 1569 | return ($self->gets(\@keyparts))[0]; |
| 203 : | sh002i | 1568 | } |
| 204 : | |||
| 205 : | sub gets($@) { | ||
| 206 : | my ($self, @keypartsRefList) = @_; | ||
| 207 : | sh002i | 874 | |
| 208 : | my $table = $self->{table}; | ||
| 209 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 210 : | sh002i | 904 | my @keynames = $self->sqlKeynames(); |
| 211 : | sh002i | 874 | |
| 212 : | sh002i | 1568 | my @records; |
| 213 : | sh002i | 874 | $self->{driver}->connect("ro"); |
| 214 : | sh002i | 1568 | 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 : | sh002i | 2851 | my ($where, @where_args) = $self->makeWhereClause(@keyparts); |
| 221 : | |||
| 222 : | sh002i | 4123 | my $fieldnames = join(", ", $self->sqlFieldnames); |
| 223 : | my $stmt = "SELECT $fieldnames FROM `$sqlTable` $where"; | ||
| 224 : | sh002i | 1771 | $self->debug("SQL-gets: $stmt\n"); |
| 225 : | sh002i | 1568 | |
| 226 : | sh002i | 2851 | my $sth = $self->{driver}->dbi()->prepare($stmt); |
| 227 : | $sth->execute(@where_args); | ||
| 228 : | my $result = $sth->fetchrow_arrayref; | ||
| 229 : | |||
| 230 : | sh002i | 1568 | if (defined $result) { |
| 231 : | my @record = @$result; | ||
| 232 : | my $Record = $self->{record}->new(); | ||
| 233 : | my @realFieldnames = $self->{record}->FIELDS(); | ||
| 234 : | foreach (@realFieldnames) { | ||
| 235 : | sh002i | 2318 | my $value = shift @record; |
| 236 : | $value = "" unless defined $value; # promote undef to "" | ||
| 237 : | $Record->$_($value); | ||
| 238 : | sh002i | 1568 | } |
| 239 : | push @records, $Record; | ||
| 240 : | } else { | ||
| 241 : | push @records, undef; | ||
| 242 : | } | ||
| 243 : | } | ||
| 244 : | sh002i | 874 | $self->{driver}->disconnect(); |
| 245 : | |||
| 246 : | sh002i | 1568 | return @records; |
| 247 : | sh002i | 874 | } |
| 248 : | |||
| 249 : | sh002i | 2955 | # getAll($userID, $setID) |
| 250 : | # | ||
| 251 : | # Returns all problems in a given set. Only supported for the problem and | ||
| 252 : | # problem_user tables. | ||
| 253 : | sh002i | 1771 | |
| 254 : | sub getAll { | ||
| 255 : | my ($self, @keyparts) = @_; | ||
| 256 : | my $table = $self->{table}; | ||
| 257 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 258 : | sh002i | 1771 | |
| 259 : | croak "getAll: only supported for the problem_user table" | ||
| 260 : | sh002i | 1772 | unless $table eq "problem" or $table eq "problem_user"; |
| 261 : | sh002i | 1771 | |
| 262 : | my @keynames = $self->sqlKeynames(); | ||
| 263 : | pop @keynames; # get rid of problem_id | ||
| 264 : | |||
| 265 : | sh002i | 2851 | my ($where, @where_args) = $self->makeWhereClause(@keyparts); |
| 266 : | |||
| 267 : | sh002i | 4123 | my $fieldnames = join(", ", $self->sqlFieldnames); |
| 268 : | my $stmt = "SELECT $fieldnames FROM `$sqlTable` $where"; | ||
| 269 : | sh002i | 1771 | $self->debug("SQL-getAll: $stmt\n"); |
| 270 : | |||
| 271 : | my @records; | ||
| 272 : | |||
| 273 : | $self->{driver}->connect("ro"); | ||
| 274 : | |||
| 275 : | sh002i | 2851 | my $sth = $self->{driver}->dbi()->prepare($stmt); |
| 276 : | $sth->execute(@where_args); | ||
| 277 : | my $results = $sth->fetchall_arrayref; | ||
| 278 : | |||
| 279 : | sh002i | 1771 | 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 : | sh002i | 2318 | my $value = shift @record; |
| 286 : | $value = "" unless defined $value; # promote undef to "" | ||
| 287 : | $Record->$_($value); | ||
| 288 : | sh002i | 1771 | } |
| 289 : | push @records, $Record; | ||
| 290 : | } | ||
| 291 : | } | ||
| 292 : | $self->{driver}->disconnect(); | ||
| 293 : | |||
| 294 : | return @records; | ||
| 295 : | } | ||
| 296 : | |||
| 297 : | sh002i | 874 | sub put($$) { |
| 298 : | my ($self, $Record) = @_; | ||
| 299 : | |||
| 300 : | sh002i | 904 | my @realKeynames = $self->{record}->KEYFIELDS(); |
| 301 : | my @keyparts = map { $Record->$_() } @realKeynames; | ||
| 302 : | sh002i | 915 | croak "(" . join(", ", @keyparts) . "): not found (use add)" |
| 303 : | sh002i | 904 | unless $self->exists(@keyparts); |
| 304 : | |||
| 305 : | sh002i | 874 | my $table = $self->{table}; |
| 306 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 307 : | sh002i | 904 | my @fieldnames = $self->sqlFieldnames(); |
| 308 : | sh002i | 874 | my $fieldnames = join(", ", @fieldnames); |
| 309 : | my $marks = join(", ", map { "?" } @fieldnames); | ||
| 310 : | sh002i | 904 | |
| 311 : | my @realFieldnames = $self->{record}->FIELDS(); | ||
| 312 : | my @fieldvalues = map { $Record->$_() } @realFieldnames; | ||
| 313 : | jj | 3396 | @fieldvalues = map { (defined($_) and $_ eq "") ? undef : $_ } @fieldvalues; |
| 314 : | sh002i | 904 | |
| 315 : | sh002i | 2851 | my ($where, @where_args) = $self->makeWhereClause(map { $Record->$_() } @realKeynames); |
| 316 : | |||
| 317 : | sh002i | 2691 | my $stmt = "UPDATE `$sqlTable` SET"; |
| 318 : | sh002i | 874 | while (@fieldnames) { |
| 319 : | sh002i | 904 | $stmt .= " " . (shift @fieldnames) . "=?"; |
| 320 : | sh002i | 874 | $stmt .= "," if @fieldnames; |
| 321 : | } | ||
| 322 : | sh002i | 2851 | $stmt .= " $where"; |
| 323 : | sh002i | 915 | $self->debug("SQL-put: $stmt\n"); |
| 324 : | sh002i | 874 | |
| 325 : | $self->{driver}->connect("rw"); | ||
| 326 : | sh002i | 1167 | my $sth = $self->{driver}->dbi()->prepare($stmt); |
| 327 : | sh002i | 2851 | my $result = $sth->execute(@fieldvalues, @where_args); |
| 328 : | sh002i | 874 | $self->{driver}->disconnect(); |
| 329 : | |||
| 330 : | unless (defined $result) { | ||
| 331 : | sh002i | 915 | croak "(" . join(", ", @keyparts) . "): failed to UPDATE: $DBI::errstr"; |
| 332 : | sh002i | 874 | } |
| 333 : | |||
| 334 : | return 1; | ||
| 335 : | } | ||
| 336 : | |||
| 337 : | sh002i | 904 | sub delete($@) { |
| 338 : | sh002i | 874 | my ($self, @keyparts) = @_; |
| 339 : | |||
| 340 : | sh002i | 972 | return 0 unless $self->exists(@keyparts); |
| 341 : | sh002i | 904 | |
| 342 : | sh002i | 874 | my $table = $self->{table}; |
| 343 : | sh002i | 2691 | my $sqlTable = $self->{sqlTable}; |
| 344 : | sh002i | 904 | my @keynames = $self->sqlKeynames(); |
| 345 : | sh002i | 874 | |
| 346 : | sh002i | 915 | croak "wrong number of keyparts for table $table (needs: @keynames)" |
| 347 : | sh002i | 904 | unless @keyparts == @keynames; |
| 348 : | sh002i | 874 | |
| 349 : | sh002i | 2851 | my ($where, @where_args) = $self->makeWhereClause(@keyparts); |
| 350 : | |||
| 351 : | my $stmt = "DELETE FROM `$sqlTable` $where"; | ||
| 352 : | sh002i | 915 | $self->debug("SQL-delete: $stmt\n"); |
| 353 : | sh002i | 874 | |
| 354 : | sh002i | 904 | $self->{driver}->connect("rw"); |
| 355 : | sh002i | 2851 | |
| 356 : | my $sth = $self->{driver}->dbi()->prepare($stmt); | ||
| 357 : | my $result = $sth->execute(@where_args); | ||
| 358 : | |||
| 359 : | sh002i | 874 | $self->{driver}->disconnect(); |
| 360 : | sh002i | 915 | croak "failed to DELETE: $DBI::errstr" unless defined $result; |
| 361 : | sh002i | 874 | |
| 362 : | sh002i | 904 | return $result; |
| 363 : | } | ||
| 364 : | |||
| 365 : | ################################################################################ | ||
| 366 : | # utility functions | ||
| 367 : | ################################################################################ | ||
| 368 : | |||
| 369 : | sub makeWhereClause($@) { | ||
| 370 : | my ($self, @keyparts) = @_; | ||
| 371 : | |||
| 372 : | my @keynames = $self->sqlKeynames(); | ||
| 373 : | sh002i | 2851 | |
| 374 : | my $where = ""; | ||
| 375 : | my @used_keyparts; | ||
| 376 : | |||
| 377 : | sh002i | 904 | my $first = 1; |
| 378 : | while (@keyparts) { | ||
| 379 : | sh002i | 2851 | my $name = shift @keynames; |
| 380 : | my $part = shift @keyparts; | ||
| 381 : | |||
| 382 : | next unless defined $part; | ||
| 383 : | |||
| 384 : | sh002i | 904 | $where .= " AND" unless $first; |
| 385 : | apizer | 3201 | # $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 : | sh002i | 2851 | push @used_keyparts, $part; |
| 391 : | |||
| 392 : | sh002i | 904 | $first = 0; |
| 393 : | sh002i | 874 | } |
| 394 : | |||
| 395 : | sh002i | 2851 | my $clause = $where ? "WHERE$where" : ""; |
| 396 : | |||
| 397 : | return ($clause, @used_keyparts); | ||
| 398 : | sh002i | 874 | } |
| 399 : | |||
| 400 : | sh002i | 904 | sub sqlKeynames($) { |
| 401 : | my ($self) = @_; | ||
| 402 : | my @keynames = $self->{record}->KEYFIELDS(); | ||
| 403 : | sh002i | 2586 | return map { "`$_`" } map { $self->{params}->{fieldOverride}->{$_} || $_ } @keynames; |
| 404 : | sh002i | 904 | } |
| 405 : | |||
| 406 : | sub sqlFieldnames($) { | ||
| 407 : | my ($self) = @_; | ||
| 408 : | my @keynames = $self->{record}->FIELDS(); | ||
| 409 : | sh002i | 2586 | return map { "`$_`" } map { $self->{params}->{fieldOverride}->{$_} || $_ } @keynames; |
| 410 : | sh002i | 904 | } |
| 411 : | |||
| 412 : | sh002i | 874 | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |