App-DBBrowser

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

        - Update cte.

2.410  2024-05-04
        - Derived table/Cte: bugfix in 'choose_query'.
        - Bugfix in 'Operators.pm'.
        - Refactoring and cleanup.
        - SQLite does not have the operators ANY and ALL.
        - Term::Choose minimum version 1.765.

2.409  2024-04-28
        - SQLite plugin: new option to set the busy timeout.
        - SQLite: Renamed and modified the user defined scalar function 'truncate'.
                  Now 'trunc' treats any value that looks like a number as a number.
        - Bugfix in the limit/offset submenu.
        - New input filter 'convert datetime'.
        - Quote entered numbers if the data type is not numeric and no placeholders are used.
        - Added scalar convert functions.
        - Epoch_to_DateTime: bugfix and updates.
        - Data import: if chosen a deleted directory warn and remove the directory from history.

2.408_05  2024-04-21
        - sqlite_busy_timeout.
        - Bugfix limit, offset.

2.408_04  2024-04-15
        - New input filter: convert_datetime.

2.408_03  2024-04-05
        - Quote numbers if the data type is not numeric.
        - Refactoring.

2.408_02  2024-04-01

lib/App/DBBrowser/DB/SQLite.pm  view on Meta::CPAN


sub get_db_driver {
    my ( $sf ) = @_;
    return 'SQLite';
}


sub read_attributes {
    my ( $sf ) = @_;
    return [
        { name => 'sqlite_busy_timeout', default => 30000 },
    ];
}


sub set_attributes {
    my ( $sf ) = @_;
    my $values = [
        DBD_SQLITE_STRING_MODE_PV               . ' DBD_SQLITE_STRING_MODE_PV',               # 0
        DBD_SQLITE_STRING_MODE_BYTES            . ' DBD_SQLITE_STRING_MODE_BYTES',            # 1
        DBD_SQLITE_STRING_MODE_UNICODE_NAIVE    . ' DBD_SQLITE_STRING_MODE_UNICODE_NAIVE',    # 4

lib/App/DBBrowser/DB/SQLite.pm  view on Meta::CPAN

    my $read_attributes = $db_opt_get->get_read_attributes( $db, $db_opt );
    my $set_attributes = $db_opt_get->get_set_attributes( $db, $db_opt );
    my $dsn = "dbi:$sf->{i}{driver}:dbname=$db";
    my $dbh = DBI->connect( $dsn, '', '', {
        PrintError => 0,
        RaiseError => 1,
        AutoCommit => 1,
        ShowErrorStatement => 1,
        %$set_attributes,
    } );
    if ( DBI::looks_like_number( $read_attributes->{sqlite_busy_timeout} ) ) {
        $dbh->sqlite_busy_timeout( 0 + $read_attributes->{sqlite_busy_timeout} );
    }
    return $dbh;
}


sub get_databases {
    my ( $sf ) = @_;
    return \@ARGV if @ARGV;
    my $cache_sqlite_files = catfile $sf->{i}{app_dir}, 'cache_SQLite_files.json';
    my $ax = App::DBBrowser::Auxil->new( {}, {}, {} );

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

            $reparse,       $remove_cell,   $insert_cell,  $skip,
            $empty_to_null, $join_columns,  $split_column, $append_col,
            $cols_to_rows,  $split_table,   $merge_rows,   $fill_up_rows,
        ];
        my $max_cols = 4;
        my $info = $sf->__get_filter_info( $sql );
        # Choose
        my $idx = $tc->choose(
            $menu,
            { info => $info, prompt => 'Filter:', layout => 0, order => 0, max_cols => $max_cols, index => 1,
              default => $old_idx, undef => $back, busy_string => $working }
        );
        $sf->__print_busy_string( $working );
        if ( ! $idx ) {
            $sql->{insert_args} = [];
            delete $sf->{d}{fi};
            return;
        }
        if ( $sf->{o}{G}{menu_memory} ) {
            if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
                $old_idx = 0;
                next FILTER;
            }
            $old_idx = $idx;
        }
        my $filter = $menu->[$idx];
        my $filter_str = sprintf( "Filter: %s", $filter );
        if ( $filter eq $reset ) {
            $sf->__print_busy_string( $working );
            $sql->{insert_args} = [ map { [ @$_ ] } @{$bu_insert_args} ];
            $sf->{empty_to_null} = $sf->{o}{insert}{empty_to_null_file};
            next FILTER
        }
        elsif ( $filter eq $confirm ) {
            if ( $sf->{empty_to_null} ) {
                no warnings 'uninitialized';
                $sql->{insert_args} = [ map { [ map { length $_ ? $_ : undef } @$_ ] } @{$sql->{insert_args}} ];
            }
            return 1;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

        elsif ( $filter eq $cols_to_rows ) {
            $sf->__transpose_rows_to_cols( $sql, $filter_str, $working );
        }
        elsif ( $filter eq $empty_to_null ) {
            $sf->__empty_to_null( $sql );
        }
    }
}


