#------------------------------------------------------------------------------
#$Author: saulius $
#$Date: 2021-08-31 09:23:50 -0400 (Tue, 31 Aug 2021) $ 
#$Revision: 7584 $
#$URL: svn://saulius-grazulis.lt/restful/tags/v0.16.0/lib/RestfulDB/Schema.pm $
#------------------------------------------------------------------------------
#*
#  The base class for RestfulDB::Schema::* classes. As such, contains
#  common code for the introspection of database schema.
#**

package RestfulDB::Schema;
use warnings;
use strict;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( is_history_table );

use Data::UUID;
use DBI;
use File::Basename qw(basename);
use List::MoreUtils qw(uniq);
use List::Util qw(any);
use LWP::Simple;
use POSIX qw(strftime);

use RestfulDB::Defaults;
use RestfulDB::Exception;
use RestfulDB::Schema::DBI;
use RestfulDB::SQL qw(
    is_internal_SQLite_table
    is_numerical
);

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}/;

## @method can_autogenerate_revision_id ($db)
#
# Checks whether we can automatically generate a revision record with
# a new database revision ID for this database.

sub can_autogenerate_revision_id
{
    my ($db, $table ) = @_;

    my $column_properties = $db->get_column_properties( $table );
    my $column_sql_types = $db->get_column_type_hash( $table );

    # We assume that we can (and must) create automatic revision
    # record if our current table has a revision_id column, or an
    # equivalent column (with possibly different name) that is
    # dedicated for storing database revisions; in that case, a
    # designated table for storing revision data MUST exist, otherwise
    # the RestfulDB will fail:
    if( (grep /revision_id/, keys %$column_sql_types) ||
        (grep /dbrev/, values %{$column_properties->{coltype}}) ) {

        if( !grep { $_ eq $RestfulDB::Defaults::revision_table }
                  $db->get_table_list() ) {
            die "Table '$table' seems to contain column(s) for revision " .
                'ID, however, the database does not have a table ' .
                "'$RestfulDB::Defaults::revision_table' for storing " .
                'revision data';
        }

        return 1;
    } else {
        return 0;
    }
}

## @method get_column_names ($db, $table)
# Gets an array of column names.
#
# @param db Database object
# @param table table name
# @retval column_names array of column names
sub get_column_names
{
    my ($db, $table, $options) = @_;

    my @excluded_coltypes = qw( uuid cssclass mimetype format );

    $options = {} unless $options;
    my( $skip_fk_pseudocolumns, $display, $hide_column_types ) = (
        $options->{skip_fk_pseudocolumns},
        $options->{display},
        $options->{hide_column_types},
    );

    @excluded_coltypes = @$hide_column_types if $hide_column_types;

    my @columns = $db->get_column_list( $table );

    if( !$display || $display ne 'all' ) {
        my $column_properties = $db->get_column_properties( $table );
        my @columns_now;
        for my $column (@columns) {
            if( $column_properties &&
                $column_properties->{display}{$column} ) {
                push @columns_now, $column
                if $column_properties->{display}{$column} ne 'never';
                next;
            }

            # Certain column types are skipped by default:
            if( $column_properties &&
                $column_properties->{coltype}{$column} &&
                any { $_ eq $column_properties->{coltype}{$column} }
                    @excluded_coltypes ) {
                next;
            }
            push @columns_now, $column;
        }
        @columns = @columns_now;
    }

    return @columns if $skip_fk_pseudocolumns;

    # Collecting composite foreign key pseudocolumns
    my $foreign_keys = $db->get_foreign_keys( $table );
    for my $fk (@$foreign_keys) {
        push @columns, $fk->name if $fk->is_composite;
    }

    return @columns;
}

sub get_reverse_column_hash
{
    my( $db, $tables ) = @_;
    my %columns;
    my @duplicates;
    for my $table (@$tables) {
        for my $column (sort keys %{$db->get_column_type_hash( $table )}) {
            if( exists $columns{$column} ) {
                push @duplicates, "'$column' (table '$table')";
                next;
            }
            $columns{$column} = $table;
        }
    }
    if( @duplicates ) {
        local $" = ', ';
        warn "duplicate columns/keys found and ignored: @duplicates\n";
    }
    return \%columns;
}

## @method get_extkey_column ($db, $table)
#
# Returns name of an external (i.e public ID) column of a table from
# metadata tables. If metadata database is not found or the table in
# question is not described in 'description' table, null column name
# is returned.
sub get_extkey_column
{
    my ($db, $table) = @_;

    return $db->get_column_of_kind( $table, 'extkey' );
}

## @method get_uuid_column ($db, $table)
#
# Returns name of a UUID column of a table from metadata tables. If
# metadata database is not found or the table in question is not
# described in 'description' table, null name is returned.
sub get_uuid_column
{
    my ($db, $table) = @_;

    return $db->get_column_of_kind( $table, 'uuid' );
}

