Return to lonmysql.pm CVS log

Up to [LON-CAPA] / loncom / interface

- Bug 6825

# The LearningOnline Network with CAPA
# MySQL utility functions
#
# $Id: lonmysql.pm,v 1.41 2019/11/20 18:02:55 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
######################################################################

package Apache::lonmysql;

use strict;
use DBI;
use POSIX qw(strftime mktime);
use Apache::lonnet;

my $mysqluser;
my $mysqlpassword;
my $mysqldatabase;
my %db_config;

sub set_mysql_user_and_password {
    # If we are running under Apache and LONCAPA, use the LON-CAPA 
    # user and password.  Otherwise...? ? ? ?
    my ($input_mysqluser,$input_mysqlpassword,$input_mysqldatabase) = @_;
    if (! defined($mysqldatabase)) {
        $mysqldatabase = 'loncapa';
    }
    if (defined($input_mysqldatabase)) {
        $mysqldatabase = $input_mysqldatabase;
    }
    if (! defined($mysqluser) || ! defined($mysqlpassword)) {
        if (! eval 'require Apache::lonnet();') {
            $mysqluser = 'www';
            $mysqlpassword = $Apache::lonnet::perlvar{'lonSqlAccess'};
        } else {
            $mysqluser = '';
            $mysqlpassword = '';
        }
    }
    if (defined($input_mysqluser)) {
        $mysqluser = $input_mysqluser;
    } 
    if (defined($input_mysqlpassword)) {
        $mysqlpassword = $input_mysqlpassword;
    }
}

######################################################################
######################################################################

=pod 

=head1 Name

lonmysql - LONCAPA MySQL utility functions

=head1 Synopsis

lonmysql contains utility functions to make accessing the mysql loncapa
database easier.  

=head1 Description

lonmysql does its best to encapsulate all the database/table functions
and provide a common interface.  The goal, however, is not to provide 
a complete reimplementation of the DBI interface.  Instead we try to 
make using mysql as painless as possible.

Each table has a numeric ID that is a parameter to most lonmysql
functions.  The table id is returned by &create_table.  If you lose
the table id, it is lost forever.  The table names in MySQL correspond
to $env{'user.name'}.'_'.$env{'user.domain'}.'_'.$table_id. (With all
non-word characters removed form user.name and user.domain) If the
table id is non-numeric, it is assumed to be the full name of a table.
If you pass the table id in a form, you MUST ensure that what you send
to lonmysql is numeric, otherwise you are opening up all the tables in
the MySQL database.

=over 4

=item Creating a table

To create a table, you need a description of its structure.  See the entry
for &create_table for a description of what is needed.

 $table_id = &create_table({ 
     id      => 'tableid',      # usually you will use the returned id
     columns => (
                 { name => 'id',
                   type => 'INT',
                   restrictions => 'NOT NULL',
                   primary_key => 'yes',
                   auto_inc    => 'yes'
                   },
                 { name => 'verbage',
                   type => 'TEXT' },
                 ),
                       fulltext => [qw/verbage/],
        });

The above command will create a table with two columns, 'id' and 'verbage'.

'id' will be an integer which is autoincremented and non-null.

'verbage' will be of type 'TEXT', which (conceivably) allows any length
text string to be stored.  Depending on your intentions for this database,
setting restrictions => 'NOT NULL' may help you avoid storing empty data.

the fulltext element sets up the 'verbage' column for 'FULLTEXT' searching.



=item Storing rows

Storing a row in a table requires calling &store_row($table_id,$data)

$data is either a hash reference or an array reference.  If it is an array
reference, the data is passed as is (after being escaped) to the 
"INSERT INTO <table> VALUES( ... )" SQL command.  If $data is a hash reference,
the data will be placed into an array in the proper column order for the table
and then passed to the database.

An example of inserting into the table created above is:

&store_row($table_id,[undef,'I am not a crackpot!']);

or equivalently,

&store_row($table_id,{ verbage => 'I am not a crackpot!'});

Since the above table was created with the first column ('id') as 
autoincrement, providing a value is unnecessary even though the column was
marked as 'NOT NULL'.



=item Retrieving rows

