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

Diff of /trunk/webwork-modperl/lib/WeBWorK/DB/Schema/SQL.pm

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

Revision 914 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################################################################################
… …
60 61
61 my $table = $self->{table}; 62 my $table = $self->{table};
62 my @keynames = $self->sqlKeynames(); 63 my @keynames = $self->sqlKeynames();
63 my $keynames = join(", ", @keynames); 64 my $keynames = join(", ", @keynames);
64 65
65 die "too many keyparts for table $table (need at most: @keynames)" 66 croak "too many keyparts for table $table (need at most: @keynames)"
66 if @keyparts > @keynames; 67 if @keyparts > @keynames;
67 68
68 my $stmt = "SELECT $keynames FROM $table "; 69 my $stmt = "SELECT $keynames FROM $table ";
69 $stmt .= $self->makeWhereClause(@keyparts); 70 $stmt .= $self->makeWhereClause(@keyparts);
70 warn "SQL-list: $stmt\n"; 71 $self->debug("SQL-list: $stmt\n");
71 72
72 $self->{driver}->connect("ro"); 73 $self->{driver}->connect("ro");
73 my $result = $self->{driver}->handle()->selectall_arrayref($stmt); 74 my $result = $self->{driver}->handle()->selectall_arrayref($stmt);
74 $self->{driver}->disconnect(); 75 $self->{driver}->disconnect();
75 die "failed to SELECT: $DBI::errstr" unless defined $result; 76 croak "failed to SELECT: $DBI::errstr" unless defined $result;
76 return @$result; 77 return @$result;
77} 78}
78 79
79sub exists($@) { 80sub exists($@) {
80 my ($self, @keyparts) = @_; 81 my ($self, @keyparts) = @_;
81 82
82 my $table = $self->{table}; 83 my $table = $self->{table};
83 my @keynames = $self->sqlKeynames(); 84 my @keynames = $self->sqlKeynames();
84 85
85 die "wrong number of keyparts for table $table (needs: @keynames)" 86 croak "wrong number of keyparts for table $table (needs: @keynames)"
86 unless @keyparts == @keynames; 87 unless @keyparts == @keynames;
87 88
88 my $stmt = "SELECT COUNT(*) FROM $table "; 89 my $stmt = "SELECT COUNT(*) FROM $table ";
89 $stmt .= $self->makeWhereClause(@keyparts); 90 $stmt .= $self->makeWhereClause(@keyparts);
90 warn "SQL-exists: $stmt\n"; 91 $self->debug("SQL-exists: $stmt\n");
91 92
92 $self->{driver}->connect("ro"); 93 $self->{driver}->connect("ro");
93 my ($result) = $self->{driver}->handle()->selectrow_array($stmt); 94 my ($result) = $self->{driver}->handle()->selectrow_array($stmt);
94 $self->{driver}->disconnect(); 95 $self->{driver}->disconnect();
95 die "failed to SELECT: $DBI::errstr" unless defined $result; 96 croak "failed to SELECT: $DBI::errstr" unless defined $result;
96 return $result > 0; 97 return $result > 0;
97} 98}
98 99
99sub add($$) { 100sub add($$) {
100 my ($self, $Record) = @_; 101 my ($self, $Record) = @_;
101 102
102 my @realKeynames = $self->{record}->KEYFIELDS(); 103 my @realKeynames = $self->{record}->KEYFIELDS();
103 my @keyparts = map { $Record->$_() } @realKeynames; 104 my @keyparts = map { $Record->$_() } @realKeynames;
104 die "(" . join(", ", @keyparts) . "): exists (use put)" 105 croak "(" . join(", ", @keyparts) . "): exists (use put)"
105 if $self->exists(@keyparts); 106 if $self->exists(@keyparts);
106 107
107 my $table = $self->{table}; 108 my $table = $self->{table};
108 my @fieldnames = $self->sqlFieldnames(); 109 my @fieldnames = $self->sqlFieldnames();
109 my $fieldnames = join(", ", @fieldnames); 110 my $fieldnames = join(", ", @fieldnames);
… …
111 112
112 my @realFieldnames = $self->{record}->FIELDS(); 113 my @realFieldnames = $self->{record}->FIELDS();
113 my @fieldvalues = map { $Record->$_() } @realFieldnames; 114 my @fieldvalues = map { $Record->$_() } @realFieldnames;
114 115
115 my $stmt = "INSERT INTO $table ($fieldnames) VALUES ($marks)"; 116 my $stmt = "INSERT INTO $table ($fieldnames) VALUES ($marks)";
116 warn "SQL-add: $stmt\n"; 117 $self->debug("SQL-add: $stmt\n");
117 118
118 $self->{driver}->connect("rw"); 119 $self->{driver}->connect("rw");
119 my $sth = $self->{driver}->handle()->prepare($stmt); 120 my $sth = $self->{driver}->handle()->prepare($stmt);
120 my $result = $sth->execute(@fieldvalues); 121 my $result = $sth->execute(@fieldvalues);
121 $self->{driver}->disconnect(); 122 $self->{driver}->disconnect();
122 123
123 unless (defined $result) { 124 unless (defined $result) {
124 my @realKeynames = $self->{record}->KEYFIELDS(); 125 my @realKeynames = $self->{record}->KEYFIELDS();
125 my @keyvalues = map { $Record->$_() } @realKeynames; 126 my @keyvalues = map { $Record->$_() } @realKeynames;
126 die "(" . join(", ", @keyvalues) . "): failed to INSERT: $DBI::errstr"; 127 croak "(" . join(", ", @keyvalues) . "): failed to INSERT: $DBI::errstr";
127 } 128 }
128 129
129 return 1; 130 return 1;
130} 131}
131 132
… …
133 my ($self, @keyparts) = @_; 134 my ($self, @keyparts) = @_;
134 135
135 my $table = $self->{table}; 136 my $table = $self->{table};
136 my @keynames = $self->sqlKeynames(); 137 my @keynames = $self->sqlKeynames();
137 138
138 die "wrong number of keyparts for table $table (needs: @keynames)" 139 croak "wrong number of keyparts for table $table (needs: @keynames)"
139 unless @keyparts == @keynames; 140 unless @keyparts == @keynames;
140 141
141 my $stmt = "SELECT * FROM $table "; 142 my $stmt = "SELECT * FROM $table ";
142 $stmt .= $self->makeWhereClause(@keyparts); 143 $stmt .= $self->makeWhereClause(@keyparts);
143 warn "SQL-get: $stmt\n"; 144 $self->debug("SQL-get: $stmt\n");
144 145
145 $self->{driver}->connect("ro"); 146 $self->{driver}->connect("ro");
146 my $result = $self->{driver}->handle()->selectrow_arrayref($stmt); 147 my $result = $self->{driver}->handle()->selectrow_arrayref($stmt);
147 $self->{driver}->disconnect(); 148 $self->{driver}->disconnect();
148 # $result comes back undefined if there are no matches. hmm... 149 # $result comes back undefined if there are no matches. hmm...
149 #die "failed to SELECT: $DBI::errstr" unless defined $result; 150 #croak "failed to SELECT: $DBI::errstr" unless defined $result;
150 return undef unless defined $result; 151 return undef unless defined $result;
151 152
152 my @record = @$result; 153 my @record = @$result;
153 my $Record = $self->{record}->new(); 154 my $Record = $self->{record}->new();
154 my @realFieldnames = $self->{record}->FIELDS(); 155 my @realFieldnames = $self->{record}->FIELDS();
… …
162sub put($$) { 163sub put($$) {
163 my ($self, $Record) = @_; 164 my ($self, $Record) = @_;
164 165
165 my @realKeynames = $self->{record}->KEYFIELDS(); 166 my @realKeynames = $self->{record}->KEYFIELDS();
166 my @keyparts = map { $Record->$_() } @realKeynames; 167 my @keyparts = map { $Record->$_() } @realKeynames;
167 die "(" . join(", ", @keyparts) . "): not found (use add)" 168 croak "(" . join(", ", @keyparts) . "): not found (use add)"
168 unless $self->exists(@keyparts); 169 unless $self->exists(@keyparts);
169 170
170 my $table = $self->{table}; 171 my $table = $self->{table};
171 my @fieldnames = $self->sqlFieldnames(); 172 my @fieldnames = $self->sqlFieldnames();
172 my $fieldnames = join(", ", @fieldnames); 173 my $fieldnames = join(", ", @fieldnames);
… …
178 my $stmt = "UPDATE $table SET"; 179 my $stmt = "UPDATE $table SET";
179 while (@fieldnames) { 180 while (@fieldnames) {
180 $stmt .= " " . (shift @fieldnames) . "=?"; 181 $stmt .= " " . (shift @fieldnames) . "=?";
181 $stmt .= "," if @fieldnames; 182 $stmt .= "," if @fieldnames;
182 } 183 }
183 warn "SQL-put: $stmt\n"; 184 $self->debug("SQL-put: $stmt\n");
184 185
185 $self->{driver}->connect("rw"); 186 $self->{driver}->connect("rw");
186 my $sth = $self->{driver}->handle()->prepare($stmt); 187 my $sth = $self->{driver}->handle()->prepare($stmt);
187 my $result = $sth->execute(@fieldvalues); 188 my $result = $sth->execute(@fieldvalues);
188 $self->{driver}->disconnect(); 189 $self->{driver}->disconnect();
189 190
190 unless (defined $result) { 191 unless (defined $result) {
191 #my @realKeynames = $self->{record}->KEYFIELDS(); 192 #my @realKeynames = $self->{record}->KEYFIELDS();
192 #my @keyvalues = map { $Record->$_() } @realKeynames; 193 #my @keyvalues = map { $Record->$_() } @realKeynames;
193 die "(" . join(", ", @keyparts) . "): failed to UPDATE: $DBI::errstr"; 194 croak "(" . join(", ", @keyparts) . "): failed to UPDATE: $DBI::errstr";
194 } 195 }
195 196
196 return 1; 197 return 1;
197} 198}
198 199
199sub delete($@) { 200sub delete($@) {
200 my ($self, @keyparts) = @_; 201 my ($self, @keyparts) = @_;
201 202
202 die "(" . join(", ", @keyparts) . "): not found" 203 croak "(" . join(", ", @keyparts) . "): not found"
203 unless $self->exists(@keyparts); 204 unless $self->exists(@keyparts);
204 205
205 my $table = $self->{table}; 206 my $table = $self->{table};
206 my @keynames = $self->sqlKeynames(); 207 my @keynames = $self->sqlKeynames();
207 208
208 die "wrong number of keyparts for table $table (needs: @keynames)" 209 croak "wrong number of keyparts for table $table (needs: @keynames)"
209 unless @keyparts == @keynames; 210 unless @keyparts == @keynames;
210 211
211 my $stmt = "DELETE FROM $table "; 212 my $stmt = "DELETE FROM $table ";
212 $stmt .= $self->makeWhereClause(@keyparts); 213 $stmt .= $self->makeWhereClause(@keyparts);
213 warn "SQL-delete: $stmt\n"; 214 $self->debug("SQL-delete: $stmt\n");
214 215
215 $self->{driver}->connect("rw"); 216 $self->{driver}->connect("rw");
216 my $result = $self->{driver}->handle()->do($stmt); 217 my $result = $self->{driver}->handle()->do($stmt);
217 $self->{driver}->disconnect(); 218 $self->{driver}->disconnect();
218 die "failed to DELETE: $DBI::errstr" unless defined $result; 219 croak "failed to DELETE: $DBI::errstr" unless defined $result;
219 220
220 if ($result > 1) { 221 if ($result > 1) {
221 warn "danger! deleted more than one record!"; 222 warn "danger! deleted more than one record!";
222 } 223 }
223 224
… …
261 my @keynames = $self->{record}->FIELDS(); 262 my @keynames = $self->{record}->FIELDS();
262 return map { $self->{params}->{fieldOverride}->{$_} || $_ } 263 return map { $self->{params}->{fieldOverride}->{$_} || $_ }
263 @keynames; 264 @keynames;
264} 265}
265 266
267sub debug($@) {
268 my ($self, @string) = @_;
269
270# if ($self->{params}->{debug}) {
271 warn @string;
272# }
273}
274
2661; 2751;
Legend:
Removed from v.914  
changed lines
  Added in v.915
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9