#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::DB::MySQL;

use strict;

use IT::Globals;
use IT::DB::Globals;

# library globals
our $MINIMUM_DBI_VERSION_REQUIRED       = 1.32;        # DBI v1.32 released December 1st, 2002
our $MINIMUM_DBD_MYSQL_VERSION_REQUIRED = 2.1021;      # DBD::Mysql v2.1021 released January 21st, 2003
our $MINIMUM_MYSQL_VERSION_REQUIRED     = '3.23.42';   # mySQL v3.23.42 released September 18th, 2001

our %VALID_WHERE_OPERATORS = map { $_ => 1 } (
    '=', '<=', '>=', '<', '>', '!=', '=F',
    'LIKE', 'NOT LIKE', 'BETWEEN', 'NOT BETWEEN', 'IN', 'NOT IN'
  );

our $CACHED_DBH_BY_CONNECTION_NAME = {};

# NOTE: Older versions of DBI, DBD, or mySQL may work, but haven't been tested.

# ------------------------------------------------------------------------
# Function    : connectIfNeeded
# Description : Initialize DBD module if not already done, then connect
#               to database and return $dbh
# Usage       : my $dbh = &IT::DB::MySQL::connectIfNeeded($connectionName);
# Usage       : my $dbh = &IT::DB::MySQL::connectIfNeeded();
# ------------------------------------------------------------------------

sub connectIfNeeded {
  my $connectionName  = shift || $CURRENT_CONNECTION_NAME;

  if ($CACHED_DBH_BY_CONNECTION_NAME->{$connectionName}) {
    return $CACHED_DBH_BY_CONNECTION_NAME->{$connectionName};
  }

  ### Load DBI/DBD modules
  &_loadModule('DBI',        $MINIMUM_DBI_VERSION_REQUIRED);
  &_loadModule('DBD::mysql', $MINIMUM_DBD_MYSQL_VERSION_REQUIRED);

  ### Create connection string
  my($database, $hostname, $port, $mysqlcompression) = &IT::DB::Schema::getConnectionAttributes($connectionName, 'database', 'hostname', 'port', 'mysqlcompression');
  my $connectString = "dbi:mysql:database=$database;host=$hostname";
  $connectString   .= ";port=$port"         if $port;
  $connectString   .= ";mysqlcompression=1" if $mysqlcompression;

  ### Connect to database
  my($username, $password) = &IT::DB::Schema::getConnectionAttributes($connectionName, 'username', 'password');
  my $dbh = DBI->connect($connectString, $username, $password, {
    'PrintError' => 0,   # disable error checking so we can do it manually below and control the error message displayed
    'RaiseError' => 0,   # disable error checking so we can do it manually below and control the error message displayed
  });
  unless ($dbh) {
    die "Program was unable to connect to the MySQL database '$database' on '$hostname'.\nThe reason given was: $DBI::errstr\n";
  }

  # die on DBI/DBD errors
  $dbh->{'PrintError'} = 0; # warn on DBI errors (disabled)
  $dbh->{'RaiseError'} = 1; # die on DBI errors (enabled)

  ### check mySQL version
  my $resultRow    = $dbh->selectrow_arrayref("SHOW VARIABLES LIKE 'version'");
  my $mySQLVersion = $resultRow->[1];
  $mySQLVersion =~ s/[^0-9\.]//g;  # remove non-numeric chars from strings such as "4.0.18-nt"

  # convert version numbers (1.2.3) to decimals for comparison on older perls that don't support that number format
  my $mySQLVersionAsDecimal = sprintf "%d%04d%04d", split /\./, $mySQLVersion;
  my $minVersionAsDecimal   = sprintf "%d%04d%04d", split /\./, $MINIMUM_MYSQL_VERSION_REQUIRED;
  my $version5AsDecimal     = sprintf "%d%04d%04d", split /\./, '5.0.0';

  # compare versions
  if ($mySQLVersionAsDecimal < $minVersionAsDecimal) {
    die "This program requires mySQL v$MINIMUM_MYSQL_VERSION_REQUIRED or newer. "
       ."This server has v$mySQLVersion installed. Please ask your server administrator "
       ."to install mySQL v$MINIMUM_MYSQL_VERSION_REQUIRED or newer.\n";
  }

  # disable strict mode for mysql 5.0
  # http://dev.mysql.com/doc/refman/5.0/en/server-sql-mode.html
  if ($mySQLVersionAsDecimal >= $version5AsDecimal) {
    $dbh->do("SET SESSION sql_mode=''");
  }

  # cache connection
  $CACHED_DBH_BY_CONNECTION_NAME->{$connectionName} = $dbh;

  # Return DBH handle
  return $dbh;
}


