#------------------------------------------------------------------------------
#$Author: andrius $
#$Date: 2020-12-10 06:44:47 -0500 (Thu, 10 Dec 2020) $ 
#$Revision: 7133 $
#$URL: svn://saulius-grazulis.lt/restful/tags/v0.15.2/lib/Database.pm $
#------------------------------------------------------------------------------
#*
#  An object to encapsulate a database connection for the RestfulDB
#  interface.
#**

package Database;
use warnings;
use strict;

require Exporter;
require RestfulDB::Schema::DBI;
our @ISA = qw( RestfulDB::Schema::DBI Exporter );
our @EXPORT_OK = qw(
    flatten_record_descriptions
    has_values
    null_if_empty
    prepare_record_descriptions_for_save_as_new
    start_revision_transaction_if_needed
);

use Clone qw(clone);
use Data::UUID;
use Digest::MD5 qw(md5_hex);
use DBI;
use File::Basename qw(basename);
use File::MimeInfo::Magic;
use List::MoreUtils qw(uniq);
use List::Util qw(any);
use LWP::Simple;
use Object::Lazy;
use POSIX qw(strftime);
use Digest::SHA qw(sha256_hex);

use Database::Filter;
use Database::Order;
use Database::View;
use RestfulDB::Defaults;
use RestfulDB::Exception;
use RestfulDB::Schema::DBI;
use RestfulDB::SQL qw(
    is_blob
    is_character_string
    is_internal_SQLite_table
    is_numerical
);

use Memoize;
memoize('_get_table_list');

our $filter_operators = {
    eq => '=',
    ne => '!=',
    gt => '>',
    lt => '<',
    le => '<=',
    ge => '>=',
    contains => 'contains',
    starts => 'starts with',
    ends => 'ends with',
    known => 'is known',
    unknown => 'is unknown',
    ## Removing 'like' and 'unlike' for now as they are not supported
    ## by OPTiMaDe specification
    # like => 'like',
    # unlike => 'unlike',
};

our $date_re = q/[0-9]{4}-[01][0-9]-[0123][0-9]/;
our $uuid_re = q/[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}/;

our $debug_sql = 0;

#=======================================================================
# Constructor and destructor

sub new
{
    my( $class, $options ) = @_;
    my $self = {};

    $self->{db}{content} = { %{$options->{content_db} } };
    $self->{db}{meta} = { %{$options->{meta_db} } } if exists $options->{meta_db};

    return bless $self;
}

sub DESTROY
{
    my $self = shift @_;
    $self->disconnect();
}

#=======================================================================
# Methods of the object

sub connect
{
    my( $self, $options ) = @_;
    $options = {} unless $options;
 
    if( $self->{db}{meta} && !$self->{db}{meta}{dbh} ) {
        # Connect to user-specified metadatabase
        $self->{db}{meta}{dbh} = _connect( $self->{db}{meta} );
    } elsif( !$self->{db}{meta} ) {
        # Try to infer the location of metadatabase
        my @candidates;

        if( $self->{db}{content}{DB} &&
            $self->{db}{content}{DB} =~ /^
                                            (.*\/)      # dirname part
                                            ([^\/]+)    # database basename
                                            (\.[^\/.]+) # extension
                                        $/x ) {
            my( $prefix, $dbname, $suffix ) = ( $1, $2, $3 );
            @candidates = ( "${prefix}${dbname}_restful${suffix}",
                            "${prefix}restful${suffix}" );
        } elsif( $self->{db}{content}{DB} ) {
            @candidates = ( $self->{db}{content}{DB} . '_restful',
                            'restful' );
        } else {
            @candidates = ( 'restful' );
        }

        $self->{db}{meta} = { %{ $self->{db}{content} } };
        delete $self->{db}{meta}{dbh};
        foreach (@candidates) {
            eval {
                $self->{db}{meta}{DB} = $_;
                $self->{db}{meta}{dbh} = _connect( $self->{db}{meta},
                                                   $RestfulDB::Defaults::database_user );
            };
            $@ ? delete $self->{db}{meta}{dbh} : last;
        }
        delete $self->{db}{meta} if !$self->{db}{meta}{dbh};
    }

    my $db_user = defined $self->{db}{content}{user} ? 
                        $self->{db}{content}{user} :
                        $RestfulDB::Defaults::database_user;
    if( defined $self->{db}{meta}{dbh} ) {
        my $username_hash = get_username_hash( $db_user );

        $db_user = $username_hash ?
    	    		    $self->get_db_username( $username_hash ) :
                        $db_user;
        $self->{db}{content}{user} = $db_user ? $db_user : 
                                                $self->{db}{content}{user};
    }

    if( !$self->{db}{content}{dbh} ) {
         $self->{db}{content}{dbh} = _connect( $self->{db}{content}, $db_user );
    }
    die $DBI::errstr if !$self->{db}{content}{dbh};
}

sub disconnect
{
    my $self = shift @_;

    _disconnect( $self->{db}{content}{dbh} ) if $self->{db}{content}{dbh};
    _disconnect( $self->{db}{meta}{dbh} ) if $self->{db}{meta}{dbh};
    
    delete $self->{db}{content}{dbh};
    delete $self->{db}{meta}{dbh};
}

## @method generate_revision_id ($id)

# Insert a new revision ID into a designated database revision table,
# and populate it with relevant metadata. Return a newly generated
# revision ID.

sub generate_revision_id
{
    my ($db) = @_;

    # FIXME: the $env parameter (a hash with all environment
    # variables, most probably coming from CGI), must be in future
    # passed down as a parameter:
    my $env = \%ENV;

    my $column_sql_types =
        $db->get_column_type_hash( $RestfulDB::Defaults::revision_table );

    # Collect all values and columns that are to be inserted:

    my %values;
    for my $column_name (qw( remote_user server_addr server_name
                             http_user_agent remote_addr http_host )) {
        my $env_key = uc( $column_name );
        if( exists $column_sql_types->{$column_name} &&
            exists $env->{$env_key} ) {
            $values{$column_name} = $env->{$env_key};
        }
        if( exists $env->{$env_key} ) {
            # FIXME: can this be removed? (A.M.)
            $env->{$env_key} =~ /^(.*)$/;
        }
    }

    if( exists $column_sql_types->{uuid} ) {
        my $uuid_gen = Data::UUID->new;
        $values{uuid} = lc( $uuid_gen->create_str() );
    }
    
    if( exists $column_sql_types->{env_text} ) {
        $values{env_text} = join( "\n", map { $_ . ': ' . $env->{$_} }
                             sort keys %$env );
    }

    if( exists $column_sql_types->{db_user} ) {
        # A username which was used to connect to a database:
        $values{db_user} = $db->{db}{content}{user};
    }

    if( exists $column_sql_types->{timestamp} ) {
        # A current GMT timestamp:
        $values{timestamp} = strftime( "%F %T", gmtime());
    }

    # Perform database insertion:

    my $dbh = $db->{db}{content}{dbh};
    my $delim = $db->{db}{content}{delim};
    my $insert_sql = "INSERT INTO ${delim}${RestfulDB::Defaults::revision_table}${delim} (" .
                     (join ', ', map { "${delim}$_${delim}" } sort keys %values) .
                     ') VALUES (' .
                     (join ', ', ('?') x scalar keys %values ) . ')';
    print STDERR "$insert_sql\n" if $debug_sql;
    my $rows_affected =
        $dbh->do( $insert_sql, undef,
                  map { $values{$_} } sort keys %values );

    if( !defined $rows_affected ) {
        die $dbh->errstr;
    }

    my $db_revid;
    if( exists $values{uuid} ) {
        $db_revid =
            $dbh->selectrow_array( 'SELECT id FROM ' .
                                   $delim . $RestfulDB::Defaults::revision_table . $delim .
                                   ' WHERE uuid = ?', undef, $values{uuid} );
        if( ! defined $db_revid ) {
            die 'could not determine revision ID from the UUID ' .
                'which was just inserted: ' . $dbh->errstr;
        }
    } else {
        $db_revid =
            $dbh->selectrow_array( 'SELECT max(id) FROM ' .
                                   $delim . $RestfulDB::Defaults::revision_table . $delim );
        if( ! defined $db_revid ) {
            die 'could not determine revision ID as max(id): ' . $dbh->errstr;
        }
    }

    return $db_revid;
}

## @method begin_transaction ($db)
#
#  Start a database transaction; take into account different SQL
#  flavors for different engines. Raise exception (die) if transaction
#  start failed.

sub begin_transaction
{
    my ($db) = @_;

    my $dbh = $db->{db}{content}{dbh};
    my $row_count = 
        $db->{db}{content}{engine} eq 'mysql' ?
        $dbh->do("START TRANSACTION") :
        $dbh->do("BEGIN TRANSACTION");
    die 'could not start transaction for the database ' .
        "'$db->{db}{content}{DB}': " . $dbh->errstr()
        if ! defined $row_count;
}

## @method commit_transaction ($db)
#
#  Commit a database transaction; take into account different SQL
#  flavors for different engines. Raise exception (die) if transaction
#  start failed.

sub commit_transaction
{
    my ($db) = @_;

    my $dbh = $db->{db}{content}{dbh};
    my $row_count =
        $db->{db}{content}{engine} eq 'mysql' ?
        $dbh->do("COMMIT") :
        $dbh->do("COMMIT TRANSACTION");
    die 'could not commit transaction for the database ' .
        "'$db->{db}{content}{DB}': " . $dbh->errstr()
        if ! defined $row_count;
}

## @method start_revision_transaction_if_needed ($db,$table)
#
# Generate automatically a new revision record and revision_id if
# necessary.

sub start_revision_transaction_if_needed
{
    my ($db, $db_table) = @_;
    
    my $dbrev_columns = [ $db->get_column_of_kind( $db_table, 'dbrev' ) ];
    my $in_transaction = 0;
    my $dbrevision_id;

    if( @$dbrev_columns && $db->can_autogenerate_revision_id( $db_table ) ) {
        $db->begin_transaction();
        $in_transaction = 1;
        $dbrevision_id = $db->generate_revision_id();
    }

    return ( $in_transaction, $dbrevision_id, $dbrev_columns );
}

