#!/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::Common;

use strict;

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

# MySQL Reference: http://mysql.com/doc/mysql/en/reserved-words.html
use vars qw(%RESERVED_WORDS);
%RESERVED_WORDS = map {$_, 1} qw(
  ADD ALL ALTER ANALYZE AND AS ASC ASENSITIVE BEFORE BETWEEN BIGINT BINARY BLOB
  BOTH BY CALL CASCADE CASE CHANGE CHAR CHARACTER CHECK COLLATE COLUMN CONDITION
  CONNECTION CONSTRAINT CONTINUE CONVERT CREATE CROSS CURRENT_DATE CURRENT_TIME
  CURRENT_TIMESTAMP CURRENT_USER CURSOR DATABASE DATABASES DAY_HOUR
  DAY_MICROSECOND DAY_MINUTE DAY_SECOND DEC DECIMAL DECLARE DEFAULT DELAYED DELETE
  DESC DESCRIBE DETERMINISTIC DISTINCT DISTINCTROW DIV DOUBLE DROP DUAL EACH ELSE
  ELSEIF ENCLOSED ESCAPED EXISTS EXIT EXPLAIN FALSE FETCH FLOAT FOR FORCE FOREIGN
  FROM FULLTEXT GOTO GRANT GROUP HAVING HIGH_PRIORITY HOUR_MICROSECOND HOUR_MINUTE
  HOUR_SECOND IF IGNORE IN INDEX INFILE INNER INOUT INSENSITIVE INSERT INT INTEGER
  INTERVAL INTO IS ITERATE JOIN KEY KEYS KILL LEADING LEAVE LEFT LIKE LIMIT LINES
  LOAD LOCALTIME LOCALTIMESTAMP LOCK LONG LONGBLOB LONGTEXT LOOP LOW_PRIORITY
  MATCH MEDIUMBLOB MEDIUMINT MEDIUMTEXT MIDDLEINT MINUTE_MICROSECOND MINUTE_SECOND
  MOD MODIFIES NATURAL NOT NO_WRITE_TO_BINLOG NULL NUMERIC ON OPTIMIZE OPTION
  OPTIONALLY OR ORDER OUT OUTER OUTFILE PRECISION PRIMARY PROCEDURE PURGE READ
  READS REAL REFERENCES REGEXP RELEASE RENAME REPEAT REPLACE REQUIRE RESTRICT
  RETURN REVOKE RIGHT RLIKE SCHEMA SCHEMAS SECOND_MICROSECOND SELECT SENSITIVE
  SEPARATOR SET SHOW SMALLINT SONAME SPATIAL SPECIFIC SQL SQLEXCEPTION SQLSTATE
  SQLWARNING SQL_BIG_RESULT SQL_CALC_FOUND_ROWS SQL_SMALL_RESULT SSL STARTING
  STRAIGHT_JOIN SUBMIT TABLE TARGET TERMINATED THEN TINYBLOB TINYINT TINYTEXT TO TRAILING
  TRIGGER TRUE UNDO UNION UNIQUE UNLOCK UNSIGNED UPDATE USAGE USE USING UTC_DATE
  UTC_TIME UTC_TIMESTAMP VALUES VARBINARY VARCHAR VARCHARACTER VARYING WHEN WHERE
  WHILE WITH WRITE XOR YEAR_MONTH ZEROFILL);

# added reserved words: submit, target (conflicted with javascript on page)

# ------------------------------------------------------------------------
# Function    : createWhereTestFunction
# Description : return a function that will test if an arrayref record
#               matches the where query.  Note: $fieldnameIndex is an index
#               of all possible valid fieldnames to their index in the arrayref
#               record.  Setting $ignoreUnknownFields to 'HIDE_UNKNOWN_FIELD_ERRORS'
#               skips tests for fields not related to the passed tablenames.  This lets us perform applicable where
#               tests on individual tables to reduce their recordsets before
#               joining them and performing all the tests again.
# Usage       : my $testFunction = &IT::DB::Common::createWhereTestFunction($tableNames, $fieldnameIndex, $whereQuery, $hideUnknownFieldErrors);
#             : my $isMatching = &{$testFunction}(\@row);
# ------------------------------------------------------------------------

sub createWhereFunction {
  my($tableNames, $fieldnameIndex, $where, $hideUnknownFieldErrors) = @_;
  &IT::Error::dieOnValidationErrors( ["\$tableNames",          $tableNames,          "notBlank notref"],
                          ["\$fieldnameIndex",      $fieldnameIndex,      "hashRef"],
                          ["\$where",               $where,               "notRef"],
                          ["\$hideUnknownFieldErrors", $hideUnknownFieldErrors, "allowUndef"] );

  # error checking
  if ($hideUnknownFieldErrors ne '' && $hideUnknownFieldErrors ne 'HIDE_UNKNOWN_FIELD_ERRORS') {
    die "\$hideUnknownFieldErrors must be either blank or 'HIDE_UNKNOWN_FIELD_ERRORS', not '$hideUnknownFieldErrors'!\n";
  }

  # create where tree
  my $whereTree = &IT::DB::WhereParser::createWhereTree($tableNames, $where, $hideUnknownFieldErrors);

  # return true if no conditions (or 'where' is blank or undefined)
  unless (@$whereTree) { return sub { 1 }; }

  # generate whereFunction code
  my $testCode = &_createWhereFunctionTestCode($fieldnameIndex, $whereTree, $hideUnknownFieldErrors);

  unless ($testCode)  { return sub { 1 }; }
  my $whereFunctionCode;
  $whereFunctionCode .= '  my $fields = shift || die "No record values specified!\n";' . "\n"; # single quoted line
  $whereFunctionCode .= "  if ($testCode) { return 1; }\n";
  $whereFunctionCode .= "  return 0;\n";

  # generate whereFunction
  my $whereFunction = eval "sub { $whereFunctionCode };";
  if ($@) { die "createWhereTestFunction error: $@"; };

  #
  return $whereFunction;
}

