view release on metacpan or  search on metacpan

lib/App/DBBrowser/Auxil.pm  view on Meta::CPAN

package # hide from PAUSE
App::DBBrowser::Auxil;

use warnings;
use strict;
use 5.016;

use Encode       qw( decode );
use Scalar::Util qw( looks_like_number );
#use Storable     qw();  # required


use DBI::Const::GetInfoType;
use JSON::MaybeXS            qw( decode_json );
use List::MoreUtils          qw( none );

use Term::Choose            qw();
use Term::Choose::Constants qw( EXTRA_W );
use Term::Choose::LineFold  qw( line_fold );
use Term::Choose::Screen    qw( clear_screen );
use Term::Choose::Util      qw( insert_sep get_term_width get_term_height unicode_sprintf );
use Term::Form::ReadLine    qw();


sub new {
    my ( $class, $info, $options, $d ) = @_;
    bless {
        i => $info,
        o => $options,
        d => $d
    }, $class;
}


sub reset_sql {
    my ( $sf, $sql ) = @_;
    # preserve base data: table name, column names and data types:
    my $backup = {
        table => $sql->{table} // '',
        columns => $sql->{columns} // [],
        data_types => $sql->{data_types} // {},
    };
    # reset:
    delete @{$sql}{ keys %$sql }; # not "$sql = {}" so $sql is still pointing to the outer $sql
    # initialize:
    my @string = qw( distinct_stmt set_stmt where_stmt having_stmt order_by_stmt limit_stmt offset_stmt );
    my @array  = qw( group_by_cols selected_cols set_args order_by_cols
                     ct_column_definitions ct_table_constraints ct_table_options
                     insert_col_names insert_args );
    my @hash   = qw( alias );
    @{$sql}{@string} = ( '' ) x  @string;
    @{$sql}{@array}  = map{ [] } @array;
    @{$sql}{@hash}   = map{ {} } @hash;
    for my $y ( keys %$backup ) {
        $sql->{$y} = $backup->{$y};
    }
}


sub __stmt_fold {
    my ( $sf, $term_w, $used_for, $stmt, $indent ) = @_;
    if ( $used_for eq 'print' ) {
        my $in = ' ' x $sf->{o}{G}{base_indent};
        my %tabs = ( init_tab => $in x $indent, subseq_tab => $in x ( $indent + 1 ) );
        return line_fold( $stmt, { width => $term_w, %tabs, join => 0 } );
    }
    else {
        return $stmt;
    }
}


sub __select_cols {
    my ( $sf, $sql ) = @_;
    my @cols;
    if ( @{$sql->{selected_cols}} ) {
        @cols = @{$sql->{selected_cols}};
    }
    elsif ( keys %{$sql->{alias}} && ! $sql->{aggregate_mode} ) {
        @cols = @{$sql->{columns}};
        # use column names and not * if columns have aliases (join)
        # unless aggregate_mode (columns are aggregate functions and group by columns) ##
    }
    if ( ! @cols ) {
        return "" if $sql->{aggregate_mode};
        return " *";
    }
    elsif ( ! keys %{$sql->{alias}} ) {
        return ' ' . join ', ', @cols;
    }
    else {
        return ' ' . join ', ', map { length $sql->{alias}{$_} ? "$_ AS $sql->{alias}{$_}" : $_ } @cols;
    }
}


sub __group_by_stmt {
    my ( $sf, $sql ) = @_;
    my $aliases = $sf->{o}{alias}{use_in_group_by} ? $sql->{alias} : {};
    return "GROUP BY " . join ', ', map { length $aliases->{$_} ? $aliases->{$_} : $_ } @{$sql->{group_by_cols}};
}


sub cte_stmts {
    my ( $sf, $used_for, $indent1 ) = @_;
    if ( ! @{$sf->{d}{cte_history}//[]} ) {
        return;
    }
    if ( length( $sf->{d}{main_info} ) && $used_for eq 'print' ) { ##
        # else the cte definitions would be printed twice if a cte is used inside a cte.
        return;
    }
    my $ctes = $sf->{d}{cte_history};
    my $with = "WITH";
    for my $cte ( @$ctes ) {