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