Retrieving rows requires calling get_rows:

@row = &Apache::lonmysql::get_rows($table_id,$condition)

This results in the query "SELECT * FROM <table> HAVING $condition".

@row = &Apache::lonmysql::get_rows($table_id,'id>20'); 

returns all rows with column 'id' greater than 20.

=back

=cut

######################################################################
######################################################################
=pod

=head1 Package Variables

=over 4

=cut

##################################################
##################################################

=pod

=item %Tables

Holds information regarding the currently open connections.  Each key
in the %Tables hash will be a unique table key.  The value associated 
with a key is a hash reference.  Most values are initialized when the 
table is created.

The following entries are allowed in the hash reference:

=over 4

=item Name

Table name.

=item Type            

The type of table, typically MyISAM.

=item Row_format

Describes how rows should be stored in the table.  DYNAMIC or STATIC.

=item Create_time

The date of the tables creation.

=item Update_time

The date of the last modification of the table.

=item Check_time

Usually NULL. 

=item Avg_row_length

The average length of the rows.

=item Data_length

The length of the data stored in the table (bytes)

=item Max_data_length

The maximum possible size of the table (bytes).

=item Index_length

The length of the index for the table (bytes)

=item Data_free

I have no idea what this is.

=item Comment 

The comment associated with the table.

=item Rows

The number of rows in the table.

=item Auto_increment

The value of the next auto_increment field.

=item Create_options

I have no idea.

=item Col_order

an array reference which holds the order of columns in the table.

=item row_insert_sth 

The statement handler for row inserts.

=item row_replace_sth 

The statement handler for row inserts.

=back

Col_order and row_insert_sth are kept internally by lonmysql and are not
part of the usual MySQL table information.

=cut

##################################################
##################################################
my %Tables;

##################################################
##################################################
=pod

=item $errorstring

Holds the last error.

=cut
##################################################
##################################################
my $errorstring;

##################################################
##################################################
=pod

=item $debugstring

Describes current events within the package.

=cut
##################################################
##################################################
my $debugstring;

##################################################
##################################################

=pod

=item $dbh

The database handler; The actual connection to MySQL via the perl DBI.

=cut

##################################################
##################################################
my $dbh;

##################################################
##################################################

# End of global variable declarations

=pod

=back

=cut

######################################################################
######################################################################

=pod

=head1 Internals

=over 4

=cut

######################################################################
######################################################################

=pod

=item &connect_to_db()

Inputs: none.  

Returns: undef on error, 1 on success.

Checks to make sure the database has been connected to.  If not, the
connection is established.  

=cut

###############################
sub connect_to_db { 
    return 1 if ($dbh);
    if (! defined($mysqluser) || ! defined($mysqlpassword)) {
        &set_mysql_user_and_password();
    }
    if (! ($dbh = DBI->connect("DBI:mysql:$mysqldatabase",$mysqluser,$mysqlpassword,
                               { RaiseError=>0,PrintError=>0}))) {
        $debugstring = "Unable to connect to loncapa database.";    
        if (! defined($dbh)) {
            $debugstring = "Unable to connect to loncapa database.";
            $errorstring = "dbh was undefined.";
        } elsif ($dbh->err) {
            $errorstring = "Connection error: ".$dbh->errstr;
        }
        return undef;
    }
    $debugstring = "Successfully connected to loncapa database.";    
    # Determine DB configuration
    undef(%db_config);
    my $sth = $dbh->prepare("SHOW VARIABLES");
    $sth->execute();
    if ($sth->err()) {
        $debugstring = "Unable to retrieve db config variables";
        return undef;
    }
    foreach my $row (@{$sth->fetchall_arrayref}) {
        $db_config{$row->[0]} = $row->[1];
    }
    #&Apache::lonnet::logthis("MySQL configuration variables");
    #while (my ($k,$v) = each(%db_config)) {
    #    &Apache::lonnet::logthis("    '$k' => '$v'");
    #}
    #
    return 1;
}

###############################

=pod

=item &verify_sql_connection()

Inputs: none.

Returns: 0 (failure) or 1 (success)

Checks to make sure the database can be connected to.  It does not
initialize anything in the lonmysql package.

