Parent Directory
| 
Revision Log
croak instead of die. -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 119 $self->{driver}->connect("rw"); 120 my $sth = $self->{driver}->handle()->prepare($stmt); 121 my $result = $sth->execute(@fieldvalues); 122 $self->{driver}->disconnect(); 123 124 unless (defined $result) { 125 my @realKeynames = $self->{record}->KEYFIELDS(); 126 my @keyvalues = map { $Record->$_() } @realKeynames; 127 croak "(" . join(", ", @keyvalues) . "): failed to INSERT: $DBI::errstr"; 128 } 129 130 return 1; 131 } 132 133 sub get($@) { 134 my ($self, @keyparts) = @_; 135 136 my $table = $self->{table}; 137 my @keynames = $self->sqlKeynames(); 138 139 croak "wrong number of keyparts for table $table (needs: @keynames)" 140 unless @keyparts == @keynames; 141 142 my $stmt = "SELECT * FROM $table "; 143 $stmt .= $self->makeWhereClause(@keyparts); 144 $self->debug("SQL-get: $stmt\n"); 145 146 $self->{driver}->connect("ro"); 147 my $result = $self->{driver}->handle()->selectrow_arrayref($stmt); 148 $self->{driver}->disconnect(); 149 # $result comes back undefined if there are no matches. hmm... 150 #croak "failed to SELECT: $DBI::errstr" unless defined $result; 151 return undef unless defined $result; 152 153 my @record = @$result; 154 my $Record = $self->{record}->new(); 155 my @realFieldnames = $self->{record}->FIELDS(); 156 foreach (@realFieldnames) { 157 $Record->$_(shift @record); 158 } 159 160 return $Record; 161 } 162 163 sub put($$) { 164 my ($self, $Record) = @_; 165 166 my @realKeynames = $self->{record}->KEYFIELDS(); 167 my @keyparts = map { $Record->$_() } @realKeynames; 168 croak "(" . join(", ", @keyparts) . "): not found (use add)" 169 unless $self->exists(@keyparts); 170 171 my $table = $self->{table}; 172 my @fieldnames = $self->sqlFieldnames(); 173 my $fieldnames = join(", ", @fieldnames); 174 my $marks = join(", ", map { "?" } @fieldnames); 175 176 my @realFieldnames = $self->{record}->FIELDS(); 177 my @fieldvalues = map { $Record->$_() } @realFieldnames; 178 179 my $stmt = "UPDATE $table SET"; 180 while (@fieldnames) { 181 $stmt .= " " . (shift @fieldnames) . "=?"; 182 $stmt .= "," if @fieldnames; 183 } 184 $self->debug("SQL-put: $stmt\n"); 185 186 $self->{driver}->connect("rw"); 187 my $sth = $self->{driver}->handle()->prepare($stmt); 188 my $result = $sth->execute(@fieldvalues); 189 $self->{driver}->disconnect(); 190 191 unless (defined $result) { 192 #my @realKeynames = $self->{record}->KEYFIELDS(); 193 #my @keyvalues = map { $Record->$_() } @realKeynames; 194 croak "(" . join(", ", @keyparts) . "): failed to UPDATE: $DBI::errstr"; 195 } 196 197 return 1; 198 } 199 200 sub delete($@) { 201 my ($self, @keyparts) = @_; 202 203 croak "(" . join(", ", @keyparts) . "): not found" 204 unless $self->exists(@keyparts); 205 206 my $table = $self->{table}; 207 my @keynames = $self->sqlKeynames(); 208 209 croak "wrong number of keyparts for table $table (needs: @keynames)" 210 unless @keyparts == @keynames; 211 212 my $stmt = "DELETE FROM $table "; 213 $stmt .= $self->makeWhereClause(@keyparts); 214 $self->debug("SQL-delete: $stmt\n"); 215 216 $self->{driver}->connect("rw"); 217 my $result = $self->{driver}->handle()->do($stmt); 218 $self->{driver}->disconnect(); 219 croak "failed to DELETE: $DBI::errstr" unless defined $result; 220 221 if ($result > 1) { 222 warn "danger! deleted more than one record!"; 223 } 224 225 return $result; 226 } 227 228 ################################################################################ 229 # utility functions 230 ################################################################################ 231 232 sub makeWhereClause($@) { 233 my ($self, @keyparts) = @_; 234 235 my @keynames = $self->sqlKeynames(); 236 my $where; 237 my $first = 1; 238 while (@keyparts) { 239 unless (defined $keyparts[0]) { 240 shift @keynames; 241 shift @keyparts; 242 next; 243 } 244 $where .= " AND" unless $first; 245 $where .= " " . (shift @keynames); 246 $where .= "='" . (shift @keyparts) . "'"; 247 $first = 0; 248 } 249 250 return $where ? "WHERE$where" : ""; 251 } 252 253 sub sqlKeynames($) { 254 my ($self) = @_; 255 my @keynames = $self->{record}->KEYFIELDS(); 256 return map { $self->{params}->{fieldOverride}->{$_} || $_ } 257 @keynames; 258 } 259 260 sub sqlFieldnames($) { 261 my ($self) = @_; 262 my @keynames = $self->{record}->FIELDS(); 263 return map { $self->{params}->{fieldOverride}->{$_} || $_ } 264 @keynames; 265 } 266 267 sub debug($@) { 268 my ($self, @string) = @_; 269 270 # if ($self->{params}->{debug}) { 271 warn @string; 272 # } 273 } 274 275 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |