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