#------------------------------------------------------------------------------
#$Author: andrius $
#$Date: 2020-12-09 10:07:18 -0500 (Wed, 09 Dec 2020) $ 
#$Revision: 7130 $
#$URL: svn://saulius-grazulis.lt/restful/tags/v0.15.2/lib/Database/View.pm $
#------------------------------------------------------------------------------
#*
#  An object to encapsulate a view in a database.
#**

package Database::View;
use strict;
use warnings;

use Database::ForeignKey;
use List::MoreUtils qw(uniq);
use RestfulDB::Exception;

#=======================================================================
# Constructors

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

    my $sql;
    if( $db->{db}{content}{engine} =~ /^SQLite[23]?$/ ) {
        my $sth = $db->{db}{content}{dbh}->prepare( 'select sql from sqlite_master ' .
                                                    "where name = ?" );
        $sth->execute( $table );
        $sql = $sth->fetchrow_hashref->{sql};

        # SQLite uses different delimiters from MySQL, therefore, they
        # have to be converted. Currently, the conversion is performed
        # in a primitive way:
        $sql =~ s/'/`/g;

    } else {
        my $delim = $db->{db}{content}{delim};
        my $sth = $db->{db}{content}{dbh}->prepare( 'show create view ' .
                                                    $delim . $table . $delim );
        $sth->execute;
        $sql = $sth->fetchrow_hashref->{'Create View'};
    }

    eval {
        require DBIx::MyParsePP;
    };
    if( $@ ) {
        NotImplementedException->throw( 'Perl module DBIx::MyParsePP is ' .
                                        'missing. As a result, records ' .
                                        'in the views cannot be inserted ' .
                                        'or modified.' );
    }

    my $parser = DBIx::MyParsePP->new;
    my $root = $parser->parse( $sql )->root;
    die "SQL view description '$sql' cannot be parsed" if !$root;

    my $parse_tree = $root->shrink;
    my %tables = get_view_tables( $parse_tree );

    my $self = {
        db      => $db,
        name    => $table,
        columns => [ get_view_columns( $parse_tree, $db ) ],
        tables  => [ sort values %tables ],
        joins   => [ get_joins( $parse_tree, $db ) ],
    };

    return bless $self;
}

#=======================================================================
# Methods

## @method expand_record_descriptions ($view, $data)
# Translate record descriptions for a view into record descriptions
# for tables.
sub expand_record_descriptions
{
    my( $view, $data ) = @_;

    my $topmost_table = $view->topmost_table;
    my @data_now;
    for my $item (@$data) {
        my $item_new =
            $view->{db}->get_record_description( $topmost_table,
                                                 { template => 1 } );
        my $tables = {};
        _get_description_table_pointers( $item_new, $tables );

        for my $column (@{$view->{columns}}) {
            $tables->{$column->{table}}{columns}{$column->{column}} =
                $item->{columns}{$column->{name}};
        }

        push @data_now, $item_new;
    }

    return \@data_now;
}

## @method topmost_table ($view)
# Returns the topmost table (the one with no parents)
sub topmost_table
{
    my( $view ) = @_;

    my $topmost_table;
    if( @{$view->{joins}} ) {
        ( $topmost_table ) = reverse _sort_fk( @{$view->{joins}} );
    } else {
        ( $topmost_table ) = @{$view->{tables}};
    }
    return $topmost_table;
}

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