## @method _insert_record ($db, $params, $db_table, $options)
# Inserts a single record into a single table. Generates UUIDs if not
# provided. Returns a hashref of unique columns with their values.
#
# @param db Database object
# @param params hash of fields for a record
sub _insert_record
{
    my ($db, $params, $db_table, $options) = @_;

    $options = {} unless $options;
    my( $id_column ) =
        ( $options->{id_column} );

    $id_column = $db->get_id_column( $db_table ) unless $id_column;

    my %params = %$params;
    my $handles = exists $options->{handles} ? $options->{handles} : {};
    my %handles = %$handles;

    my $columns = $db->get_column_properties( $db_table );

    # Detecting UUID and other unique columns:
    my @uuid_columns;
    if( $columns && $columns->{coltype} ) {
        @uuid_columns = grep { $columns->{coltype}{$_} &&
                               $columns->{coltype}{$_} eq 'uuid' }
                             sort keys %{$columns->{coltype}};
    }
    my @unique_columns = uniq (@uuid_columns,
                               $db->get_unique_columns( $db_table ));

    my $column_sql_types = $db->get_column_type_hash( $db_table );
    for my $column (keys %$column_sql_types) {
        next if !exists $params{$column};

        if( $db->{db}{content}{engine} eq 'mysql' &&
            lc $column_sql_types->{$column} eq 'date' ) {
            # Trimming dates for MySQL
            $params{$column} = trim_mysql_date( $params{$column} );
        }

        # Converting values of non-character and non-blob SQL types to NULL
        # values.
        $params{$column} = null_if_empty( $params{$column},
                                          $column_sql_types->{$column},
                                          $columns->{coltype}{$column} );
    }

    # Detecting exact duplicates:
    my %record_keys;
    my @matching_records;
    if( $options->{duplicates} &&
        $options->{duplicates} =~ /^(ignore|update)$/ ) {
        %record_keys = map { $_ => $params{$_} }
                           grep { defined $params{$_} }
                                @unique_columns;
        if( %record_keys ) {
            my $filter =
                Database::Filter->new_for_conjunction( [ map { [ $_ ] }
                                                             sort keys %record_keys ],
                                                       [ map { $record_keys{$_} }
                                                             sort keys %record_keys ] );
            my $records = $db->get_records( $db_table,
                                            undef,
                                            { filter => $filter } );
            @matching_records = @$records;
        }
        if( $options->{duplicates} eq 'ignore' && @matching_records ) {
            return \%record_keys;
        }
    }

    # Adding revision ID if supplied and required in the table:
    if( $options->{revision} ) {
        my @dbrev_columns = $db->get_column_of_kind( $db_table, 'dbrev' );
        for my $column (@dbrev_columns) {
            $params{$column} = $options->{revision};
        }
    }

    # Handling UPSERTs
    if( $options->{duplicates} && $options->{duplicates} eq 'update' ) {
        if( @matching_records ) {
            # Removing undefined values
            %params = map { defined $params{$_} || $handles{$_}
                            ? ( $_ => $params{$_} ) : () }
                          keys %params;

            $db->_update_record( \%params,
                                 $matching_records[0]->{$id_column},
                                 $db_table,
                                 { handles => $handles } );
            return \%record_keys, $options->{revision};
        }
    }

    # Checking whether at least one value for automatically generated
    # columns is provided:
    my $mandatory_columns = $db->get_mandatory_columns( $db_table );
    my @autogenerated_columns;
    my $value_for_autogenerated_column_present;
    for my $column (@$mandatory_columns) {
        next if !$db->is_autogenerated( $db_table, $column );
        next if !grep { $column eq $_ } $db->get_unique_columns( $db_table );

        push @autogenerated_columns, $column;

        next if !exists  $params{$column};
        next if !defined $params{$column};

        $value_for_autogenerated_column_present = 1;
    }
    if( @autogenerated_columns && !$value_for_autogenerated_column_present ) {
        local $" = "', '";
        InputException->throw( 'Value for at least one of mandatory ' .
                               'automatically generated columns (' .
                               "'@autogenerated_columns') is required " .
                               "to insert a new record into '$db_table'." );
    }

    # Automatically generate UUIDs for inserted rows, if necessary:
    my $uuid_gen = Data::UUID->new;
    for my $key (@uuid_columns) {
        next if $params{$key};
        $params{$key} = lc $uuid_gen->create_str();
    }

    # Validating the input data
    for my $column (sort keys %{$columns->{validation_regex}}) {
        my $regex = $columns->{validation_regex}{$column};
        next if !$regex;
        validate_with_regex( $column, $params{$column}, $regex );
    }

    # Loading blobs
    for my $column_name (keys %params) {
        next if !exists $column_sql_types->{$column_name} ||
                !defined $column_sql_types->{$column_name} ||
                !is_blob( $column_sql_types->{$column_name} );

        if( !$handles{$column_name} ) {
            warn "Cannot insert file contents of field '$column_name': " .
                 'either file cannot be read or not a file submitted.';
            next;
        }

        %params = process_uploaded_file( $handles{$column_name},
                                         \%params,
                                         $column_name,
                                         $params{$column_name},
                                         $columns );
    }

    # Removing undefined values
    %params = map { defined $params{$_} ? ( $_ => $params{$_} ) : () }
                  keys %params;

    # Requiring all mandatory values
    my @missing_columns = grep { $_ ne $id_column && !exists $params{$_} }
                               @$mandatory_columns;
    if( @missing_columns ) {
        local $" = "', '";
        InputException->throw( 'Value(s) for mandatory column(s) ' .
                               "'@missing_columns' of table '$db_table' " .
                               "are missing, cannot insert record." );
    }

    my @inserted_column_params = sort keys %params;

    my $sth = $db->prepare_insert_record( $db_table,
                                          \@inserted_column_params,
                                          $id_column );

    my @new_values;
    for my $inserted_column_param ( @inserted_column_params ) {
        push @new_values, $params{$inserted_column_param};
    }

    %record_keys = map { defined $params{$_} ? ($_ => $params{$_}) : () }
                       @unique_columns;

    # Actual insert
    my $affected_rows = $sth->execute( @new_values );
    if( !$affected_rows ) {
        local $" = ',';
        my @new_values_printable = map { defined $_ ? $_ : '' }
                                       @new_values;
        $db->error( 'Error while executing prepared INSERT statement ' .
                    "with values @new_values_printable " .
                    $sth->errstr . " '" . $db->{db}{content}{DB} . "'" );
    }

    my $dbh   = $db->{db}{content}{dbh};
    my $delim = $db->{db}{content}{delim};
    if( !%record_keys && $id_column &&
        any { $_ eq $id_column } @unique_columns ) {
        my $max_sql = "SELECT MAX(${delim}${id_column}${delim}) " .
                      "FROM ${delim}${db_table}${delim}";
        print STDERR "$max_sql\n" if $debug_sql;
        my( $id ) = $dbh->selectrow_array( $max_sql ) ||
            die "'$max_sql' failed: " . DBI::errstr;
        $record_keys{$id_column} = $id if defined $id;
    }

    return (%record_keys ? \%record_keys : undef,
            $options->{revision}); 
}

## @method _update_record ($db, $params, $record_id, $db_table, $options)
# Updates a single record in a single table. Unsets columns if requested.
#
# @param db Database object
# @param params hash of fields for a record
sub _update_record
{
    my ($db, $params, $record_id, $db_table, $options) = @_;

    return if !%$params;
    if( !defined $record_id ) {
        InputException->throw(
            'Record ID is not supplied for update operation.' );
    }

    $options = {} unless $options;
    if( !exists $options->{id_column} ) {
        $options->{id_column} = $db->get_id_column( $db_table );
    }

    my %params = %$params;
    my $handles = exists $options->{handles} ? $options->{handles} : {};
    my %handles = %$handles;

    my $column_sql_types = $db->get_column_type_hash( $db_table );
    my $id_column = $options->{id_column};
    my $delim = $db->{db}{content}{delim};

    my $columns = $db->get_column_properties( $db_table );
    for my $column (keys %$column_sql_types) {
        next if !exists $params{$column};

        if( $db->{db}{content}{engine} eq 'mysql' &&
            lc $column_sql_types->{$column} eq 'date' ) {
            # Trimming dates for MySQL
            $params{$column} = trim_mysql_date( $params{$column} );
        }

        # Converting values of non-character and non-blob SQL types to NULL
        # values.
        $params{$column} = null_if_empty( $params{$column},
                                          $column_sql_types->{$column},
                                          $columns->{coltype}{$column} );
    }

  COLUMN:
    for my $key (sort keys %params) {
        my $value = $params{$key};
        delete $params{$key};

        if( $columns->{validation_regex}{$key} ) {
            validate_with_regex( $key,
                                 $value,
                                 $columns->{validation_regex}{$key} );
        }

        if ( exists $column_sql_types->{$key} &&
             defined $column_sql_types->{$key} &&
             is_blob($column_sql_types->{$key}) ) {

            if( !$handles{$key} ) {
                warn "Cannot insert file contents of field '$key': " .
                     'either file cannot be read or not a file submitted.';
                next;
            }

            %params = process_uploaded_file( $handles{$key},
                                             \%params,
                                             $key,
                                             $value,
                                             $columns );
            next;
        } elsif( !$value &&
                 exists  $columns->{coltype}{$key} &&
                 defined $columns->{coltype}{$key} &&
                 $columns->{coltype}{$key} eq 'uuid' ) {
            my $uuid_gen = Data::UUID->new;
            my $uuid = lc( $uuid_gen->create_str() );
            $value = $uuid;
        }

        $params{$key} = $value;
    }

    # Requiring all mandatory values to be defined
    my $mandatory_columns = $db->get_mandatory_columns( $db_table );
    my @missing_columns = grep { exists   $params{$_} &&
                                 !defined $params{$_} }
                               @$mandatory_columns;
    if( @missing_columns ) {
        local $" = "', '";
        InputException->throw( 'Value(s) for mandatory column(s) ' .
                               "'@missing_columns' of table '$db_table' " .
                               "are missing, cannot update record." );
    }

    my @new_keys;
    my @new_values;
    for my $key (sort keys %params) {
        push @new_keys, $key;
        push @new_values, $params{$key};
    }
    my $sql_statement = "UPDATE ${delim}${db_table}${delim} SET " .
                        join( ', ', map { "${delim}$_${delim} = ?" }
                                        @new_keys ) . ' ' .
                        "WHERE ${delim}${id_column}${delim} = ?";

    print STDERR "$sql_statement\n" if $debug_sql;
    my $sth = $db->{db}{content}{dbh}->prepare( $sql_statement ) or
        $db->error( "Error preparing statement '$sql_statement' " .
                    "for database '" . $db->{db}{content}{DB} . "': " .
                    DBI::errstr );

    my $affected_rows = $sth->execute( @new_values, $record_id );
    if( !$affected_rows ) {
        $db->error( "Error while executing prepared statement " .
                    "'$sql_statement' (with values " .
                    join( ",", @new_values ) . "): " .
                    $sth->errstr . " '" . $db->{db}{content}{DB} . "'" );
    }

    if( $affected_rows eq '0E0' ) {
        RecordNotFoundException->throw(
            "Record with '${id_column}' = '$record_id' not found, so not updated." );
    }

    $sth->finish;
}