# ------------------------------------------------------------------------
# Function    : _loadModule
# Description : require a module, checking for a minimum required version number
# Usage       : &_loadModule('DBD::mysql', 1.23);
# ------------------------------------------------------------------------

sub _loadModule {
  my ($moduleName, $requiredVersion) = @_;
  &IT::Error::dieOnValidationErrors( ["\$moduleName", $moduleName, "notBlank notRef"],
                          ["\$requiredVersion", $requiredVersion, "notBlank notRef"]);

  ### Include the module's code
  my $moduleFilename =  "$moduleName.pm";
  $moduleFilename    =~ s|::|/|g;
  eval { require $moduleFilename; };
  if ($@) { die("Unable to load the $moduleName Perl module.  Please ask your server administrator to install the Perl module $moduleName, version $requiredVersion or newer.\n\n$@"); }

  ### Check for an appropriate version
  my $installedVersion = eval "\$$moduleName\::VERSION";
  if ($installedVersion < $requiredVersion) {
    die("Program requires at least version $requiredVersion of $moduleName to work with this type of database.  The version installed on this server is $installedVersion  Please ask your server administrator to install the Perl module $moduleName, version $requiredVersion or newer.");
  }
}


# ------------------------------------------------------------------------
# Function    : _buildWhereString
# Usage       : my $where_string = &_buildWhereString($tbl, $where_tree);
# ------------------------------------------------------------------------

sub _buildWhereString {
  my ($tableNames, $whereQuery) = @_;
  &IT::Error::dieOnValidationErrors(
    ["\$tableNames",  $tableNames,  "notBlank notRef"],
    ["\$whereQuery", $whereQuery, "notRef"],
  );

  my $whereTree = &IT::DB::WhereParser::createWhereTree($tableNames, $whereQuery);
  unless (@$whereTree) { return ''; }

  my $SQLwhereString = &__createWhereSQL($tableNames, $whereTree);

  return "WHERE $SQLwhereString";
}

# ------------------------------------------------------------------------------
# Function    : __createWhereSQL
# Description :
# Usage       : my $whereSQL = &__createWhereSQL($tableNames, $whereTree);
# ------------------------------------------------------------------------------

sub __createWhereSQL {
  my $tableNames = shift || die "no tableNames specified!";
  my $node = shift;

  ### Recurse for AND, OR, and NOT node_types
  my $nodeType = $node->[0];
  my $isAND    = $nodeType eq 'AND';
  my $isOR     = $nodeType eq 'OR';
  my $isNOT    = $nodeType eq 'NOT';
  if ($isAND || $isOR || $isNOT) {
    my $expr1 = &__createWhereSQL($tableNames, $node->[1]);
    my $expr2 = &__createWhereSQL($tableNames, $node->[2]) if ($isAND || $isOR);

    # create sql
    my $sql;
    if    ($isAND) { $sql = "($expr1 AND $expr2)"; }
    elsif ($isOR)  { $sql = "($expr1 OR $expr2)"; }
    elsif ($isNOT) { $sql = "NOT($expr1)"; }
    else           { die "unknown operator '$nodeType')!"; }
    return $sql;
  }
  elsif ($nodeType ne 'TEST') {  die ("unknown tree node_type ($nodeType)"); }


  ### process "TEST" nodes (these all have a $nodeType of 'TEST' or we die in the line above)
  my ($fieldName, $operator, $unsafeUnquotedValue) = @$node[1, 2, 3];

  if ($operator eq 'BETWEEN' || $operator eq 'NOT BETWEEN') {
    my ($min, $max) = sort { $a <=> $b } map { int } @$unsafeUnquotedValue;
    return "$fieldName $operator $min AND $max";
  }
  elsif ($operator eq 'IN' || $operator eq 'NOT IN') {
    my @safeQuotedValues     = map { &_getSingleQuotedStringAndEscapeUnescapedMetaChars($_) } @$unsafeUnquotedValue;
    my $safeQuotedValuesList = join ', ', @safeQuotedValues;
    return "$fieldName $operator ($safeQuotedValuesList)";
  }
  elsif (uc $operator eq '=F') {  # compare fields
    my($tableName, $secondFieldName) = eval { &IT::DB::Common::getOriginalTableAndFieldname($tableNames, $unsafeUnquotedValue); };
    if ($secondFieldName && &IT::DB::Schema::existsField($tableName, $secondFieldName)) {
      return "$fieldName = $unsafeUnquotedValue";
    }
    else {
      die "Unknown field '$unsafeUnquotedValue'!\n";
    }
  }
  elsif ($VALID_WHERE_OPERATORS{$operator}) {
    my $safeQuotedValue = &_getSingleQuotedStringAndEscapeUnescapedMetaChars($unsafeUnquotedValue);
    return "$fieldName $operator $safeQuotedValue";
  }
  else { die "Unknown operator '$operator'!"; }
};