# ------------------------------------------------------------------------------
# Function    : _createWhereFunctionTestCode
# Description : Create perl function to test where conditions against result
#               array.
# Usage       : my $perlTestCode = &_createWhereFunctionTestCode($fieldnameIndex, $whereTree, $hideUnknownFieldErrors);
# ------------------------------------------------------------------------------

sub _createWhereFunctionTestCode {
  if (@_ != 3) { die "_createWhereFunctionTestCode requires 3 arguments!"; }
  my $fieldnameIndex      = shift || die "no fieldnameIndex specified!";
  my $whereTree           = shift;
  my $hideUnknownFieldErrors = shift;
  my $node = $whereTree;

  ### 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 = &_createWhereFunctionTestCode($fieldnameIndex, $node->[1], $hideUnknownFieldErrors);
    my $expr2 = &_createWhereFunctionTestCode($fieldnameIndex, $node->[2], $hideUnknownFieldErrors) if ($isAND || $isOR);

    # create test code
    my $testCode;
    if    ($isAND) {
      if    ($expr1 && $expr2)   { $testCode = "($expr1 && $expr2)"; }
      elsif ($expr1 && !$expr2)  { $testCode = "($expr1)"; }
      elsif (!$expr1 && $expr2)  { $testCode = "($expr2)"; }
      elsif (!$expr1 && !$expr2) { $testCode = ""; }
    }
    elsif ($isOR)  {
      if    ($expr1 && $expr2)   { $testCode = "($expr1 || $expr2)"; }
      elsif ($expr1 && !$expr2)  { $testCode = "($expr1)"; }
      elsif (!$expr1 && $expr2)  { $testCode = "($expr2)"; }
      elsif (!$expr1 && !$expr2) { $testCode = ""; }
    }
    elsif ($isNOT) {
      if    ($expr1)             { $testCode = "!($expr1)"; }
      elsif (!$expr1)            { $testCode = ""; }
    }
    else { die "unknown operator '$nodeType')!"; }

    return $testCode;
  }
  elsif ($nodeType ne 'TEST') {  die ("unknown tree node_type ($nodeType)"); }


  ### Process individual tests
  my ($fieldName, $operator) = ($node->[1], $node->[2]);
  my @values                 = (ref $node->[3] eq 'ARRAY') ? @{$node->[3]} : ($node->[3]);  # contains exactly 1, 2, or unknown number of values based on operator
  my $firstValue             = $values[0];

  # get fieldName var
  my $validFieldNamesAsCSV = join ", ", keys %$fieldnameIndex;
  my $fieldIndex = $fieldnameIndex->{$fieldName};
  if ($fieldIndex eq '') {
    if ($hideUnknownFieldErrors) { return; }
    else                         { die "Couldn't find fieldname index for '$fieldName'!\nValid fieldnames: $validFieldNamesAsCSV\n"; }
  }

  # get escaped values and fieldname values
  my $escapedFirstValue  = quotemeta($values[0]);
  my $escapedSecondValue = quotemeta $values[1];
  my $fieldnameVar       = "\$fields->[$fieldIndex]";

  ### Create test code
  if ($operator eq '=') {
    my $perlCode = "$fieldnameVar =~ /^$firstValue\$/i";    # ignore case to match SQL
    return $perlCode;
  }
  elsif ($operator eq '!=') {
    return "$fieldnameVar !~ /^$firstValue\$/i";    # ignore case to match SQL
  }
  elsif (uc $operator eq '=F') {
    my $secondFieldName    = $firstValue;
    my $secondFieldIndex   = $fieldnameIndex->{$secondFieldName};
    if ($secondFieldIndex eq '') {
      if ($hideUnknownFieldErrors) { return; }
      else                         { die "_createWhereFunctionTestCode: Unknown fieldname '$secondFieldName'!\nValid fieldnames: $validFieldNamesAsCSV\n"; }
    }
    my $secondFieldnameVar = "\$fields->[$secondFieldIndex]";
    return "$fieldnameVar eq $secondFieldnameVar";    # ignore case to match SQL
  }
  elsif ($operator eq '<' || $operator eq '>' || $operator eq '<=' || $operator eq '>=') {
    return "$fieldnameVar $operator '$escapedFirstValue'";
  }
  elsif ($operator eq 'BETWEEN' || $operator eq 'NOT BETWEEN') {
    my $notOperator        = ($operator eq 'NOT BETWEEN') ? '!' : '';
    my $perlTest           = "$fieldnameVar >= '$escapedFirstValue' && $fieldnameVar <= '$escapedSecondValue'";
    return "$notOperator($perlTest)";
  }
  elsif ($operator eq 'IN' || $operator eq 'NOT IN') {
    my $notOperator = ($operator eq 'NOT IN') ? '!' : '';
    my $perlTest;
    foreach my $value (@values) {
      my $escapedValue = quotemeta $value;
      $perlTest .= " || " if $perlTest;
      $perlTest .=  "$fieldnameVar eq '$escapedValue'";
    }
    return "$notOperator($perlTest)";
  }
  elsif ($operator eq 'LIKE' || $operator eq 'NOT LIKE') {
    my $regexp   = $firstValue;
    $regexp      =~ s/(?<!\\)((\\\\)*)%/$1.*/g;          # turn unescaped % (or % prefixes with escaped slashes) into perl regexp
    $regexp      =~ s/(?<!\\)((\\\\)*)_/$1./g;           # turn unescaped % (or % prefixes with escaped slashes) into perl regexp
    my $regexpOp = ($operator eq 'NOT LIKE') ? '!~' : '=~';
    my $perlCode = "$fieldnameVar $regexpOp /^$regexp\$/is";   # ignore case on match (just like mySQL)
    return $perlCode;
  }
  else { die "Unknown operator '$operator'!"; }
}