## @function get_view_columns ($tree)
# Extract column names of a view.
sub get_view_columns
{
    my( $tree, $db ) = @_;

    my $view_list = $tree->extract( 'view_list' );
    my $select_part2 = $tree->extract( 'select_part2' );

    # Return empty array in case no explicitly enumerated columns exist
    return () if !$select_part2;

    my %tables = get_view_tables( $tree );
    my @tables = sort values %tables;

    my( $column_subtree ) = $select_part2->children;

    if( $column_subtree->isa( 'DBIx::MyParsePP::Token' ) &&
        $column_subtree->type eq '*' ) {
        return map { _get_all_columns( $db, $_ ) } @tables;
    }

    if( $column_subtree->isa( 'DBIx::MyParsePP::Rule' ) &&
        $column_subtree->name eq 'table_wild' ) {
        my( $table_token ) = $column_subtree->children;
        return _get_all_columns( $db, $table_token->value );
    }

    my $reverse_columns;
    if( $db ) {
        $reverse_columns = $db->get_reverse_column_hash( \@tables );
    }

    my @underlying_columns = map { values %$_ }
                                 process_select_part2( $select_part2, \%tables, $db );

    my @view_columns;
    if( $view_list ) {
        @view_columns = map { $_->value }
                            @{$view_list->extract( 'IDENT' )};
    } else {
        @view_columns = map { keys %$_ }
                            process_select_part2( $select_part2, \%tables, $db );
    }

    my @view_columns_to_underlying;
    for my $i (0..$#view_columns) {
        my $table = @tables == 1 ? $tables[0] : undef;
        if( $underlying_columns[$i]->{table} ) {
            $table = $underlying_columns[$i]->{table};
        } elsif( $reverse_columns ) {
            $table =
                $reverse_columns->{$underlying_columns[$i]->{column}};
        }
        push @view_columns_to_underlying,
             { name => $view_columns[$i],
               table => $table,
               column => $underlying_columns[$i]->{column} };
    }

    return @view_columns_to_underlying;
}

## @function get_view_tables ($tree)
# Extract table names of a view.
sub get_view_tables
{
    my( $tree ) = @_;

    my $table_list = $tree->extract( 'join_table' );

    $table_list = $tree->extract( 'select_from' )  if !$table_list;
    $table_list = $tree->extract( 'table_factor' ) if !$table_list;

    return () if !$table_list;

    my %tables;
    my $parentheses_open;
    for my $child ($table_list->children) {
        if( $parentheses_open &&
            $child->isa( 'DBIx::MyParsePP::Token' ) &&
            $child->type eq ')' ) {
            $parentheses_open = 0;
        } elsif( $parentheses_open ) {
            next;
        } elsif( $child->isa( 'DBIx::MyParsePP::Rule' ) ) {
            my( $ident, $alias ) = $child->children;
            if( $child->name eq 'table_factor' &&
                $ident->isa( 'DBIx::MyParsePP::Token' ) &&
                $ident->type =~ /^IDENT(_QUOTED)?$/ &&
                ( ($alias->isa( 'DBIx::MyParsePP::Rule' ) &&
                   $alias->name eq 'opt_table_alias') ||
                  ($alias->isa( 'DBIx::MyParsePP::Token' ) &&
                   $alias->type =~ /^IDENT(_QUOTED)?$/) ) ) {
                my $table_alias;
                if( $alias->isa( 'DBIx::MyParsePP::Token' ) ) {
                    $table_alias = $alias->value;
                } else {
                    my( undef, $alias_token ) = $alias->children;
                    $table_alias = $alias_token->value;
                }
                $tables{$table_alias} = $ident->value;
            } else {
                %tables = ( %tables, get_view_tables( $child ) );
            }
        } elsif( $child->type eq '(' ) {
            $parentheses_open = 1;
        } elsif( $child->type =~ /^IDENT(_QUOTED)?$/ ) {
            $tables{$child->value} = $child->value;
            last if $table_list->name eq 'table_factor';
        }
    }

    return %tables;
}