## @method get_id_column ($db, $table)
#
# Returns name of ID column of a table from metadata tables. If
# metadata database is not found or the table in question is not
# described in 'description' table, default ID column name is assumed
# to be the name of the real ID column. Otherwise: 
# 1. If a table has a primary key defined on any column - 
#    primary key is returning;
# 2. If a table has NOT primary keys defined but has defined
#    UNIQUE NON NULL column(s) - first column by alphabet is  
#    returning;
# 3. If such columns does not exist, an undefined value is returned.
sub get_id_column
{
    my ($db, $table) = @_;

    my $id_column = $db->get_column_of_kind( $table, 'id' );
    return $id_column if defined $id_column;

    my $default_id_column = $RestfulDB::Defaults::default_id_column;
    my @columns = $db->get_column_names( $table,
                                         { skip_fk_pseudocolumns => 1,
                                           display => 'all' } );
    if( grep { $_ eq $default_id_column } @columns ) {
        return $default_id_column;
    }

    my @primary_columns = sort $db->get_primary_key_columns( $table ); 
    return $primary_columns[0] if @primary_columns;

    my @unique_columns = sort $db->get_unique_columns( $table );
    return $unique_columns[0] if @unique_columns;

    return undef;
}

## @method get_unique_key_column ($table, $id_value);
#
# Returns a name of a unique key column that matches a provided value.
#
# @retval $id_column unique key column name.

sub get_unique_key_column
{
    my ($db, $db_table, $id_value) = @_;

    my $id_column   = $db->get_id_column( $db_table );
    my $uuid_column = $db->get_uuid_column( $db_table );
    return $id_column if !defined $id_value;

    my $sql_types = $db->get_column_type_hash( $db_table );
    my $column_properties = $db->get_column_properties( $db_table );
    if( is_numerical( $sql_types->{$id_column} ) ) {
        return $id_column if $id_value =~ /^\d+$/;
    } elsif( $column_properties->{validation_regex}{$id_column} ) {
        if( $id_value =~ /^$column_properties->{validation_regex}{$id_column}$/ ) {
            return $id_column;
        }
    } else {
        return $id_column;
    }

    if( $uuid_column && lc( $id_value ) =~ /^$uuid_re$/ ) {
        # uid: 558ebc74-f084-11e7-a4c8-7f35a099dece
        return $uuid_column;
    }

    my @extkey_columns = $db->get_extkey_column( $db_table );
    if( @extkey_columns == 1 ) {
        return shift @extkey_columns;
    } else {
        # More than one external key detected -- inspect regular
        # expressions to see whether there is only one which matches
        my @matching_columns =
            grep { my $re = $column_properties->{validation_regex}{$_};
                   !defined $re || $id_value =~ /^$re$/ }
                 @extkey_columns;
        if( @matching_columns && @matching_columns > 1 ) {
            local $" = "', '";
            MetadatabaseException->throw(
                "table '$db_table' has more than one external key " .
                "column: '@matching_columns', cannot continue due to " .
                'ambiguity' );
        }
        return shift @matching_columns if @matching_columns;
    }

    return $id_column;
}

## @method get_column_of_kind ($db, $table, $kind)
#
# Returns name of a column of kind '$kind' (e.g. 'id', 'uuid' or
# 'extkey') for a requested table; queries metadata tables. If
# metadata database is not found or the table in question is not
# described in 'description' table, undef column name is returned.
sub get_column_of_kind
{
    my ($db, $table, $kind) = @_;

    my $column_properties = $db->get_column_properties( $table );

    my @columns;
    for my $column (keys %{$column_properties->{coltype}}) {
        next if !$column_properties->{coltype}{$column};
        next if  $column_properties->{coltype}{$column} ne $kind;
        push @columns, $column;
    }

    return if !@columns;

    @columns = sort @columns;
    return @columns if wantarray;

    if( @columns > 1 ) {
        local $" = "', '";
        warn "table '$table' has more than one column of kind '$kind': " .
             "'@columns'; '$columns[0]' will be used\n";
    }
    return $columns[0];
}

## @method get_reverse_foreign_keys ($db, $table)
# Returns list of columns of each table that are related to the table
# under question by foreign key relations.
#
# @retval reverse_fk =
# \code{Perl}
# $reverse_fk = {
#   'table1' => [
#       {
#           column => [ 'column1' ],
#           relation => 'N',
#           visualisation => 'table',
#       },
#       ...
#   ]
#   ...
# }
# \endcode
sub get_reverse_foreign_keys
{
    my($db, $table) = @_;

    $db->_load_foreign_keys();
    my $fk = $db->{fk};

    my $reverse_fk = {};

    for my $rel_table (sort keys %$fk) {
        for my $relation (@{$fk->{$rel_table}}) {
            next if $relation->parent_table ne $table;
            push @{$reverse_fk->{$rel_table}}, $relation;
        }
    }

    return $reverse_fk;
}

## @function is_history_table ($table)
# Indicates whether table is history table.
sub is_history_table
{
    my( $table ) = @_;
    return $table =~ /\Q$RestfulDB::Defaults::history_table_suffix\E$/;
}

# FIXME: report auto increment columns
sub is_autogenerated
{
    my( $db, $table, $column ) = @_;
    my $columns = $db->get_column_properties( $table );

    return 1 if $columns->{can_be_suggested}{$column};
    return 1 if $columns->{coltype}{$column} &&
                $columns->{coltype}{$column} eq 'uuid';
    return 0;
}

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;
    }
}

1;