# ------------------------------------------------------------------------------
# Function    : getTableNamesAndAliases
# Description : Get array of tables and aliases from single tablename 'mytable'
#               or table reference(s) 'mytable AS my, yourTable AS you'.  If no
#               alias is specified, alias is tablename without prefix.
#               Note: We use an array instead of a hash so we can have two tables
#               with the same name and different aliases, sometimes used in joins.
# Usage       : my $tableNamesAndAliases = &IT::DB::Common::getTableNamesAndAliases($tablenames);
#               foreach my $row (@$tableNamesAndAliases) {
#                 my($tableName, $tableAlias) = @$row;
#                 ...
#               }
# ------------------------------------------------------------------------------

sub getTableNamesAndAliases {
  my $tableOrTables = shift || die "no table(s) specified!\n";

  my $tableNamesAndAliases = [];
  my @tableReferences = split(/\s*,\s*/, $tableOrTables);
  foreach my $tableReference (@tableReferences) {
    my($tableName, $alias) = split /\s*AS\s*/i, $tableReference;
    if (!$alias) {
      $alias = $tableName;
      $alias =~ s/^$TABLE_PREFIX//;
    }
    push @$tableNamesAndAliases, [ $tableName, $alias ];
  }

  return $tableNamesAndAliases;
}

# ------------------------------------------------------------------------------
# Function    : getOriginalTableAndFieldname
# Description : Given a list of tablenames and their aliases (tablename AS alias, etc)
#               and a prefixed fieldname (tableAlias.fieldname), returns orginal
#               tablename and fieldname (tablename, fieldname);
# Usage       : my($tableName, $fieldName) = &IT::DB::Common::getOriginalTableAndFieldname($tableNamesAndAliases, $prefixedFieldname);
# ------------------------------------------------------------------------------

sub getOriginalTableAndFieldname {
  my $tableNames        = shift || die "no tableNamesAndAliases specified!\n";
  my $prefixedFieldname = shift || die "no prefixedFieldname specified!\n";

  # get fieldPrefix and fieldName
  my $fieldPrefix;
  my $fieldName = $prefixedFieldname;
  if ($fieldName =~ s/^([^\.]+)\.(.+)$//s) {
    ($fieldPrefix, $fieldName) = ($1, $2);
  }

  # get tableNames and aliases
  my $tableNamesAndAliases = &IT::DB::Common::getTableNamesAndAliases($tableNames);
  my %aliasesToNames       = map { $_->[1] => $_->[0] } @$tableNamesAndAliases;
  my $tableCount           = int scalar @$tableNamesAndAliases;

  # get matching table name for prefixed fields
  if ($fieldPrefix && $aliasesToNames{$fieldPrefix}) {  # for prefixed fields
    my $tableName = $aliasesToNames{$fieldPrefix};
    return($tableName, $fieldName);
  }

  # get matching table name for unprefixed fields
  elsif (!$fieldPrefix && $tableCount == 1) {
    my $tableName = $tableNamesAndAliases->[0][0];
    return($tableName, $fieldName);
  }

  # report errors
  if    ($tableCount > 1 && !$fieldPrefix)               { die "You must specify field prefixes when joining multiple tables. Field: '$prefixedFieldname', tables: '$tableNames'!\n"; }
  elsif ($fieldPrefix && !$aliasesToNames{$fieldPrefix}) { die "No matching tables were found for field '$prefixedFieldname' with tables '$tableNames'!\n"; }
  else                                                   { die "Couldn't find fieldname '$prefixedFieldname' in table(s) '$tableNames'!\n"; }

}

# ----------------------------------------------------------------------------
# Function    : dieOnValueSizeAndTypeErrors
# Description :
# Usage       : &IT::DB::Common::dieOnValueSizeAndTypeErrors($tableName, $fieldname, $value);
# ----------------------------------------------------------------------------

sub dieOnValueSizeAndTypeErrors {
  my $tableName  = shift || die "no table name specified!";
  my $fieldname  = shift || die "no fieldname specified!";
  my $value      = shift;

  &IT::Error::dieOnValidationErrors(
    ["\$tableName", $tableName, "notBlank notRef"],
    ["\$fieldname", $fieldname, "notBlank notRef"],
    ["\$value",     $value,     "notRef"],
  );

  my $isFieldNumeric = &isFieldNumeric($tableName, $fieldname);
  my @errors;

  ### Check if value can be stored in field type
  my $fieldType = &IT::DB::Schema::getFieldAttributes($tableName, $fieldname, 'type');
  if    ($fieldType eq 'string')       { 1; }  # everything is allowed
  elsif ($fieldType eq 'memo')         { 1; }  # everything is allowed
  elsif ($fieldType eq 'int' && $value =~ /[^0-9]/) {
    push @errors, "field '$fieldname' only allows the following characters (0-9)";
  }

  ### Check value fits in field size
  my $maxSize = &getMaxFieldSize($tableName, $fieldname);
  if ($isFieldNumeric  && $value > $maxSize)         { push @errors, "field '$fieldname' value exceeds maximum allowed value of $maxSize"; }
  if (!$isFieldNumeric && length($value) > $maxSize) { push @errors, "field '$fieldname' value exceeds maximum field size of $maxSize chars"; }

  # return errors
  if (@errors) {
    my $errors = join(", \n", @errors);
    die "$errors\n";
  }

}

