[system] / trunk / webwork2 / lib / WeBWorK / DB / Schema / SQL.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/WeBWorK/DB/Schema/SQL.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 874 Revision 915
… …
11 11
12=cut 12=cut
13 13
14use strict; 14use strict;
15use warnings; 15use warnings;
16use Carp qw(croak);
16 17
17use constant TABLES => qw(password permission key user set set_user problem problem_user); 18use constant TABLES => qw(password permission key user set set_user problem problem_user);
18use constant STYLE => "sql"; 19use constant STYLE => "sql";
19 20
20################################################################################ 21################################################################################
… …
44 driver => $driver, 45 driver => $driver,
45 table => $table, 46 table => $table,
46 record => $record, 47 record => $record,
47 params => $params, 48 params => $params,
48 }; 49 };
50 $self->{table} = $params->{tableOverride} if $params->{tableOverride};
49 bless $self, $class; 51 bless $self, $class;
50 return $self; 52 return $self;
51} 53}
52 54
53################################################################################ 55################################################################################
54# table access functions 56# table access functions
55################################################################################ 57################################################################################
56 58
57sub list($) { 59sub list($@) {
58 my ($self, @keyparts) = @_; 60 my ($self, @keyparts) = @_;
59 61
60 my $table = $self->{table}; 62 my $table = $self->{table};
61 my @keynames = $self->{record}->KEYFIELDS(); 63 my @keynames = $self->sqlKeynames();
62 my $keynames = join(", ", @keynames); 64 my $keynames = join(", ", @keynames);
65
66 croak "too many keyparts for table $table (need at most: @keynames)"
67 if @keyparts > @keynames;
68
63 my $stmt = "SELECT $keynames FROM $table"; 69 my $stmt = "SELECT $keynames FROM $table ";
64 $stmt .= " WHERE" if @keyparts; 70 $stmt .= $self->makeWhereClause(@keyparts);
65 while (@keyparts) { 71 $self->debug("SQL-list: $stmt\n");
66 $stmt .= " " . shift @keynames . "=" . shift @keyparts;
67 $stmt .= " AND" if @keyparts;
68 }
69 72
70 $self->{driver}->connect("ro"); 73 $self->{driver}->connect("ro");
71 my $keys = $self->{driver}->handle()->selectall_arrayref($stmt); 74 my $result = $self->{driver}->handle()->selectall_arrayref($stmt);
72 $self->{driver}->disconnect(); 75 $self->{driver}->disconnect();
73 76 croak "failed to SELECT: $DBI::errstr" unless defined $result;
74 unless (defined $keys) {
75 die "failed to SELECT: $DB::errstr";
76 }
77
78 return $keys; 77 return @$result;
79} 78}
80 79
81sub exists($$) { 80sub exists($@) {
82 my ($self, @keyparts) = @_; 81 my ($self, @keyparts) = @_;
83 82
84 my $table = $self->{table}; 83 my $table = $self->{table};
85 my @keynames = $self->{record}->KEYFIELDS(); 84 my @keynames = $self->sqlKeynames();
86 85
87 die "wrong number of keyparts for table $table (needs: @keynames)" 86 croak "wrong number of keyparts for table $table (needs: @keynames)"
88 unless (@keyparts == @keynames); 87 unless @keyparts == @keynames;
89 88
90 my $stmt = "SELECT COUNT(*) FROM $table WHERE"; 89 my $stmt = "SELECT COUNT(*) FROM $table ";
91 while (@keyparts) { 90 $stmt .= $self->makeWhereClause(@keyparts);
92 $stmt .= " " . shift @keynames . "=" . shift @keyparts; 91 $self->debug("SQL-exists: $stmt\n");
93 $stmt .= " AND" if @keyparts;
94 }
95 92
96 $self->{driver}->connect("ro"); 93 $self->{driver}->connect("ro");
97 my $exists = $self->{driver}->handle()->do($stmt); 94 my ($result) = $self->{driver}->handle()->selectrow_array($stmt);
98 $self->{driver}->disconnect(); 95 $self->{driver}->disconnect();
99 96 croak "failed to SELECT: $DBI::errstr" unless defined $result;
100 unless (defined $exists) { 97 return $result > 0;
101 die "failed to SELECT: $DB::errstr";
102 }
103
104 return $exists;
105} 98}
106 99
107sub add($$) { 100sub add($$) {
108 my ($self, $Record) = @_; 101 my ($self, $Record) = @_;
109 102
110 my $table = $self->{table};
111 my @fieldnames = $self->{record}->FIELDS(); 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();
112 my $fieldnames = join(", ", @fieldnames); 110 my $fieldnames = join(", ", @fieldnames);
113 my @fieldvalues = map { $Record->$_() } @fieldnames;
114 my $marks = join(", ", map { "?" } @fieldnames); 111 my $marks = join(", ", map { "?" } @fieldnames);
112
113 my @realFieldnames = $self->{record}->FIELDS();
114 my @fieldvalues = map { $Record->$_() } @realFieldnames;
115
115 my $stmt = "INSERT INTO $table ($fieldnames) VALUES ($marks)"; 116 my $stmt = "INSERT INTO $table ($fieldnames) VALUES ($marks)";
117 $self->debug("SQL-add: $stmt\n");
116 118
117 $self->{driver}->connect("rw"); 119 $self->{driver}->connect("rw");
118 my $sth = $self->{driver}->handle()->prepare($stmt); 120 my $sth = $self->{driver}->handle()->prepare($stmt);
119 my $result = $sth->execute(@fieldvalues); 121 my $result = $sth->execute(@fieldvalues);
120 $self->{driver}->disconnect(); 122 $self->{driver}->disconnect();
121 123
122 unless (defined $result) { 124 unless (defined $result) {
123 my @keynames = $self->{record}->KEYFIELDS(); 125 my @realKeynames = $self->{record}->KEYFIELDS();
124 my @keyvalues = map $Record->$_() } @keynames; 126 my @keyvalues = map { $Record->$_() } @realKeynames;
125 die "(@keyvalues): failed to INSERT: $DB::errstr"; 127 croak "(" . join(", ", @keyvalues) . "): failed to INSERT: $DBI::errstr";
126 } 128 }
127 129
128 return 1; 130 return 1;
129} 131}
130 132
131sub get($$) { 133sub get($@) {
132 my ($self, @keyfields) = @_; 134 my ($self, @keyparts) = @_;
133 135
134 my $table = $self->{table}; 136 my $table = $self->{table};
135 my @keynames = $self->{record}->KEYFIELDS(); 137 my @keynames = $self->sqlKeynames();
136 138
137 die "wrong number of keyparts for table $table (needs: @keynames)" 139 croak "wrong number of keyparts for table $table (needs: @keynames)"
138 unless (@keyparts == @keynames); 140 unless @keyparts == @keynames;
139 141
140 my $stmt = "SELECT * FROM $table WHERE"; 142 my $stmt = "SELECT * FROM $table ";
141 while (@keyparts) { 143 $stmt .= $self->makeWhereClause(@keyparts);
142 $stmt .= " " . shift @keynames . "=" . shift @keyparts; 144 $self->debug("SQL-get: $stmt\n");
143 $stmt .= " AND" if @keyparts;
144 }
145 145
146 $self->{driver}->connect("ro"); 146 $self->{driver}->connect("ro");
147 my @record = $self->{driver}->handle()->selectrow_array($stmt); 147 my $result = $self->{driver}->handle()->selectrow_arrayref($stmt);
148 $self->{driver}->disconnect(); 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;
149 152
150 unless (defined @record) { 153 my @record = @$result;
151 die "failed to SELECT: $DB::errstr";
152 }
153
154 my $Record = $self->{record}->new(); 154 my $Record = $self->{record}->new();
155 my @fieldnames = $self->{record}->FIELDS(); 155 my @realFieldnames = $self->{record}->FIELDS();
156 foreach (@fieldnames) { 156 foreach (@realFieldnames) {
157 $Record->$_(shift @record); 157 $Record->$_(shift @record);
158 } 158 }
159 159
160 return $Record; 160 return $Record;
161} 161}
162 162
163sub put($$) { 163sub put($$) {
164 my ($self, $Record) = @_; 164 my ($self, $Record) = @_;
165 165
166 my $table = $self->{table};
167 my @fieldnames = $self->{record}->FIELDS(); 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();
168 my $fieldnames = join(", ", @fieldnames); 173 my $fieldnames = join(", ", @fieldnames);
169 my @fieldvalues = map { $Record->$_() } @fieldnames;
170 my $marks = join(", ", map { "?" } @fieldnames); 174 my $marks = join(", ", map { "?" } @fieldnames);
175
176 my @realFieldnames = $self->{record}->FIELDS();
177 my @fieldvalues = map { $Record->$_() } @realFieldnames;
178
171 my $stmt = "UPDATE $table SET"; 179 my $stmt = "UPDATE $table SET";
172 while (@fieldnames) { 180 while (@fieldnames) {
173 $stmt .= " " . shift @fieldnames . "=?"; 181 $stmt .= " " . (shift @fieldnames) . "=?";
174 $stmt .= "," if @fieldnames; 182 $stmt .= "," if @fieldnames;
175 } 183 }
184 $self->debug("SQL-put: $stmt\n");
176 185
177 $self->{driver}->connect("rw"); 186 $self->{driver}->connect("rw");
178 my $sth = $self->{driver}->handle()->prepare($stmt); 187 my $sth = $self->{driver}->handle()->prepare($stmt);
179 my $result = $sth->execute(@fieldvalues); 188 my $result = $sth->execute(@fieldvalues);
180 $self->{driver}->disconnect(); 189 $self->{driver}->disconnect();
181 190
182 unless (defined $result) { 191 unless (defined $result) {
183 my @keynames = $self->{record}->KEYFIELDS(); 192 #my @realKeynames = $self->{record}->KEYFIELDS();
184 my @keyvalues = map $Record->$_() } @keynames; 193 #my @keyvalues = map { $Record->$_() } @realKeynames;
185 die "(@keyvalues): failed to UPDATE: $DB::errstr"; 194 croak "(" . join(", ", @keyparts) . "): failed to UPDATE: $DBI::errstr";
186 } 195 }
187 196
188 return 1; 197 return 1;
189} 198}
190 199
191sub delete($$) { 200sub 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
232sub 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
253sub sqlKeynames($) {
192 my ($self, @keyparts) = @_; 254 my ($self) = @_;
193
194 my $table = $self->{table};
195 my @keynames = $self->{record}->KEYFIELDS(); 255 my @keynames = $self->{record}->KEYFIELDS();
256 return map { $self->{params}->{fieldOverride}->{$_} || $_ }
257 @keynames;
258}
259
260sub sqlFieldnames($) {
261 my ($self) = @_;
262 my @keynames = $self->{record}->FIELDS();
263 return map { $self->{params}->{fieldOverride}->{$_} || $_ }
264 @keynames;
265}
266
267sub debug($@) {
268 my ($self, @string) = @_;
196 269
197 die "wrong number of keyparts for table $table (needs: @keynames)" 270# if ($self->{params}->{debug}) {
198 unless (@keyparts == @keynames); 271 warn @string;
199
200 my $stmt = "DELETE FROM $table WHERE";
201 while (@keyparts) {
202 $stmt .= " " . shift @keynames . "=" . shift @keyparts;
203 $stmt .= " AND" if @keyparts;
204 } 272# }
205
206 $self->{driver}->connect("ro");
207 my $num = $self->{driver}->handle()->do($stmt);
208 $self->{driver}->disconnect();
209
210 unless (defined $num) {
211 die "failed to SELECT: $DB::errstr";
212 }
213
214 unless ($num > 1) {
215 warn "danger! deleted more than one record!";
216 }
217
218 return $num;
219} 273}
220 274
2211; 2751;
Legend:
Removed from v.874  
changed lines
  Added in v.915
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9