=cut

###############################
sub verify_sql_connection {
    if (! defined($mysqluser) || ! defined($mysqlpassword)) {
        &set_mysql_user_and_password();
    }
    my $connection;
    if (! ($connection = DBI->connect("DBI:mysql:loncapa",
                                      $mysqluser,$mysqlpassword,
                                      { RaiseError=>0,PrintError=>0}))) {
        return 0;
    }
    undef($connection);
    return 1;
}

###############################

=pod

=item &disconnect_from_db()

Inputs: none.

Returns: Always returns 1.

Severs the connection to the mysql database.

=cut

###############################
sub disconnect_from_db { 
    foreach (keys(%Tables)) {
        # Supposedly, having statement handlers running around after the
        # database connection has been lost will cause trouble.  So we 
        # kill them off just to be sure.
        if (exists($Tables{$_}->{'row_insert_sth'})) {
            delete($Tables{$_}->{'row_insert_sth'});
        }
        if (exists($Tables{$_}->{'row_replace_sth'})) {
            delete($Tables{$_}->{'row_replace_sth'});
        }
    }
    $dbh->disconnect if ($dbh);
    $debugstring = "Disconnected from database.";
    $dbh = undef;
    return 1;
}

###############################

=pod

=item &number_of_rows()

Input: table identifier

Returns: the number of rows in the given table, undef on error.

=cut

###############################
sub number_of_rows { 
    my ($table_id) = @_;
    return undef if (! defined(&connect_to_db()));
    return undef if (! defined(&update_table_info($table_id)));
    return $Tables{&translate_id($table_id)}->{'Rows'};
}
###############################

=pod

=item &get_dbh()

Input: nothing

Returns: the database handler, or undef on error.

This routine allows the programmer to gain access to the database handler.
Be careful.

=cut

###############################
sub get_dbh { 
    return undef if (! defined(&connect_to_db()));
    return $dbh;
}

###############################

=pod

=item &get_error()

Inputs: none.

Returns: The last error reported.

=cut

###############################
sub get_error {
    return $errorstring;
}

###############################

=pod

=item &get_debug()

Inputs: none.

Returns: A string describing the internal state of the lonmysql package.

=cut

###############################
sub get_debug {
    return $debugstring;
}

###############################

=pod

=item &update_table_info()

Inputs: table id

Returns: undef on error, 1 on success.

&update_table_info updates the %Tables hash with current information about
the given table.  

The default MySQL table status fields are:

   Name             Type            Row_format
   Max_data_length  Index_length    Data_free
   Create_time      Update_time     Check_time
   Avg_row_length   Data_length     Comment 
   Rows             Auto_increment  Create_options

Additionally, "Col_order" is updated as well.

=cut

###############################
sub update_table_info { 
    my ($table_id) = @_;
    return undef if (! defined(&connect_to_db()));
    my $table_status = &check_table($table_id);
    return undef if (! defined($table_status));
    if (! $table_status) {
        $errorstring = "table $table_id does not exist.";
        return undef;
    }
    my $tablename = &translate_id($table_id);
    #
    # Get MySQLs table status information.
    #
    my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
    my $sth = $dbh->prepare($db_command);
    $sth->execute();
    if ($sth->err) {
        $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
            $sth->errstr;
        &disconnect_from_db();
        return undef;
    }
    my @column_name = @{$sth->{NAME}};
    #
    my @info=$sth->fetchrow_array;
    for (my $i=0;$i<= $#info ; $i++) {
        if ($column_name[$i] =~ /^(Create_|Update_|Check_)time$/) {
            $Tables{$tablename}->{$column_name[$i]}= 
                &unsqltime($info[$i]);
        } else {
            $Tables{$tablename}->{$column_name[$i]}= $info[$i];
        }
    }
    #
    # Determine the column order
    #
    $db_command = "DESCRIBE $tablename";
    $sth = $dbh->prepare($db_command);
    $sth->execute();
    if ($sth->err) {
        $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
            $sth->errstr;
        &disconnect_from_db();
        return undef;
    }
    my $aref=$sth->fetchall_arrayref;
    $Tables{$tablename}->{'Col_order'}=[]; # Clear values.
    # The values we want are the 'Field' entries, the first column.
    for (my $i=0;$i< @$aref ; $i++) {
        push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0];
    }
    #
    $debugstring = "Retrieved table info for $tablename";
    return 1;
}