#-----------------------------------------------------------------------------
# Function    : dieOnFieldDefinitionErrors
# Description : ensure that field definitions are valid and can be used to
#               create a table.  these cases should all be caught by the
#               core-ui layer, and should only cause errors during development
# Usage       : &IT::DB::Common::dieOnFieldDefinitionErrors($field_defs);
#
# Example Field Defs:
#
#  my $fieldDefinitions = [
#    { 'name' => 'num',                'type' => 'int',          },
#    { 'name' => 'created_time',       'type' => 'int',          },
#    { 'name' => 'created_by_user_id', 'type' => 'int',          },
#    { 'name' => 'name',               'type' => 'string',       },
#    { 'name' => 'keyword',            'type' => 'string', },
#    { 'name' => 'content',            'type' => 'memo',         },
#  ];
# -----------------------------------------------------------------------------

sub dieOnFieldDefinitionErrors {
  my ($fieldDefs) = @_;
  &IT::Error::dieOnValidationErrors( ["\$fieldDefs", $fieldDefs, "notBlank arrayRef"] );

  my @errors;

  ### check each field def
  my %fieldsChecked;

  if (! defined $$fieldDefs[0]) { push @errors, "field definition must not be blank"; }

  foreach my $index (0..$#$fieldDefs) {
    my $fieldDef   = $fieldDefs->[$index];
    my $fieldName  = $fieldDef->{'name'};
    my $fieldType  = $fieldDef->{'type'};
    my $isIndexed  = $fieldDef->{'index'};

    # error checking disabled - not needed for mysql only database applications
    # check first field is an 'int' named 'num'
    #if ($index == 0) {
    #  if ($fieldName ne 'num') { push @errors, "first field must be named 'num' not '$fieldName'"; }
    #  if ($fieldType ne 'int') { push @errors, "first field must be type 'int' not '$fieldType'"; }
    #}

    # check fieldname
    if ($fieldsChecked{$fieldName}++)       { push @errors, "fieldname '$fieldName' occurs more than once"; }
    if (!$VALID_FIELD_TYPES{$fieldType} &&
        $fieldType ne 'none')               { push @errors, "fieldname '$fieldName' has unrecognized fieldtype '$fieldType'"; }
    if ($fieldType eq 'memo' && $isIndexed) { push @errors, "fieldname '$fieldName' - memo fields can't be indexed"; } # mySQL rules

    foreach my $attributeName (keys %$fieldDef) {
      unless ($VALID_FIELD_ATTRIBUTES{$attributeName}) { push @errors, "fieldname '$fieldName' has unknown attribute '$attributeName'"; }
    }

    eval { &IT::DB::Common::dieOnInvalidFieldName($fieldName); };
    if ($@) { push @errors, $@; }
  }

  # die with errors
  if (@errors) {
    die "invalid field definitions: " . join(", \n", @errors);
  }

}

#-----------------------------------------------------------------------------
# Function    : dieOnInvalidTableName
# Description : ensure that tablenames are valid and can be used to
#               create a table.  these cases should all be caught by the
#               core-ui layer, and should only cause errors during development
#
# Usage       : &IT::DB::Common::dieOnInvalidTableName($tableName);
# -----------------------------------------------------------------------------

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

  my @errors;

  # NOTE: mysql accepts uppercase chars in table names, but can converts them to lowercase silently depending on OS and mysql settings - so we don't allow uppercase chars
  if ($tableName =~ /[^a-zA-Z0-9_]/)                               { push @errors,  "table name '$tableName' can only contain the following characters (a-z, A-Z, 0-9, _)"; }
  if (length $tableName > $IT::DB::Globals::MAX_TABLENAME_LENGTH)  { push @errors,  "table name '$tableName' cannot exceed $IT::DB::Globals::MAX_TABLENAME_LENGTH characters"; }
  if (&isReservedWord($tableName))                                 { push @errors,  "table name '$tableName' cannot be a reserved word"; }

  # die with errors
  if (@errors) { die "invalid table name: " . join(", \n", @errors); }
}

#-----------------------------------------------------------------------------
# Function    : dieOnInvalidFieldName
# Description :
# Usage       : &IT::DB::Common::dieOnInvalidFieldName($fieldName);
# -----------------------------------------------------------------------------

sub dieOnInvalidFieldName {
  my ($fieldName) = @_;

  my @errors;
  if ($fieldName eq '')                                            { push @errors, "field name '$fieldName' can not be blank!"; }
  if ($fieldName =~ /[^a-zA-Z0-9_]/)                               { push @errors, "field name '$fieldName' can only contain the following characters (a-z, A-Z, 0-9, _)"; }
  if (length $fieldName > $IT::DB::Globals::MAX_FIELDNAME_LENGTH)  { push @errors, "field name '$fieldName' cannot exceed $IT::DB::Globals::MAX_FIELDNAME_LENGTH characters"; }
  if (&IT::DB::Common::isReservedWord($fieldName))                 { push @errors, "field name '$fieldName' cannot be a reserved word"; }

  # die with errors
  if (@errors) { die "invalid field name: " . join(", \n", @errors); }
}

#-----------------------------------------------------------------------------
# Function    : dieOnNonExistantTable
# Description : die if table doesn't exist in schema
# Usage       : &IT::DB::Common::dieOnNonExistantTable($tableName);
# -----------------------------------------------------------------------------