# \todo Rewrite using delete()
sub delete_record
{
    my ($db, $record_id, $db_table, $options) = @_;

    $options = {} unless $options;
    if( !exists $options->{id_column} ) {
        $options->{id_column} = $db->get_id_column( $db_table );
    }

    my $id_column = $options->{id_column};
    my $delim = $db->{db}{content}{delim};

    my ( $in_transaction, $dbrevision_id, $dbrev_columns ) =
        $db->start_revision_transaction_if_needed( $db_table );

    my $sql_statement = "DELETE FROM ${delim}${db_table}${delim} " .
                        "WHERE ${delim}${id_column}${delim} = ?";

    print STDERR "$sql_statement\n" if $debug_sql;
    my $sth = $db->{db}{content}{dbh}->prepare( $sql_statement ) or
        $db->error( "Error preparing statement '$sql_statement' " .
                    "for database '" . $db->{db}{content}{DB} . "': " .
                    DBI::errstr );

    $sth->execute( ($record_id) ) or
        $db->error( "Error while executing prepared DELETE statement " .
                    "'$sql_statement': " . $sth->errstr . " '" .
                    $db->{db}{content}{DB} . "'" );

    $sth->finish;

    if( $in_transaction ) {
        $db->commit_transaction();
    }
}

sub delete($$$)
{
    my( $db, $db_table, $filter ) = @_;

    my $delim = $db->{db}{content}{delim};

    $filter->canonicalize_table_names( $db->get_table_list );
    my( $where_clause, $values ) = $filter->where_clause( $delim );

    my ( $in_transaction, $dbrevision_id, $dbrev_columns ) =
        $db->start_revision_transaction_if_needed( $db_table );

    my $sql_statement = "DELETE FROM ${delim}${db_table}${delim} " .
                        $where_clause;

    print STDERR "$sql_statement\n" if $debug_sql;
    my $sth = $db->{db}{content}{dbh}->prepare( $sql_statement ) or
        $db->error( "Error preparing statement '$sql_statement' " .
                    "for database '" . $db->{db}{content}{DB} . "': " .
                    DBI::errstr );

    my $affected_rows = $sth->execute( @$values ) or
        $db->error( "Error while executing prepared DELETE statement " .
                    "'$sql_statement': " . $sth->errstr . " '" .
                    $db->{db}{content}{DB} . "'" );

    $sth->finish;

    if( $in_transaction ) {
        $db->commit_transaction();
    }

    return $affected_rows + 0;
}

## @method get_count ($db, $table, $filter)
# Returns count of entries in a data table, optionally matching supplied
# WHERE statement.
#
# @param db Database object
# @param table table name
# @param filter Database::Filter object (optional)
sub get_count
{
    my ($db, $table, $filter ) = @_;

    my $sth = $db->search( $table, { filter => $filter,
                                     count => 1 } );
    my @row = $sth->fetchrow_array();

    return $row[0];
}

# Prepares DBI statement handle for INSERT statements.
sub prepare_insert_record
{
    my ($db, $db_table, $columns, $id_column, $options) = @_;

    $options = {} unless $options;

    my $delim = $db->{db}{content}{delim};

    my @columns = @$columns;

    # Handling the request to ignore duplicates:
    my $insert = 'INSERT';
    if( exists $options->{duplicates} &&
        lc($options->{duplicates}) eq 'ignore' ) {
        if( $db->{db}{content}{engine} eq 'mysql' ) {
            $insert .= ' IGNORE';
        } else {
            $insert .= ' OR IGNORE';
        }
    }

    my $sql_statement = "$insert INTO $delim$db_table$delim ( " .
                        join( ', ', map { "${delim}${_}${delim}" }
                                        @columns ) .
                        ' ) VALUES ( ' .
                        join( ', ', ('?') x int @columns ) . ' )';

    if( !@columns ) {
        InputException->throw( 'no columns provided for INSERT statement ' .
                               "for table '$db_table': '$sql_statement'" );
    }

    if( exists $options->{duplicates} &&
        $db->{db}{content}{engine} eq 'mysql' ) {
        if( lc($options->{duplicates}) eq 'update' ) {
            my $update_columns = join ', ',
            map { "${delim}$_${delim} = VALUES(${delim}$_${delim})" } @columns;
            $sql_statement .= " ON DUPLICATE KEY UPDATE " . $update_columns;
        }
    }

    print STDERR "$sql_statement\n" if $debug_sql;
    my $sth = $db->{db}{content}{dbh}->prepare( $sql_statement ) or
        $db->error( "Error preparing statement '$sql_statement' " .
                    "for database '" . $db->{db}{content}{DB} . "': " .
                    DBI::errstr );

    return $sth;
}

## @method search ($db, $db_table, %$options)
# Searches the table for values matching an optional criteria. Returns
# DBI statement handle. For SQLite2 databases a paginated result is
# returned.
#
# @param db Database object
# @param table table name
# @param options options (optional)
# \code{perl} {
#       offset => 'offset for pagination (non-SQLite2 databases only)',
#       rows   => 'max. rows for pagination (non-SQLite2 databases only)',
#       filter => 'Database::Filter object',
#       order  => 'Database::Order object',
# }
# \endcode
sub search
{
    my ($db, $db_table, $options) = @_;

    my $delim = $db->{db}{content}{delim};
    my $engine = $db->{db}{content}{engine};

    my( $filter, $order, $rows, $offset, $count ) =
        ( $options->{filter},
          $options->{order},
          $options->{rows},
          $options->{offset},
          $options->{count},
        );

    my( $where_clause, $values );
    if( $filter ) {
        $filter->canonicalize_table_names( $db->get_table_list );
        ( $where_clause, $values ) = $filter->where_clause( $delim );
    }

    my $order_clause;
    if( $order ) {
        $order_clause = $order->order_clause( $delim );
    }

    $where_clause = $where_clause ? " $where_clause" : '';
    $order_clause = $order_clause ? " $order_clause" : '';

    my $foreign_keys = $db->get_foreign_keys( $db_table );

    my @columns = ( $delim . $db_table . $delim . '.*' );
    my @tables = ( $delim . $db_table . $delim );
    for my $fk (@$foreign_keys) {
        next if !$fk->is_composite;
        my $parent_table = $fk->parent_table;
        my $id_column = $db->get_id_column( $parent_table );
        push @columns, "${delim}${parent_table}${delim}." .
                       "${delim}${id_column}${delim} AS " .
                       $delim . $fk->name . $delim;
        my @child_columns = $fk->child_columns;
        my @parent_columns = $fk->parent_columns;
        push @tables, "LEFT JOIN ${delim}${parent_table}${delim} ON " .
                      join( ' AND ', map { "${delim}${db_table}${delim}." .
                                           "${delim}$child_columns[$_]${delim} = " .
                                           "${delim}${parent_table}${delim}." .
                                           "${delim}$parent_columns[$_]${delim}" }
                                         0..$fk->size-1 );
    }

    if( $options->{count} ) {
        # Only COUNT(*) requested
        @columns = ( 'count(*)' );
    }

    my @values;
    @values = @$values if $values && ref $values;

    my $sql_statement = 'SELECT ' . join( ', ', @columns ) . ' ' .
                        'FROM ' . join( ' ', @tables ) .
                        $where_clause . $order_clause;
    if( $engine ne 'SQLite2' && defined $offset && defined $rows ) {
        $sql_statement .= ' LIMIT ?, ?';
        push @values, $offset;
        push @values, $rows;
    }

    print STDERR "$sql_statement\n" if $debug_sql;
    my $sth = $db->{db}{content}{dbh}->prepare( $sql_statement ) or
        $db->error( "could not prepare SELECT statement: $DBI::errstr" );
    $sth->execute( @values ) ||
        $db->error( "'$sql_statement' failed: " . DBI::errstr );

    return $sth;
}

## @method get_records ($db, $table, $record_id, $options)
# Returns values of all columns of records as reference to an array of
# hash references.
# \todo $record_id should be moved to $options as an optional parameter
sub get_records
{
    my ($db, $table, $record_id, $options) = @_;

    $options = {} unless $options;
    my( $id_column, $filter, $order, $rows, $offset, $no_cache ) = (
        $options->{id_column},
        $options->{filter},
        $options->{order},
        $options->{rows},
        $options->{offset},
        $options->{no_cache},
        );

    $id_column = $db->get_id_column( $table ) unless $id_column;

    if( defined $record_id ) {
        my $comparison = OPTIMADE::Filter::Comparison->new( '=' );
        $comparison->left( OPTIMADE::Filter::Property->new( $table, $id_column ) );
        $comparison->right( $record_id );
        $filter = Database::Filter->new_from_tree( $comparison );
    }

    # As ORDER clauses may be complex, we cannot cache them.
    if( !$no_cache && ( !$order || !@$order ) ) {
        my $cache = $db->{db}{content}{cache}{$table};
        my @cache_key = ( $filter ? $filter->query_string : ('') );
        if( !exists $cache->{@cache_key} ) {
            $cache->{@cache_key} = $db->get_records( $table, undef,
                                                     { id_column => $id_column,
                                                       filter => $filter,
                                                       no_cache => 1 } );
        }

        my @records;
        foreach( @{$cache->{@cache_key}} ) {
            if( defined $record_id && $_->{$id_column} ne $record_id ) {
                next;
            }
            if( defined $offset && $offset > 0 ) {
                $offset--;
                next;
            }
            push @records, $_;
            last if $rows && @records == $rows;
        }

        return \@records;
    }

    my $sth = $db->search( $table,
                           {
                             filter       => $filter,
                             order        => $order,
                             rows         => $rows,
                             offset       => $offset,
                           } );

    my $db_engine = $db->{db}{content}{engine};

    # Skipping $offset of rows for SQLite2
    if( $db_engine eq 'SQLite2' && $offset ) {
        for (1..$offset) {
            $sth->fetchrow_hashref();
        }
    }

    my @results;
    while( my $row = $sth->fetchrow_hashref() ) {
        last if $db_engine eq 'SQLite2' &&
            defined $rows && $rows == @results;
        push @results, $row;
    }
    return \@results;
}

# @method get_column_data ($db, $table, $record_key, $record_column, $id_column)
# Returns data for record $record_key from column $record_column.
#
# @retval data
# Data (possibly binary) from the column.
sub get_column_data
{
    my ($db, $table, $record_key, $record_column, $id_column) = @_;

    die 'record_key is undefined' unless defined $record_key;

    $id_column = $db->get_id_column( $table ) unless $id_column;

    my $comparison = OPTIMADE::Filter::Comparison->new( '=' );
    $comparison->left( OPTIMADE::Filter::Property->new( $table, $id_column ) );
    $comparison->right( $record_key );
    my $filter = Database::Filter->new_from_tree( $comparison );

    my $records = $db->get_records( $table,
                                    undef,
                                    { id_column => $id_column,
                                      filter => $filter } );
    return $records->[0]{$record_column};
}

