package RestfulDB::Spreadsheet;
use strict;
use warnings;

# Insist on the CSC_XS module to be used for reading CSV, otherwise
# some CSV syntax errors are not diagnosed and some tests fail:
$ENV{PERL_TEXT_CSV} = "Text::CSV_XS";

use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
use Clone qw(clone);
use Data::UUID;
use File::Basename qw(basename dirname);
use File::Copy qw(copy);
use File::LibMagic;
use File::Temp qw/ :seekable /;
use Encode qw(encode decode);
use Excel::Writer::XLSX;
use FileHandle;
use Hash::Merge qw(merge);
use IO::String;
use List::Util qw(any);
use POSIX qw(strftime);
use Scalar::Util qw(blessed looks_like_number);
use Spreadsheet::ParseExcel::Utility qw(ExcelLocaltime);
use Spreadsheet::Read qw(rows ReadData);
use Spreadsheet::Wright::OpenDocument;
use Spreadsheet::Wright::Excel;
use Spreadsheet::XLSX;
use Text::CSV;
use Text::CSV::Encoded;

use Database qw(
    flatten_record_descriptions
    has_values
    null_if_empty
);
use RestfulDB::Exception;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
    data2spreadsheet
    data2template
    spreadsheet2data
    sprintf_csv_line
);

our %content_types = (
    'text/csv' => 'csv',
    'application/vnd.oasis.opendocument.spreadsheet' => 'ods',
    'application/vnd.ms-excel' => 'xls',
    'application/vnd.openxmlformats-officedocument.wordprocessingml.document' => 'xlsx',
    'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet' => 'xlsx',
    'application/zip' => 'zip',
);

Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );

sub read_spreadsheet
{
    my( $file, $type, $archive_format, $options ) = @_;
    my ( $table_name ) = ( $options->{table_name} );

    my %tables;
    if( defined $archive_format ) {
        if( $archive_format eq 'zip' ) {
            my $tmpfile = File::Temp->new( SUFFIX => ".$type" ) ||
                die "Cannot create temp file: $!";
            copy( $file, $tmpfile ) or
                die "Cannot copy to a temporary file: $!";
            close $tmpfile;

            my $zip = Archive::Zip->new();
            unless ( $zip->read( $tmpfile->filename ) == AZ_OK ) {
                die 'cannot open zip file';
            }

            for my $member ( $zip->members() ) {
                my( $string, $status ) = $member->contents();
                die "error $status" unless $status == AZ_OK;

                my $member_tmpfile = IO::String->new( $string );

                my $member_table_name;
                if( $type eq 'csv' ) {
                    $member_table_name = $member->fileName;
                    $member_table_name =~ s/\.${type}//g;
                } else {
                    $member_table_name = $table_name;
                }

                my $member_spreadsheets =
                    read_spreadsheet( $member_tmpfile, $type, undef,
                                      { 'table_name' => $member_table_name } );
                for my $table_name ( keys %{ $member_spreadsheets } ) {
                    $tables{$table_name} = $member_spreadsheets->{$table_name};
                }
            }
        }
    } else {
        if( $type eq 'csv' ) {
            $tables{$table_name} = read_csv( $file );
        } elsif( $type eq 'xls' ) {
            %tables = %{ read_xls( $file, $table_name ) };
        } else {
            my $tmpfile = File::Temp->new( SUFFIX => ".$type" ) ||
                die "Cannot create temporary file: $!";
            copy( $file, $tmpfile ) or
                die "Cannot copy to a temporary file: $!";
            close $tmpfile;

            eval {
                if( $type eq 'xlsx' ) {
                    %tables = %{ read_xlsx( $tmpfile->filename,
                                            $table_name ) };
                } else {
                    %tables = %{ read_any( $tmpfile->filename,
                                           $type, $table_name ) };
                }
            };
            InputException->throw( "data file '${file}' cannot be parsed: $@" ) if $@;
        }
    }

    InputException->throw( "data file '${file}' is empty or cannot be parsed" ) if !%tables;

    my %rows;

    # Everything in zip files are converted to 'csv' due to recursive call in the
    # current function.
    if( defined $archive_format && $archive_format eq 'zip' ) {
        $type = 'csv';
    }

    # Because everything is converted to CSV, it can be checked if the file
    # is empty or corrupted.
    if( $type eq 'csv' ) {
        InputException->throw( "data file '${file}' is empty or cannot be parsed" )
            if ! map { @{ $tables{$_} } }
                grep { defined $tables{$_} }
                keys %tables;
    }

    for my $table_name ( keys %tables ) {
        my $book;
        my( $minrow, $maxrow, $mincol, $maxcol );

        if( $type eq 'csv' ) {
            $book = $tables{$table_name};
            $minrow = $mincol = 0;
            $maxrow = @$book - 1;
            $maxcol = @{$book->[0]} - 1;
        } elsif( $type eq 'xlsx' ) {
            $book = $tables{$table_name}{Worksheet}[0];
            $minrow = $book->{MinRow};
            $maxrow = $book->{MaxRow};
            $mincol = $book->{MinCol};
            $maxcol = $book->{MaxCol};
        } else {
            $book = $tables{$table_name}[1];

            # Spreadsheet::Read v0.54 returns defined but empty $table
            InputException->throw(
                "data file '${file}' is empty or cannot be parsed" ) if !$book;

            $minrow = $book->{minrow};
            $maxrow = $book->{maxrow};
            $mincol = $book->{mincol};
            $maxcol = $book->{maxcol};

            # The following values are not defined by ODS parser:
            $minrow = 1 if !defined $minrow;
            $mincol = 1 if !defined $mincol;
        }

        # The raw data is extracted instead of using rows() in
        # order to know indexes for 'attr' table.
        for my $i ($minrow..$maxrow) {
            my @row;
            for my $j ($mincol..$maxcol) {
                my $value;
                if( $type eq 'csv' ) {
                    $value = $book->[$i][$j];
                } elsif( $type eq 'xlsx' ) {
                    my $cell = $book->get_cell( $i, $j );
                    if( defined $cell ) {
                        $value = decode( 'UTF-8', $cell->unformatted );
                        if( $cell->get_format && $cell->get_format ne 'General' ) {
                            # Processing a date. Contains a workaround for
                            # https://projects.ibt.lt/repositories/issues/583
                            if( looks_like_number( $value ) ) {
                                $value = strftime( "%F %T",
                                                   ExcelLocaltime( $value ) );
                            } else {
                                warn "Non-numeric date value '$value' " .
                                     'encountered in XLSX file, leaving as is.';
                            }
                        }
                    }
                } else {
                    $value = $book->{cell}[$j][$i];
                    # UTF-16BE is decoded by Spreadsheet::Read starting with
                    # v0.64, with older versions we have to do it ourselves.
                    if( $book->{attr}[$j][$i]{enc} &&
                        $book->{attr}[$j][$i]{enc} ne 'utf-8' &&
                        $Spreadsheet::Read::VERSION <= '0.63' ) {
                        $value = decode( $book->{attr}[$j][$i]{enc},
                                         $value );
                    }
                    # Spreadsheet::ParseExcel does not decode single byte
                    # UTF-16, which is the default format. For details see
                    # https://projects.ibt.lt/repositories/issues/699.
                    if( defined $value &&
                        $type eq 'xls' && !defined $book->{attr}[$j][$i]{enc} ) {
                        $value =~ s/(.)/\x00$1/g;
                        $value = decode( 'UTF-16BE', $value );
                    }
                    if( $type eq 'xls' &&
                        $book->{attr}[$j][$i]{type} &&
                        $book->{attr}[$j][$i]{type} eq 'date' ) {
                        # processing a date
                        $value = strftime( "%F %T", ExcelLocaltime( $value ) );
                    }
                }
                # Trims right trailing spaces, because XLS parser can leave them if
                # the user made columns longer in GUI.
                if( defined $value ) { 
                    $value =~ s/\s+$//;
                }
                push @row, $value;
            }
            push @{ $rows{$table_name} }, \@row;
        }
    }

    return \%rows;
}