sub dieOnNonExistantTable {
  my($tableName) = @_;

  # check if table exists in schema
  unless (&IT::DB::Schema::existsTable($tableName)) {
    &IT::Error::dieAsCaller("table '$tableName' does not exist in schema!\n", 2);
  }
}

#-----------------------------------------------------------------------------
# Function    : dieOnInvalidTablesOrAliases
# Description : die if tables doesn't exist in schema or invalid alias
# Usage       : &IT::DB::Common::dieOnInvalidTablesOrAliases($tableName);
# -----------------------------------------------------------------------------

sub dieOnInvalidTablesOrAliases {
  my($tableNames) = @_;

  my @tableReferences = split(/\s*,\s*/, $tableNames);

  my $errors;
  foreach my $tableReference (@tableReferences) {
    my($tableName, $alias) = split /\s*AS\s*/i, $tableReference;
    if (!$tableName)                                  { $errors .= "no tablename defined!\n"; next; }
    unless (&IT::DB::Schema::existsTable($tableName)) { $errors .= "table '$tableName' does not exist in schema!\n"; }
#    if (!$alias)                                      { $errors .= "no alias defined for table '$tableName'!\n"; next; }
    if (&isReservedWord($alias))                      { $errors .= "table alias '$alias' is a reserved word!\n"; next; }
    if ($alias =~ m/[^a-z0-9\_]/i)                    { $errors .= "table alias '$alias' contains invalid chars (only a-z, 0-9 and _ are allowed)!\n"; }
  }

  if ($errors) { &IT::Error::dieAsCaller($errors, 2); }

}

#-----------------------------------------------------------------------------
# Function    : dieOnInvalidGroupBy
# Description :
# Usage       : &IT::DB::Common::dieOnInvalidGroupBy($tableNamesAndAliases, $sortBy);
# -----------------------------------------------------------------------------

sub dieOnInvalidGroupBy {
  my($tableNames, $groupBy) = @_;
  if (@_ != 2) { die "dieOnInvalidGroupBy requires two arguments!\n"; }
  &IT::Error::dieOnValidationErrors( ["\$tableNames", $tableNames, "notBlank"],
                          ["\$groupBy",    $groupBy,    "allowUndef arrayRef"]);

  my @errors;

  # skip if no sortby defined
  if (!defined $groupBy) { return; }

  # check sortBy array isn't empty
  if (@$groupBy == 0) { push @errors, "groupBy doesn't contain any fieldnames!"; }

  # get list of valid fields
  my %fieldnames;
  my $tableNamesAndAliases = &getTableNamesAndAliases($tableNames);
  foreach my $row (@$tableNamesAndAliases) {
    my($tableName, $tableAlias) = @$row;
    foreach my $fieldname (&IT::DB::Schema::getFieldNames($tableName)) {
      $fieldnames{"$tableAlias.$fieldname"} = 1;
      $fieldnames{"$fieldname"} = 1;
    }
  }

  # check groupBy fields exist
  my $tableNamesAsCSV = join ", ", map { $_->[0] } @$tableNamesAndAliases;
  foreach my $fieldname (@$groupBy) {
    if (!$fieldnames{$fieldname}) { push @errors, "groupBy contains unrecognized fieldname '$fieldname' in tables '$tableNamesAsCSV'!"; }
  }

  # die with errors
  if (@errors) {
    die join(", \n", @errors);
  }
}

#-----------------------------------------------------------------------------
# Function    : dieOnInvalidSortBy
# Description :
# Usage       : &IT::DB::Common::dieOnInvalidSortBy($tableNames, $sortBy);
# -----------------------------------------------------------------------------

sub dieOnInvalidSortBy {
  my($tableNames, $sortBy) = @_;
  if (@_ != 2) { die "dieOnInvalidSortBy requires two arguments!\n"; }
  &IT::Error::dieOnValidationErrors( ["\$tableNames", $tableNames, "notBlank"],
                          ["\$sortBy",     $sortBy,    "allowUndef arrayRef"]);

  my @errors;

  # skip if no sortby defined
  if (!defined $sortBy) { return; }

  # check sortBy array isn't empty
  if (@$sortBy == 0) { push @errors, "sortBy doesn't contain any fieldnames!"; }

  # get list of valid fields
  my %fieldnames;
  my $tableNamesAndAliases = &getTableNamesAndAliases($tableNames);
  foreach my $row (@$tableNamesAndAliases) {
    my($tableName, $tableAlias) = @$row;
    foreach my $fieldname (&IT::DB::Schema::getFieldNames($tableName)) {
      $fieldnames{"$tableAlias.$fieldname"} = 1;
      $fieldnames{"$fieldname"} = 1;
    }
  }

  # check sort fields exist
  my $tableNamesAsCSV = join ", ", map { $_->[0] } @$tableNamesAndAliases;
  foreach my $sortField (@$sortBy) {
    $sortField =~ /^(-?)(.*)/;
    my $reverseOrder = $1;
    my $fieldname    = $2;
    if (!$fieldnames{$fieldname}) { push @errors, "sortBy contains unrecognized fieldname '$fieldname' in tables '$tableNamesAsCSV'!"; }
  }

  # die with errors
  if (@errors) {
    die join(", \n", @errors);
  }
}


#-----------------------------------------------------------------------------
# Function    : dieOnInvalidLimit
# Description :
# Usage       : &IT::DB::Common::dieOnInvalidLimit($limit);
# -----------------------------------------------------------------------------