## @method get_record_descriptions ($db, $db_table, %$options)
# Generates a schema for a table and its related tables, optionally
# fills it with data (if available).
#
# @param db Database object
# @param db_table table name
# @param options option hash (optional). May contain the following keys:
#   * record_id - an ID of record to return together with the schema
#   * seen_tables - hash index of already seen tables to prevent
#       circular visiting of related tables, effectively turning graph
#       into spanning tree
#   * no_foreign - do not add schemata/record data from foreign records
#   * no_related - do not add schemata/record data from related tables
#   * show_fk_values - add schemata/record data of all fk related records.
#   * show_enumeration_values - add hash of lists of possible enumerator values.
#
# @retval DOMs
# \code{perl}
# $DOMs = [
# {
#   metadata => {
#                  table_name => 'table_name',
#                  # fk column that links current related table to the parent. Optional,
#                  # because the top level table has no parent tables.
#                  fk => 'column1',
#                  # Order in which the columns should be displayed or listed:
#                  column_order => [ 'column1', 'column2' ],
#                  # Order in which related tables should be displayed or listed:
#                  related_table_order => [ 'table1', 'table2' ],
#                  enumeration_values =>
#                     {
#                       'column1' => [ 'enum1', 'enum2', ... ],
#                       'column2' => [ 'enum1', 'enum2', ... ],
#                       ...
#                     },
#                  # Action that will be available for form_parameters_to_descriptions().
#                  action => 'update',
#               },
#   columns  => {
#     # Descriptions for regular table columns:
#     'column1' => {
#                  value => 'value if any',
#                  sqltype => 'SQL data type',
#                  coltype => 'Column type from metdata',
#                             # from table `description`', database schema, 
#                             # or guessed from column name
#                  urlvalue => 'URL for values of type blob',
#                  mandatory => 1, # for NOT NULL columns
#                },
#     # Descriptions for parent records:
#     'column2' => {
#                  value => 'value if any',
#                  sqltype => 'SQL data type',
#                  coltype => 'Column type from metdata table `description`',
#                  fk_target => {
#                      metadata => {
#                          table_name => 'table1', # N:1 related table name
#                          fk_values => [
#                              {
#                                  metadata => {
#                                      table_name => 'table1',
#                                  },
#                              columns  => {
#                                 'fktable_column1' => { ... },
#                              }, ...
#                          ],
#                      },
#                      columns  => {
#                          'fktable_column1' => { ... },
#                          # .. and so on, as returned by get_record_descriptions()
#                          # recursively
#                      },
#                  },
#                },
#   },
#   related_tables => {
#     # Descriptions for child records:
#     'table1' => $db->get_record_descriptions( $db, 'table1', ... ),
#     'table2' => $db->get_record_descriptions( $db, 'table2', ... ),
#     # ...
#   }
# },
# ...
# ]
# \endcode
sub get_record_descriptions
{
    my($db, $db_table, $options) = @_;

    $options = {} unless $options;
    my ($record_id, $id_column, $filter, $order, $seen_tables, $web_base,
        $no_foreign, $no_related, $no_empty, $no_views, $foreign_key,
        $show_fk_values, $show_enumeration_values, $requested_tables,
        $rows, $offset, $depth, $template, $fk_data) = (
        $options->{record_id},
        $options->{id_column},
        $options->{filter},
        $options->{order},
        $options->{seen_tables},
        $options->{web_base},
        $options->{no_foreign},
        $options->{no_related},
        $options->{no_empty},
        $options->{no_views},
        $options->{foreign_key},
        $options->{show_fk_values},
        $options->{show_enumeration_values},
        $options->{requested_tables},
        $options->{rows},
        $options->{offset},
        $options->{depth},
        $options->{template},
        $options->{fk_data}
    );

    $seen_tables = {} unless $seen_tables;
    $id_column = $db->get_id_column( $db_table ) unless $id_column;
    $web_base = '' unless $web_base;
    if( defined $depth && $depth == 0 ) {
        $no_related = 1;
    }
    $depth-- if $depth && $depth > 0;

    # Load all information about database columns:
    my $column_properties = $db->get_column_properties( $db_table );
    my $column_names = [ $db->get_column_names( $db_table, { display => 'all' } ) ];
    #print STDERR "column_names: ". join(",",@{$column_names})." \n";
    my $foreign_keys = $db->get_foreign_keys( $db_table );
    my $column_sql_types = $db->get_column_type_hash( $db_table );
    my $column_lengths = $db->get_column_lengths( $db_table );
    my $resolvers = $db->get_resolvers( $db_table );
    my $real_id_column = $db->get_id_column( $db_table );
    my $mandatory_columns = { map { $_ => 1 } @{$db->get_mandatory_columns( $db_table )} };

    # Load record data from relevant table rows, recursively:
    my @data;
    if( $template ) {
        @data = ( undef );
    } elsif( defined $fk_data) {
        @data = ($fk_data);
    } else {
        my $order_now = Database::Order->new();
        $order_now = $order->order_for_table( $db_table ) if $order;

        if( $real_id_column ) {
            $order_now = Database::Order->new( @$order_now,
                                               [ $db_table, $real_id_column, 'a' ] );
        } else {
            $order_now = Database::Order->new( @$order_now,
                                               map { [ $db_table, $_, 'a' ] }
                                                   @$column_names );
        }

        @data = @{$db->get_records( $db_table, $record_id,
                                    { id_column => $id_column,
                                      filter => $filter,
                                      order => $order_now,
                                      rows => $rows,
                                      offset => $offset,
                                      cache => 1 } )};
    }

    @data = ( undef ) if !@data && !$no_empty;

    my $fk_cache;
    my @dom;
    for my $data (@data) {
        # ID of this particular record:
        my $record_id = $data && $real_id_column ? $data->{$real_id_column} : undef;

        # Generate the DOM:
        my $dom = { metadata => { table_name => $db_table } };

        $dom->{metadata}{column_order} = $column_names;
        $dom->{metadata}{related_table_order} = [];
        $dom->{metadata}{foreign_key} = $foreign_key if defined $foreign_key;
        $dom->{metadata}{filter} = $filter;

        if( defined $record_id ) {
            $dom->{metadata}{action} = 'update';
        } else {
            $dom->{metadata}{action} = 'insert';
        }

        my $fk_format = $db->get_fk_format( $db_table );
        if( defined $fk_format ) {
            $dom->{metadata}{fk_format} = $fk_format;
        }

        # Generating schema/loading values for columns and 1:N-related
        # records
        for my $column (keys %$column_sql_types) {
            my $value;
            if( $data ) {
                $value = $data->{$column};
                if( !$db->{db}{content}{user} 
                    && defined ($column_properties->{display}{$column}) 
                    && $column_properties->{display}{$column} eq 'foruser' ){
                    $value = 'Confidential. Please get authorisation to get full data.';
                }
            }

            $dom->{columns}{$column}{sqltype}  = $column_sql_types->{$column};
            $dom->{columns}{$column}{coltype}  = $column_properties->{coltype}{$column};
            $dom->{columns}{$column}{length}   = $column_lengths->{$column};
            $dom->{columns}{$column}{resolver} = $resolvers->{$column};
            if( $data ) {
                if( is_blob( $column_sql_types->{$column} ) ) {
                    if( defined $value ) {
                        $dom->{columns}{$column}{urlvalue} =
                            "$web_base/$db_table/$record_id/$column";
                    }
                } else {
                    $dom->{columns}{$column}{value} = $value;
                }
            }
            if( $mandatory_columns->{$column} ) {
                $dom->{columns}{$column}{mandatory} = 1;
            }

            # Determines the enumerators and stores as simple hash of arrays.
            if( $show_enumeration_values ) {
                my $enumeration_values = $db->get_enumerations( $db_table, $column );
                $dom->{metadata}{enumeration_values}{$column} =
                    $enumeration_values if @{ $enumeration_values };
            }

            my $set_values = $db->get_set_values( $db_table, $column );
            if( @$set_values ) {
                $dom->{columns}{$column}{set_values} = $set_values;
            }
        }

        # Recursively fetch data and descriptions for records that are
        # pointed to by foreign keys:
        for my $fk (@$foreign_keys) {
            my $column = $fk->name;
            $dom->{columns}{$column}{fk} = $fk;

            next if $no_foreign;
            next if $requested_tables && !grep { $_ eq $fk->parent_table }
                                               @$requested_tables;
           
            if( !exists $fk_cache->{$column} && defined $rows && defined $offset ) {
                $fk_cache->{$column} = 
                    $db->get_fk_record_descriptions( $fk, 
                                                     { 
                                                        filter => $filter,
                                                        order => $order,
                                                        rows => $rows,
                                                        offset => $offset
                                                     } );
            }

            my( $filter );
            if( $data && !any { !defined $data->{$_} } $fk->child_columns ) {
                $filter =
                    Database::Filter->new_for_conjunction(
                        [ map { [ $fk->parent_table, $_ ] } $fk->parent_columns ],
                        [ map { $data->{$_} } $fk->child_columns ] );
            }
            next if !$filter && $no_empty;
        
            my $fk_column_id = $dom->{columns}{$column}{value};
            
            my $fk_data;
            if( defined $fk_column_id ){ 
                $fk_data = defined $record_id ? $fk_cache->{$column}{$fk_column_id} : undef;
            }

            my $related_values =
                $db->get_record_descriptions( $fk->parent_table,
                                              { 
                                                  no_foreign => 1,
                                                  no_related => 1,
                                                  no_empty => $no_empty,
                                                  no_views => $no_views,
                                                  filter => $filter,
                                                  show_fk_values =>
                                                      $show_fk_values,
                                                  show_enumeration_values =>
                                                      $show_enumeration_values,
                                                  requested_tables => $requested_tables,
                                                  template => !$filter,
                                                  web_base => $web_base,
                                                  fk_data => $fk_data
                                              } );
            $dom->{columns}{$column}{fk_target} = $related_values->[0];
            
            if( $filter && !defined $dom->{columns}{$column}{fk_target} ) {
                warn 'one or more parent records could not be found in ' .
                     "parent table '" . $fk->parent_table . "'\n";
            }

            # Pseudo-FK columns get the ID of the related records:
            if( !exists $dom->{columns}{$column}{value} && $filter ) {
                my( $id_column ) =
                    grep { $related_values->[0]{columns}{$_}{coltype} &&
                           $related_values->[0]{columns}{$_}{coltype} eq 'id' }
                         @{$related_values->[0]{metadata}{column_order}};
                if( defined $id_column ) {
                    $dom->{columns}{$column}{value} =
                        $related_values->[0]{columns}{$id_column}{value};
                }
            }

            # Pseudo-FK columns are marked as FKs:
            if( !exists $dom->{columns}{$column}{coltype} ) {
                $dom->{columns}{$column}{coltype} = 'fk';
            }
        }

        # Adding schema from N:1-related tables

        if( !$no_related ) {
            my $reverse_fk = $db->get_reverse_foreign_keys( $db_table );
            for my $table (sort keys %$reverse_fk) {
                next if exists $seen_tables->{$table};
                next if $requested_tables &&
                        !grep { $_ eq $table } @$requested_tables;
                next if $no_views && $db->is_view( $table );
                next if $template && $db->is_view( $table );

                my $id_column = $db->get_id_column( $table );

                my %seen_relation = ();
                for my $relation (@{$reverse_fk->{$table}}) {
                    next if !$relation->is_visualised;

                    if( !exists $dom->{related_tables}{$table} ) {
                        $dom->{related_tables}{$table} = [];
                    }

                    if( defined $record_id ) {
                        my $related_foreign_keys = $db->get_foreign_keys( $table );
                        my @related_fk_columns = grep { $_->parent_table eq $db_table }
                                                     @$related_foreign_keys;
                        my $filter =
                            Database::Filter->new_for_conjunction(
                                [ map { [ $table, $_ ] } $relation->child_columns ],
                                [ map { $data->{$_} } $relation->parent_columns ] );

                        my $related_values =
                             $db->get_record_descriptions( $table,
                                                           { seen_tables =>
                                                             { 
                                                                 %$seen_tables,
                                                                 $db_table => 1,
                                                             },
                                                             no_empty => $no_empty,
                                                             no_views => $no_views,
                                                             foreign_key =>
                                                                 ( @related_fk_columns > 1 ?
                                                                   $relation->name : undef ),
                                                             order => $order,
                                                             filter => $filter,
                                                             show_fk_values =>
                                                                 $show_fk_values,
                                                             show_enumeration_values =>
                                                                 $show_enumeration_values,
                                                             requested_tables => $requested_tables,
                                                             depth => $depth,
                                                             web_base => $web_base,
                                                          } );
                        push @{$dom->{related_tables}{$table}},
                             @$related_values;
                    }

                    # If no related records exist for this table, an empty
                    # record is added to represent the schema.
                    if( !@{$dom->{related_tables}{$table}} && !$no_empty ) {
                        my $related_foreign_keys = $db->get_foreign_keys( $table );
                        my @related_fk_columns = grep { $_->parent_table eq $db_table }
                                                     @$related_foreign_keys;

                        # If multiple fk points to the same table, adds multiple
                        # tables.
                        for my $related_fk ( @related_fk_columns ) {
                            my $related_values =
                                $db->get_record_descriptions(
                                    $table,
                                    { seen_tables =>
                                      {
                                          %$seen_tables,
                                          $db_table => 1,
                                      },
                                      foreign_key => (@related_fk_columns > 1
                                                        ? $related_fk->name : undef),
                                      order => $order,
                                      show_fk_values =>
                                          $show_fk_values,
                                      show_enumeration_values =>
                                          $show_enumeration_values,
                                      requested_tables => $requested_tables,
                                      depth => $depth,
                                      template => 1,
                                      web_base => $web_base,
                                    } );
                            push @{$dom->{related_tables}{$table}},
                                 @$related_values;
                        }
                    }
                }

                if( exists $dom->{related_tables}{$table} ) {
                    push @{$dom->{metadata}{related_table_order}},
                         $table;
                }
            }
        }
        push @dom, $dom;
    }

    return \@dom;
}