###############################

=pod

=item &table_information()

Inputs: table id

Returns: hash with the table status

=cut

###############################
sub table_information {
    my $table_id=shift;
    if (&update_table_info($table_id)) {
	return %{$Tables{$table_id}};
    } else {
	return ();
    }
}

###############################

=pod

=item &col_order()

Inputs: table id

Returns: array with column order

=cut

###############################
sub col_order {
    my $table_id=shift;
    if (&update_table_info($table_id)) {
	return @{$Tables{$table_id}->{'Col_order'}};
    } else {
	return ();
    }
}

###############################

=pod

=item &create_table()

Inputs: 
    table description, see &build_table_creation_request
Returns:
    undef on error, table id on success.

=cut

###############################
sub create_table {
    return undef if (!defined(&connect_to_db($dbh)));
    my ($table_des)=@_;
    my ($request,$table_id) = &build_table_creation_request($table_des);
    #
    # Execute the request to create the table
    #############################################
    my $count = $dbh->do($request);
    if (! defined($count)) {
        $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
            $dbh->errstr();
        return undef;
    }
    my $tablename = &translate_id($table_id);
    delete($Tables{$tablename}) if (exists($Tables{$tablename}));
    return undef if (! defined(&update_table_info($table_id)));
    $debugstring = "Created table $tablename at time ".time.
        " with request\n$request";
    return $table_id;
}

###############################

=pod

=item build_table_creation_request

Input: table description

    table description = {
        permanent  => 'yes' or 'no',
        columns => [
                    { name         => 'colA',
                      type         => mysql type,
                      restrictions => 'NOT NULL' or empty,
                      primary_key  => 'yes' or empty,
                      auto_inc     => 'yes' or empty,
                  },
                    { name => 'colB',
                      ...
                  },
                    { name => 'colC',
                      ...
                  },
        ],
        'PRIMARY KEY' => (index_col_name,...),
         KEY => [{ name => 'idx_name', 
                  columns => (col1,col2,..),},],
         INDEX => [{ name => 'idx_name', 
                    columns => (col1,col2,..),},],
         UNIQUE => [{ index => 'yes',
                     name => 'idx_name',
                     columns => (col1,col2,..),},],
         FULLTEXT => [{ index => 'yes',
                       name => 'idx_name',
                       columns => (col1,col2,..),},],

    }

Returns: scalar string containing mysql commands to create the table

=cut

###############################
sub build_table_creation_request {
    my ($table_des)=@_;
    #
    # Build request to create table
    ##################################
    my @Columns;
    my $col_des;
    my $table_id;
    if (exists($table_des->{'id'})) {
        $table_id = $table_des->{'id'};
    } else {
        $table_id = &get_new_table_id();
    }
    my $tablename = &translate_id($table_id);
    my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
    foreach my $coldata (@{$table_des->{'columns'}}) {
        my $column = $coldata->{'name'};
        next if (! defined($column));
        $col_des = '';
        if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
            $col_des.=$column." ".$coldata->{'type'}."('".
                join("', '",@{$coldata->{'values'}})."')";
        } else {
            $col_des.=$column." ".$coldata->{'type'};
            if (exists($coldata->{'size'})) {
                $col_des.="(".$coldata->{'size'}.")";
            }
        }
        # Modifiers
        if (exists($coldata->{'restrictions'})){
            $col_des.=" ".$coldata->{'restrictions'};
        }
        if (exists($coldata->{'default'})) {
            $col_des.=" DEFAULT '".$coldata->{'default'}."'";
        }
        $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
                                        ($coldata->{'auto_inc'} eq 'yes'));
        $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
                                        ($coldata->{'primary_key'} eq 'yes'));
    } continue {
        # skip blank items.
        push (@Columns,$col_des) if ($col_des ne '');
    }
    if (exists($table_des->{'PRIMARY KEY'})) {
        push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})
              .')');
    }
    #
    foreach my $indextype ('KEY','INDEX') {
        next if (!exists($table_des->{$indextype}));
        foreach my $indexdescription (@{$table_des->{$indextype}}) {
            my $text = $indextype.' ';
            if (exists($indexdescription->{'name'})) {
                $text .=$indexdescription->{'name'};
            }
            $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
            push (@Columns,$text);
        }
    }
    #
    foreach my $indextype ('UNIQUE','FULLTEXT') {
        next if (! exists($table_des->{$indextype}));
        foreach my $indexdescription (@{$table_des->{$indextype}}) {
            my $text = $indextype.' ';
            if (exists($indexdescription->{'index'}) &&
                $indexdescription->{'index'} eq 'yes') {
                $text .= 'INDEX ';
            }
            if (exists($indexdescription->{'name'})) {
                $text .=$indexdescription->{'name'};
            }
            $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
            push (@Columns,$text);
        }
    }
    #
    $request .= "(".join(", ",@Columns).") ";
    unless($table_des->{'permanent'} eq 'yes') {
        $request.="COMMENT = 'temporary' ";
    } 
    $request .= "ENGINE=MYISAM";
    return $request,$table_id;
}