sub dieOnInvalidLimit {
  my($limit) = @_;
  my @errors;

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

  # check limit values
  my ($start, $length) = @$limit;

  if    ($start eq '')           { push @errors, "limit start value isn't defined!"; }
  elsif ($start ne int $start)   { push @errors, "limit start ($start) must be an int!"; }
  elsif ($length < 0)            { push @errors, "limit start ($start) can't be less than 0!"; }

  if    ($length eq '')          { push @errors, "limit length value isn't defined!"; }
  elsif ($length ne int $length) { push @errors, "limit length ($length) must be an int!"; }
  elsif ($length < 1)            { push @errors, "limit length ($length) can't be less than 1!"; }

  if (@$limit > 2)               { push @errors, "limit cannot contain more than 2 values!"; }

  # die with errors
  if (@errors) {
    die join(", \n", @errors);
  }
}

#-----------------------------------------------------------------------------
# Function    : dieOnInvalidUpdateArray
# Description :
# Usage       : &IT::DB::Common::dieOnInvalidUpdateArray($tableName, $updateArray);
# -----------------------------------------------------------------------------

sub dieOnInvalidUpdateArray {
  my($tableName, $updateArray) = @_;
  my @errors;

  my %validOperators   = map { $_, 1 } qw(= += -= =F);
  my %numericOperators = map { $_, 1 } qw(+= -=);
  my %validFieldnames  = map { $_, 1 } &IT::DB::Schema::getFieldNames($tableName);
  my $autoSequencing   = &IT::DB::Schema::getTableAttributes($tableName, 'autoSequencing');

  # check updateArray structure
  foreach my $command (@$updateArray) {
    if (ref($command) ne 'ARRAY') { die "entries must be array references!"; }
    if (scalar(@$command) != 3)   { push(@errors, "entries must have exactly 3 elements"); next; }
  }

  # check updateArray content
  foreach my $command (@$updateArray) {
    my ($field, $operator, $value) = @$command; # eg: count, +=, 1
    $operator = uc $operator;

    # check fieldnames
    if (!$validFieldnames{$field})                      { push @errors, "contains unrecognized field '$field'"; next; }
    if ($operator eq '=F' && !$validFieldnames{$value}) { push @errors, "contains unrecognized field '$value' in =F operation"; next;}

    my $isFieldNumeric = &IT::DB::Common::isFieldNumeric($tableName, $field);

    # check operators
    if (!$validOperators{ $operator })                        { push @errors, "contains an invalid operator '$operator'";  }
    if ($numericOperators{$operator} && !$isFieldNumeric)     { push @errors, "cannot use numeric operator '$operator' with non-numeric field '$field'"; }
    if ($numericOperators{$operator} && $value =~ /[^0-9]/)   { push @errors, "operator '$operator' can only be used with numeric values (only chars 0-9 allowed)"; }
    if ($operator eq '=F' && $isFieldNumeric &&
        !&IT::DB::Common::isFieldNumeric($tableName, $value)) { push @errors, "cannot copy value from non-numeric field '$value' to numeric field '$field'"; }

    # check values
    if ($operator eq '=') {
      eval { &IT::DB::Common::dieOnValueSizeAndTypeErrors($tableName, $field, $value); };
      push(@errors, $@) if $@;
    }

    # check update rules
    if ($field eq 'num') { push @errors, "cannot set 'num' field with update"; }
  }

  # die with errors
  if (@errors) {
    die "invalid update: " . join(", \n", @errors);
  }
}

#-----------------------------------------------------------------------------
# Function    : dieOnInvalidInsertRecords
# Description :
# Usage       : &IT::DB::Common::dieOnInvalidInsertArray($tableName, $insertRecords);
# -----------------------------------------------------------------------------

sub dieOnInvalidInsertArray {
  my($tableName, $recordList) = @_;

  my @errors;
  my %validFieldnames = map { $_, 1 } &IT::DB::Schema::getFieldNames($tableName);
  my $autoSequencing  = &IT::DB::Schema::getTableAttributes($tableName, 'autoSequencing');

  # check each insert record
  foreach my $record (@$recordList) {

    # check insert format
    if (ref($record) ne 'HASH')                { push @errors, "records must be hashrefs"; next; }

    # check insert rules
    if ($autoSequencing && $record->{'num'} )  { push @errors, "cannot set 'num' field when 'autoSequencing' is enabled"; }
    if (!$autoSequencing && !$record->{'num'}) { push @errors, "you must specify 'num' field when 'autoSequencing' is disabled"; }

    # check fieldnames
    foreach my $field (keys %$record) {
      if (!$validFieldnames{$field}) { die "invalid insert: contains unrecognized field '$field'";}
    }

    # check field values (size and format)
    foreach my $fieldname (keys %$record) {
      my $value = $record->{$fieldname};
      eval { &IT::DB::Common::dieOnValueSizeAndTypeErrors($tableName, $fieldname, $value); };
      if ($@) {
        my $error = $@;
        if ($record->{'num'}) {
          $error .= " (on record # $record->{'num'})";
        }
        push @errors, "$error\n";
      }
    }
  }

  ### Manual Sequencing - check no record numbers are already in use
  if (!$autoSequencing && @$recordList) {
    my $listOfRecordNumbers              = join ", ", map { $_->{'num'} } @$recordList;
    my $countOfRecordNumbersAlreadyInUse = &IT::DB::count($tableName, "num IN ($listOfRecordNumbers)");
    if ($countOfRecordNumbersAlreadyInUse) {
      push @errors, "manual sequencing - $countOfRecordNumbersAlreadyInUse of the insert records have sequence numbers that already exist in database!";
    }
  }

  ### display errors
  if (@errors) {
    my $errors = join(", \n", @errors);
    die "invalid insert: $errors";
  }

}