sub __print_busy_string {
    my ( $sf, $working ) = @_;
    if ( $working ) {
        print clear_screen();
        print $working . "\r";
    }
}


sub __get_filter_info {
    my ( $sf, $sql, $filter_str ) = @_;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

        }
    }
    if ( @$non_empty_cols == $col_count ) {
        $non_empty_cols = undef; # no preselect if all cols have entries
    }
    my $info = $sf->__get_filter_info( $sql, $filter_str );
    # Choose
    my $col_idx = $tu->choose_a_subset(
        $header,
        { cs_label => 'Cols: ', layout => 0, order => 0, mark => $non_empty_cols, all_by_default => 1, index => 1,
          info => $info, keep_chosen => 1, busy_string => $working }
    );
    $sf->__print_busy_string( $working );
    if ( ! defined $col_idx ) {
        return;
    }
    $sql->{insert_args} = [ map { [ @{$_}[@$col_idx] ] } @$aoa ];
    return 1;
}


sub __remove_empty_rows {
    my ( $sf, $sql, $filter_str, $working ) = @_;
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $menu = [ undef, '- Remove empty rows', '- Remove rows where all fields are empty or undef' ];
    my $info = $sf->__get_filter_info( $sql, $filter_str );
    my $choice = $tc->choose(
        $menu,
        { info => $info, index => 1, layout => 2, busy_string => $working }
    );
    $sf->__print_busy_string( $working );
    if ( ! $choice ) {
        return;
    }
    else {
        my $aoa = $sql->{insert_args};
        my $tmp = [];

        ROW: for my $row ( @$aoa ) {
            if ( $choice == 1 && @$row > 1 ) {
                push @$tmp, $row;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    return 1;
}


sub __choose_rows {
    my ( $sf, $sql, $filter_str, $working ) = @_;
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $aoa = $sql->{insert_args};
    my @pre = ( undef, $sf->{i}{ok} );
    my $stringified_rows = [];
    $sf->__print_busy_string( $working );
    {
        no warnings 'uninitialized';
        for my $i ( 0 .. $#$aoa ) {
            push @$stringified_rows, join ',', @{$aoa->[$i]};
        }
    }
    my $prompt = 'Choose rows:';
    $sql->{insert_args} = []; # $sql->{insert_args} refers to a new empty array - this doesn't delete $aoa

    while ( 1 ) {
        my $info = $sf->__get_filter_info( $sql, $filter_str );
        # Choose
        my @idx = $tc->choose(
            [ @pre, @$stringified_rows ],
            { %{$sf->{i}{lyt_v}}, prompt => $prompt, info => $info, meta_items => [ 0 .. $#pre ],
              include_highlighted => 2, index => 1, undef => $sf->{i}{s_back}, busy_string => $working }
        );
        $sf->__print_busy_string( $working );
        if ( ! $idx[0] ) {
            $sql->{insert_args} = $aoa;
            return;
        }
        if ( $idx[0] == $#pre ) {
            shift @idx;
            for my $i ( @idx ) {
                my $idx = $i - @pre;
                push @{$sql->{insert_args}}, $aoa->[$idx];
            }

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    my ( $back, $confirm, $add_range ) = ( $sf->{i}{_back}, $sf->{i}{_confirm}, '- Add Range' );

    while ( 1 ) {
        if ( @{$sql->{insert_args}} ) {
            my $info = $sf->__get_filter_info( $sql, $filter_str );
            # Choose
            my $choice = $tc->choose(
                [ undef, $confirm, $add_range ],
                { %{$sf->{i}{lyt_v}}, info => $info, undef => $back }
            );
            $sf->__print_busy_string( $working );
            if ( ! $choice ) {
                if ( @last_indexes ) {
                    my $li = pop @last_indexes;
                    $#{$sql->{insert_args}} = $li;
                    next;
                }
                $sql->{insert_args} = $aoa;
                return;
            }
            if ( $choice eq $confirm ) {

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

        push @choices_groups, sprintf '  %*s %s %2d %s',
            $len, insert_sep( $row_count, $sf->{i}{info_thsd_sep} ), $row_str,
            $col_count, $col_str;
    }
    my $prompt = 'Choose group:';
    my $info = $sf->__get_filter_info( $sql, $filter_str );
    # Choose
    my $idxs = $tu->choose_a_subset(
        \@choices_groups,
        { info => $info, prompt => $prompt, layout => 2, index => 1, all_by_default => 1,
          cs_label => "Chosen groups:\n", cs_separator => "\n", cs_end => "\n", busy_string => $working }
    );
    $sf->__print_busy_string( $working );
    if ( ! defined $idxs ) {
        return;
    }
    else {
        my $row_idxs = [];
        for my $idx ( @$idxs ) {
            push @$row_idxs, @{$group{ $keys_sorted[$idx] }};
        }
        $sql->{insert_args} = [ @{$aoa}[sort { $a <=> $b } @$row_idxs] ];
        return;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

        push @tmp_info, line_fold(
            $label . $str_row_with_placeholder, { subseq_tab => ' ' x length $label, join => 0 }
        );
        $prompt = "<*>: ";
        $info = $sf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
        # Readline
        my $cell = $tr->readline(
            $prompt,
            { info => $info, history => [] }
        );
        $sf->__print_busy_string( $working );
        splice( @{$aoa->[$row_idx]}, $col_idx, 0, $cell );
        $sql->{insert_args} = $aoa;
        return;
    }
}


sub __fill_up_rows {
    my ( $sf, $sql, $filter_str, $working ) = @_;
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $aoa = $sql->{insert_args};
    my $menu = [ undef, '- YES' ];
    my $prompt = 'Fill up shorter rows?';
    my $info = $sf->__get_filter_info( $sql, $filter_str );
    # Choose
    my $ok = $tc->choose(
        $menu,
        { info => $info, prompt => $prompt, index => 1, undef => '- NO', layout => 2 }
    );
    $sf->__print_busy_string( $working );
    if ( ! $ok ) {
        return;
    }
    my $longest_row = 0;
    for my $row ( @$aoa ) {
        my $col_count = scalar @$row;
        if ( $col_count > $longest_row ) {
            $longest_row = $col_count;
        }
    }

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $aoa = $sql->{insert_args};
    my $menu = [ undef, '- YES' ];
    my $prompt = 'Append an empty column?';
    my $info = $sf->__get_filter_info( $sql, $filter_str );
    # Choose
    my $ok = $tc->choose(
        $menu,
        { info => $info, prompt => $prompt, index => 1, undef => '- NO', layout => 2 }
    );
    $sf->__print_busy_string( $working );
    if ( $ok ) {
        my $new_last_idx = $#{$aoa->[0]} + 1;
        for my $row ( @$aoa ) {
            $#$row = $new_last_idx;
        }
        $sql->{insert_args} = $aoa;
    }
    return;
}

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

        [ 'Right trim', '\s+' ]
    ];
    my $back = $sf->{i}{back} . ' ' x 3;
    $prompt = "Split column \"$header->[$idx]\"";
    $info = $sf->__get_filter_info( $sql, $filter_str );
    # Fill_form
    my $form = $tf->fill_form(
        $fields,
        { info => $info, prompt => $prompt, confirm => $sf->{i}{confirm}, back => $back }
    );
    $sf->__print_busy_string( $working );
    if ( ! $form ) {
        return;
    }
    my ( $pattern, $limit, $left_trim, $right_trim ) = map { $_->[1] } @$form;
    $pattern //= '';

    for my $row ( @$aoa ) { # modifies $aoa
        my $col = splice @$row, $idx, 1;
        my @split_col;
        if ( length $limit ) {

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    my $col_count;

    CHOOSE_A_NUMBER: while( 1 ) {
        my $info = $sf->__get_filter_info( $sql, $filter_str );
        # Choose
        $col_count = $tu->choose_a_number(
            $digits,
            { info => $info, cs_label => 'Number columns new table: ', small_first => 1,
              confirm => $sf->{i}{confirm}, back => $sf->{i}{back} }
        );
        $sf->__print_busy_string( $working );
        if ( ! $col_count ) {
            return;
        }
        if ( @{$aoa->[0]} < $col_count ) {
            my $prompt = sprintf 'Chosen number(%d) bigger than the available columns(%d)!', $col_count, scalar( @{$aoa->[0]} );
            my $info = $sf->__get_filter_info( $sql, $filter_str );
            $tc->choose(
                [ 'Continue with ENTER' ],
                { info => $info, prompt => $prompt }
            );
            $sf->__print_busy_string( $working );
            next CHOOSE_A_NUMBER;
        }
        if ( @{$aoa->[0]} % $col_count ) {
            my $prompt = sprintf 'The number of available columns(%d) cannot be divided by the selected number(%d) without remainder!', scalar( @{$aoa->[0]} ), $col_count;
            my $info = $sf->__get_filter_info( $sql, $filter_str );
            $tc->choose(
                [ 'Continue with ENTER' ],
                { info => $info, prompt => $prompt }
            );
            $sf->__print_busy_string( $working );
            next CHOOSE_A_NUMBER;
        }
        last CHOOSE_A_NUMBER;
    }
    my $begin = 0;
    my $end = $col_count - 1;
    my $tmp = [];

    while ( 1 ) {
        for my $row ( @$aoa ) {

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

                $str_row;
            }
        } @$aoa;
    }
    my $prompt = 'Choose rows:';
    my $info = $filter_str;
    # Choose
    my $chosen_idxs = $tu->choose_a_subset(
        $stringified_rows,
        { cs_separator => "\n", cs_end => "\n", layout => 2, order => 0, all_by_default => 0, prompt => $prompt,
          index => 1, info => $info, busy_string => $working }
    );
    $sf->__print_busy_string( $working );
    if ( ! defined $chosen_idxs || ! @$chosen_idxs ) {
        return;
    }
    my $merged = [];
    for my $col ( 0 .. $#{$aoa->[$chosen_idxs->[0]]} ) {
        my @tmp;
        for my $row ( @$chosen_idxs ) {
            next if ! defined $aoa->[$row][$col];
            next if $aoa->[$row][$col] =~ /^\s*\z/;
            $aoa->[$row][$col] =~ s/^\s+|\s+\z//g;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    $prompt = @$chosen_idxs == 1 ? 'Edit row cells:' : 'Edit cells of merged rows:';
    my $col_number = 0;
    my $fields = [ map { [ ++$col_number, defined $_ ? "$_" : '' ] } @$merged ];
    $info = $sf->__get_filter_info( $sql, $filter_str );
    # Fill_form
    my $form = $tf->fill_form(
        $fields,
        { info => $info, prompt => $prompt, confirm => $sf->{i}{confirm},
          back => $sf->{i}{back} . '   ' }
    );
    $sf->__print_busy_string( $working );
    if ( ! $form ) {
        return;
    }
    $merged = [ map { $_->[1] } @$form ];
    my $first_idx = shift @$chosen_idxs;
    $aoa->[$first_idx] = $merged; # modifies $aoa
    for my $idx ( sort { $b <=> $a } @$chosen_idxs ) {
        splice @$aoa, $idx, 1;
    }
    $sql->{insert_args} = $aoa;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
    my $tf = Term::Form->new( $sf->{i}{tf_default} );
    my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
    my $aoa = $sql->{insert_args};
    my $is_empty = $sf->__search_empty_cols( $aoa );
    my $header = $sf->__prepare_header( $aoa, $is_empty );
    my $info = $sf->__get_filter_info( $sql, $filter_str );
    # Choose
    my $chosen_idxs = $tu->choose_a_subset(
        $header,
        { cs_label => 'Cols: ', layout => 0, order => 0, index => 1, info => $info, busy_string => $working }
    );
    $sf->__print_busy_string( $working );
    if ( ! defined $chosen_idxs || ! @$chosen_idxs ) {
        return;
    }
    my $join_char = '';
    my $prompt;
    if ( @$chosen_idxs == 1 ) {
        $prompt = 'Edit cells of ' . ( $aoa->[0][$chosen_idxs->[0]] // '--' ) . ':';
    }
    else {
        $prompt = 'Edit cells of joined columns:';

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

        push @tmp_info, line_fold(
            $label . '"' . join( '", "', @{$header}[@$chosen_idxs] ) . '"',
            { subseq_tab => ' ' x length $label, join => 0 }
        );
        $info = $sf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
        # Readline
        $join_char = $tr->readline(
            'Join-string: ',
            { info => $info, history => [ '-', ' ', '_', ',', '/', '=', '+' ] }
        );
        $sf->__print_busy_string( $working );
        if ( ! defined $join_char ) {
            return;
        }
    }
    my $merged = [];
    for my $row ( 0 .. $#{$aoa} ) {
        my @tmp;
        for my $col ( @$chosen_idxs ) {
            next if ! defined $aoa->[$row][$col];
            next if $aoa->[$row][$col] =~ /^\s*\z/;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    }
    my $col_number = 0;
    my $fields = [ map { [ ++$col_number, defined $_ ? "$_" : '' ] } @$merged ];
    $info = $filter_str;
    # Fill_form
    my $form = $tf->fill_form(
        $fields,
        { info => $info, prompt => $prompt, confirm => $sf->{i}{confirm},
          back => $sf->{i}{back} . '   ' }
    );
    $sf->__print_busy_string( $working );
    if ( ! $form ) {
        $sql->{insert_args} = $aoa;
        return;
    }
    $merged = [ map { $_->[1] } @$form ];
    my $first_idx = shift @$chosen_idxs;
    for my $row ( 0 .. $#{$aoa} ) { # modifies $aoa
        $aoa->[$row][$first_idx] = $merged->[$row];
        for my $idx ( sort { $b <=> $a } @$chosen_idxs ) {
            splice @{$aoa->[$row]}, $idx, 1 if $idx < @{$aoa->[$row]};

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN


sub __transpose_rows_to_cols {
    my ( $sf, $sql, $filter_str, $working ) = @_;
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $aoa = $sql->{insert_args};
    my $menu = [ undef, '- YES' ];
    my $prompt = 'Transpose columns to rows?';
    my $info = $sf->__get_filter_info( $sql, $filter_str );
    my $ok = $tc->choose(
        $menu,
        { info => $info, prompt => $prompt, index => 1, undef => '- NO', layout => 2, busy_string => $working }
    );
    $sf->__print_busy_string( $working );
    if ( $ok ) {
        my $tmp_aoa = [];
        for my $row ( 0 .. $#$aoa ) {
            for my $col ( 0 .. $#{$aoa->[$row]} ) {
                $tmp_aoa->[$col][$row] = $aoa->[$row][$col];
            }
        }
        $sql->{insert_args} = $tmp_aoa;
    }
    return;

lib/App/DBBrowser/GetContent/Filter.pm  view on Meta::CPAN

    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my @stringified_rows;
    {
        no warnings 'uninitialized';
        @stringified_rows = map { join ',', @$_ } @$aoa;
    }
    my @pre = ( undef );
    # Choose
    my $row_idx = $tc->choose(
        [ @pre, @stringified_rows ],
        { layout => 2, index => 1, info => $info, prompt => $prompt, busy_string => $working }
    );
    $sf->__print_busy_string( $working );
    if ( ! $row_idx ) {
        return;
    }
    return $row_idx - @pre;
}



1;

lib/App/DBBrowser/GetContent/Filter/ConvertDate.pm  view on Meta::CPAN


sub convert_date {
    my ( $sf, $sql, $bu_insert_args, $filter_str ) = @_;
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $cf = App::DBBrowser::GetContent::Filter->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $rx_locale_dependent = "\%[aAbBhcpPxX]";
    my $aoa = $sql->{insert_args};
    my $row_count = @$aoa;
    my $busy_text = 'Convert datetime: ';
    my $threshold_busy = 5_000;
    my $threshold_progress = 100_000;
    my ( $working, $fmt, $step );
    if ( $row_count > $threshold_busy ) {
        $working = $busy_text . '...';
        if ( $row_count > $threshold_progress ) {
            $step = 1_000;
            my $total = int $row_count / $step;
            $fmt = $busy_text . $total . '/%' . length( $total ) . 'd';
        }
    }
    my $is_empty =  $cf->__search_empty_cols( $aoa );
    my $header = $cf->__prepare_header( $aoa, $is_empty );

    COL: while ( 1 ) {
        my $info = $cf->__get_filter_info( $sql, $filter_str);
        my $prompt = "Choose column:";
        # Stop
        my $col_idx = $cf->__choose_a_column_idx( $header, $info, $prompt );

lib/App/DBBrowser/GetContent/Filter/ConvertDate.pm  view on Meta::CPAN

                            my ( $seconds, $milliseconds, $microseconds, $fract ) = ( '- Seconds', '- Milliseconds', '- Microseconds', '- Seconds.Fract' );
                            my $menu = [ @pre, $seconds, $milliseconds, $microseconds, $fract ];
                            # Choose
                            my $epoch_type = $tc->choose(
                                $menu,
                                { %{$sf->{i}{lyt_v}}, undef => $sf->{i}{s_back}, info => $info }
                            );
                            if ( ! defined $epoch_type ) {
                                next TYPE;
                            }
                            $cf->__print_busy_string( $working );
                            if ( ! eval {
                                for my $row ( $row_idx_begin .. $#$aoa ) {
                                    next if ! defined $aoa->[$row][$col_idx];
                                    my $dt = $formatter->parse_datetime( $aoa->[$row][$col_idx] );
                                    if ( ! defined $dt ) {
                                        for my $row ( 1 .. $row ) {
                                            $aoa->[$row][$col_idx] = $bu_insert_args->[$row][$col_idx];
                                        }
                                        my $message = $sf->__error_messagte_parse_datetime( $formatter, $row, $aoa->[$row][$col_idx] );
                                        die $message;

lib/App/DBBrowser/GetContent/Filter/ConvertDate.pm  view on Meta::CPAN

                                    elsif ( $epoch_type eq $milliseconds ) {
                                        $aoa->[$row][$col_idx] = int( $dt->hires_epoch() * 1_000 );
                                    }
                                    elsif ( $epoch_type eq $microseconds ) {
                                        $aoa->[$row][$col_idx] = int( $dt->hires_epoch() * 1_000_000 );
                                    }
                                    else {
                                        $aoa->[$row][$col_idx] = $dt->hires_epoch();
                                    }
                                    if ( $fmt && ! ( $row % $step ) ) {
                                        $cf->__print_busy_string( sprintf $fmt, $row / $step );
                                    }
                                }
                                1 }
                            ) {
                                $ax->print_error_message( $@ );
                                ++$count_error_in;
                                next IN;
                            }
                        }
                        else {

lib/App/DBBrowser/GetContent/Filter/ConvertDate.pm  view on Meta::CPAN

                                my $prompt_locale_out = 'Locale out: ';
                                # ReadLine
                                $locale_out = $tr->readline(
                                    $prompt_locale_out,
                                    { info => $info, history => [] }
                                );
                                if ( length $locale_out ) {
                                    push @tmp_info, $prompt_locale_out . $locale_out;
                                }
                            }
                            $cf->__print_busy_string( $working );
                            if ( ! eval {
                                for my $row ( $row_idx_begin .. $#$aoa ) {
                                    next if ! length $aoa->[$row][$col_idx];
                                    my $dt = $formatter->parse_datetime( $aoa->[$row][$col_idx] );
                                    if ( ! defined $dt ) {
                                        for my $row ( 1 .. $row ) {
                                            $aoa->[$row][$col_idx] = $bu_insert_args->[$row][$col_idx];
                                        }
                                        my $message = $sf->__error_messagte_parse_datetime( $formatter, $row, $aoa->[$row][$col_idx] );
                                        die $message;
                                    }
                                    if ( length $locale_out ) {
                                        $dt->set_locale( $locale_out );
                                    }
                                    $aoa->[$row][$col_idx] = $dt->strftime( $pattern_out );
                                    if ( $fmt && ! ( $row % $step ) ) {
                                        $cf->__print_busy_string( sprintf $fmt, $row / $step );
                                    }
                                }
                                1 }
                            ) {
                                $ax->print_error_message( $@ );
                                if ( $@ =~ /^Pattern:/ ) {
                                    ++$count_error_in;
                                    next IN;
                                }
                                ++$count_error_out;

lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm  view on Meta::CPAN

                my $menu = [ undef, $yes, $no ];
                my @tmp_info_addition = ( 'Header: ' . join( ', ', map { $_ // '' } @{$sql->{insert_args}[0]} ), ' ' );
                $info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info, @tmp_info_addition ) );
                # Choose
                my $idx = $tc->choose(
                    $menu,
                    { %{$sf->{i}{lyt_v}}, info => $info, prompt => 'Restore header?', index => 1, undef => $sf->{i}{s_back} }
                );
                if ( ! defined $idx || ! defined $menu->[$idx] ) {
                    if ( @$aoa * @$col_idxs > 500_000 ) {
                        $cf->__print_busy_string( 'Working ...' );
                    }
                    $sql->{insert_args} = [ map { [ @$_ ] } @{$bu_insert_args} ];
                    return;
                }
                my $choice = $menu->[$idx];
                if ( $choice eq $yes ) {
                    $sql->{insert_args}[0] = $header;
                }
            }
            return 1;

lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm  view on Meta::CPAN

    if ( ! defined $col_idxs ) {
        return;
    }
    return $col_idxs;
}


sub __execute_substitutions {
    my ( $sf, $aoa, $col_idxs, $all_sr_groups ) = @_;
    my $cf = App::DBBrowser::GetContent::Filter->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $busy_string = 'Search and replace: ';
    my $col_count = @$col_idxs;
    my $cell_count = @$aoa * $col_count;
    my $threshold_busy = 25_000;
    if ( $cell_count > $threshold_busy ) {
        $cf->__print_busy_string( $busy_string . '...' );
    }
    my $threshold_progress = 500_000;
    my ( $show_progress, $step, $total, $fmt );
    if ( $cell_count > $threshold_progress ) {
        $show_progress = $cell_count > ( $threshold_progress * 3 ) ? 2 : 1;
        $step = 1_000;
        $total = int $cell_count / $step;
        $fmt = $busy_string . $total . '/%' . length( $total ) . 'd';
    }
    else {
        $show_progress = 0;
    }
    my $c;

    for my $sr_group ( @$all_sr_groups ) {
        for my $sr_single ( @$sr_group ) {
            my ( $pattern, $replacement_str, $modifiers ) = @$sr_single{qw(pattern replacement modifiers)};
            my $global = $modifiers =~ tr/g//;

lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm  view on Meta::CPAN

                            next;
                        }
                        elsif ( $global ) {
                            gsub_modify( $aoa->[$row][$col], $pattern, $replacement );   # modifies $aoa
                        }
                        else {
                            sub_modify( $aoa->[$row][$col], $pattern, $replacement );    # modifies $aoa
                        }
                    }
                    if ( $show_progress && ! ( $row * $col_count % $step ) ) {
                        $cf->__print_busy_string( sprintf $fmt, $row * $col_count / $step );
                    }
                }
            }
            else {
                if ( $show_progress == 1 ) {
                    $cf->__print_busy_string( $busy_string . '...' );
                }
                for my $row ( 0 .. $#$aoa ) {
                    for my $col ( @$col_idxs ) {
                        $c = 0;
                        if ( ! defined $aoa->[$row][$col] ) {
                            next;
                        }
                        elsif ( $global ) {
                            $aoa->[$row][$col] =~ s/$pattern/$replacement/g;   # modifies $aoa
                        }
                        else {
                            $aoa->[$row][$col] =~ s/$pattern/$replacement/;    # modifies $aoa
                        }
                    }
                    if ( $show_progress == 2 && ! ( $row * $col_count % $step ) ) {
                        $cf->__print_busy_string( sprintf $fmt, $row * $col_count / $step );
                    }
                }
            }
        }
    }
}


sub _stringified_sr_group {
    my ( $sr_group ) = @_;



( run in 0.524 second using v1.01-cache-2.11-cpan-87723dcf8b7 )