###############################

=pod

=item &get_table_prefix()

returns the cleaned version of user.name and user.domain for us in table names

=cut

###############################
sub get_table_prefix {
    my $clean_name   = $env{'user.name'};
    my $clean_domain = $env{'user.domain'};
    $clean_name =~ s/\W//g;
    $clean_domain =~ s/\W//g;
    return $clean_name.'_'.$clean_domain.'_';
}

###############################

=pod

=item &get_new_table_id()

Used internally to prevent table name collisions.

=cut

###############################
sub get_new_table_id {
    my $newid = 0;
    my @tables = &tables_in_db();
    my $prefix = &get_table_prefix();
    foreach (@tables) {
        if (/^\Q$prefix\E(\d+)$/) {
            $newid = $1 if ($1 > $newid);
        }
    }
    return ++$newid;
}

###############################

=pod

=item &get_rows()

Inputs: $table_id,$condition

Returns: undef on error, an array ref to (array of) results on success.

Internally, this function does a 'SELECT * FROM table WHERE $condition'.
$condition = 'id>0' will result in all rows where column 'id' has a value
greater than 0 being returned.

=cut

###############################
sub get_rows {
    my ($table_id,$condition) = @_;
    return undef if (! defined(&connect_to_db()));
    my $table_status = &check_table($table_id);
    return undef if (! defined($table_status));
    if (! $table_status) {
        $errorstring = "table $table_id does not exist.";
        return undef;
    }
    my $tablename = &translate_id($table_id);
    my $request;
    if (defined($condition) && $condition ne '') {
        $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
    } else {
        $request = 'SELECT * FROM '.$tablename;
        $condition = 'no condition';
    }
    my $sth=$dbh->prepare($request);
    $sth->execute();
    if ($sth->err) {
        $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
            $sth->errstr;
        $debugstring = "Failed to get rows matching $condition";
        return undef;
    }
    $debugstring = "Got rows matching $condition";
    my @Results = @{$sth->fetchall_arrayref};
    return @Results;
}

###############################

=pod

=item &store_row()

Inputs: table id, row data

returns undef on error, 1 on success.

=cut

###############################
sub store_row {
    my ($table_id,$rowdata) = @_;
    # 
    return undef if (! defined(&connect_to_db()));
    my $table_status = &check_table($table_id);
    return undef if (! defined($table_status));
    if (! $table_status) {
        $errorstring = "table $table_id does not exist.";
        return undef;
    }
    #
    my $tablename = &translate_id($table_id);
    #
    my $sth;
    if (exists($Tables{$tablename}->{'row_insert_sth'})) {
        $sth = $Tables{$tablename}->{'row_insert_sth'};
    } else {
        # Build the insert statement handler
        return undef if (! defined(&update_table_info($table_id)));
        my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
        foreach (@{$Tables{$tablename}->{'Col_order'}}) {
            $insert_request.="?,";
        }
        chop $insert_request;
        $insert_request.=")";
        $sth=$dbh->prepare($insert_request);
        $Tables{$tablename}->{'row_insert_sth'}=$sth;
    }
    my @Parameters; 
    if (ref($rowdata) eq 'ARRAY') {
        @Parameters = @$rowdata;
    } elsif (ref($rowdata) eq 'HASH') {
        foreach (@{$Tables{$tablename}->{'Col_order'}}) {
            push(@Parameters,$rowdata->{$_});
        }
    } 
    $sth->execute(@Parameters);
    if ($sth->err) {
        $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
            $sth->errstr;
        return undef;
    }
    $debugstring = "Stored row.";    
    return 1;
}