## @method get_record_description ($db, $db_table, %$options)
## Retains the old functionality of the method.
sub get_record_description
{
    my $doms = &get_record_descriptions;
    return $doms->[0];
}

## @method modify_record_descriptions ($db, $data)
# Modifies database records (inserts, updates or deletes) provided in the form of
# data structure, as returned by get_record_descriptions().
sub modify_record_descriptions
{
    my( $db, $data, $options ) = @_;

    my( $dbrevision_id, $records_seen ) = (
        $options->{revision},
        $options->{records_seen},
    );

    $records_seen = {} unless $records_seen;

    my( $in_transaction, $dbrev_columns );
    if( !defined $dbrevision_id && @$data ) {
        my $table = $data->[0]{metadata}{table_name};
        if( $db->is_view( $table ) ) {
            my $view = Database::View->new( $db, $table );
            $table = $view->topmost_table;
        }
        ( $in_transaction, $dbrevision_id, $dbrev_columns ) =
            $db->start_revision_transaction_if_needed( $table );
    }

    my %options = %$options;
    $options{records_seen} = $records_seen;
    if( $in_transaction ) {
        $options{revision} = $dbrevision_id;
    }

    my @record_keys;
    my $all_revisions_returned = 1;
    for my $item ( @{ $data } ) {
        my $table = $item->{metadata}{table_name};
        my $view;
        if( $db->is_view( $table ) ) {
            $view = Database::View->new( $db, $table );
            ( $item ) = @{$view->expand_record_descriptions( [ $item ] )};
            $table = $item->{metadata}{table_name};
        }

        my $parameters = {};
        my $handles = {};
        my $action = $item->{metadata}{action};
        my $id_column = $db->get_id_column( $table );
        my $record_id = $item->{columns}{$id_column}{value} if $id_column;

        next if defined $record_id && $records_seen->{$table}{$record_id};

        my $foreign_keys = $db->get_foreign_keys( $table );

        my $dbrev_columns;
        if( defined $dbrevision_id ) {
            $dbrev_columns = [ $db->get_column_of_kind( $table, 'dbrev' ) ];
        }

        for my $field (sort keys %{$item->{columns}}) {
            my $field_value = $item->{columns}{$field}{value};
            my $field_urlvalue = $item->{columns}{$field}{urlvalue};
            my $field_handle = $item->{columns}{$field}{handle};
            my $field_sqltype = $item->{columns}{$field}{sqltype};

            my( $fk ) = grep { $_->is_composite &&
                               $_->name eq $field } @$foreign_keys;
            my $fk_target = $item->{columns}{$field}{fk_target};

            if( ( $in_transaction || $dbrevision_id ) &&
                any { $_ eq $field } @$dbrev_columns ) {
                # Overwriting the revision ID column
                $parameters->{$field} = $dbrevision_id;
            } elsif( defined $fk_target &&
                    ( $action eq 'update' || has_values( $fk_target ) ) ) {
                my $fk_table = $item->{columns}{$field}
                                      {fk_target}{metadata}
                                      {table_name};
                my $fk_id = $item->{columns}{$field}{value}; # For updating.
                my $record_keys; # For inserting.

                if( $action eq 'insert' ) {
                    my( $records ) =
                        $db->modify_record_descriptions( [ $fk_target ],
                                                         \%options );
                    $record_keys = $records->[0];
                }

                if( $fk ) {
                    my @child_columns = $fk->child_columns;
                    my @parent_columns = $fk->parent_columns;
                    for my $i (0..$fk->size-1) {
                        $parameters->{$child_columns[$i]} =
                            $fk_target->{columns}{$parent_columns[$i]}{value};
                    }
                } else {
                    if( $action eq 'insert' ) {
                        my( $first_key ) = sort keys %$record_keys;
                        $parameters->{$field} =
                            $db->get_column_data( $fk_table,
                                                  $record_keys->{$first_key},
                                                  $db->get_id_column( $fk_table ),
                                                  $first_key );
                    } elsif( $action eq 'update' ) {
                        $parameters->{$field} = $fk_id;
                    }
                }

                next if $action eq 'update' &&
                        ( !defined $fk_id ||
                          $records_seen->{$fk_table}{$fk_id} ||
                          !has_values( $fk_target ) );

                if( $action eq 'update' ) {
                    # Updating 1:N related data.
                    $db->modify_record_descriptions( [ $fk_target ], \%options );
                    $records_seen->{$fk_table}{$fk_id} = 1;
                }
                # TODO: check, how it will behave under update.
            } elsif( defined $field_value ||
                     ( defined $field_sqltype && lc $field_sqltype eq 'enum' ) ) {
                $parameters->{$field} = $field_value;
            } elsif( defined $field_urlvalue ) {
                $parameters->{$field} = $field_urlvalue;
            } else {
                # Undefined values have to be passed as well, as they are
                # indications to unset values during the update.
                $parameters->{$field} = $field_value;
            }

            if( defined $field_handle ) {
                $handles->{$field} = $field_handle;
            }

            # Handling submitted multiple values. For SQL SET types they
            # are joined, for other types only the first value is taken.
            if( ref $parameters->{$field} eq 'ARRAY' ) {
                if( defined $field_sqltype && lc $field_sqltype eq 'set' ) {
                    # HACK: empty string option values are not supported
                    # now as an empty string value is used to designate
                    # unsetting of all set values:
                    $parameters->{$field} = join ',',
                                            grep { $_ ne '' }
                                                @{$parameters->{$field}};
                } else {
                    $parameters->{$field} = $parameters->{$field}[0];
                }
            }
        }

        my $record_keys;
        if( $action eq 'update' ) {
            $db->_update_record( $parameters,
                                 $record_id,
                                 $table,
                                 { %options, handles => $handles } );
            $records_seen->{$table}{$record_id} = 1;
        } elsif( $action eq 'insert' ) {
            ( $record_keys, my $revision ) =
                $db->_insert_record( $parameters,
                                     $table,
                                     { %options, handles => $handles } );

            $all_revisions_returned &= defined $revision;

            # Related entries cannot be added if there is no way to know
            # to which entry they have to be linked to.
            next if !defined $record_keys || !keys %$record_keys;

            # NOTE: it has to be ensured that all record keys can be resolved,
            # otherwise the behaviour will depend on the order of the sorted
            # keys.
            my( $first_key ) = sort keys %$record_keys;
            $record_id = $db->get_column_data( $table,
                                               $record_keys->{$first_key},
                                               $id_column,
                                               $first_key );
        }

        # Updating N:N related data.
        for my $related_table ( sort keys %{ $item->{related_tables} } ) {
            my $related_foreign_keys = $db->get_foreign_keys( $related_table );
            my @fk = grep { !$_->is_composite &&
                            $_->{table_to} eq $table }
                         @$related_foreign_keys;

            next if !@fk;

            my $related_items;
            if( $action eq 'update' ) {
                $related_items = $item->{related_tables}{$related_table};
            } elsif( $action eq 'insert' ) {
                $related_items = clone($item->{related_tables}{$related_table});
            }

            # Removes empty entries.
            $related_items = [ grep { has_values( $_ ) }
                                   @{ $related_items } ];

            next if !has_values( $related_items->[0] );

            for my $related_item ( @$related_items ) {
                my $related_action = $related_item->{metadata}{action};
                my $column;
                if( exists $related_item->{metadata}{foreign_key} ) {
                    $column = $related_item->{metadata}{foreign_key};
                } else {
                    ( $column ) = map { $_->child_column } @fk;
                }

                # Parent record is already inserted, thus its ID is
                $related_item->{columns}{$column}{value} = $record_id;
                delete $related_item->{columns}{$column}{fk_target};
            }
            $db->modify_record_descriptions( $related_items, \%options );
        }

        # Translating back the view columns
        if( $view && $record_keys ) {
            my $record_keys_now = {};
            for my $column (@{$view->{columns}}) {
                next if $column->{table} ne $table;
                next if !exists $record_keys->{$column->{name}};
                $record_keys_now->{$column->{column}} =
                    $record_keys->{$column->{name}};
            }
            $record_keys = $record_keys_now;
        }

        push @record_keys, $record_keys;
    }

    if( $in_transaction ) {
        $db->commit_transaction();
    }

    return \@record_keys,
           defined $dbrevision_id && $all_revisions_returned ? $dbrevision_id : ();
}