# -----------------------------------------------------------------------------
# Function    : dieOnDisabledDatabaseWrites
# Description :
# Usage       : &IT::DB::Common::dieOnDisabledDatabaseWrites($connectionName);
# -----------------------------------------------------------------------------

sub dieOnDisabledDatabaseWrites {
  my $connectionName = shift || die "no connection name specified!";

  my $secondsRemaining = &IT::DB::isDatabaseWritesDisabled($connectionName);
  if ($secondsRemaining) {
    die "Database writes are currently disabled while the database is being updated.  Please wait a few minutes and try again. ($secondsRemaining seconds remaining on current lock)";
  }

}

# ----------------------------------------------------------------------------
# Function    : getMaxFieldSize
# Description :
# Usage       :  my $maxFieldSize = &getMaxFieldSize($tableName, $fieldname);
# ----------------------------------------------------------------------------

sub getMaxFieldSize {
  my $tableName = shift || die "no table name specified!";
  my $fieldname = shift || die "no field name specified!";

  my $fieldType = &IT::DB::Schema::getFieldAttributes($tableName, $fieldname, 'type');

  my $maxSize;
  if    ($fieldType eq 'string')       { $maxSize = $IT::DB::Globals::MAX_STRING; }   # string reference: http://dev.mysql.com/doc/mysql/en/string-type-overview.html
  elsif ($fieldType eq 'memo')         { $maxSize = $IT::DB::Globals::MAX_MEMO; }     # string
  elsif ($fieldType eq 'int')          { $maxSize = $IT::DB::Globals::MAX_INT; }      # numeric reference: http://dev.mysql.com/doc/mysql/en/numeric-type-overview.html
  else { die "unknown field type '$fieldType'!"; }

  return $maxSize;
}

# -----------------------------------------------------------------------------
# Function    : isReservedWord
# Description : determine if the given string is a reserved word
# Usage       : my $isReserved = &IT::DB::Common::isReservedWord($tableName);
# -----------------------------------------------------------------------------

sub isReservedWord {
  my ($fieldOrTableName) = shift;

  my $isReservedWord = $RESERVED_WORDS{uc $fieldOrTableName};;
  return $isReservedWord;

}

# -----------------------------------------------------------------------------
# Function    : isFieldNumeric
# Description : determine if the given field is of a numeric type
# Usage       : my $isNumeric = &IT::DB::Common::isFieldNumeric($tableName, $fieldname);
# -----------------------------------------------------------------------------

sub isFieldNumeric {
  my $tableName = shift || die "no table name specified!";
  my $fieldName = shift || die "no field name specified!";

  my $dbFieldType = $IT::DB::Schema::FIELD_ATTRIBUTES->{$tableName}{$fieldName}{'type'};

  my $isNumeric;
  if    ($dbFieldType eq 'string') { $isNumeric = 0; }  # string
  elsif ($dbFieldType eq 'memo')   { $isNumeric = 0; }  # string
  elsif ($dbFieldType eq 'int')    { $isNumeric = 1; }  # number
  else { die "unknown field type '$dbFieldType'!"; }

  return $isNumeric;
}

# ------------------------------------------------------------------------
# Function    : limitRecordset
# Description : crop an array to a limit (works like mySQL limit)
#               The offset of the initial row is 0 (not 1):
# Usage       : &limitRecordset($recordset, [21, 10]);
# ------------------------------------------------------------------------