###############################

=pod

=item &bulk_store_rows()

Inputs: table id, [columns],[[row data1].[row data2],...]

returns undef on error, 1 on success.

=cut

###############################
sub bulk_store_rows {
    my ($table_id,$columns,$rows) = @_;
    # 
    return undef if (! defined(&connect_to_db()));
    my $dbh = &get_dbh();
    return undef if (! defined($dbh));
    my $table_status = &check_table($table_id);
    return undef if (! defined($table_status));
    if (! $table_status) {
        $errorstring = "table $table_id does not exist.";
        return undef;
    }
    #
    my $tablename = &translate_id($table_id);
    #
    my $request = 'INSERT IGNORE INTO '.$tablename.' ';
    if (defined($columns) && ref($columns) eq 'ARRAY') {
        $request .= join(',',@$columns).' ';
    }
    if (! defined($rows) || ref($rows) ne 'ARRAY') {
        $errorstring = "no input rows given.";
        return undef;
    }
    $request .= 'VALUES ';
    foreach my $row (@$rows) {
        # avoid doing row stuff here...
        $request .= '('.join(',',@$row).'),';
    }
    $request =~ s/,$//;
    # $debugstring = "Executed ".$/.$request; # commented out - this is big
    $dbh->do($request);
    if ($dbh->err) {
        $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr();
        return undef;
    }
    return 1;
}


###############################

=pod

=item &replace_row()

Inputs: table id, row data

returns undef on error, 1 on success.

Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'.

=cut

###############################
sub replace_row {
    my ($table_id,$rowdata) = @_;
    # 
    return undef if (! defined(&connect_to_db()));
    my $table_status = &check_table($table_id);
    return undef if (! defined($table_status));
    if (! $table_status) {
        $errorstring = "table $table_id does not exist.";
        return undef;
    }
    #
    my $tablename = &translate_id($table_id);
    #
    my $sth;
    if (exists($Tables{$tablename}->{'row_replace_sth'})) {
        $sth = $Tables{$tablename}->{'row_replace_sth'};
    } else {
        # Build the insert statement handler
        return undef if (! defined(&update_table_info($table_id)));
        my $replace_request = 'REPLACE INTO '.$tablename.' VALUES(';
        foreach (@{$Tables{$tablename}->{'Col_order'}}) {
            $replace_request.="?,";
        }
        chop $replace_request;
        $replace_request.=")";
        $sth=$dbh->prepare($replace_request);
        $Tables{$tablename}->{'row_replace_sth'}=$sth;
    }
    my @Parameters; 
    if (ref($rowdata) eq 'ARRAY') {
        @Parameters = @$rowdata;
    } elsif (ref($rowdata) eq 'HASH') {
        foreach (@{$Tables{$tablename}->{'Col_order'}}) {
            push(@Parameters,$rowdata->{$_});
        }
    } 
    $sth->execute(@Parameters);
    if ($sth->err) {
        $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n".
            $sth->errstr;
        return undef;
    }
    $debugstring = "Stored row.";    
    return 1;
}

###########################################

=pod

=item &tables_in_db()

Returns a list containing the names of all the tables in the database.
Returns undef on error.

=cut

###########################################

########## Show-Tables Cache
my $have_read_tables = 0;
my $dbh_sth;
##########

