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