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

use strict;

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

# library globals
use vars qw(%VIRTUAL_TABLES);

# ------------------------------------------------------------------------
# Function    : _filterRecordset
# Description : Filter a hash-based recordset with a where condition
# Usage       : &_filterRecordset($tableName, $recordset, $whereQuery)
# ------------------------------------------------------------------------

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

  ### Skip this if there's no whereQuery
  if (!$whereQuery) { return $recordset; }

  ### Convert WhereQuery to Perl filter sub
  my $perlTests = &IT::DB::Common::convertWhereQueryToPerlTests($tableName, $whereQuery, 'virtual');

  my $filterCode = eval 'sub {
    my $recordset = shift || die "no recordset specified!";
    if (ref $recordset ne "ARRAY") { die "recordset must be an array ref!"; }

    my $matchingRecords = [];
    foreach my $record (@$recordset) {
      if (' . $perlTests . ') { push @$matchingRecords, $record; }
    }

    return $matchingRecords;
  };
  ';

  ### Get matching Records
  my $matchingRecords = &$filterCode($recordset);
  return $matchingRecords;
}

# ------------------------------------------------------------------------
# Function    : _sortRecordset
# Description : take a reference to an unsorted, list of hashes, and return
#               a sorted list of hashes
# Usage       : &_sortRecordset($tableName, $recordset, $sortBy);
# ------------------------------------------------------------------------

sub _sortRecordset {
  my($tableName, $recordset, $sortBy) = @_;
  &IT::Error::dieOnValidationErrors(
    ["\$tableName,", $tableName, "notBlank notRef"],
    ["\$recordset",  $recordset, "notBlank arrayRef"],
    ["\$sortBy",     $sortBy,    "allowUndef arrayRef"],
  );

  ### Skip this if there's no sortFields defined
  if (!$sortBy) { return $recordset; }

  ### Sort recordset
  my $sortedRecords;
  @$sortedRecords = sort {
    my $comparison = 0;
    foreach my $sortField (@$sortBy) {
      $sortField =~ /^(-?)(.*)/;
      my $reverseOrder = $1;
      my $fieldname    = $2;

      # compare values
      my $isFieldNumeric = &IT::DB::Common::isFieldNumeric($tableName, $fieldname);
      if ($isFieldNumeric) { $comparison = ($a->{$fieldname} <=> $b->{$fieldname}) * ($reverseOrder ? -1 : 1); }
      else                 { $comparison = ($a->{$fieldname} cmp $b->{$fieldname}) * ($reverseOrder ? -1 : 1); }
      last if $comparison; # skip remaining sortFields for this value if we've already established it's order from an earlier sortField
    }
    $comparison;
  } @$recordset;

  return $sortedRecords;
}


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

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

  die "select2 not implemented for virtual databases yet!";

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

  return $self
}

# ----------------------------------------------------------------------------
# Function    : count
# Description : returns the number of records that match the whereQuery
# Usage       : my $count = &count($tableName, $whereQuery);
# ----------------------------------------------------------------------------

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

  # load and filter recordset
  my $recordset       = $VIRTUAL_TABLES{ $tableName }{'recordset'};
  my $matchingRecords = &_filterRecordset($tableName, $recordset, $whereQuery);

  ### Return the number of (matching) records
  return scalar(@$matchingRecords);
}