sub tables_in_db {
    return undef if (!defined(&connect_to_db()));
    
    ########## Show-Tables Cache
    if(!$have_read_tables) { 
     $dbh_sth=$dbh->prepare('SHOW TABLES');
     $have_read_tables = 1;
    }   
    $dbh_sth->execute();
    #$dbh_sth->execute(); # Removed strange execute - from release 119
    ##########    
    
    my $aref = $dbh_sth->fetchall_arrayref;
    if ($dbh_sth->err()) {
        $errorstring = 
            "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.
            "\nRESULTING ERROR:\n".$dbh_sth->errstr;
        return undef;
    }
    my @table_list;
    foreach (@$aref) {
        push(@table_list,$_->[0]);
    }
    $debugstring = "Got list of tables in DB: ".join(',',@table_list);
    return(@table_list);
}

###########################################

=pod

=item &translate_id()

Used internally to translate a numeric table id into a MySQL table name.
If the input $id contains non-numeric characters it is assumed to have 
already been translated.

Checks are NOT performed to see if the table actually exists.

=cut

###########################################
sub translate_id {
    my $id = shift;
    # id should be a digit.  If it is not a digit we assume the given id
    # is complete and does not need to be translated.
    return $id if ($id =~ /\D/);  
    return &get_table_prefix().$id;
}

###########################################

=pod

=item &check_table()

Input: table id

Checks to see if the requested table exists.  Returns 0 (no), 1 (yes), or 
undef (error).

=cut

###########################################
sub check_table {
    my $table_id = shift;
    return undef if (!defined(&connect_to_db()));
    #
    $table_id = &translate_id($table_id);
    my @Table_list = &tables_in_db();
    my $result = 0;
    foreach (@Table_list) {
        if ($_ eq $table_id) {
            $result = 1;
            last;
        }
    }
    # If it does not exist, make sure we do not have it listed in %Tables
    delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
    $debugstring = "check_table returned $result for $table_id";
    return $result;
}

###########################################

=pod

=item &remove_from_table()

Input: $table_id, $column, $value

Returns: the number of rows deleted.  undef on error.

Executes a "delete from $tableid where $column like binary '$value'".

=cut

###########################################
sub remove_from_table {
    my ($table_id,$column,$value) = @_;
    return undef if (!defined(&connect_to_db()));
    #
    $table_id = &translate_id($table_id);
    my $command = 'DELETE FROM '.$table_id.' WHERE '.$column.
        " LIKE BINARY ".$dbh->quote($value);
    my $sth = $dbh->prepare($command); 
    unless ($sth->execute()) {
        $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
        return undef;
    }
    $debugstring = $command;
    my $rows = $sth->rows;
    return $rows;
}

###########################################

=pod

=item drop_table($table_id)

Issues a 'drop table if exists' command

=cut

###########################################

sub drop_table {
    my ($table_id) = @_;
    return undef if (!defined(&connect_to_db()));
    #
    $table_id = &translate_id($table_id);
    my $command = 'DROP TABLE IF EXISTS '.$table_id;
    my $sth = $dbh->prepare($command); 
    $sth->execute();
    if ($sth->err) {
        $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
        return undef;
    }
    $debugstring = $command;
    delete($Tables{$table_id}); # remove any knowledge of the table
    return 1; # if we got here there was no error, so return a 'true' value
}

##########################################

=pod

=item fix_table_name 

Fixes a table name so that it will work with MySQL.

=cut

##########################################
sub fix_table_name {
    my ($name) = @_;
    $name =~ s/^(\d+[eE]\d+)/_$1/;
    $name =~ s/\W//g;
    return $name;
}


# ---------------------------- convert 'time' format into a datetime sql format
sub sqltime {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime(&unsqltime($_[0]));
    $mon++; $year+=1900;
    return "$year-$mon-$mday $hour:$min:$sec";
}

sub maketime {
    my %th=@_;
    return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
                          $th{'day'},$th{'month'}-1,
                          $th{'year'}-1900,0,0,$th{'dlsav'}));
}


#########################################
#
# Retro-fixing of un-backward-compatible time format

sub unsqltime {
    my $timestamp=shift;
    if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
        $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
                             'hours'=>$4,'minutes'=>$5,'seconds'=>$6,'dlsav'=>-1);
    }
    return $timestamp;
}


1;

__END__;

=pod

=back

=cut