sub _get_table_list
{
    my ($dbh) = @_;

    # Trick to select only tables and views:
    my $sth = $dbh->table_info( undef, undef, undef, "'TABLE','VIEW'" )
        or die DBI::errstr;

    my @tables;
    while( my $row = $sth->fetchrow_arrayref ) {
        push @tables, $row->[2];
    }

    $sth->finish;
    return @tables;
}

## @method get_neighbour_id ($db, %$options)
# Returns the information about ID of neighbouring entry (next or
# previous) in the table.
#
# @param db Database object
# @param db_table table name
# @param options hash (required). May contain the following keys:
#   db_table (required) - database table name
#   selected_column (required) - selected column from the table name
#   filter (optional) - 'Database::Filter object'
#   order (optional) - 'Database::Order object'
#   current_row (required) - a slice of a current row from the DOM 
#               element generated by 'Database::get_record_description' 
#               function
#   previous (optional) - 'TRUE' for previous record id calculation 
#   coint (optional) - 
#
# @retval neighbour_id
sub get_neighbour_id
{
    my ( $db, $options ) = @_;
    my ( $db_table, $record_id, $filter, $real_order, $current_row,
        $previous, $count ) = ($options->{db_table}, $options->{selected_column},
                               $options->{filter}, $options->{order},
                               $options->{current_row}, $options->{previous},
                               $options->{count});

    my $dbh = $db->{db}{content}{dbh};
    my $delim = $db->{db}{content}{delim};
    
    my $table_order = $real_order->order_for_table( $db_table );
    my @order = map { { %$_ } } @$table_order;

    my $id_column = $db->get_id_column( $db_table );
    if( !$id_column ){
        die "unique key column for value '$id_column' cannot be " .
                "found in table '$db_table'";
    }

    push( @order, { table => $db_table, 
                    column => $id_column,
                    order => 'a' });

    my( $filter_where_clause, $filter_values );
    my( $where_clause, $values );
    if( $filter ) {
       ( $filter_where_clause, $filter_values ) = $filter->where_clause( $delim ); 
        $filter_where_clause =~ s/^WHERE //;
        if ($filter_where_clause) {
            push(@$where_clause, $filter_where_clause);
            push(@$values, @$filter_values);
        }
    }

    my $order_clause;
    if( @order ) {
        if( $previous ){
            foreach( @order ){
                if( $_->{order} eq 'a' ){
                    $_->{order} = 'd';
                }else{
                    $_->{order} = 'a';
                }
            }
        }
        my $order_object = Database::Order->new( @order );
        $order_clause = $order_object->order_clause( $delim );
    }

    $order_clause = $order_clause ? " $order_clause" : '' ;

    my @unique_columns = $db->get_unique_columns( $db_table );
    
    my @current_order;
    foreach ( @order ) {
        my $order_column = $_->{column};
        my $order_sign   = $_->{order};
        
        my $is_uniq = any { $_ eq $order_column } @unique_columns; 

        push( @current_order, { 
                column => $order_column, 
                operator => $order_sign,
                value => $current_row->{columns}{$order_column}{value}, 
                uniq => $is_uniq ? 1 : 0
                                } );
    }

    my ( $order_where_clause, $order_where_values ) = 
        get_where_by_order( \@current_order, $current_row, $db_table, $delim );
    push(@$where_clause, $order_where_clause);
    push(@$values, @$order_where_values);

    if( $count ){
        my $sql_statement = 'SELECT count(*) FROM ' .
                            $delim . $db_table . $delim .
                            ' WHERE ' .
                            join( ' AND ', map {"( $_ )"} @$where_clause );

        my $sth = $dbh->prepare( $sql_statement) or
            $db->error( "could not prepare SELECT statement: $DBI::errstr" );
        $sth->execute( @$values ) or
            $db->error( "'SELECT *' failed: " . $DBI::errstr );

        my @results_array = $sth->fetchrow_array();
        my $result = $results_array[0];
        return $result + 1; 
    }

    my $sql_statement = 'SELECT ' . $delim . $record_id . $delim .
                        ' FROM ' . $delim . $db_table . $delim .
                        ' WHERE ' .
                        join( ' AND ', map {"( $_ )"} @$where_clause ) .
                        $order_clause . ' LIMIT 1';

    my $sth = $dbh->prepare( $sql_statement) or
        $db->error( "could not prepare SELECT statement: $DBI::errstr" );
    $sth->execute( @$values ) or
        $db->error( "'SELECT *' failed: " . $DBI::errstr );

    my @results_array = $sth->fetchrow_array();
    my $result = $results_array[0];

    if( !defined $result ){
        $filter_where_clause = $filter_where_clause ?
                               ' WHERE '.$filter_where_clause : '';
        $sql_statement = 'SELECT ' . $delim . $record_id . $delim .
                         ' FROM ' . $delim . $db_table . $delim .
                         $filter_where_clause .
                         $order_clause . ' LIMIT 1';

        $sth = $dbh->prepare( $sql_statement) or
            $db->error( "could not prepare SELECT statement: $DBI::errstr" );
        $sth->execute( @$filter_values ) or
            $db->error( "'SELECT *' failed: " . $DBI::errstr );

        @results_array = $sth->fetchrow_array();
        $result = $results_array[0];                            
    }

    return $result;
}

sub get_where_by_order
{
    my( $order, $row, $db_table, $delim) = @_;
    
    my @where_by_order;
    my @where_by_order_values;

    my $last_index = $#{ $order};

    for( my $i = 0; $i < $last_index; $i++ ){
        if( defined $order->[$i]{value} ){
            push( @where_by_order, "${delim}${db_table}${delim}." .
                                   "${delim}$order->[$i]{column}${delim} = ?" );
            push( @where_by_order_values, $order->[$i]{value});
        } else {
            push( @where_by_order, "${delim}${db_table}${delim}." .
                                   "${delim}$order->[$i]{column}${delim} IS ?" );
            push( @where_by_order_values, undef);
        }
    }

     if( $order->[$last_index]{operator} eq 'a' ){
         my $exp = !defined $order->[$last_index]{value} ?
                    " ( ${delim}${db_table}${delim}." . 
                    "${delim}$order->[$last_index]{column}${delim} IS NOT ? )" : 
                    " ( ${delim}${db_table}${delim}." . 
                    "${delim}$order->[$last_index]{column}${delim} > ? )";
        push( @where_by_order, $exp);
        push( @where_by_order_values, $order->[$last_index]{value});
    } else {
        if(defined $order->[$last_index]{value}){
            push( @where_by_order, 
                "( ${delim}${db_table}${delim}." . 
                "${delim}$order->[$last_index]{column}${delim} < ? OR " .
                "${delim}${db_table}${delim}." . 
                "${delim}$order->[$last_index]{column}${delim} IS ? )");
        
            push( @where_by_order_values, $order->[$last_index]{value});
            push( @where_by_order_values, undef);
        }else{
            push( @where_by_order, "$order->[$last_index]{column} < ?");
            push( @where_by_order_values, undef);
        }
    }
 

    my $where_clause = '';

    if( $last_index > 0){
    
        my @smaller = @$order[0..$last_index-1];
        # print join(', ', @$order)."\n";
        # print join(', ', @smaller)."\n";
        my( $second_part, $values ) = get_where_by_order(\@smaller, $row, $db_table, $delim);
        $where_clause .=   $second_part . " OR ";
        @where_by_order_values = (@$values, @where_by_order_values);
    }

    $where_clause .= '( ' . 
                        join ( ' AND ',  @where_by_order ) .
                        ' )';
    
    return ( $where_clause, \@where_by_order_values);
    
}

## @method get_neighbour_ids ($db, $db_table, $record_id, $order)
# Returns the information about IDs of neighbouring entries (next and
# previous) in the table.
#
# @param db Database object
# @param db_table table name
# @param record_id ID of the record in question
# @param order data structure representing the ordering
# @param filter data structure represent filter query
#
# @retval {
#		next_id => 'next record id',
#		prev_id => 'previous record id',
#               curr_rec => 'current id number in the table',
#               n_rec => 'total number of records'
# }
#
sub get_neighbour_ids
{
#    my ($db, $db_table, $record_id, $order, $filter, $selected_column) = @_;
     my ( $db, $db_table, $options ) = @_;
     my ( $record_id, $order, $filter, $selected_column) = 
            ( $options->{record_id},
              $options->{order},
              $options->{filter},
              $options->{selected_column}
            );

    my $id_column = $db->get_id_column( $db_table );
    if( !$id_column ){
        die "unique key column for value '$id_column' cannot be " .
                "found in table '$db_table'";
    }

    $order = $order->order_for_table( $db_table );
    if( @$order ) {
        if( !$order->column_is_ordered( $db_table, $id_column ) ) {
            $order->order_ascending( $db_table, $id_column );
        }
    } else {
        $order = Database::Order->new( [ $db_table, $id_column, 'a' ] );
    }

    my $sth = $db->search( $db_table,
                           {
                                filter => $filter,
                                order  => $order,
                           } );

    my( $prev_id, $next_id );
    my $curr_rec = 0; # current record
    my $i_rec = 0; # records counter
	
    while( my $row = $sth->fetchrow_hashref() ) {
        $i_rec++;
        $next_id = $row unless defined $next_id;

        if( $record_id eq $row->{$id_column} ) {
            $curr_rec = $i_rec;
            my $next_row = $sth->fetchrow_hashref();

            $next_id = $next_row if defined $next_row;

            last if defined $prev_id;
            if( defined $next_row ) {
                $prev_id = $next_row;
            } else {
                $prev_id = $next_id;
            }
        } else {
            $prev_id = $row;
        }
    }

    my $n_rec = $db->get_count( $db_table, $filter );

    return {next_id => $next_id->{$selected_column},
            prev_id => $prev_id->{$selected_column},
            curr_rec => $curr_rec,
            n_rec => $n_rec };
}

## @method get_id_by_extkey ($db, $db_table, $record_key, %$options)
# Returns the ID of a record by its external key.
sub get_id_by_extkey
{
    my ($db, $db_table, $record_key, $options) = @_;

    my( $id_column, $key_column ) =
        ( $options->{id_column},
          $options->{key_column} );

    $id_column = $db->get_id_column( $db_table ) if !$id_column;
    $key_column = $db->get_unique_key_column( $db_table, $record_key )
        if !$key_column;

    if( !$key_column ) {
        die "unique key column for value '$record_key' cannot be " .
            "found in table '$db_table'";
    }

    my $records = $db->get_records( $db_table, $record_key,
                                    { id_column => $key_column } );
    return undef if !@$records;
    return $records->[0]{$id_column};
}

#=======================================================================
# Standalone a.k.a. static functions