# ------------------------------------------------------------------------
# Function    : _buildUpdateString
# Usage       : my $update_string = &_buildUpdateString($tbl, $update);
# ------------------------------------------------------------------------

sub _buildUpdateString {
  my ($tableName, $updateArray) = @_;
  &IT::Error::dieOnValidationErrors(
    ["\$tableName", $tableName, "notBlank notref"],
    ["\$updateArray", $updateArray, "notBlank arrayRef"],
  );

  my @updateStrings;

  foreach my $command (@$updateArray) {
    my ($fieldName, $operator, $unsafeUnescapedValue) = @$command;
    $operator = uc $operator;
    my $safeQuotedValue = &_getSingleQuotedStringWithEscapedMetaChars($unsafeUnescapedValue);


    if    ($operator eq '=F') { push @updateStrings, "$fieldName = $unsafeUnescapedValue"; } # don't quote fieldname, valid fieldname checking for =F is done in IT::DB::_update_errorChecking
    elsif ($operator eq '+=') { push @updateStrings, "$fieldName = $fieldName + $safeQuotedValue"; }
    elsif ($operator eq '-=') { push @updateStrings, "$fieldName = $fieldName - $safeQuotedValue"; }
    elsif ($operator eq '=')  { push @updateStrings, "$fieldName = $safeQuotedValue"; }
    else                      { die "Unknown operator '$operator'!"; }
  }

  my $SQLupdateString = "SET " . join(', ', @updateStrings);
  return $SQLupdateString;

}

# ------------------------------------------------------------------------
# Function    : _buildGroupByString
# Usage       : my $groupBystring = &_buildGroupByString($self->{'groupBy'});
# Note        : valid characters are checked through &IT::DB::Common::dieOnInvalidGroupBy()
# ------------------------------------------------------------------------

sub _buildGroupByString {
  my ($groupByFieldsArray) = @_;
  &IT::Error::dieOnValidationErrors( ["\$groupByFieldsArray", $groupByFieldsArray, "allowBlank arrayRef"] );

  # skip if no sort order specified
  if (!$groupByFieldsArray) { return ''; }

  my $groupByString = "GROUP BY " . join(", ", @$groupByFieldsArray);
  return $groupByString;
}

# ------------------------------------------------------------------------
# Function    : buildSortString
# Usage       : my $sqlOrderBy = &IT::DB::MySQL::buildSortString($args->{'sortBy'});
# Note        : valid characters are checked through &IT::DB::Common::dieOnInvalidSortBy()
# ------------------------------------------------------------------------

sub buildSortString {
  my ($sortBy) = @_;
  &IT::Error::dieOnValidationErrors( ["\$sortBy", $sortBy, "allowBlank arrayRef"] );

  # skip if no sort order specified
  if (!$sortBy) { return ''; }

  my @orderByFields;

  foreach my $sortField (@$sortBy) {
    $sortField =~ /^(-?)(.*)/;
    my $reverseOrder = $1;
    my $fieldName    = $2;

    my $ascendingOrDescending = ($reverseOrder) ? "DESC" : "ASC";
    push @orderByFields, "$fieldName $ascendingOrDescending";
  }

  my $SQLorderByString = "ORDER BY " . join(', ', @orderByFields);
  return $SQLorderByString;
}

# ------------------------------------------------------------------------
# Function    : _buildLimitString
# Usage       : my $limit_string = &_buildLimitString($args->{'limit'});
# Note        : valid characters are checked through &IT::DB::Common::dieOnInvalidLimit()
# ------------------------------------------------------------------------

sub _buildLimitString {
  my($limitArgs) = @_;
  &IT::Error::dieOnValidationErrors( ["\$limitArgs", $limitArgs, "allowBlank arrayRef"] );

  # skip if no limit
  if (!$limitArgs) { return ''; }

  # create SQL string
  my ($start, $length) = @$limitArgs;
  my $SQLlimitString = "LIMIT $start, $length";
  return $SQLlimitString;
}

# ------------------------------------------------------------------------
# Function    : _getSingleQuotedStringWithEscapedMetaChars
# Description : Encode a value (quote metachars) for use in an SQL query
# Usage       : $quoteValue = &_getSingleQuotedStringWithEscapedMetaChars($unsafeUnescapedValue);
# ------------------------------------------------------------------------