sub read_csv
{
    my ( $file ) = @_;
    my $csv = Text::CSV::Encoded->new( { encoding_in => 'utf-8' } );
    my $table = [];
    while ( my $row = $csv->getline( $file ) ) {
        next if @$row && $row->[0] =~ /^#/; # Skip comments
        push @$table, $row;
    }
    if( $csv->error_diag && $csv->error_diag !~ /^EOF/ ) {
        InputException->throw( 'Cannot read CSV line: ' . $csv->error_diag );
    }
    return $table;
}

sub read_xls
{
    my ( $file, $table_name ) = @_;
    return read_any( $file, 'xls', $table_name );
}

sub read_xlsx
{
    my ( $file, $table_name ) = @_;
    my $book = Spreadsheet::XLSX->new( $file );

    my %tables = ();
    for my $tab ( $book->worksheets() ) {
        my $tab_name;
        if( scalar $book->worksheets() > 1 ) {
            $tab_name = $tab->{Name};
        } else {
            $tab_name = $table_name;
        }

        for my $key ( keys %{ $book } ) {
            next if $key eq 'Worksheet' || $key eq 'SheetCount';

            $tables{$tab_name}{$key} = $book->{$key};
        }
        $tables{$tab_name}{'Worksheet'} = [ $tab ];
        $tables{$tab_name}{'SheetCount'} = 1;
    }

    return \%tables;
}

# TODO: find better function name. It use Spreadsheet::Read::ReadData() and can
# handle any spreadsheet that this function is capable of parsing.
sub read_any
{
    my ( $file, $parser, $table_name ) = @_;
    my $book = ReadData( $file,
                         parser => $parser,
                         attr => 1,
                         # Forces Spreadsheet::ReadSXC to take the "raw" date
                         # value from ODS spreadsheets:
                         StandardDate => 1 );
    my $metadata = $book->[0];
    my $tabs = $metadata->{sheet};
    my $tab_count = scalar keys %{ $tabs };

    my %tables;
    for my $tab ( keys %{ $tabs } ) {
        my $index = $tabs->{$tab};
        my $current_metadata = clone( $metadata );

        delete $current_metadata->{sheet};

        $current_metadata->{sheet}{$tab} = 1;
        $current_metadata->{sheets} = 1;

        my $current_book = $book->[$index];
        if( $tab_count > 1 ) {
            $tables{$tab} = [ $current_metadata, $current_book ];
        } else {
            $tables{$table_name} = [ $current_metadata, $current_book ];
        }
    }

    return \%tables;
}

sub sprintf_csv_line
{
    my ($columns, $csv) = @_;

    $csv = Text::CSV->new( { binary => 1 } ) unless $csv;
    $csv->combine( @$columns ) ||
        warn 'Cannot combine CSV line: '. $csv->error_diag . "\n";
    return $csv->string();
}