sub _connect 
{
    my( $DBhash, $username ) = @_;
    
    $DBhash->{engine} = 'SQLite2' unless defined $DBhash->{engine};
    $DBhash->{delim}  = $DBhash->{engine} eq 'SQLite2' ? "'" : '`';
    $DBhash->{DB} = basename( $DBhash->{DB} ) if $DBhash->{engine} eq 'mysql';
    if( defined $username ){
        $DBhash->{user} = $username;
        #$DBhash->{password} = $RestfulDB::Defaults::database_password;
        $DBhash->{hostname} = $RestfulDB::Defaults::database_hostname;
    }

    my %DBhash = %$DBhash;

    my $dbh;
    if( $DBhash{engine} eq "SQLite2" || $DBhash{engine} eq "SQLite" ) {
        if( !-e $DBhash{'DB'} ) {
            DatabaseDoesNotExist->throw(
                "Cannot connect: database '$DBhash{DB}' does not exist" );
        }

        $dbh = DBI->connect( "dbi:$DBhash{'engine'}:$DBhash{'DB'}",
                             undef, undef,
                             {sqlite_unicode => 1} )
            || die "Cannot connect: $DBI::errstr";
    } elsif( $DBhash{engine} eq "mysql" ) {
        my $user = defined $DBhash{'user'} ?
            $DBhash{'user'} : $RestfulDB::Defaults::database_user;
        my $password = defined $DBhash{'password'} ?
            $DBhash{'password'} : $RestfulDB::Defaults::database_password;
        my $hostname = defined $DBhash{'hostname'} ?
            $DBhash{'hostname'} : $RestfulDB::Defaults::database_hostname;
        $dbh = DBI->connect("dbi:$DBhash{'engine'}:" .
                            "dbname=$DBhash{'DB'};" .
                            "hostname=$hostname",
                            $user, $password,
                            {
                                mysql_enable_utf8 => 1,
                                PrintError => 0,
                                PrintWarn => 0,
                            } );
        if( !$dbh ) {
            if( $DBI::errstr =~ /^Access denied for user/ ) {
                UnauthorizedException->throw(
                    "Cannot connect: $DBI::errstr" );
            } else {
                die "Cannot connect: $DBI::errstr";
            }
        }
        $dbh->do( "SET SESSION sql_mode='TRADITIONAL'" );
    } else {
        NotImplementedException->throw(
            "Unsupported database engine '$DBhash{engine}'" );
    }
    return $dbh;
}

sub _disconnect
{
    my $dbh = shift;
    $dbh->disconnect || die "Cannot disconnect: $DBI::errstr";
}

## @function null_if_empty ($value, $sql_type_name)
# Converting values of non-character and non-blob SQL types to NULL
# values.
# TODO: DISCUSS: How enums and sets should be treated? In principle,
# they are textual, but in some cases enum could both hold an empty
# string option and NULL value.
sub null_if_empty
{
    my( $value, $type_name, $coltype ) = @_;

    return undef  if !defined $value;
    return $value if $value ne '';
    return undef  if $coltype && $coltype =~ /^(uuid|url|cssclass|mimetype|
                                                cdate|ctime|cdatetime)$/x;
    return $value if is_character_string( $type_name ) || is_blob( $type_name );
    return undef;
}

# Check whether the referenced table has a row which is identified by
# a foreighn key (check for "dangling keys"):
#
# @param: the data structure returned by 'get_record_description':
#
# @retval has_values – boolean; true if at least one value was found.
sub has_values
{
    my ( $fk_table ) = (@_);
    my $columns = $fk_table->{columns};
    for my $column (keys %{$columns}) {
        if( exists $columns->{$column}{value} ||
            exists $columns->{$column}{urlvalue} ) {
            return 1;
        }
        return 1 if $columns->{$column}{fk_target} &&
                    has_values( $columns->{$column}{fk_target} );
    }
    return 0;
}

# Trim ISO 8601/RFC 3339 dates to fit them to MySQL/MariaDB DATE data type
sub trim_mysql_date
{
    my( $date ) = @_;
    return $date if !defined $date;

    # If date does not look like understandable one, no interpretation is
    # done; other code will report the issues.
    return $date if $date !~ /^$date_re/ || $date =~ /^$date_re$/;

    $date =~ /^($date_re)/;
    my $date_now = $1;
    warn "date value '$date' has been trimmed to '$date_now' in order " .
         "to fit MySQL DATE data type";
    return $date_now;
}

## @function form_parameters_to_descriptions ($data,%$parameters)
# Updates the data structure (generated by $db->get_record_descriptions())
# with the values from HTTP GET/POST form parameters.
#
# @params data data structure generated with $db->get_record_descriptions().
# @params parameters hash of HTTP GET/POST parameters.
# @retval data the same data structure with updated values.
# @retval parameter_counter parameter position counter in hash form.
sub form_parameters_to_descriptions
{
    my ( $db, $data, $parameters, $options ) = @_;

    my %parameters = %{ $parameters };

    $options = {} unless $options;
    my( $cgi, $full_table_name, $default_action ) = (
        $options->{cgi},
        $options->{full_table_name},
        $options->{default_action},
    );

    $default_action //= 'insert';
    
    my $db_table = $data->[0]{metadata}{table_name};
    $full_table_name = "$db_table:0" unless $full_table_name;
    my $foreign_keys = $db->get_foreign_keys( $db_table );
    my @columns = sort keys %{ $data->[0]{columns} };

    # Determines what action (update or insert) should be performed.
    my $action_key = "action:$full_table_name";
    my $action = exists $parameters{$action_key} ?
                        $parameters{$action_key} : $default_action;
    $data->[0]{metadata}{action} = $action;

    for my $column ( @columns ) {
        # Foreign key values are not modified, therefore they are
        # stripped in order not to introduce id <-> value inconsistency
        delete $data->[0]{columns}{$column}{fk_target};

        my $key = "column:$full_table_name.$column";

        next if !exists $parameters{$key};
        next unless $parameters{$key} ne '' ||
                    exists $data->[0]{columns}{$column}{value} &&
                    defined $data->[0]{columns}{$column}{value} &&
                    $data->[0]{columns}{$column}{value} ne '';

        $data->[0]{columns}{$column}{value} = $parameters{$key};

        if( is_blob( $data->[0]{columns}{$column}{sqltype} ) ) {
            if( $cgi && $cgi->upload( $key ) ) {
                $data->[0]{columns}{$column}{handle} =
                    $cgi->upload( $key )->handle();
            } else {
                $data->[0]{columns}{$column}{handle} =
                    Object::Lazy->new(
                        sub {
                                my $html = get( $parameters{$key} ) ||
                                    die "Cannot retrieve '$parameters{$key}'";
                                return IO::String->new( $html );
                            }
                    );
            }
        }
    }

    # Generates the list of all unique full table names from parameters.
    my @parameter_full_table_names =
        uniq map { /^column:(.+)\.\w+$/ } keys %parameters;

    my $related_tables = $data->[0]{related_tables};
    for my $related_table ( sort keys %$related_tables ) {
        # Creates the table counter where table indexes can be easily
        # looked up.
        my @related_full_table_names;
        my $related_table_name_root = "$full_table_name.$related_table";
        my %related_table_counter = ();
        for my $related_data ( @{ $related_tables->{$related_table} } ) {
            my $related_fk = $related_data->{metadata}{foreign_key};
            my $related_table_name = $related_table_name_root;

            if( defined $related_fk ) {
                $related_table_name .= ".$related_fk";
            }

            if( ! exists $related_table_counter{$related_table_name} ) {
                $related_table_counter{$related_table_name} = 0;
            }

            push @related_full_table_names,
                $related_table_name . ':' .
                $related_table_counter{$related_table_name};

            $related_table_counter{$related_table_name}++;
        }

        # Creates a copy of table if there is a shortage in data structure
        # compared to parameters.
        for my $parameter_full_table_name ( @parameter_full_table_names ) {
            if( $parameter_full_table_name =~
                    m/\Q${related_table_name_root}\E\.?(\w+)?:\d+$/ &&
                !any { $parameter_full_table_name eq $_ }
                    @related_full_table_names ) {

                my $foreign_key = $1; # If present.
                my $cloned_related_data =
                    $db->get_record_description( $related_table,
                                                 { template => 1 } );
                $cloned_related_data->{metadata}{foreign_key} = $foreign_key
                    if defined $foreign_key;
                $cloned_related_data->{metadata}{action} = 'insert';

                push @{ $data->[0]{related_tables}{$related_table} },
                    $cloned_related_data;
            }
        }
    }

    for my $related_table ( sort keys %$related_tables ) {
        my %related_table_counter = (); # Mainly for foreign key tracking.
        for( my $i = 0; $i <= $#{ $related_tables->{$related_table} }; $i++ ) {
            my $related_data = $related_tables->{$related_table}[$i];
            my $related_table_name_root = "$full_table_name.$related_table";
            my $related_fk = $related_data->{metadata}{foreign_key};
            my $related_table_name = $related_table_name_root;

            if( defined $related_fk ) {
                $related_table_name .= ".$related_fk";
            }

            if( ! exists $related_table_counter{$related_table_name} ) {
                $related_table_counter{$related_table_name} = 0;
            }

            $related_data = form_parameters_to_descriptions(
                $db,
                [ $related_data ],
                \%parameters,
                {
                    cgi => $cgi,
                    full_table_name =>
                        $related_table_name . ':' .
                        $related_table_counter{$related_table_name},
                    default_action => $default_action,
                }
            );
            $related_tables->{$related_table}[$i] = $related_data->[0];
            $related_table_counter{$related_table_name}++;
        }
    }

    # Ensuring consistency of composite key values
    for my $fk (@$foreign_keys) {
        next if !$fk->is_composite;
        next if !exists  $data->[0]{columns}{$fk->name} ||
                !exists  $data->[0]{columns}{$fk->name}{value} ||
                !defined $data->[0]{columns}{$fk->name}{value};

        my $record = $db->get_record_description(
            $fk->parent_table,
            { record_id => $data->[0]{columns}{$fk->{name}}{value} }
        );

        if( $record ) {
            $data->[0]{columns}{$fk->name}{fk_target} = $record;
        } else {
            delete $data->[0]{columns}{$fk->name};
            $data->[0]{metadata}{column_order} =
                [ grep { $_ ne $fk->name } @{$data->[0]{metadata}{column_order}} ];
            delete $parameters{"column:$full_table_name." . $fk->name};
        }

        # get_record_description() will return an empty record only if
        # pseudocolumn value is null or it does not refer to any parent
        # record. In such case entered values for individual columns
        # should prevail.
        my @child_columns = $fk->child_columns;
        my @parent_columns = $fk->parent_columns;
        for my $i (0..($fk->size-1)) {
            my $child_column = $child_columns[$i];
            my $parent_column = $parent_columns[$i];
            my $key = "column:$full_table_name.$child_column";
            next if !has_values( $record ) &&
                    defined null_if_empty( $parameters{$key},
                                           $data->[0]{columns}{$child_column}{sqltype},
                                           $data->[0]{columns}{$child_column}{coltype} );
            $data->[0]{columns}{$child_column}{value} =
                $record->{columns}{$parent_column}{value};
        }
    }

    for my $key (sort keys %parameters) {
        if( $key =~ /^(column|action):\Q${full_table_name}.\E([^\.]+)$/ &&
            $1 ne 'action' && !exists $data->[0]{columns}{$2} ) {
            warn "column '$2' is not found in table '$db_table'\n";
        }
    }

    return $data;
}

