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)

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

    my $term_h = get_term_height();
    my $term_w = get_term_width() + EXTRA_W;
    my $row_count = @{$sql->{insert_args}};
    if ( $row_count == 0 ) {
        return [];
    }
    my $col_count = 0; ##
    if ( $sf->{d}{stmt_types}[0] && $sf->{d}{stmt_types}[0] eq 'Create_Table' ) {
        $col_count = @{$sql->{insert_args}[0]//[]};
        #$col_count = @{$sql->{ct_column_definitions//[]}};
        $col_count += 1 + $sf->{o}{create}{table_constraint_rows} if $sf->{o}{create}{table_constraint_rows};
        $col_count += 1 + $sf->{o}{create}{table_option_rows}     if $sf->{o}{create}{table_option_rows};
        $col_count += 12;
        if ( $col_count < 22 ) {
            $col_count = 22;
        }
    }
    else {
        $col_count = 22;
    }
    my $avail_h = $term_h - $col_count;
    if ( $avail_h < $term_h / 3.5 ) {
        $avail_h = int $term_h / 3.5;
    }
    if ( $avail_h < 5) {
        $avail_h = 5;
    }
    my $tmp = [];
    if ( $row_count > $avail_h ) {
        $avail_h -= 2; # for "[...]" + "[count rows]"
        my $count_part_1 = int( $avail_h / 1.5 );
        my $count_part_2 = $avail_h - $count_part_1;
        my $begin_idx_part_1 = 0;
        my $end___idx_part_1 = $count_part_1 - 1;
        my $begin_idx_part_2 = $row_count - $count_part_2;
        my $end___idx_part_2 = $row_count - 1;
        for my $row ( @{$sql->{insert_args}}[ $begin_idx_part_1 .. $end___idx_part_1 ] ) {
            push @$tmp, $sf->__prepare_data_row( $row, $indent, $term_w );
        }
        push @$tmp, $indent . '[...]';
        for my $row ( @{$sql->{insert_args}}[ $begin_idx_part_2 .. $end___idx_part_2 ] ) {
            push @$tmp, $sf->__prepare_data_row( $row, $indent, $term_w );
        }
        my $row_count = scalar( @{$sql->{insert_args}} );
        push @$tmp, $indent . '[' . insert_sep( $row_count, $sf->{i}{info_thsd_sep} ) . ' rows]';
    }
    else {
        for my $row ( @{$sql->{insert_args}} ) {
            push @$tmp, $sf->__prepare_data_row( $row, $indent, $term_w );
        }
    }
    return $tmp;
}


sub __prepare_data_row {
    my ( $sf, $row, $indent, $term_w ) = @_;
    my $list_sep = ', ';
    no warnings 'uninitialized';
    my $row_str = join( $list_sep, map { s/\t/  /g; s/\n/\\n/g; s/\v/\\v/g; $_ } @$row );
    return unicode_sprintf( $indent . $row_str, $term_w, { suffix_on_truncate => $sf->{i}{dots} } );
}


sub print_sql_info {
    my ( $sf, $info, $waiting ) = @_;
    if ( ! defined $info ) {
        return;
    }
    print clear_screen();
    print $info, "\n";
    if ( defined $waiting ) {
        print $waiting . "\r";
    }
}


sub get_sql_info {
    my ( $sf, $sql ) = @_;
    my $stmt = '';
    for my $stmt_type ( @{$sf->{d}{stmt_types}} ) {
        $stmt .= $sf->get_stmt( $sql, $stmt_type, 'print' );
    }
    return $stmt;
}


sub sql_limit {
    my ( $sf, $rows ) = @_;
    my $driver = $sf->{i}{driver}; # Use driver so that dbms remains optional.
    if ( $driver =~ /^(?:SQLite|mysql|MariaDB|Pg|DuckDB)\z/ ) {
        return " LIMIT $rows";
    }
    elsif ( $driver =~ /^(?:Firebird|DB2|Oracle)\z/ ) {
        return " FETCH NEXT $rows ROWS ONLY"
    }
    else {
        return "";
    }
}
#sub sql_limit {
#    my ( $sf, $rows ) = @_;
#    my $dbms = $sf->{i}{dbms};
#    if ( $dbms =~ /^(?:SQLite|mysql|MariaDB|Pg|DuckDB)\z/ ) {
#        return " LIMIT $rows";
#    }
#    elsif ( $dbms =~ /^(?:Firebird|DB2|Oracle)\z/ ) {
#        return " FETCH NEXT $rows ROWS ONLY"
#    }
#    elsif ( $dbms eq 'MSSQL' ) {
#        return " OFFSET 0 ROWS FETCH NEXT $rows ROWS ONLY"
#    }
#    else {
#        return "";
#    }
#}



sub column_names_and_types {
    my ( $sf, $table ) = @_;