## @function get_joins ($tree)
# Extract joins of the view.
sub get_joins
{
    my( $tree, $db ) = @_;

    my $join_table = $tree->extract( 'join_table' );
    return () if !$join_table;

    my %tables = get_view_tables( $tree );
    my @tables = sort values %tables;
    my $reverse_columns;
    if( $db ) {
        $reverse_columns = $db->get_reverse_column_hash( \@tables );
    }

    my @joins;
    my $bool_pris = $join_table->extract( 'bool_pri' );
    if( $bool_pris ) {
        my @bool_pris = ref $bool_pris eq 'ARRAY' ? @$bool_pris : $bool_pris;
        for my $bool_pri (@bool_pris) {
            my @tables = $bool_pri->children;
            splice @tables, 1, 1;
            my @join;
            for my $table (@tables) {
                my( $table_name, $column_name );
                if( $table->isa( 'DBIx::MyParsePP::Token' ) &&
                    $table->type eq 'IDENT' ) {
                    $column_name = $table->value;
                    if( $reverse_columns ) {
                        $table_name = $reverse_columns->{$column_name};
                    }
                } else {
                    ( $table_name, undef, $column_name ) =
                        map { $_->value } $table->children;
                }
                push @join, { table  => $table_name,
                              column => $column_name };
            }

            # Simple mechanism to ensure that 'table_parent'.'column_parent'
            # will not be a foreign key:
            if( $db ) {
                my @table_id_columns = map { $db->get_id_column( $_->{table} ) }
                                           @join;
                if( defined $table_id_columns[0] &&
                    defined $table_id_columns[1] &&
                    ( $table_id_columns[0] ne $join[0]->{column} ||
                      $table_id_columns[1] ne $join[1]->{column} ) ) {
                    @join = map { $join[$_] }
                            sort { ($table_id_columns[$a] ne $join[$a]->{column}) <=>
                                   ($table_id_columns[$b] ne $join[$b]->{column}) ||
                                   $join[$a]->{column} cmp $join[$b]->{column} } 0..1;
                }
            }

            push @joins,
                 Database::ForeignKey->new(
                    {
                        table_from  => $join[1]->{table},
                        table_to    => $join[0]->{table},
                        table       => $join[0]->{table},
                        column_from => [ $join[1]->{column} ],
                        column_to   => [ $join[0]->{column} ],
                        column      => [ $join[0]->{column} ],
                        name        => $join[1]->{column},
                    }
                );
        }
    } else {
        my @children = $join_table->children;
        while (@children && $children[0]->type ne '(' ) {
            shift @children;
        }
        return () if !@children || $children[0]->type ne '(';

        shift @children;
        my $using = shift @children;
        my $using_fields;
        if( $using->isa( 'DBIx::MyParsePP::Rule' ) &&
            $using->name eq 'using_list' ) {
            $using_fields = $using->extract( 'IDENT' );
            $using_fields = [ $using_fields ] if !ref $using_fields;
        } else {
            $using_fields = [ $using ];
        }
        shift @children;

        @joins = map { Database::ForeignKey->new(
                        {
                            table_from  => $tables[0],
                            table_to    => $tables[1],
                            table       => $tables[1],
                            column_from => [ $_->value ],
                            column_to   => [ $_->value ],
                            column      => [ $_->value ],
                            name        => $_->value,
                        } )
                     } @$using_fields;
        if( @children ) {
            die 'cannot parse the view definition: too complicated';
        }
    }

    return @joins;
}