sub spreadsheet2data
{
    my( $db, $data, $params, $cgi, $table_name ) = @_;

    my %params = %$params;

    my $file;
    my $type;
    my $archive_format;

    if( $cgi->content_type() && exists $content_types{$cgi->content_type()} ) {
        $type = $content_types{$cgi->content_type()};
        $file = IO::String->new( scalar $cgi->param(  $ENV{REQUEST_METHOD} . 'DATA' ) );
    } else {
        my @ext_pairs = ();
        for my $file_ext ('autodetect', 'csv', 'ods', 'xls', 'xlsx') {
            push @ext_pairs, [ $file_ext, undef ];
            for my $archive_ext ( 'zip' ) {
                push @ext_pairs, [ $file_ext, $archive_ext ];
            }
        }
        for my $ext_pair ( @ext_pairs ) {
            my ( $file_ext, $archive_ext ) = @{ $ext_pair };
            my $full_ext = join '', grep { defined $_ } @{ $ext_pair };

            next if !defined $params{$full_ext . 'file'};

            $file = $cgi->upload( $full_ext . 'file' );

            if( $full_ext eq 'autodetect' ) {
                my $mime_type = $cgi->uploadInfo( $file )->{'Content-Type'};
                if( defined $mime_type ) {
                    if( exists $content_types{$mime_type} ) {
                        if( $content_types{$mime_type} eq 'zip' ) {
                            # NOTE: For now, all ZIP files are auto-detected as
                            # CSV+ZIP.
                            $type = 'csv';
                            $archive_format = 'zip';
                        } else {
                            $type = $content_types{$mime_type};
                            $archive_format = undef;
                        }
                    } else {
                        # Tries to determine mime-type using Perl module, because
                        # server could not recognise or is configured that way.
                        if( $mime_type eq 'application/octet-stream' ) {
                            my $magic = File::LibMagic->new();
                            my $info = $magic->info_from_handle( $file );
                            if( exists $content_types{$info->{mime_type}} ) {
                                if( $content_types{$info->{mime_type}} eq 'zip' ) {
                                    # NOTE: For now, all ZIP files are auto-detected as
                                    # CSV+ZIP.
                                    $type = 'csv';
                                    $archive_format = 'zip';
                                } else {
                                    $type = $content_types{$info->{mime_type}};
                                    $archive_format = undef;
                                }
                            }
                        }
                    }
                }
            } else {
                $type = $file_ext;
                $archive_format = $archive_ext;
            }
        }

        # Processing generic uploads if none of previous were found.
        if( !$type && defined $params{spreadsheet} ) {
            if( $params{spreadsheet} =~ /\.(csv|ods|xlsx?)$/ ) {
                $type = $1;
            } else {
                die "Cannot determine data file '${file}' type from file " .
                    "name of '$params{spreadsheet}'";
            }
            $file = $cgi->upload( 'spreadsheet' );
        }
    }

    die "No upload file handle?" unless $file;

    my $rows = 
        read_spreadsheet( $file,
                          $type,
                          $archive_format,
                          { table_name => $table_name } );

    close $file;

    # If any fields are provided by POST as 'column:...=value',
    # they are appended to every row.

    for my $key (grep { /^column:.+$/ } sort keys %$params) {
        $key =~ /^column:(.+)$/;
        my $column = $1;
        push @{$rows->{$table_name}[0]}, $column;
        foreach (@{$rows->{$table_name}}[1..$#{$rows->{$table_name}}]) {
            push @$_, $params{$key};
        }
    }

    my @data = @{ csv_to_record_descriptions( $db, $data, $rows,
                                              {'filename' => $file } ) };

    return \@data;
}

sub csv_to_record_descriptions
{
    my ( $db, $data, $csv, $options ) = @_;
    my ( $parent, $filename ) = ( $options->{parent}, $options->{filename} );

    # Checks beforehand if there is any data in CSV.
    my $is_csv_empty = 1;
    foreach( keys %{ $csv } ) {
        if( scalar @{ $csv->{$_} } > 1 ) {
            $is_csv_empty = 0;
            last;
        }
    }
    if( $is_csv_empty ) {
        if( $filename ) {
            warn "data file '${filename}' has no records\n";
        } else {
            warn "data file has no records\n";
        }
        return [];
    }

    my @data;
    for my $data_item (@$data) {
        my $table_name = $data_item->{metadata}{table_name};

        next if ! exists $csv->{$table_name};

        my @columns = @{ $csv->{$table_name}[0] };
        my @foreign_keys = map   { $_->{fk} }
                           grep  { defined $_->{coltype} &&  $_->{coltype} eq 'fk' }
                           map   { $data_item->{columns}{$_} }
                           keys %{ $data_item->{columns} };

        for my $i (1..$#{ $csv->{$table_name} }) {
            my $row = $csv->{$table_name}[$i];

            my $item = {};
            my $parents = {};
            for my $j (0..$#columns) {
                if( $columns[$j] =~ /^(.+)\.(.+)$/ ) {
                    next if !defined $row->[$j];

                    my $parent_table = $1;
                    my $column = $2;

                    my $column_properties = $db->get_column_properties( $parent_table );
                    my $column_types = $db->get_column_type_hash( $parent_table );

                    my $value = null_if_empty( $row->[$j],
                                               $column_types->{$column},
                                               $column_properties->{coltype}{$column} );
                    next if !defined $value;
                    $parents->{$parent_table}{$column} = $value;
                } else {
                    if( $data_item->{columns}{$columns[$j]}{sqltype} &&
                        $data_item->{columns}{$columns[$j]}{sqltype} =~
                        /^(date|timestamp)$/i &&
                        $row->[$j] && $row->[$j] !~ /^\d{4}-\d{2}-\d{2}/ ) {
                        warn "date/timestamp '$row->[$j]' looks ambiguous, " .
                             'please make sure that it was understood correctly' .
                             "\n";
                    }
                    $item->{columns}{$columns[$j]}{value} = $row->[$j];
                }
            }

            if( $parent && $parents->{$parent->{metadata}{table_name}} ) {
                my( @matching_keys, @mismatching_keys );
                my $parent_table = $parent->{metadata}{table_name};
                foreach (sort keys %{$parents->{$parent_table}}) {
                    next if defined $parents->{$parent_table}{$_} &&
                            $parents->{$parent_table}{$_} eq '';

                    if( defined $parents->{$parent_table}{$_} &&
                        defined $parent->{columns}{$_}{value} &&
                        $parents->{$parent_table}{$_} eq $parent->{columns}{$_}{value} ) {
                        push @matching_keys, $_;
                    } elsif( defined $parents->{$parent_table}{$_} ) {
                        push @mismatching_keys, $_;
                    }
                }

                if( @matching_keys && @mismatching_keys ) {
                    local $" = "', '";
                    InputException->throw(
                        "cannot insert record to table '$table_name' due to " .
                        "partial mismatch of keys to a parent record ('" .
                        $parent_table . "'): values of '@matching_keys' " .
                        "match, whereas values of '@mismatching_keys' do not." );
                }
                next if @mismatching_keys;
                delete $parents->{$parent_table};
            }

            for my $parent_table (sort keys %$parents) {
                my $filter = Database::Filter->new_for_conjunction(
                                [ map { [ $_ ] }
                                      grep { defined $parents->{$parent_table}{$_} }
                                      sort keys %{$parents->{$parent_table}} ],
                                [ map { $parents->{$parent_table}{$_} }
                                      grep { defined $parents->{$parent_table}{$_} }
                                      sort keys %{$parents->{$parent_table}} ] );

                my $fk_data =
                    $db->get_record_description( $parent_table,
                                                 { filter => $filter,
                                                   no_empty => 1,
                                                   no_related => 1,
                                                   no_foreign_keys => 1 } );

                if( !$fk_data ) {
                    InputException->throw(
                        "cannot insert record to table '$table_name' due to " .
                        "nonexistent parent record ('" . $parent_table . "'): " .
                        "nothing matches '" . $filter->query_string . "'." );
                }

                my( $fk ) = grep { $_->child_table  eq $table_name &&
                                   $_->parent_table eq $parent_table }
                                 @foreign_keys;
                if( $fk ) {
                    $item->{columns}{$fk->child_column}{value} =
                        $fk_data->{columns}{$fk->parent_column}{value};
                }
            }

            $item = merge( clone( $data_item ), $item );

            # Determines the action according to the existence of the data unique
            # keys.
            my ( $record_id ) = map  { $item->{columns}{$_}{value} }
                                grep { $item->{columns}{$_}{coltype} &&
                                       $item->{columns}{$_}{coltype} eq 'id' }
                                sort keys %{ $item->{columns} };

            if( defined $record_id && @{$db->get_records( $table_name, $record_id )} ) {
                $item->{metadata}{action} = 'update';
            } else {
                $item->{metadata}{action} = 'insert';
            }

            # Changes the values of the related items, if the foreign key is present.
            for my $related_table_name (keys %{$item->{related_tables}}){
                $item->{related_tables}{$related_table_name} =
                    csv_to_record_descriptions(
                        $db,
                        $data_item->{related_tables}{$related_table_name},
                        $csv,
                        {
                            parent => $item,
                            filename => $filename
                        }
                    );
            }

            push @data, $item;
        }
    }

    return \@data;
}

sub data2template
{
    my( $template, $data, $options ) = @_;

    if( ref $data eq 'HASH' ) {
        $data = [ $data ];
    }

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

    my $main_table = $data->[0]{metadata}{table_name};
    my $tables = flatten_record_descriptions( $data );
    expand_foreign_keys( $tables,
                         { columns => { $main_table => $columns },
                           hide_column_types => [ 'id', 'dbrev' ] } );

    for my $table_name (sort keys %$tables) {
        my $table = $tables->{$table_name};

        # Prefill UUIDs
        if( $options->{rows} &&
            $table_name eq $main_table &&
            any { $table->[0]{columns}{$_}{coltype} &&
                  $table->[0]{columns}{$_}{coltype} eq 'uuid' }
                keys %{$table->[0]{columns}} ) {
            my $uuid_gen = Data::UUID->new;
            for (0..$options->{rows}-1) {
                $table->[$_] = clone( $table->[0] ) if $_ > 0;
                for my $column (keys %{$table->[$_]{columns}}) {
                    next if !$table->[$_]{columns}{$column}{coltype};
                    next if  $table->[$_]{columns}{$column}{coltype} ne 'uuid';
                    $table->[$_]{columns}{$column}{value} =
                        lc $uuid_gen->create_str();
                }
            }
        }
    }

    tables2spreadsheet( $template, $tables,
                        { order => [ $main_table,
                                     sort grep { $_ ne $main_table }
                                     keys %$tables ] } );
}

sub data2spreadsheet
{
    my( $spreadsheet, $data, $options ) = @_;

    if( ref $data eq 'HASH' ) {
        $data = [ $data ];
    }
    my $table_name = $data->[0]{metadata}{table_name};
    my $tables = flatten_record_descriptions( $data );
    expand_foreign_keys( $tables,
                         { fk_column_types => [ 'extkey', 'id', 'uuid' ] } );
    for my $table (keys %$tables) {
        next if $table eq $table_name;
        next if grep { has_values( $_ ) } @{$tables->{$table}};
        delete $tables->{$table};
    }

    tables2spreadsheet( $spreadsheet, $tables,
                        { order => [ $table_name,
                                     sort grep { $_ ne $table_name }
                                     keys %$tables ] } );
}

sub tables2spreadsheet
{
    my( $spreadsheet, $tables, $options ) = @_;

    $options = {} unless $options;
    my ( $table_order ) = ( $options->{order} );
    $table_order //= [ sort keys %$tables ];

    my $is_first = 1;
    for my $table ( @$table_order ) {
        my $columns = $tables->{$table}[0]{metadata}{column_order};
        if( !blessed $spreadsheet ) {
            $$spreadsheet .= sprintf_csv_line( $columns ) . "\n";
            my $csv = Text::CSV->new( { binary => 1 } );
            for my $entry (@{$tables->{$table}}) {
                next if !has_values( $entry );
                $$spreadsheet .=
                    sprintf_csv_line( [ map { $entry->{columns}{$_}{value} }
                                            @$columns ], $csv ) . "\n";
            }
            return; # Only one table can be produced for CSV format
        } elsif( $spreadsheet->isa( Archive::Zip:: ) ) {
            my $spreadsheet_file = '';
            tables2spreadsheet( \$spreadsheet_file,
                                { $table => $tables->{$table} } );
            $spreadsheet->addString( encode( 'UTF-8', $spreadsheet_file ), "$table.csv" );
        } elsif( $spreadsheet->isa( Excel::Writer::XLSX:: ) ) {
            my $worksheet = $spreadsheet->add_worksheet( $table );
            $worksheet->write( 0, 0, $columns );
            my $n = 1;
            for my $entry (@{$tables->{$table}}) {
                next if !has_values( $entry );
                for my $j (0..$#$columns) {
                    my  $value = $entry->{columns}{$columns->[$j]}{value};
                    if( $value && $value =~ /^=/ ) {
                        $worksheet->write_string( $n, $j, $value );
                    } else {
                        $worksheet->write( $n, $j, [ $value ] );
                    }
                }
                $n++;
            }
        } elsif( $spreadsheet->isa( Spreadsheet::Wright::Excel:: ) ||
                 $spreadsheet->isa( Spreadsheet::Wright::OpenDocument:: ) ) {
            if( $is_first ) {
                # A hack to get around
                # https://rt.cpan.org/Ticket/Display.html?id=131337
                $spreadsheet->{_SHEETNAME} = $table;
            } else {
                $spreadsheet->addsheet( $table );
            }
            $spreadsheet->addrow( @$columns );
            for my $i (0..$#{$tables->{$table}}) {
                my $entry = $tables->{$table}[$i];
                next if !has_values( $entry );
                $spreadsheet->addrow( map { $_ && $_ =~ /^=/
                                            ? { content => $_, type => 'string' }
                                            : $_ }
                                      map { $entry->{columns}{$_}{value} }
                                          @$columns );
            }
        }
        $is_first = 0;
    }
}

sub expand_foreign_keys
{
    my( $tables, $options ) = @_;

    $options = {} unless $options;
    my( $columns, $fk_column_types, $hide_column_types ) = (
        $options->{columns},
        $options->{fk_column_types},
        $options->{hide_column_types},
    );

    $fk_column_types = [ 'extkey', 'uuid' ] unless $fk_column_types;
    $fk_column_types = '^(' . join( '|', @$fk_column_types ) . ')$';

    for my $table_name (sort keys %$tables) {
        my $table = $tables->{$table_name};
        foreach (@$table) {
            my %parent_tables;
            for my $column (sort keys %{$_->{columns}}) {
                next if !$_->{columns}{$column}{fk};
                $parent_tables{$_->{columns}{$column}{fk}->parent_table}++;
            }

            my @order_now;
            for my $column (@{$_->{metadata}{column_order}}) {
                if( $columns && $columns->{$table_name} &&
                    !grep { $_ eq $column } @{$columns->{$table_name}} ) {
                    delete $_->{columns}{$column};
                    next;
                }

                my $coltype = $_->{columns}{$column}{coltype};
                if( !$coltype ) {
                    push @order_now, $column;
                    next;
                }

                if( $hide_column_types &&
                    any { $_ eq $coltype } @$hide_column_types ) {
                    delete $_->{columns}{$column};
                    next;
                }

                if( $coltype ne 'fk' ) {
                    push @order_now, $column;
                    next;
                }

                my $fk = $_->{columns}{$column}{fk};
                my $fk_table = $fk->parent_table;
                if( $parent_tables{$fk_table} > 1 ) {
                    warn "cannot expand column name for '$table_name'." .
                         "'$column': more than one column of '$table_name' " .
                         "are foreign keys to '$fk_table'\n";
                    push @order_now, $column;
                    next;
                }

                my $fk_target = $_->{columns}{$column}{fk_target};
                my @key_columns =
                    grep { $fk_target->{columns}{$_}{coltype} &&
                           $fk_target->{columns}{$_}{coltype} =~ $fk_column_types }
                         sort keys %{$fk_target->{columns}};
                if( @key_columns ) {
                    delete $_->{columns}{$column};
                    for my $key (@key_columns) {
                        $_->{columns}{"$fk_table.$key"} = {};
                        if( defined $fk_target->{columns}{$key}{value} ) {
                            $_->{columns}{"$fk_table.$key"}{value} =
                                $fk_target->{columns}{$key}{value};
                        }
                        push @order_now, "$fk_table.$key";
                    }
                } elsif( $fk ) {
                    $_->{columns}{$fk->compound_name} = {};
                    if( defined $_->{columns}{$column}{value} ) {
                        $_->{columns}{$fk->compound_name}{value} =
                            $_->{columns}{$column}{value};
                    }
                    delete $_->{columns}{$column};
                    push @order_now, $fk->compound_name;
                } else {
                    push @order_now, $column;
                }
            }
            $_->{metadata}{column_order} = \@order_now;
        }
    }
}

1;