sub _getSingleQuotedStringWithEscapedMetaChars {
  my $value = shift;

  # NOTE:  We are not escaping the wildchar characters % and _.  If you want
  # to do that you have to do it manually in the application code.

  # Reference: http://dev.mysql.com/doc/mysql/en/string-syntax.html
  my $escapedAndQuotedValue = $value;
  $escapedAndQuotedValue =~ s/\\/\\\\/g;                # escape escape chars
  $escapedAndQuotedValue =~ s/'/\\'/g;                  # escape quote char
  $escapedAndQuotedValue =~ s/\x00/\\0/g;               # null byte \0
  $escapedAndQuotedValue = "'$escapedAndQuotedValue'";  # single quote entire string

  return $escapedAndQuotedValue;
}
# ------------------------------------------------------------------------
# Function    : _getSingleQuotedStringAndEscapeUnescapedMetaChars
# Description : Escaped metachars that aren't already escaped already!
# Usage       : $quoteValue = &_getSingleQuotedStringAndEscapeUnescapedMetaChars($unsafeUnescapedValue);
# ------------------------------------------------------------------------

sub _getSingleQuotedStringAndEscapeUnescapedMetaChars {
  my $value = shift;

  # NOTE:  We are not escaping the wildchar characters % and _.  If you want
  # to do that you have to do it manually in the application code.

  # Reference: http://dev.mysql.com/doc/mysql/en/string-syntax.html
  my $escapedAndQuotedValue = $value;
  $escapedAndQuotedValue   =~ s/(?<!\134)((\134\134)*)\134(?![\\'"%_\x00])/$1\134\134/g;  # escape unescaped slash
  $escapedAndQuotedValue   =~ s/(?<!\134)((\134\134)*)'/$1\134'/g;                       # escape unescaped single-quote
  $escapedAndQuotedValue   =~ s/(?<!\134)((\134\134)*)"/$1\134"/g;                       # escape unescaped double-quote
  $escapedAndQuotedValue   =~ s/(?<!\134)((\134\134)*)\x00/$1\134\x00/g;                 # escape unescaped null-byte
  $escapedAndQuotedValue   = "'$escapedAndQuotedValue'";  # single quote entire string

  return $escapedAndQuotedValue;
}

# ------------------------------------------------------------------------
# Function    : _execute
# Description : A common interface to the DBI module.  Use this instead of
#               raw DBI calls so that SQL queries can be logged.
# Note        : This sub can accept a $tbl or a $conn as the first argument
# Usage       : my ($return_value, $sth) = &_execute($tbl, $sql);
# Usage       : my $sth = &_execute($tbl, $sql);
# Usage       : &_execute($tbl, $sql) || die("Could not perform query");
# Usage       : my $rowsAffected        = &_execute($connectionName, $sqlQuery);
# Usage       : my($rowsAffected, $sth) = &IT::DB::MySQL::_execute($connectionName, $sqlQuery);
# ------------------------------------------------------------------------

sub _execute {
  my ($connectionName, $sqlQuery) = @_;
  &IT::Error::dieOnValidationErrors(
    ["\$connectionName", $connectionName, "notBlank notref"],
    ["\$sqlQuery", $sqlQuery, "notBlank notRef"],
  );

#  $IT::DB::MySQL::DEBUG_CONTENT_HEADER++;
#  print "Content-type: text/html\n\n" unless $IT::DB::MySQL::DEBUG_CONTENT_HEADER > 1;
#  print "<xmp>SQL QUERY: $sqlQuery</xmp>\n";

  # connect to database
  my $dbh = &connectIfNeeded($connectionName) || die "Not connected to database!";

  # execute query
  my $sth          = $dbh->prepare($sqlQuery);
  my $rowsAffected = eval { int $sth->execute(); }; # returns 0E0 for 0, true for SELECT, and rowsAffected for everything else
  if ($rowsAffected == -1) { die "Unable to determine the number of rows affected!"; }
  if ($@) { die "$@"; }


  # return values
  if (wantarray) { return ($rowsAffected, $sth); }
  else           { return $rowsAffected; }
}

# ------------------------------------------------------------------------------
# Function    :
# Description :
# Usage       :
# ------------------------------------------------------------------------------

sub select2 {
  my $self = shift || die;
  if (ref $self !~ /^IT::DB/) { die "self isn't an object!", ref $self; }

  ### re-bless object into this package
  my $package = "IT::DB::MySQL";
  bless $self, $package;

  # get fieldnames
  my @fieldNames;
  my $tableNamesAndAliases = &IT::DB::Common::getTableNamesAndAliases($self->{'tableNames'});
  foreach my $row (@$tableNamesAndAliases) {
    my($tableName, $tableAlias) = @$row;
    foreach my $fieldName (&IT::DB::Schema::getFieldNames($tableName)) {
      push @fieldNames, "$tableName.$fieldName AS '$tableAlias.$fieldName'";
    }
  }
  my $fieldNameList    = join ', ', @fieldNames;

  # Construct SQL query
  my $expr     = "";
  my $where    = &_buildWhereString($self->{'tableNames'}, $self->{'where'});
  my $groupBy  = &_buildGroupByString($self->{'groupBy'});
  my $orderBy  = &buildSortString($self->{'sortBy'});
  my $limit    = &_buildLimitString($self->{'limit'});

  # replace table aliases with full table names in query
  foreach my $row (@$tableNamesAndAliases) {
    my($tableName, $tableAlias) = @$row;
    $where   =~ s/$tableAlias\./$tableName./gs;
    $groupBy =~ s/$tableAlias\./$tableName./gs;
    $orderBy =~ s/$tableAlias\./$tableName./gs;
  }

  #
  my $sqlQuery = "SELECT $fieldNameList FROM $self->{'tableNames'} $where $groupBy $orderBy $limit";

  ### execute query
  my $listedRecordCount = 0;
  my($rowsAffected, $sth) = &_execute($self->{'connectionName'}, $sqlQuery);  # $rowsAffected is always true for SELECT statements

  ### Update object
  $self->{'sth'}        = $sth;
  $self->{'fieldNames'} = \@fieldNames;

  #
  return $self

}

# ------------------------------------------------------------------------------
# Function    :
# Description :
# Usage       :
# ------------------------------------------------------------------------------

sub fetchrow_hashref {
  my $self = shift;
  my $no_fieldname_prefixes = shift;
  if ($no_fieldname_prefixes && $no_fieldname_prefixes ne "NO_FIELDNAME_PREFIXES") { die "no_fieldname_prefixes must be '' or 'NO_FIELDNAME_PREFIXES'!"; }

  # error checking
  my $thisPackage = __PACKAGE__;
  my $objPackage  = ref $self;
  if (!ref $self)                  { die "Function can only be called as an object method."; }
  if ($objPackage ne $thisPackage) { die "Method can only be called by $thisPackage objects, not $objPackage objects!"; }

  # get next row
  my $row = $self->{'sth'}->fetchrow_hashref();
  if (!$row) { return; }

  # remove fieldName prefixes
  if ($no_fieldname_prefixes) {
    my $newRow = {};
    foreach my $prefixedFieldname (keys %$row) {
      my $fieldName = $prefixedFieldname;
      $fieldName =~ s/^[^\.]+\.//;  # remove fieldname prefix
      $newRow->{$fieldName} = $row->{$prefixedFieldname};
    }
    $row = $newRow;
  }

  # return as hashref
  return $row;

}

# ------------------------------------------------------------------------
# Function    : list
# Usage       : called from DB_List
# ------------------------------------------------------------------------

sub list {
  my($connectionName, $args) = @_;
  my($tableName, $whereQuery, $sortBy, $limit, $rowcode) = @$args{'tableName', 'whereQuery', 'sortBy', 'limit', 'rowcode'}; # hash slice
  ### Argument error checking done in IT::DB

  ### Construct SQL query
  my $sqlWhereString = &_buildWhereString($tableName, $whereQuery);
  my $sortOrder      = $sortBy || &IT::DB::Schema::getTableAttributes($tableName, 'defaultSort');
  my $sqlSortString  = &buildSortString($sortOrder);
  my $sqlLimitString = &_buildLimitString($limit);
  my @fieldNames     = &IT::DB::Schema::getFieldNames($tableName);
  my $fieldNameList  = join ', ', @fieldNames;
  my $sqlQuery       = "SELECT $fieldNameList FROM $tableName $sqlWhereString $sqlSortString $sqlLimitString";


  ### execute rowcode for each matching record
  my $listedRecordCount = 0;
  my($rowsAffected, $sth) = &_execute($connectionName, $sqlQuery);  # $rowsAffected is always true for SELECT statements
  while (my $fieldValues = $sth->fetchrow_arrayref()) {

    my %record = map { $fieldNames[$_] => $fieldValues->[$_] } (0..$#fieldNames);
    $ACTIVE_LIST_QUERY = 1;              # prevent other db functions that might recursively call this function from being called from rowcode
    &{$rowcode}(\%record);
    $ACTIVE_LIST_QUERY = 0;

    $listedRecordCount++;
    last if $LIST_STOP;                   # skip remaining records if liststop has been called
    &IT::FileLock::renewLockTimeout();
  }
  $LIST_STOP = 0;

  # return records listed
  return $listedRecordCount;
}

# ------------------------------------------------------------------------
# Function    : listSaveSlow
# Description : List a few records at a time, queuing updates and deletes
# Usage       : called from DB_listSaveSlow
# ------------------------------------------------------------------------

sub listSaveSlow {
  my($connectionName, $args) = @_;
  my($tableName, $whereQuery, $sortBy, $limit, $rowcode) = @$args{'tableName', 'whereQuery', 'sortBy', 'limit', 'rowcode'}; # hash slice
  ### Argument error checking done in IT::DB

  ### Construct SQL query
  my $sqlWhereString = &_buildWhereString($tableName, $whereQuery);
  my $sortOrder      = $sortBy || &IT::DB::Schema::getTableAttributes($tableName, 'defaultSort');
  my $sqlSortString  = &buildSortString($sortOrder);
  my $sqlLimitString = &_buildLimitString($limit);
  my @fieldNames     = &IT::DB::Schema::getFieldNames($tableName);
  my $fieldNameList  = join ', ', @fieldNames;
  my $sqlQuery       = "SELECT $fieldNameList FROM $tableName $sqlWhereString $sqlSortString $sqlLimitString";



  ### Execute rowcode for each record
  my $autoSequencing      = &IT::DB::Schema::getTableAttributes($tableName, 'autoSequencing');
  my($rowsAffected, $sth) = &_execute($connectionName, $sqlQuery);  # $rowsAffected is always true for SELECT statements
  my $changedRecordCount = 0;

  while (my $fieldValues = $sth->fetchrow_arrayref()) {
    last if $LIST_STOP;                   # skip remaining records if liststop has been called
    &IT::FileLock::renewLockTimeout();

    my %record         = map { $fieldNames[$_] => $fieldValues->[$_] } (0..$#fieldNames);
    my %originalRecord = %record;        # copy record for detecting changes below
    $ACTIVE_LIST_QUERY = 1;              # prevent other db functions that might recursively call this function from being called from rowcode
    &{$rowcode}(\%record);
    $ACTIVE_LIST_QUERY = 0;

    # erase records with num removed
    if (!$record{'num'}) {
      $changedRecordCount += &IT::DB::delete($tableName, "num = $originalRecord{'num'}");
      next;
    }

    # check if num field was changed with autoSequencing on
    my $numChanged   = $record{'num'} && $originalRecord{'num'} != $record{'num'};  # don't count erased num as changed
    if ($autoSequencing && $numChanged) { die "can't change 'num' field when 'autoSequencing' is enabled"; }

    # error check new field values
    my @changedFields = grep { $originalRecord{$_} ne $record{$_} } keys %originalRecord;
    foreach my $fieldname (@changedFields) {
      &IT::DB::Common::dieOnValueSizeAndTypeErrors($tableName, $fieldname, $record{$fieldname});
    }

    # update record with new field values
    if (@changedFields) {
      my @updateArray      = map { [$_, '=', $record{$_}] } @changedFields;
      $changedRecordCount += &IT::DB::update($tableName, "num = $record{'num'}", \@updateArray);
    }
  }
  $LIST_STOP = 0;

  ### Return the number of records changed
  return $changedRecordCount;

}

# ------------------------------------------------------------------------
# Function    : update
# Usage       : called from DB_Update
# ------------------------------------------------------------------------

sub update {
  my($connectionName, $tableName, $whereString, $update) = @_;
  ### Argument error checking done in IT::DB

  # build sql query
  my $sqlWhereString  = &_buildWhereString($tableName, $whereString);
  my $sqlUpdateString = &_buildUpdateString($tableName, $update);
  my $sqlQuery        = "UPDATE $tableName $sqlUpdateString $sqlWhereString";

  # execute sql query
  my $updatedRecordCount = &_execute($connectionName, $sqlQuery);

  return $updatedRecordCount;
}

# ------------------------------------------------------------------------
# Function    : insert
# Usage       : called from DB_Insert
# ------------------------------------------------------------------------

sub insert {
  my ($connectionName, $tableName, $recordList) = @_;
  ### Argument error checking done in IT::DB

  # get list of fields to insert
  my @fieldNames     = &IT::DB::Schema::getFieldNames($tableName);
  my $autoSequencing = &IT::DB::Schema::getTableAttributes($tableName, 'autoSequencing');
  if ($autoSequencing) { shift @fieldNames; }     # remove 'num' field
  my $fieldNameList  = join(', ', @fieldNames);

  # Insert records
  my $newRecordCount = 0;
  foreach my $record (@$recordList) {

    # build sql statement
    my @safeQuotedValues     = map { &_getSingleQuotedStringWithEscapedMetaChars($record->{$_}) } @fieldNames;
    my $safeQuotedValuesList = join(", ", @safeQuotedValues);
    my $sqlQuery             = "INSERT INTO $tableName ( $fieldNameList ) VALUES ( $safeQuotedValuesList )";

    # execute query
    $newRecordCount += &_execute($connectionName, $sqlQuery);

    # autosequencing - set assigned 'num' value in record reference for caller
    if ($autoSequencing) {
      $record->{'num'} = &IT::DB::getSequence($tableName);
    }
  }

  # Return how many records were inserted
  return $newRecordCount;
}

# ------------------------------------------------------------------------
# Function    : count
# Usage       : called from DB_Count
# ------------------------------------------------------------------------

sub count {
  my ($connectionName, $tableName, $whereQuery) = @_;
  ### Argument error checking done in IT::DB

  # build sql query
  my $sqlWhereString  = &_buildWhereString($tableName, $whereQuery);
  my $sqlQuery        = "SELECT count(1) FROM $tableName $sqlWhereString";

  # execute query
  my ($rowsAffected, $statementHandler) = &_execute($connectionName, $sqlQuery);

  # get result
  my $resultRow   = $statementHandler->fetchrow_arrayref();
  my $recordCount = $resultRow->[0];  # first (and only) column is the count result

  # Return the number of records
  return $recordCount;
}

# ------------------------------------------------------------------------
# Function    : delete
# Usage       : called from DB_Delete
# ------------------------------------------------------------------------

sub delete {
  my ($connectionName, $tableName, $whereQuery) = @_;
  ### Argument error checking done in IT::DB

  # build query
  my $sqlWhereString = &_buildWhereString($tableName, $whereQuery);
  my $sqlQuery       = "DELETE FROM $tableName $sqlWhereString";

  # execute query
  my $deletedRecords = &_execute($connectionName, $sqlQuery);

  return $deletedRecords;
}

# ------------------------------------------------------------------------
# Function    : getSequence
# Description :
# Usage       : called from DB_SQL_GetSequence
# ------------------------------------------------------------------------

sub getSequence {
  my ($connectionName, $tableName) = @_;
  &IT::Error::dieOnValidationErrors( ["\$tableName", $tableName, "notBlank notRef"] );

  my $sqlQuery            = "SHOW TABLE STATUS LIKE '$tableName'";
  my ($returnValue, $sth) = &IT::DB::MySQL::_execute($connectionName, $sqlQuery);

  my $tableValues = $sth->fetchrow_hashref('NAME_lc');
  my $sequenceNum = $tableValues->{'auto_increment'};
  $sequenceNum--;   # MySQL sequence numbers are one less than the next 'num' that will be assigned

  return $sequenceNum;
}

# ------------------------------------------------------------------------
# Function    : setSequence
# Usage       : called from DB_SQL_SetSequence
# ------------------------------------------------------------------------

sub setSequence {
  my ($connectionName, $tableName, $sequenceNum) = @_;
  &IT::Error::dieOnValidationErrors(
    ["\$tableName",   $tableName,   "notBlank notRef"],
    ["\$sequenceNum", $sequenceNum, "allowBlank notRef"],
  );

  # create SQL query
  $sequenceNum++; # MySQL sequence numbers are one less than the next 'num' that will be assigned
  my $sqlQuery = "ALTER TABLE $tableName AUTO_INCREMENT = $sequenceNum";

  # execute query
  &IT::DB::MySQL::_execute($connectionName, $sqlQuery);

}

# ----------------------------------------------------------------------------
# Function    : createField
# Description : create a new field in the datastore
# Usage       : &IT::DB::MySQL::createField($tableName, $fieldName, $fieldType);
# ----------------------------------------------------------------------------

sub createField {
  my($tableName, $fieldName, $fieldType) = @_;
  ### Argument error checking done in IT::DB

  # create query
  my $newSQLfieldType = $DB_TYPE_TO_MYSQL_TYPE{ $fieldType } || die "unknown field type '$fieldType'!";
  my $sqlQuery        = "ALTER TABLE $tableName ADD $fieldName $newSQLfieldType";

  # execute query
  my $connectionName = &IT::DB::Schema::getTableAttributes($tableName, 'connectionName');
  &IT::DB::MySQL::_execute($connectionName, $sqlQuery);

}

# ----------------------------------------------------------------------------
# Function    : dropField
# Description : drop a field from the datastore
# Usage       : &IT::DB::MySQL::dropField($tableName, $fieldName, $fieldType);
# ----------------------------------------------------------------------------

sub dropField {
  my($tableName, $fieldName) = @_;
  ### Argument error checking done in IT::DB

  # create query
  my $sqlQuery        = "ALTER TABLE $tableName DROP $fieldName";

  # execute query
  my $connectionName = &IT::DB::Schema::getTableAttributes($tableName, 'connectionName');
  &IT::DB::MySQL::_execute($connectionName, $sqlQuery);

}

# ----------------------------------------------------------------------------
# Function    : changeFieldNameAndType
# Description : change a field name and type in the database, dies on errors
# Usage       : &IT::DB::MySQL::changeFieldNameAndType($tableName, $oldFieldName, $newFieldName, $newFieldType);
# ----------------------------------------------------------------------------

sub changeFieldNameAndType {
  my($tableName, $oldFieldName, $newFieldName, $newFieldType) = @_;
  ### Argument error checking done in IT::DB

  # create query
  my $newSQLfieldType = $DB_TYPE_TO_MYSQL_TYPE{ $newFieldType } || die "unknown field type '$newFieldType'!";
  my $sqlQuery        = "ALTER TABLE $tableName CHANGE $oldFieldName $newFieldName $newSQLfieldType";

  # execute query
  my $connectionName = &IT::DB::Schema::getTableAttributes($tableName, 'connectionName');
  &IT::DB::MySQL::_execute($connectionName, $sqlQuery);
}

# ------------------------------------------------------------------------
# Function    : listTables
# Usage       : called from DB_SQL_listTables
# ------------------------------------------------------------------------

sub listTables {
  my ($connectionName) = @_;
  ### Argument error checking done in IT::DB

  my $sqlQuery                         = 'SHOW TABLES';
  my ($returnValue, $statementHandler) = &IT::DB::MySQL::_execute($connectionName, $sqlQuery);

  my @tables;
  while (my $resultRow = $statementHandler->fetchrow_arrayref()) {
    my $tableName = $resultRow->[0];
    push @tables, $tableName;
  }

  return @tables;
}

# ------------------------------------------------------------------------
# Function    : createTable
# Usage       : called from DB_createTable
# ------------------------------------------------------------------------

sub createTable {
  my ($connectionName, $tableName, $fieldDefs) = @_;
  ### Argument error checking done in IT::DB

  ### Create Query
  my @createTableFields;
  foreach my $fieldDef (@$fieldDefs) {

    # provide type information for first field
    if ($fieldDef->{'name'} eq 'num') {
      push @createTableFields, 'num INT AUTO_INCREMENT PRIMARY KEY';
      next;
    };

    # get SQL field type for fields
    my $sqlType = $DB_TYPE_TO_MYSQL_TYPE{ $fieldDef->{'type'} } || die "createTable: unrecognized field type: $fieldDef->{'type'}";

    # add index
    my $index = $fieldDef->{'index'} ? ", INDEX $fieldDef->{'name'}_idx($fieldDef->{'name'})" : "";
    push @createTableFields, "$fieldDef->{'name'} $sqlType$index";
  }

  my $sqlFieldsList  = join(', ', @createTableFields);
  my $sqlQuery       = "CREATE TABLE $tableName ($sqlFieldsList) ENGINE = MYISAM";

  ### execute query
  &IT::DB::MySQL::_execute($connectionName, $sqlQuery);

  return;
}

# ------------------------------------------------------------------------
# Function    : describeTable
# Usage       : called from DB_SQL_describeTable
# ------------------------------------------------------------------------

sub describeTable {
  my($connectionName, $tableName) = @_;
  ### Argument error checking done in IT::DB

  # create query
  my $sqlQuery      = "DESC $tableName";
  my ($returnValue, $sth) = &IT::DB::MySQL::_execute($connectionName, $sqlQuery);

  # execute query
  my $fieldDefs = [];
  while (my $resultRow = $sth->fetchrow_hashref('NAME_lc')) {                # fetch repeatedly

    # get field name
    my $fieldDef = {};
    $fieldDef->{'name'} = $resultRow->{'field'};

    # is field indexed
    $fieldDef->{'index'} = $resultRow->{'key'} ? 1 : 0;

    # get field type (translate mySQL type to internal type)
    if    ($resultRow->{'type'}  =~ /^int/i)           { $fieldDef->{'type'}  = 'int'; }
    elsif ($resultRow->{'type'}  =~ /^varchar\(255/i)  { $fieldDef->{'type'}  = 'string'; }
    elsif ($resultRow->{'type'}  =~ /^mediumtext/i)    { $fieldDef->{'type'}  = 'memo'; }
    else                                               { $fieldDef->{'type'}  = 'unknown'; }

    push @$fieldDefs, $fieldDef;
  }

  return $fieldDefs;
}

# ------------------------------------------------------------------------
# Function    : dropTable
# Usage       : called from DB_dropTable
# ------------------------------------------------------------------------

sub dropTable {
  my($connectionName, $tableName) = @_;
  ### Argument error checking done in IT::DB

  # build query
  my $sqlQuery      = "DROP TABLE $tableName";

  ### Execute query
  eval { &IT::DB::MySQL::_execute($connectionName, $sqlQuery); };
  if ($@) { die "Table drop error: $@"; }
}

# ------------------------------------------------------------------------
# Function    : renameTable
# Usage       : called from DB_renameTable
# ------------------------------------------------------------------------

sub renameTable {
  my($connectionName, $sourceTableName, $targetTableName) = @_;
  ### Argument error checking done in IT::DB

  # build query
  my $sqlQuery            = "ALTER TABLE $sourceTableName RENAME $targetTableName, ENGINE=MYISAM";

  ### Execute SQL Statement
  eval { &IT::DB::MySQL::_execute($connectionName, $sqlQuery); };
  if ($@) { die "Table rename error: $@"; }

}

# ----------------------------------------------------------------------------
# end of file
1;