## @function process_select_part2 ($tree, $db)
# Extract selected columns and their aliases (if any) from 'select_part2'
# subtree of the parsed CREATE VIEW SQL statement.
#
# @param tree 'select_part2' subtree
# \code{perl}
# @columns = (
#   { alias => { column => 'column_name', table => 'table_name' } },
#   ...
# )
# \endcode
sub process_select_part2
{
    my( $select_part2, $tables, $db ) = @_;

    my( $selection ) = $select_part2->children;

    # SELECT * FROM ...
    return if $selection->isa( 'DBIx::MyParsePP::Token' ) &&
              $selection->type eq '*';

    # SELECT single_column FROM ...
    if( $selection->isa( 'DBIx::MyParsePP::Token' ) &&
        $selection->type =~ /^IDENT(_QUOTED)?$/ ) {
        return { $selection->value =>
                 { column => $selection->value } };
    }

    if( $selection->isa( 'DBIx::MyParsePP::Token' ) ) {
        die "unknown SQL token '" . $selection->value . "'";
    }

    my @columns;
    for my $column ($selection->children) {
        # SELECT a, b, c FROM ...
        if( $column->isa( 'DBIx::MyParsePP::Token' ) &&
            $column->type =~ /^IDENT(_QUOTED)?$/ ) {
            push @columns, { $column->value =>
                             { column => $column->value } };
        }
        # SELECT single_column AS alias FROM ...
        if( $column->isa( 'DBIx::MyParsePP::Rule' ) &&
            $column->name eq 'select_alias' ) {
            my $last_column = pop @columns;
            my( $last_key ) = keys %$last_column;
            push @columns, { ($column->children)[1]->value =>
                             { column => $last_key } };
        }
        # SELECT first.a, b FROM ...
        if( $column->isa( 'DBIx::MyParsePP::Rule' ) &&
            $column->name eq 'simple_ident_q' ) {
            my ( $table_name, undef, $column_name ) =
                map { $_->value }
                    $column->children;
            if( $tables && $tables->{$table_name} ) {
                $table_name = $tables->{$table_name};
            }
            push @columns, { $column_name =>
                             { column => $column_name,
                               table  => $table_name } };
        }
        # SELECT a AS first, b AS second FROM ...
        if( $column->isa( 'DBIx::MyParsePP::Rule' ) &&
            $column->name eq 'select_item' ) {
            my( $name, $alias ) = $column->children;

            my $table_name;
            my $column_name;

            # SELECT `a` AS `first` ...
            if( $name->isa( 'DBIx::MyParsePP::Rule' ) &&
                $name->name eq 'simple_ident_q' ) {
                ( $table_name, undef, $column_name ) =
                    map { $_->value } $name->children;
            } elsif( $name->isa( 'DBIx::MyParsePP::Token' ) ) {
                $column_name = $name->value;
            } else {
                # Possibly a function; could not be treated in a
                # generic case.
                next;
            }

            if( $table_name && $tables && $tables->{$table_name} ) {
                $table_name = $tables->{$table_name};
            }
            push @columns, { ($alias->children)[1]->value =>
                             { column => $column_name,
                               table  => $table_name } };
        }
        # SELECT a.* FROM a
        if( $column->isa( 'DBIx::MyParsePP::Rule' ) &&
            $column->name eq 'table_wild' ) {
            next if !$db;

            my( $table_token ) = $column->children;
            my $table = $table_token->value;
            if( $tables && $tables->{$table} ) {
                $table = $tables->{$table};
            }
            push @columns,
                 map { { $_ => { column => $_, table => $table } } }
                     $db->get_column_names( $table, { display => 'all' } );
        }
    }

    return @columns;
}

sub _sort_fk
{
    my @fk = @_;

    # Topological sorting as in Kahn's algorithm taken from:
    # https://en.wikipedia.org/w/index.php?title=Topological_sorting&oldid=867510827

    my @L;
    my @S;
    foreach my $node ( uniq( map( $_->child_table, @fk ),
                             map( $_->parent_table, @fk ) ) ) {
        push @S, $node if !grep { $node eq $_->parent_table } @fk;
    }
    while( @S ) {
        my $n = shift @S;
        push @L, $n;
        my @edges = grep { $_->child_table eq $n } @fk;
        foreach my $e (@edges) {
            my $m = $e->parent_table;
            @fk = grep { $_ ne $e } @fk;
            if( !grep { $m eq $_->parent_table } @fk ) {
                push @S, $m;
            }
        }
    }

    return @L;
}

sub _locate_parent_tables
{
    my @fk = @_;

    my %with_parents = map { $_->parent_table => 1 } @fk;
    return map { $_->child_table }
               grep { !exists $with_parents{$_->child_table} } @fk;
}

sub _get_description_table_pointers
{
    my( $data, $hash ) = @_;

    my $table_name = $data->{metadata}{table_name};
    if( !exists $hash->{$table_name} ) {
        $hash->{$table_name} = $data;
    }

    for my $key (@{$data->{metadata}{column_order}}) {
        next unless $data->{columns}{$key}{fk_target};
        _get_description_table_pointers( $data->{columns}{$key}{fk_target},
                                         $hash );
    }

    for my $key (@{$data->{metadata}{related_table_order}}) {
        _get_description_table_pointers( $data->{related_tables}{$key}[0],
                                         $hash );
    }
}

sub _get_all_columns
{
    my( $db, $table ) = @_;
    return () if !$db;
    return map { { name => $_, column => $_, table => $table } }
               $db->get_column_names( $table, { display => 'all' } );
}

1;
