View of /branches/dg2_dev/webwork2/lib/WeBWorK/DB/Schema/NewSQL/Std.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/DB/Schema/NewSQL/Std.pm,v 1.22 2009/02/02 03:18:09 gage Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::DB::Schema::NewSQL::Std;
   18 use base qw(WeBWorK::DB::Schema::NewSQL);
   19 
   20 =head1 NAME
   21 
   22 WeBWorK::DB::Schema::NewSQL - support SQL access to single tables.
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 use Carp qw(croak);
   29 use Iterator;
   30 use Iterator::Util;
   31 use File::Temp;
   32 use String::ShellQuote;
   33 use WeBWorK::DB::Utils::SQLAbstractIdentTrans;
   34 use WeBWorK::Debug;
   35 
   36 =head1 SUPPORTED PARAMS
   37 
   38 This schema pays attention to the following items in the C<params> entry.
   39 
   40 =over
   41 
   42 =item tableOverride
   43 
   44 Alternate name for this table, to satisfy SQL naming requirements.
   45 
   46 =item fieldOverride
   47 
   48 A reference to a hash mapping field names to alternate names, to satisfy SQL
   49 naming requirements.
   50 
   51 =back
   52 
   53 =cut
   54 
   55 ################################################################################
   56 # constructor for SQL-specific behavior
   57 ################################################################################
   58 
   59 sub new {
   60   my $self = shift->SUPER::new(@_);
   61 
   62   $self->sql_init;
   63 
   64   # provide a custom error handler
   65   $self->dbh->{HandleError} = \&handle_error;
   66 
   67   return $self;
   68 }
   69 
   70 sub sql_init {
   71   my $self = shift;
   72 
   73   # transformation functions for table and field names: these allow us to pass
   74   # the WeBWorK table/field names to SQL::Abstract, and have it translate them
   75   # to the SQL table/field names from tableOverride and fieldOverride.
   76   # (Without this, it would be hard to translate field names in WHERE
   77   # structures, since they're so convoluted.)
   78   my ($transform_table, $transform_field);
   79   if (defined $self->{params}{tableOverride}) {
   80     $transform_table = sub {
   81       my $label = shift;
   82       if ($label eq $self->{table}) {
   83         return $self->{params}{tableOverride};
   84       } else {
   85         #warn "can't transform unrecognized table name '$label'";
   86         return $label;
   87       }
   88     };
   89   }
   90   if (defined $self->{params}{fieldOverride}) {
   91     $transform_field = sub {
   92       my $label = shift;
   93       return defined $self->{params}{fieldOverride}{$label}
   94         ? $self->{params}{fieldOverride}{$label}
   95         : $label;
   96     };
   97   }
   98 
   99   # add SQL statement generation object
  100   $self->{sql} = new WeBWorK::DB::Utils::SQLAbstractIdentTrans(
  101     quote_char => "`",
  102     name_sep => ".",
  103     transform_table => $transform_table,
  104     transform_field => $transform_field,
  105   );
  106 }
  107 
  108 ################################################################################
  109 # table creation
  110 ################################################################################
  111 
  112 sub create_table {
  113   my ($self) = @_;
  114 
  115   my $stmt = $self->_create_table_stmt;
  116   $self->dbh->do($stmt);
  117   my @fields = $self->fields;
  118   my @rows = map { [ @$_{@fields} ] } $self->initial_records;
  119   return $self->insert_fields(\@fields, \@rows);
  120 }
  121 
  122 # this is mostly ripped off from wwdb_check, which is pretty much a per-table
  123 # version of the table creation code in sql_single.pm. wwdb_check is going away
  124 # after 2.3.x, and sql_single.pm is being replaced by this code.
  125 sub _create_table_stmt {
  126   my ($self) = @_;
  127 
  128   my $sql_table_name = $self->sql_table_name;
  129 
  130   my @field_list;
  131 
  132   # generate a column specification for each field
  133   foreach my $field ($self->fields) {
  134     my $sql_field_name = $self->sql_field_name($field);
  135     my $sql_field_type = $self->field_data->{$field}{type};
  136 
  137     push @field_list, "`$sql_field_name` $sql_field_type";
  138   }
  139 
  140   # generate an INDEX specification for each all possible sets of keyfields (i.e. 0+1+2, 1+2, 2)
  141   my @keyfields = $self->keyfields;
  142   foreach my $start (0 .. $#keyfields) {
  143     my @index_components;
  144 
  145     foreach my $component (@keyfields[$start .. $#keyfields]) {
  146       my $sql_field_name = $self->sql_field_name($component);
  147       my $sql_field_type = $self->field_data->{$component}{type};
  148       my $length_specifier = $sql_field_type =~ /(text|blob)/i ? "(255)" : "";
  149       if ($start == 0 and $length_specifier and $sql_field_type !~ /tiny/i) {
  150         warn "warning: UNIQUE KEY component $sql_field_name is a $sql_field_type, which can"
  151           . " hold values longer than 255 characters. However, the maximum key prefix"
  152           . " length for text/blob fields is 255. Therefore, uniqueness must occur within"
  153           . " the first 255 characters of this field.";
  154       }
  155       push @index_components, "`$sql_field_name`$length_specifier";
  156     }
  157 
  158     my $index_string = join(", ", @index_components);
  159     my $index_type = $start == 0 ? "UNIQUE KEY" : "KEY";
  160     push @field_list, "$index_type ( $index_string )";
  161   }
  162 
  163   my $field_string = join(", ", @field_list);
  164   return "CREATE TABLE `$sql_table_name` ( $field_string )";
  165 }
  166 
  167 ################################################################################
  168 # table renaming
  169 ################################################################################
  170 
  171 sub rename_table {
  172   my ($self, $new_sql_table_name) = @_;
  173 
  174   my $stmt = $self->_rename_table_stmt($new_sql_table_name);
  175   return $self->dbh->do($stmt);
  176 }
  177 
  178 sub _rename_table_stmt {
  179   my ($self, $new_sql_table_name) = @_;
  180 
  181   my $sql_table_name = $self->sql_table_name;
  182   return "RENAME TABLE `$sql_table_name` TO `$new_sql_table_name`";
  183 }
  184 
  185 ################################################################################
  186 # table deletion
  187 ################################################################################
  188 
  189 sub delete_table {
  190   my ($self) = @_;
  191 
  192   my $stmt = $self->_delete_table_stmt;
  193   return $self->dbh->do($stmt);
  194 }
  195 
  196 sub _delete_table_stmt {
  197   my ($self) = @_;
  198 
  199   my $sql_table_name = $self->sql_table_name;
  200   return "DROP TABLE IF EXISTS `$sql_table_name`";
  201 }
  202 
  203 ################################################################################
  204 # table dumping and restoring
  205 ################################################################################
  206 
  207 # These are limited to mysql, since they use the mysql monitor and mysqldump.
  208 # An exception will be thrown if the table in question doesn't use mysql.
  209 # It also requires some additions to the params:
  210 #     mysqldump_path - path to mysqldump(1)
  211 #     mysql_path - path to mysql(1)
  212 
  213 sub dump_table {
  214   my ($self, $dumpfile_path) = @_;
  215 
  216   my ($my_cnf, $database) = $self->_get_db_info;
  217   my $mysqldump = $self->{params}{mysqldump_path};
  218 
  219   # 2>&1 is specified first, which apparently makes stderr go to stdout
  220   # and stdout (not including stderr) go to the dumpfile. see bash(1).
  221   my $dump_cmd = "2>&1 " . shell_quote($mysqldump)
  222 #     . " --defaults-extra-file=" . shell_quote($my_cnf->filename)
  223     . " --defaults-file=" . shell_quote($my_cnf->filename) # work around for mysqldump bug
  224     . " " . shell_quote($database)
  225     . " " . shell_quote($self->sql_table_name)
  226     . " > " . shell_quote($dumpfile_path);
  227   my $dump_out = readpipe $dump_cmd;
  228   if ($?) {
  229     my $exit = $? >> 8;
  230     my $signal = $? & 127;
  231     my $core = $? & 128;
  232     warn "Warning: Failed to dump table '".$self->sql_table_name."' with command '$dump_cmd' (exit=$exit signal=$signal core=$core): $dump_out\n";
  233     warn "This can be expected if the course was created with an earlier version of WeBWorK.";
  234   }
  235 
  236   return 1;
  237 }
  238 
  239 sub restore_table {
  240   my ($self, $dumpfile_path) = @_;
  241 
  242   my ($my_cnf, $database) = $self->_get_db_info;
  243   my $mysql = $self->{params}{mysql_path};
  244 
  245   my $restore_cmd = "2>&1 " . shell_quote($mysql)
  246 #     . " --defaults-extra-file=" . shell_quote($my_cnf->filename)
  247     . " --defaults-file=" . shell_quote($my_cnf->filename) # work around for mysqldump bug
  248     . " " . shell_quote($database)
  249     . " < " . shell_quote($dumpfile_path);
  250   my $restore_out = readpipe $restore_cmd;
  251   if ($?) {
  252     my $exit = $? >> 8;
  253     my $signal = $? & 127;
  254     my $core = $? & 128;
  255     warn "Failed to restore table '".$self->sql_table_name."' with command '$restore_cmd' (exit=$exit signal=$signal core=$core): $restore_out\n";
  256   }
  257 
  258   return 1;
  259 }
  260 
  261 sub _get_db_info {
  262   my ($self) = @_;
  263   my $dsn = $self->{driver}{source};
  264   my $username = $self->{params}{username};
  265   my $password = $self->{params}{password};
  266 
  267   die "Can't call dump_table or restore_table on a table with a non-MySQL source"
  268     unless $dsn =~ s/^dbi:mysql://i;
  269 
  270   # this is an internal function which we probably shouldn't be using here
  271   # but it's quick and gets us what we want (FIXME what about sockets, etc?)
  272   my %dsn;
  273   DBD::mysql->_OdbcParse($dsn, \%dsn, ['database', 'host', 'port']);
  274   die "no database specified in DSN!" unless defined $dsn{database};
  275 
  276   # doing this securely is kind of a hassle...
  277   my $my_cnf = new File::Temp;
  278   $my_cnf->unlink_on_destroy(1);
  279   chmod 0600, $my_cnf or die "failed to chmod 0600 $my_cnf: $!"; # File::Temp objects stringify with ->filename
  280   print $my_cnf "[client]\n";
  281   print $my_cnf "user=$username\n" if defined $username and length($username) > 0;
  282   print $my_cnf "password=$password\n" if defined $password and length($password) > 0;
  283   print $my_cnf "host=$dsn{host}\n" if defined $dsn{host} and length($dsn{host}) > 0;
  284   print $my_cnf "port=$dsn{port}\n" if defined $dsn{port} and length($dsn{port}) > 0;
  285 
  286   return ($my_cnf, $dsn{database});
  287 }
  288 ####################################################
  289 # checking Fields
  290 ####################################################
  291 
  292 sub tableFieldExists {
  293   my $self = shift;
  294   my $field_name = shift;
  295   my $stmt = $self->_exists_field_stmt($field_name);
  296   my $result = $self->dbh->do($stmt);
  297   return  ($result eq "1") ? 1 : 0;    # failed result is 0E0
  298 }
  299 
  300 sub _exists_field_stmt {
  301   my $self = shift;
  302   my $field_name=shift;
  303   my $sql_table_name = $self->sql_table_name;
  304   return "Describe `$sql_table_name` `$field_name`";
  305 }
  306 ####################################################
  307 # adding Field column
  308 ####################################################
  309 
  310 sub add_column_field {
  311   my $self = shift;
  312   my $field_name = shift;
  313   my $stmt = $self->_add_column_field_stmt($field_name);
  314   #warn "database command $stmt";
  315   my $result = $self->dbh->do($stmt);
  316   #warn "result of add column is $result";
  317   #return  ($result eq "0E0") ? 0 : 1;    # failed result is 0E0
  318   return 1;   #FIXME  how to determine if database update was successful???
  319 }
  320 
  321 sub _add_column_field_stmt {
  322   my $self = shift;
  323   my $field_name=shift;
  324   my $sql_table_name = $self->sql_table_name;
  325   my $sql_field_name = $self->sql_field_name($field_name);
  326   my $sql_field_type = $self->field_data->{$field_name}{type};
  327   return "Alter table `$sql_table_name` add column `$sql_field_name` $sql_field_type";
  328 }
  329 ####################################################
  330 # checking Tables
  331 ####################################################
  332 sub tableExists {
  333   my $self = shift;
  334   my $stmt = $self->_exists_table_stmt;
  335   my $result = eval { $self->dbh->do($stmt); };
  336   ( caught WeBWorK::DB::Ex::TableMissing ) ? 0:1;
  337 }
  338 
  339 sub _exists_table_stmt {
  340   my $self = shift;
  341   my $sql_table_name = $self->sql_table_name;
  342   return "Describe `$sql_table_name` ";
  343 }
  344 
  345 
  346 ################################################################################
  347 # counting/existence
  348 ################################################################################
  349 
  350 # returns the number of matching rows
  351 sub count_where {
  352   my ($self, $where) = @_;
  353   $where = $self->conv_where($where);
  354 
  355   my ($stmt, @bind_vals) = $self->sql->select($self->table, "COUNT(*)", $where);
  356   my $sth = $self->dbh->prepare_cached($stmt, undef, 3); # 3 -- see DBI docs
  357   $self->debug_stmt($sth, @bind_vals);
  358   $sth->execute(@bind_vals);
  359   my ($result) = $sth->fetchrow_array;
  360   $sth->finish;
  361 
  362   return $result;
  363 }
  364 
  365 # returns true iff there is at least one matching row
  366 sub exists_where {
  367   my ($self, $where) = @_;
  368   return $self->count_where($where) > 0;
  369 }
  370 
  371 ################################################################################
  372 # lowlevel get
  373 ################################################################################
  374 
  375 # returns a list of refs to arrays containing field values for each matching row
  376 sub get_fields_where {
  377   my ($self, $fields, $where, $order) = @_;
  378   $fields ||= [$self->fields];
  379 
  380   my $sth = $self->_get_fields_where_prepex($fields, $where, $order);
  381   my @results = @{ $sth->fetchall_arrayref };
  382   $sth->finish;
  383   return @results;
  384 }
  385 
  386 # returns an Iterator that generates refs to arrays containg field values for each matching row
  387 sub get_fields_where_i {
  388   my ($self, $fields, $where, $order) = @_;
  389   $fields ||= [$self->fields];
  390 
  391   my $sth = $self->_get_fields_where_prepex($fields, $where, $order);
  392   return new Iterator sub {
  393     my @row = $sth->fetchrow_array;
  394     if (@row) {
  395       return \@row;
  396     } else {
  397       $sth->finish; # let the server know we're done getting values
  398       undef $sth; # allow the statement handle to get garbage-collected
  399       Iterator::is_done();
  400     }
  401   };
  402 }
  403 
  404 # helper, returns a prepared statement handle
  405 sub _get_fields_where_prepex {
  406   my ($self, $fields, $where, $order) = @_;
  407   $where = $self->conv_where($where);
  408 
  409   my ($stmt, @bind_vals) = $self->sql->select($self->table, $fields, $where, $order);
  410   my $sth = $self->dbh->prepare_cached($stmt, undef, 3); # 3: see DBI docs
  411   $self->debug_stmt($sth, @bind_vals);
  412   $sth->execute(@bind_vals);
  413   return $sth;
  414 }
  415 
  416 ################################################################################
  417 # getting keyfields (a.k.a. listing)
  418 ################################################################################
  419 
  420 # returns a list of refs to arrays containing keyfield values for each matching row
  421 sub list_where {
  422   my ($self, $where, $order) = @_;
  423   return $self->get_fields_where([$self->keyfields], $where, $order);
  424 }
  425 
  426 # returns an iterator that generates refs to arrays containing keyfield values for each matching row
  427 sub list_where_i {
  428   my ($self, $where, $order) = @_;
  429   return $self->get_fields_where_i([$self->keyfields], $where, $order);
  430 }
  431 
  432 ################################################################################
  433 # getting records
  434 ################################################################################
  435 
  436 # returns a record objects for each matching row
  437 sub get_records_where {
  438   my ($self, $where, $order) = @_;
  439 
  440   return map { $self->box($_) }
  441     $self->get_fields_where([$self->fields], $where, $order);
  442 }
  443 
  444 # returns an iterator that generates a record object for each matching row
  445 sub get_records_where_i {
  446   my ($self, $where, $order) = @_;
  447 
  448   return imap { $self->box($_) }
  449     $self->get_fields_where_i([$self->fields], $where, $order);
  450 }
  451 
  452 ################################################################################
  453 # lowlevel insert
  454 ################################################################################
  455 
  456 # returns the number of rows affected by inserting each row
  457 sub insert_fields {
  458   my ($self, $fields, $rows) = @_;
  459 
  460   my ($sth, @order) = $self->_insert_fields_prep($fields);
  461   my @results;
  462   foreach my $row (@$rows) {
  463     my @bind_vals = @$row[@order];
  464     $self->debug_stmt($sth, @bind_vals);
  465     push @results, $sth->execute(@bind_vals);
  466   }
  467   $sth->finish;
  468   return @results;
  469 }
  470 
  471 # returns the number of rows affected by inserting each row
  472 sub insert_fields_i {
  473   my ($self, $fields, $rows_i) = @_;
  474 
  475   my ($sth, @order) = $self->_insert_fields_prep($fields);
  476   my @results;
  477   until ($rows_i->is_exhausted) {
  478     my @bind_vals = @{$rows_i->value}[@order];
  479     $self->debug_stmt($sth, @bind_vals);
  480     push @results, $sth->execute(@bind_vals);
  481   }
  482   $sth->finish;
  483   return @results;
  484 }
  485 
  486 # helper, returns a prepared statement handle
  487 sub _insert_fields_prep {
  488   my ($self, $fields) = @_;
  489 
  490   # we'll use dummy values to determine bind order
  491   my %values;
  492   @values{@$fields} = (0..@$fields-1);
  493 
  494   my ($stmt, @order) = $self->sql->insert($self->table, \%values);
  495   my $sth = $self->dbh->prepare_cached($stmt, undef, 3); # 3: see DBI docs
  496   return $sth, @order;
  497 }
  498 
  499 ################################################################################
  500 # inserting records
  501 ################################################################################
  502 
  503 # returns the number of rows affected by inserting each record
  504 sub insert_records {
  505   my ($self, $Records) = @_;
  506   return $self->insert_fields_i([$self->fields], imap { $self->unbox($_) } iarray $Records);
  507 }
  508 
  509 # returns the number of rows affected by inserting each record
  510 sub insert_records_i {
  511   my ($self, $Records_i) = @_;
  512   return $self->insert_fields_i([$self->fields], imap { $self->unbox($_) } $Records_i);
  513 }
  514 
  515 ################################################################################
  516 # lowlevel update-where
  517 ################################################################################
  518 
  519 # execute a single UPDATE by passing a ref to a hash mapping field names to new
  520 # values and a reference to a hash specifying a where clause
  521 
  522 # returns number of rows affected by update
  523 sub update_where {
  524   my ($self, $fieldvals, $where) = @_;
  525   $where = $self->conv_where($where);
  526 
  527   my ($stmt, @bind_vals) = $self->sql->update($self->table, $fieldvals, $where);
  528   my $sth = $self->dbh->prepare_cached($stmt, undef, 3); # 3 -- see DBI docs
  529   $self->debug_stmt($sth, @bind_vals);
  530   my $result = $sth->execute(@bind_vals);
  531   $sth->finish;
  532 
  533   return $result;
  534 }
  535 
  536 ################################################################################
  537 # lowlevel update-fields
  538 ################################################################################
  539 
  540 # rather than allowing an unrestrained where clause here, we generate one based
  541 # on the value of the keyfields in each row. in this respect, the behavior is
  542 # more like "REPLACE INTO", except that a record with matching keys must already
  543 # exist.
  544 
  545 # returns the number of rows affected by updating each row
  546 sub update_fields {
  547   my ($self, $fields, $rows) = @_;
  548 
  549   my ($sth, $val_order, $where_order) = $self->_update_fields_prep($fields);
  550   my @results;
  551   foreach my $row (@$rows) {
  552     my @bind_vals = @$row[@$val_order,@$where_order];
  553     $self->debug_stmt($sth, @bind_vals);
  554     push @results, $sth->execute(@bind_vals);
  555   }
  556   $sth->finish;
  557   return @results;
  558 }
  559 
  560 # returns the number of rows affected by updating each row
  561 sub update_fields_i {
  562   my ($self, $fields, $rows_i) = @_;
  563 
  564   my ($sth, $val_order, $where_order) = $self->_update_fields_prep($fields);
  565   my @results;
  566   until ($rows_i->is_exhausted) {
  567     my @bind_vals = @{$rows_i->value}[@$val_order,@$where_order];
  568     $self->debug_stmt($sth, @bind_vals);
  569     push @results, $sth->execute(@bind_vals);
  570   }
  571   $sth->finish;
  572   return @results;
  573 }
  574 
  575 # helper, returns a prepared statement handle
  576 sub _update_fields_prep {
  577   my ($self, $fields) = @_;
  578 
  579   # get hashes to pass to update() and where()
  580   # (dies if any keyfield is missing from @$fields)
  581   my ($values, $where) = $self->gen_update_hashes($fields);
  582 
  583   # do the where clause separately so we get a separate bind list (cute substr trick, huh?)
  584   my ($stmt, @val_order) = $self->sql->update($self->table, $values);
  585   (substr($stmt,length($stmt),0), my @where_order) = $self->sql->where($where);
  586 
  587   my $sth = $self->dbh->prepare_cached($stmt, undef, 3); # 3: see DBI docs
  588   return $sth, \@val_order, \@where_order;
  589 }
  590 
  591 ################################################################################
  592 # updating records
  593 ################################################################################
  594 
  595 # returns the number of rows affected by updating each record
  596 sub update_records {
  597   my ($self, $Records) = @_;
  598   return $self->update_fields_i([$self->fields], imap { $self->unbox($_) } iarray $Records);
  599 }
  600 
  601 # returns the number of rows affected by updating each record
  602 sub update_records_i {
  603   my ($self, $Records_i) = @_;
  604   return $self->update_fields_i([$self->fields], imap { $self->unbox($_) } $Records_i);
  605 }
  606 
  607 ################################################################################
  608 # lowlevel delete-where
  609 ################################################################################
  610 
  611 # execute a single DELETE by passing a ref to a hash specifying a where clause
  612 
  613 # returns number of rows affected by delete
  614 sub delete_where {
  615   my ($self, $where) = @_;
  616   $where = $self->conv_where($where);
  617 
  618   my ($stmt, @bind_vals) = $self->sql->delete($self->table, $where);
  619   my $sth = $self->dbh->prepare_cached($stmt, undef, 3); # 3 -- see DBI docs
  620   $self->debug_stmt($sth, @bind_vals);
  621   my $result = $sth->execute(@bind_vals);
  622   $sth->finish;
  623 
  624   return $result;
  625 }
  626 
  627 ################################################################################
  628 # lowlevel delete-fields
  629 ################################################################################
  630 
  631 # rather than allowing an unrestrained where clause here, we generate one based
  632 # on the value of the keyfields in each row. this allows us to delete a bunch
  633 # of records with a single statement handle, if what we have is a big list of
  634 # record IDs (i.e. keyfields)
  635 
  636 # an alternate approach would be to generate one big WHERE clause by ORing
  637 # together the ANDed keyfields for each record to delete. This has the potential
  638 # to accumulate a huge stmt string, but it's just one execute.
  639 
  640 # this doesn't support NULL in keyfields, because the WHERE clause is
  641 # constructed differently for NULL and non-NULL values. use delete_where.
  642 
  643 # returns the number of rows affected by deleting each row
  644 sub delete_fields {
  645   my ($self, $fields, $rows) = @_;
  646 
  647   my ($sth, @order) = $self->_delete_fields_prep($fields);
  648   my @results;
  649   foreach my $row (@$rows) {
  650     my @bind_vals = @$row[@order];
  651     $self->debug_stmt($sth, @bind_vals);
  652     push @results, $sth->execute(@bind_vals);
  653   }
  654   $sth->finish;
  655   return @results;
  656 }
  657 
  658 # returns the number of rows affected by deleting each row
  659 sub delete_fields_i {
  660   my ($self, $fields, $rows_i) = @_;
  661 
  662   my ($sth, @order) = $self->_delete_fields_prep($fields);
  663 
  664   my @results;
  665   until ($rows_i->is_exhausted) {
  666     my @bind_vals = @{$rows_i->value}[@order];
  667     $self->debug_stmt($sth, @bind_vals);
  668     push @results, $sth->execute(@bind_vals);
  669   }
  670   $sth->finish;
  671   return @results;
  672 }
  673 
  674 # helper, returns a prepared statement handle
  675 sub _delete_fields_prep {
  676   my ($self, $fields) = @_;
  677 
  678   # get hashes to pass to update() and where()
  679   # (dies if any keyfield is missing from @$fields)
  680   my (undef, $where) = $self->gen_update_hashes($fields);
  681 
  682   # do the where clause separately so we get a separate bind list (cute substr trick, huh?)
  683   my ($stmt, @order) = $self->sql->delete($self->table, $where);
  684 
  685   my $sth = $self->dbh->prepare_cached($stmt, undef, 3); # 3: see DBI docs
  686   return $sth, @order;
  687 }
  688 
  689 ################################################################################
  690 # deleting records
  691 ################################################################################
  692 
  693 # we can pass whole records in here, even though all that's needed to delete is
  694 # the keyfields. will be unboxed, and then _delete_fields_prep will ignore the
  695 # non-keyfields when generating the WHERE clause template.
  696 
  697 # returns the number of rows affected by deleting each record
  698 sub delete_records {
  699   my ($self, $Records) = @_;
  700   return $self->delete_fields_i([$self->fields], imap { $self->unbox($_) } iarray $Records);
  701 }
  702 
  703 # returns the number of rows affected by deleting each record
  704 sub delete_records_i {
  705   my ($self, $Records_i) = @_;
  706   return $self->delete_fields_i([$self->fields], imap { $self->unbox($_) } $Records_i);
  707 }
  708 
  709 ################################################################################
  710 # compatibility methods for old API
  711 ################################################################################
  712 
  713 # oldapi
  714 sub count {
  715   my ($self, @keyparts) = @_;
  716   return $self->count_where($self->keyparts_to_where(@keyparts));
  717 }
  718 
  719 # oldapi
  720 sub list {
  721   my ($self, @keyparts) = @_;
  722   return $self->list_where($self->keyparts_to_where(@keyparts));
  723 }
  724 
  725 # oldapi
  726 sub exists {
  727   my ($self, @keyparts) = @_;
  728   return $self->exists_where($self->keyparts_to_where(@keyparts));
  729 }
  730 
  731 # oldapi
  732 sub get {
  733   my ($self, @keyparts) = @_;
  734   return ( $self->get_records_where($self->keyparts_to_where(@keyparts)) )[0];
  735 }
  736 
  737 # oldapi
  738 sub gets {
  739   my ($self, @keypartsRefList) = @_;
  740   return map { $self->get_records_where($self->keyparts_to_where(@$_)) } @keypartsRefList;
  741 }
  742 
  743 # oldapi
  744 sub add {
  745   my ($self, $Record) = @_;
  746   return ( $self->insert_records([$Record]) )[0];
  747 }
  748 
  749 # oldapi
  750 sub put {
  751   my ($self, $Record) = @_;
  752   return ( $self->update_records([$Record]) )[0];
  753 }
  754 
  755 # oldapi
  756 sub delete {
  757   my ($self, @keyparts) = @_;
  758   return $self->delete_where($self->keyparts_to_where(@keyparts));
  759 }
  760 
  761 ################################################################################
  762 # utility methods
  763 ################################################################################
  764 
  765 sub sql {
  766   return shift->{sql};
  767 }
  768 
  769 # returns non-quoted SQL name of current table
  770 sub sql_table_name {
  771   my ($self) = @_;
  772   return defined $self->{params}{tableOverride}
  773     ? $self->{params}{tableOverride}
  774     : $self->table;
  775 }
  776 
  777 # returns non-quoted SQL name of given field
  778 sub sql_field_name {
  779   my ($self, $field) = @_;
  780   return defined $self->{params}{fieldOverride}{$field}
  781     ? $self->{params}{fieldOverride}{$field}
  782     : $field;
  783 }
  784 
  785 # returns fully quoted expression refering to the specified field
  786 # if $include_table is true, the field name is prefixed with the table name
  787 sub sql_field_expression {
  788   my ($self, $field, $table) = @_;
  789 
  790   # _quote will do native-to-SQL table/field name translation
  791   if (defined $table) {
  792     return $self->sql->_quote("$table.$field");
  793   } else {
  794     return $self->sql->_quote($field);
  795   }
  796 }
  797 
  798 # maps error numbers to exception classes for MySQL
  799 our %MYSQL_ERROR_CODES = (
  800   1062 => 'WeBWorK::DB::Ex::RecordExists',
  801   1146 => 'WeBWorK::DB::Ex::TableMissing',
  802 );
  803 
  804 # turns MySQL error codes into exceptions -- WeBWorK::DB::Schema::Ex objects
  805 # for known error types, and normal die STRING exceptions for unknown errors.
  806 # This is one method you'd want to override if you were writing a subclass for
  807 # another RDBMS.
  808 sub handle_error {
  809   my ($errmsg, $handle, $returned) = @_;
  810 
  811   if (exists $MYSQL_ERROR_CODES{$handle->err}) {
  812     $MYSQL_ERROR_CODES{$handle->err}->throw;
  813   } else {
  814       my $error = $errmsg."\n".join("\n",caller(1),caller(2),caller(3),caller(4));
  815       #$error =~ s|\n|<br/>|;
  816     die $error ;
  817   }
  818 }
  819 
  820 1;
  821