sub limitRecordset {
  my($records, $limit) = @_;
  &IT::Error::dieOnValidationErrors( ["\$records", $records, "notBlank arrayRef"],
                          ["\$limit",   $limit,   "allowUndef arrayRef"]);

  # Skip function if no limit or no records defined
  if (!$limit)        { return $records; }

  # limit records
  my ($start, $length) = @$limit;
  my $startIndex     = $start;
  my $finishIndex    = &IT::Common::mathMin( ($start + $length-1), $#$records );
  my @limitedRecords = @$records[$startIndex .. $finishIndex];

  return \@limitedRecords;
}

# -----------------------------------------------------------------------------
# Function    : preventRecursiveOperations
# Usage       : &preventRecursiveOperations();
# -----------------------------------------------------------------------------

sub preventRecursiveOperations {
#  Disabled: Was only required for MS SQL which didn't support concurrent queries in
#            ... some server editions but we're not supporting MS SQL anyways.
#  if ($ACTIVE_LIST_QUERY) {
#    die 'preventRecursiveOperations: cannot perform another DB operation during an active list query!';
#  }
}

# ------------------------------------------------------------------------
# Function    : convertWhereQueryToPerlTests
# Description :
# Usage       : my $tests = &convertWhereQueryToPerlTests($tableName, $whereQuery, $targetEngine);
# ------------------------------------------------------------------------

sub convertWhereQueryToPerlTests {
  my($tableName, $whereQuery, $targetEngine) = @_;
  &IT::Error::dieOnValidationErrors( ["\$tableName",    $tableName,    "notBlank notref"],
                          ["\$whereQuery",   $whereQuery,   "notRef"],
                          ["\$targetEngine", $targetEngine, "oneOf(virtual,file)"] );

  my $whereTree = &IT::DB::WhereParser::createWhereTree($tableName, $whereQuery);

  unless (@$whereTree) { return 1; } # match all when 'where' undefined

  my ($BuildNode);

  $BuildNode = sub {
    my $node = shift;

    ### Recurse for AND, OR, and NOT node_types
    my $nodeType = $node->[0];
    if    ($nodeType eq 'AND')  { return ('('  . &$BuildNode($node->[1]) . ' && ' . &$BuildNode($node->[2]) . ')'); }
    elsif ($nodeType eq 'OR')   { return ('('  . &$BuildNode($node->[1]) . ' || ' . &$BuildNode($node->[2]) . ')'); }
    elsif ($nodeType eq 'NOT')  { return ('!(' . &$BuildNode($node->[1]) . ')'); }
    elsif ($nodeType ne 'TEST') { die ("unknown tree node_type ($nodeType)"); }

    ### Process individual tests
    my ($fieldName, $operator) = ($node->[1], $node->[2]);
    my @values                 = (ref $node->[3] eq 'ARRAY') ? @{$node->[3]} : ($node->[3]);  # contains exactly 1, 2, or unknown number of values based on operator

    # get fieldName var
    my $fieldnameVar;
    my $fieldIndex = &IT::DB::Schema::getFieldIndex($tableName, $fieldName);
    if    ($targetEngine eq 'file')    { $fieldnameVar = "\$fields[$fieldIndex]"; }
    elsif ($targetEngine eq 'virtual') { $fieldnameVar = "\$record->{'$fieldName'}"; }

    # file engine - encode values to match record encoding
    if ($targetEngine eq 'file') {
      foreach my $element (@values) { $element =~ s/([\x1a\r\n\¡\¿])/sprintf('¿%02x',ord($1))/egx; }
    }

    # quote non-word chars in value(s) to avoid code injection into eval
    foreach my $value (@values) { $value = quotemeta($value); }


    if ($operator eq 'LIKE' || $operator eq 'NOT LIKE') {
      $values[0] =~ s/(?<!\\)\\%/.*/g;      # turn % with one backslash into Perl regexp

      $values[0] =~ s/\\\\\\%/\\%/g;        # unescape escaped "\%" which would have quotemeta'd as "\\\%" (from when user wants to search for literal %)
      $values[0] =~ s/\\\\\\'/\\'/g;        # unescape escaped "\'" which would have quotemeta'd as "\\\'" (from when user wants to search for literal ')
      $values[0] =~ s/\\\\\\"/\\"/g;        # unescape escaped "\"" which would have quotemeta'd as "\\\"" (from when user wants to search for literal ")

      $values[0] =~ s/\\\\_/\\_/g;          # unescape escaped "\_" which would have quotemeta'd as "\\_" (from when user wants to search for literal _)
      $values[0] =~ s/\\\\/\\/g;            # unescape escaped "\" which would have quotemeta'd as "\\\\" (from when user wants to search for literal \)

      if    ($targetEngine eq 'file')    { $values[0] =~ s/(?<!\\)_/(¿[0-9A-F][0-9A-F]|.)/g; }
      elsif ($targetEngine eq 'virtual') { $values[0] =~ s/(?<!\\)_/./g; }

      my $regexpOp = ($operator eq 'NOT LIKE') ? '!~' : '=~';
      my $perlCode = "$fieldnameVar $regexpOp /^$values[0]\$/is";  # ignore case to match SQL
      return $perlCode;
    }
    elsif ($operator eq '=') {
      my $perlCode = "$fieldnameVar =~ /^$values[0]\$/i";    # ignore case to match SQL
      return $perlCode;
    }
    elsif ($operator eq '!=') {
      return "$fieldnameVar !~ /^$values[0]\$/i";    # ignore case to match SQL
    }
    elsif ($operator eq '<' || $operator eq '>' || $operator eq '<=' || $operator eq '>=') {
      return "$fieldnameVar $operator '$values[0]'";
    }
    elsif ($operator eq 'BETWEEN' || $operator eq 'NOT BETWEEN') {
      my $notOperator = ($operator eq 'NOT BETWEEN') ? '!' : '';
      my $perlTest    = "$fieldnameVar >= '$values[0]' && $fieldnameVar <= '$values[1]'";
      return "$notOperator($perlTest)";
    }
    elsif ($operator eq 'IN' || $operator eq 'NOT IN') {
      my $notOperator = ($operator eq 'NOT IN') ? '!' : '';
      my $perlTest    = join ' || ', map { "$fieldnameVar eq '$_'" } @values;
      return "$notOperator($perlTest)";
    }
    else { die "Unknown operator '$operator'!"; }
  };

  my $perlTests = &$BuildNode($whereTree);

  return $perlTests;
}

# ----------------------------------------------------------------------------
# Function    : convertFieldHashToUpdateArray
# Description : convert an updateHash to an updateArray.  Note:  You can't set
#               'num' with an update hash and 'num' fields are automatically
#               removed.  The reason for this is so you don't have to manually
#               delete the num key every time you update a record with form input.
# Usage       : my $updateArray = &IT::DB::Common::convertFieldHashToUpdateArray($fieldHash);
# ----------------------------------------------------------------------------

sub convertFieldHashToUpdateArray {
  if (@_ != 2) { die "convertFieldHashToUpdateArray: invalid number of arguments!"; }
  my $tableName   = shift || die "no tablename specified!";
  my $updateHash  = shift || die "no update hash specified!";

  # error checking
  &IT::DB::Common::dieOnNonExistantTable($tableName);

  # convert name/value pairs into array elements ['name', '=', 'value']
  my %validFieldnames  = map { $_, 1 } &IT::DB::Schema::getFieldNames($tableName);
  my $updateArray      = [];
  foreach my $fieldname (keys %$updateHash) {
    if ($fieldname eq 'num')           { next; } # can't set num from updateHash, see function header
    if (!$validFieldnames{$fieldname}) { next; } # skip unknown/unneeded fields (eg: submit = 1)
    push @$updateArray, [ $fieldname, '=', $updateHash->{$fieldname} ];
  }

  return $updateArray;
}

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

