view release on metacpan or  search on metacpan

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

package # hide from PAUSE
App::DBBrowser::GetContent::Parse;

use warnings;
use strict;
use 5.016;

use Encode qw( decode );

use Encode::Locale    qw();
#use Spreadsheet::Read qw( ReadData rows ); # required
#use String::Unescape  qw( unescape );      # required
#use Text::CSV_XS      qw();                # required

use Term::Choose           qw();
use Term::Choose::LineFold qw( line_fold );
use Term::Choose::Screen   qw( clear_screen );
use Term::Choose::Util     qw( get_term_size unicode_sprintf insert_sep );
use Term::Form             qw();

use App::DBBrowser::Options;
use App::DBBrowser::Options::ReadWrite;


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


sub __print_waiting_str {
    my ( $sf ) = @_;
    print clear_screen;
    print 'Parsing file ... ' . "\r";
}


sub parse_with_Text_CSV {
    my ( $sf, $sql, $fh ) = @_;
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    $sf->__print_waiting_str;
    seek $fh, 0, 0;
    require String::Unescape;
    my $options = {
        map { $_ => String::Unescape::unescape( $sf->{o}{csv_in}{$_} ) }
        # grep length: keep the default value if the option is set to ''
        grep { length $sf->{o}{csv_in}{$_} }
        keys %{$sf->{o}{csv_in}}
    };
    require Text::CSV_XS;
    my $csv = Text::CSV_XS->new( $options ) or die Text::CSV_XS->error_diag();
    $csv->callbacks( error => sub {
        my ( $code, $str, $pos, $rec, $fld ) = @_;
        if ( $code == 2012 ) {
            # no warnings for end of data.
            # 2012 "EOF - End of data in parsing input stream"
        }
        else {
            my $error_input = $csv->error_input() // 'No Error Input defined.';
            my $prompt = "Error Input:";
            $error_input =~ s/\R/ /g;
            my $info = "Close with ENTER\nText::CSV_XS\n$code $str\nrecord:$rec field:$fld position:$pos\n";
            $tc->choose(
                [ line_fold( $error_input, { join => 0 } ) ],
                { info => $info, prompt => $prompt  }
            );
            $ax->print_sql_info( $info );
            return;
        }
    } );
    my $rows_of_cols = $csv->getline_all( $fh );
    $sql->{insert_args} = $rows_of_cols;
    return 1;
}


sub parse_with_split {
    my ( $sf, $sql, $fh ) = @_;
    $sf->__print_waiting_str;
    my $rows_of_cols = [];
    local $/;
    seek $fh, 0, 0;
    my $record_lead  = $sf->{o}{split}{record_l_trim};
    my $record_trail = $sf->{o}{split}{record_r_trim};
    my $field_lead   = $sf->{o}{split}{field_l_trim};
    my $field_trail  = $sf->{o}{split}{field_r_trim};
    for my $row ( split /$sf->{o}{split}{record_sep}/, <$fh> ) {
        $row =~ s/^$record_lead//   if length $record_lead;
        $row =~ s/$record_trail\z// if length $record_trail;
        push @$rows_of_cols, [
            map {
                s/^$field_lead//   if length $field_lead;
                s/$field_trail\z// if length $field_trail;
                $_
            } split /$sf->{o}{split}{field_sep}/, $row, -1 ]; # negative LIMIT (-1) to preserve trailing empty fields
    }
    $sql->{insert_args} = $rows_of_cols;
    return 1;
}


sub __print_template_info {
    my ( $sf, $rows, $occupied_term_h ) = @_;
    my ( $term_w, $term_h ) = get_term_size();
    my $ten_steps = '';
    for my $count ( 1 .. int( $term_w / 10 ) ) {
        $ten_steps .= ( ' ' x ( 10 - length $count ) ) . $count;
    }
    my $tapeline = '123456789*';
    my $ruler = '';
    $ruler .= $tapeline x int( $term_w / 10 );
    $ruler .= substr( $tapeline, 0, ( $term_w % 10 ) );