sub flatten_record_descriptions
{
    my( $data, $tables, $seen ) = @_;

    $data = [ $data ] if ref $data ne 'ARRAY';
    $tables = {} unless $tables;
    $seen = {} unless $seen;

    for my $entry (@$data) {
        my $table = $entry->{metadata}{table_name};
        next if !has_values( $entry ) && $tables->{$table};
        my( $id ) = map { $entry->{columns}{$_}{value} }
                    grep { defined $entry->{columns}{$_}{coltype} &&
                                   $entry->{columns}{$_}{coltype} eq 'id' }
                         sort keys %{$entry->{columns}};

        if( !defined $id || !$seen->{$table}{$id} ) {
            push @{$tables->{$table}}, $entry;
            $seen->{$table}{$id} = 1 if defined $id;
        }

        for my $column (@{$entry->{metadata}{column_order}}) {
            # As this function is used only for spreadsheet generation,
            # parent records are not scanned.
            next;
            next if !$entry->{columns}{$column}{fk_target};
            flatten_record_descriptions( $entry->{columns}{$column}{fk_target},
                                         $tables,
                                         $seen );
        }
        for my $related_table (@{$entry->{metadata}{related_table_order}}) {
            flatten_record_descriptions( $entry->{related_tables}{$related_table},
                                         $tables,
                                         $seen );
        }
    }

    return $tables;
}

sub prepare_record_descriptions_for_save_as_new
{
    my( $data ) = @_;

    $data = [ $data ] if ref $data ne 'ARRAY';

    my $uuid_gen = Data::UUID->new;
    for my $item (@$data) {
        next if !has_values( $item );

        $item->{metadata}{action} = 'insert';

        for my $column (%{$item->{columns}}) {
            my $coltype = $item->{columns}{$column}{coltype};
            next if !$coltype;

            if(      $coltype =~ /^(id|dbrev)$/ ) {
                $item->{columns}{$column}{value} = undef;
                delete $item->{columns}{$column}{fk_target};
            } elsif( $coltype eq 'uuid' ) {
                $item->{columns}{$column}{value} = lc $uuid_gen->create_str();
            }
        }

        for my $related_table (keys %{ $item->{related_tables} }) {
            prepare_record_descriptions_for_save_as_new(
                $item->{related_tables}{$related_table} );
        }
    }
}

sub process_uploaded_file
{
    my( $handle, $parameters, $key, $filename, $column_properties ) = @_;

    my %parameters = %$parameters;

    my $blob = '';
    while( my $bytesread = $handle->read( my $buffer, 1024 ) ) {
        $blob .= $buffer;
    }

    if( $column_properties->{mimetype}{$key} ) {
        $parameters{$column_properties->{mimetype}{$key}} =
            mimetype( $handle );
    }

    if( $column_properties->{filename}{$key} ) {
        $parameters{$column_properties->{filename}{$key}} = $filename;
    }

    if( $column_properties->{md5}{$key} ) {
        $parameters{$column_properties->{md5}{$key}} = md5_hex( $blob );
    }

    $parameters{$key} = $blob;
    return %parameters;
}

sub validate_with_regex
{
    my( $column, $value, $regex ) = @_;

    # Undefined values are treated as valid, as definedness constrain
    # is to be checked by the underlying DBMS.
    return if !defined $value;

    my $matches = 1;
    eval {
        $matches = $value =~ /^$regex$/;
    };
    if( $@ ) {
        MetadatabaseException->throw(
            "invalid regular expression for '$column' ('$regex'): $@" );
    }
    return if $matches;

    InputException->throw( "value for '$column' ('$value') does not " .
                           "match regular expression '^$regex\$', cannot " .
                           'insert invalid record' );
}

sub get_username_hash
{
    my( $username ) = @_;
    return sha256_hex( $username ); 
}

sub error
{
    my( $db, $message ) = @_;
    if( $db->{db}{content}{engine} eq 'mysql' ) {
        if( defined $DBI::err && ( $DBI::err == 1142 || $DBI::err == 1143 ) ) {
            # ER_TABLEACCESS_DENIED_ERROR or ER_COLUMNACCESS_DENIED_ERROR
            UnauthorizedException->throw( $message );
        } elsif( defined $DBI::err && $DBI::err == 1062 ) {
            DuplicateEntryException->throw( $message );
        } else {
            die $message;
        }
    } else {
        if( defined $DBI::err && $DBI::err == 19 ) {
            DuplicateEntryException->throw( $message );
        }
        die $message;
    }
}

## @function get_fks_cell_text($db, $fks)
#  Creates a simplified version of data structure generated by 
#  Database::get_record_description() function.
#
#  @param db Database object
#  @param foreign_keys array of Database::ForeignKey objects representing foreign
#                      keys
#
#  @return DOMs (simplified version of Database::get_record_description() DOMs).
sub get_fks_cell_text
{
    my( $db, $fks, $full_fk_table ) = @_;
    my $fk_values = {};
    
    foreach my $fk ( @{$fks} ){
        my $fk_name = $fk->name();
        my $table_to = $fk->parent_table();
        my @columns_to = $fk->parent_columns();
        my $column_to = $columns_to[0];
        my @columns_from = $fk->child_columns();
        my $column_from = $columns_from[0];
        my $table_from = $fk->child_table();

        my $fk_format = $db->get_fk_format( $table_to );

        next if $table_to eq 'revision'; 

        my $dbh = $db->{db}{content}{dbh};
        my $delim = $db->{db}{content}{delim};
 
        my $column_properties = $db->get_column_properties( $table_to );
        my $column_types = $db->get_column_type_hash($table_to);
        my @column_names = $db->get_column_names( $table_to, { skip_fk_pseudocolumns => 1,
                                                 display => 'all' } ); 
       
        my $sql_statement;

        if( $full_fk_table ){
            my $table_to_columns = join ', ', map { $delim . $_ . $delim }
                                                  @column_names;
            $sql_statement = 'SELECT ' . $table_to_columns .
                             ' FROM ' . $delim . $table_to . $delim;
        } else {
            my $table_to_columns = join ', ', map { "A.${delim}$_${delim}" }
                                                  ( @column_names,
                                                    $column_to );

            $sql_statement = 'SELECT ' . $table_to_columns .
                             ' FROM ' . $delim . $table_to . $delim . ' AS A' . 
                             ' INNER JOIN ' . $delim . $table_from . $delim .
                             ' AS B' .
                             ' ON A.' . $delim . $column_to . $delim .
                             ' = '.' B.' . $delim . $column_from . $delim;
        }

        print STDERR "$sql_statement\n" if $debug_sql;
             
        my $sth = $dbh->prepare( $sql_statement ) or
            $db->error( "could not prepare SELECT statement: $DBI::errstr" );
        
        $sth->execute() or
            $db->error( "'SELECT *' failed: " . $DBI::errstr );
        
        # Straightforward solution for composite foreign keys. 
        # However, at the moment filter unable to work with composite fk's. 
        # After filter bug correction, this code should be revised!   
        $column_from = (scalar @columns_from == 1) ? $column_from : $fk_name; 
        
        my %ambiguity_counter;
        $fk_values->{$column_from} = [];

        while( my $row  = $sth->fetchrow_hashref() ){

            my $tmp_value->{columns} = {  map{ $_  => { 
                                                'value' => $row->{ $_ },
                                                'coltype' => $column_properties->{coltype}{$_},
                                                'sqltype' => $column_types->{$_} 
                                                      } } keys %{ $row } };

            $tmp_value->{metadata}{fk_format}  = $fk_format; 
            $tmp_value->{value} = $row->{$column_to};
            
            push( @{ $fk_values->{ $column_from }  }, $tmp_value );
        }
    }
    return { fk_values => $fk_values };
}

sub get_fk_record_descriptions
{
    my($db, $fk, $options) = @_;

    my( $filter, $order, $rows, $offset ) =
        ( $options->{filter},
          $options->{order},
          $options->{rows},
          $options->{offset}
        );

    my $parent_table = $fk->parent_table;
    my @parent_ids = $fk->parent_columns;
    my $parent_id = $parent_ids[0];
    my @parent_table_columns = $db->get_column_names( $parent_table,
                                                        { skip_fk_pseudocolumns => 1,
                                                        display => 'all' });
    my $child_table = $fk->child_table;
    my @child_ids = $fk->child_columns;
    my $child_id = $child_ids[0];
    my $child_id_column = $db->get_id_column( $child_table );

    my $dbh = $db->{db}{content}{dbh};
    my $delim = $db->{db}{content}{delim};
    my $engine = $db->{db}{content}{engine};

    my( $where_clause, $values );
    if( $filter ) {
        $filter->canonicalize_table_names( ($child_table) );
        ( $where_clause, $values ) = $filter->where_clause( $delim );
    }

    my $order_clause;
    if( $order ) {
        $order_clause = $order->order_clause( $delim );
    }

    $where_clause = $where_clause ? " $where_clause" : '';
    $order_clause = $order_clause ? " $order_clause, $child_id_column ASC" : 
                                     'ORDER BY ' . $child_id_column  . ' ASC' ;

    

    my $sql1 = 'SELECT ' . join( ', ', map { $delim . $_ . $delim }
                                           @child_ids ) .
               ' FROM '. $child_table . $where_clause . ' '. $order_clause;

    if( $engine ne 'SQLite2' && defined $offset && defined $rows ) {
        $sql1 .= ' LIMIT ?, ?';
        push @$values, $offset;
        push @$values, $rows;
    }

    my $sql2 = 'SELECT ' . join( ', ', map { "A.${delim}$_${delim}" }
                                           @parent_table_columns ) .
               ' FROM ' . $delim . $parent_table . $delim .
               ' AS ' . 'A' .
               ' INNER JOIN ( '. $sql1 . ' )  AS ' . 'B' .
               ' ON ' .  join( ' AND ', map { "B." .
                "$child_ids[$_] = " .
                "A." .
                "$parent_ids[$_]" }
              0..$fk->size-1 );

    my %fk_cache;
    my $sth = $dbh->prepare( $sql2 ) or
        $db->error( "could not prepare SELECT statement: $DBI::errstr" );
            
    $sth->execute( @$values ) or
        $db->error( "'SELECT *' failed: " . $DBI::errstr );
     
    while(  my $row = $sth->fetchrow_arrayref ){
        my(  @parent_table_values ) = @$row;
        my %hash;
        @hash{@parent_table_columns} = @parent_table_values;
        my $parent_key = join '', map { $hash{$_} } @parent_ids;
        $fk_cache{$parent_key} = \%hash; 
    }
    
    print STDERR "$sql2\n" if $debug_sql;

    return \%fk_cache;
}
1;