# ----------------------------------------------------------------------------
# Function    : insert
# Description : inserts a set of records into a table
# Usage       : my $insertedRecordCount = &insert($tableName, $insertRecords)
# ----------------------------------------------------------------------------

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

  ### load table data
  my $recordset         = $VIRTUAL_TABLES{ $tableName }{'recordset'};

  ### update sequence number
  my $oldSequenceNumber = &IT::DB::getSequence($tableName);
  my $newSequenceNumber = $oldSequenceNumber;
  my $autoSequencing    = &IT::DB::Schema::getTableAttributes($tableName, 'autoSequencing');
  my $newRecordCount    = @$insertRecords;
  if ($autoSequencing) {                         # autoSequencing - increase sequence by number of new records
    $newSequenceNumber += $newRecordCount;
  }
  else {
    foreach my $record (@$insertRecords) {       # manualSequencing - use highest record num (or old sequence num) as new sequence
      if ($record->{'num'} > $newSequenceNumber) { $newSequenceNumber = $record->{'num'}; }
    }
  }
  &IT::DB::setSequence($tableName, $newSequenceNumber);


  ### Add new record(s)
  my @fieldnames              = &IT::DB::Schema::getFieldNames($tableName);
  my $autoSequencingRecordNum = $oldSequenceNumber;

  foreach my $iRecord (@$insertRecords) {

    # create new record
    my $newRecord = {};
    foreach my $fieldname (@fieldnames) {
      if    (exists $iRecord->{$fieldname})                           { $newRecord->{$fieldname} = $iRecord->{$fieldname}; }  # copy defined value
      elsif (&IT::DB::Common::isFieldNumeric($tableName, $fieldname)) { $newRecord->{$fieldname} = 0; }   # default undefined ints to 0
      else                                                            { $newRecord->{$fieldname} = ''; }  # default all other fields to ''
    }

    # set sequence
    if ($autoSequencing) { $newRecord->{'num'} = ++$autoSequencingRecordNum; } # define num automatically when autoSequencing enabled

    # add new record to recordset
    push @$recordset, $newRecord;
  }

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

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

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

  ### Load Recordset
  my $recordset = $VIRTUAL_TABLES{ $tableName }{'recordset'};

  # filter records
  my $matchingRecords = &_filterRecordset($tableName, $recordset, $whereQuery);

  # sort records
  $sortBy           ||= &IT::DB::Schema::getTableAttributes($tableName, 'defaultSort');
  my $sortedRecords = &_sortRecordset($tableName, $matchingRecords, $sortBy);

  # limit result set
  my $limitedRecords = &IT::DB::Common::limitRecordset($sortedRecords, $limit);

  ### execute rowcode for each record
  my $listedRecordCount = 0;

  foreach my $recordRef (@$limitedRecords) {
    my $recordCopy = { %$recordRef };     # avoid modifying record in datastore
    $ACTIVE_LIST_QUERY = 1;              # prevent other db functions that might recursively call this function from being called from rowcode
    &{$rowcode}($recordCopy);
    $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 : Load the datafile, then save it back one record at a time
# Usage       : called from DB_listSaveSlow
# ------------------------------------------------------------------------

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

  ### Load Recordset
  my $recordset       = $VIRTUAL_TABLES{ $tableName }{'recordset'};

  # filter records
  my $matchingRecords = &_filterRecordset($tableName, $recordset, $whereQuery);

  # sort records
  $sortBy           ||= &IT::DB::Schema::getTableAttributes($tableName, 'defaultSort');
  my $sortedRecords   = &_sortRecordset($tableName, $matchingRecords, $sortBy);

  # limit result set
  my $limitedRecords = &IT::DB::Common::limitRecordset($sortedRecords, $limit);

  ### execute rowcode for each record
  my $autoSequencing     = &IT::DB::Schema::getTableAttributes($tableName, 'autoSequencing');
  my $changedRecordCount = 0;

  ### Note: since recordref is a direct reference to the record in the datastore
  ### we don't have to do anything to save the changed record back.  We do need
  ### to remove it from the array when erasing records though.

  foreach my $recordRef (@$limitedRecords) {
    last if $LIST_STOP;                     # skip remaining records if liststop has been called
    my $originalRecord = { %$recordRef };   # 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}($recordRef);                # exec rowcode and modify record
    $ACTIVE_LIST_QUERY = 0;

    # check if num field was changed with autoSequencing on
    my $numChanged   = $originalRecord->{'num'} != $recordRef->{'num'};
    my $recordErased = !$recordRef->{'num'};
    if ($autoSequencing && $numChanged && !$recordErased) {
      die "can't change 'num' field when 'autoSequencing' is enabled";
    }

    # get a list of changed fields
    my @changedFields = grep { $originalRecord->{$_} ne $recordRef->{$_} } keys %$originalRecord;

    # error check new field values
    foreach my $fieldname (@changedFields) {
      &IT::DB::Common::dieOnValueSizeAndTypeErrors($tableName, $fieldname, $recordRef->{$fieldname});
    }

    # update changed record counter
    if (@changedFields) { $changedRecordCount++; }

    &IT::FileLock::renewLockTimeout();
  }
  $LIST_STOP = 0;

  ### remove records with no nums (user method to remove records in rowcode)
  for (my $index = $#$recordset; $index >= 0; $index--) {  # remove elements from end of array first so as to not change index positions
    my $isNumErased = ($recordset->[$index]{'num'} == 0);
    if ($isNumErased) { splice(@$recordset, $index, 1); }
  }

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

# ------------------------------------------------------------------------
# Function    : getSequence
# Usage       : called from DB_GetSequence
# ------------------------------------------------------------------------

sub getSequence {
  my $tableName = shift;
  ### Argument error checking done in IT::DB

  my $sequenceNum = $VIRTUAL_TABLES{ $tableName }{'sequence'};

  return $sequenceNum;
}


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

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

  $VIRTUAL_TABLES{ $tableName }{'sequence'} = $sequenceNum;
}

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

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

  my $recordset = $VIRTUAL_TABLES{ $tableName }{'recordset'} || die "no recordset defined for $tableName!";

  ### add field to  field defs
  my $fieldDefs   = $VIRTUAL_TABLES{ $tableName }{'fields'};
  my $newFieldDef = { 'name' => $fieldName, 'type' => $fieldType, 'index' => 0 };
  push @$fieldDefs, $newFieldDef;

  ### add field to each record
  foreach my $recordRef (@$recordset) {
    $recordRef->{$fieldName} = '';
  }

}


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

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

  my $recordset = $VIRTUAL_TABLES{ $tableName }{'recordset'} || die "no recordset defined for $tableName!";

  ### remove field from datastore field defs
  my $oldFieldDefs = $VIRTUAL_TABLES{ $tableName }{'fields'};
  my $newFieldDefs = [];
  my $removedField = 0;
  foreach my $fieldDef (@$oldFieldDefs) {
    if ($fieldDef->{'name'} eq $fieldName) {
      $removedField = 1;
      next;
    }
    push @$newFieldDefs, $fieldDef;
  }
  if (!$removedField) { die "Couldn't find drop field '$fieldName'!"; }
  $VIRTUAL_TABLES{ $tableName }{'fields'} = $newFieldDefs;

  ### remove field from each record
  foreach my $recordRef (@$recordset) {
    delete $recordRef->{$fieldName};
  }

}

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

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

  my $recordset = $VIRTUAL_TABLES{ $tableName }{'recordset'} || die "no recordset defined for $tableName!";

  ### update field defs
  my $fieldDefs = $VIRTUAL_TABLES{ $tableName }{'fields'};
  my $foundField = 0;
  foreach my $fieldDef (@$fieldDefs) {
    if ($fieldDef->{'name'} ne $oldFieldName) { next; }
    $fieldDef->{'name'} = $newFieldName;      # update field name
    $fieldDef->{'type'} = $newFieldType;      # update field type
    $foundField = 1;
  }
  if (!$foundField) { die "Couldn't find old field '$oldFieldName'!"; }

  ### rename field for each record
  foreach my $recordRef (@$recordset) {
    $recordRef->{$newFieldName} = delete $recordRef->{$oldFieldName};  # erase old field and assign value from old field to new field
  }

}

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

sub listTables {
  ### Argument error checking done in IT::DB

  my @tableNames = sort keys %VIRTUAL_TABLES;

  return @tableNames;
}

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

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

  # create table
  $VIRTUAL_TABLES{ $tableName } = {
    'name'            => $tableName,
    'recordset'       => [],
    'fields'          => $fieldDefs,
  };

  # set sequence
  &IT::DB::Virtual::setSequence($tableName, 0);
}

# ------------------------------------------------------------------------
# Function    : describeTable
# Description : open a datafile and return field information
# Usage       : called from DB_describeTable();
# ------------------------------------------------------------------------

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

  my $fieldDefs = $VIRTUAL_TABLES{ $tableName }{'fields'};

  return $fieldDefs;
}

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

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

  my $dropTableped = delete $VIRTUAL_TABLES{$tableName};
  if (!$dropTableped) { die "Table drop error: table didn't exist in hash!\n"; }
}

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

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

  # erase old table
  my $erasedValue = delete $VIRTUAL_TABLES{ $sourceTableName };

  # create new table
  $VIRTUAL_TABLES{ $targetTableName } = $erasedValue;

}

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

