view release on metacpan or  search on metacpan

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

    }
    print 'Working ...' . "\r" if $sf->{o}{table}{progress_bar};
    my $all_arrayref = $sf->select_statement_results( $sql );
    my $open_mode;
    if ( length $sf->{o}{export}{file_encoding} ) {
        $open_mode = '>:encoding(' . $sf->{o}{export}{file_encoding} . ')';
    }
    else {
        $open_mode = '>';
    }
    open my $fh, $open_mode, $file_fs or die "$file_fs: $!";
    require String::Unescape;
    my $options = {
        map { $_ => String::Unescape::unescape( $sf->{o}{csv_out}{$_} ) }
        grep { length $sf->{o}{csv_out}{$_} } # keep the default value if the option is set to ''
        keys %{$sf->{o}{csv_out}}
    };
    if ( ! length $options->{eol} ) {
        $options->{eol} = $/; # for `eol` use `$/` as the default value
    }
    require Text::CSV_XS;
    my $csv = Text::CSV_XS->new( $options ) or die Text::CSV_XS->error_diag();
    $csv->print( $fh, $_ ) for @$all_arrayref;
    close $fh;
    return 1;
}


sub __get_filename_fs {
    my ( $sf, $sql ) = @_;
    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 $file_name;
    if ( $sf->{o}{export}{default_filename} ) {
        $file_name = $sf->{d}{table_key};
    }
    my $count = 0;

    FILE_NAME: while ( 1 ) {
        if ( ++$count > 2 ) {
            $file_name = '';
        }
        my $info = $ax->get_sql_info( $sql );
        # Readline
        $file_name = $tr->readline(
            'File name: ',
            { info => $info, default => $file_name, hide_cursor => 2, history => [] }
        );
        $ax->print_sql_info( $info );
        if ( ! length $file_name ) {
            return;
        }

        FULL_FILE_NAME: while ( 1 ) {
            my $file_name_plus = $file_name;
            if ( $sf->{o}{export}{add_extension} && $file_name !~ /\.csv\z/i ) {
                $file_name_plus .= '.csv';
            }
            my $export_dir = $sf->{o}{export}{export_dir};
            my $dir_fs = realpath( encode( 'locale_fs', $export_dir ) ) or die "$export_dir: $!";
            my $file_fs = catfile $dir_fs, encode( 'locale_fs', $file_name_plus );
            my ( $new_name, $overwrite ) = ( '- New name', '- Overwrite' );
            my $chosen;
            if ( -e $file_fs ) {
                my $menu;
                my $prompt;
                if ( -d $file_fs ) {
                    $prompt = 'A directory with name "' . $file_name_plus . '" already exists.';
                    $menu = [ undef, $new_name ];
                }
                else {
                    $prompt =  'A file with name "' . $file_name_plus . '" already exists.';
                    $menu = [ undef, $new_name, $overwrite ];
                }
                # Choose
                $chosen = $tc->choose(
                    $menu,
                    { %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, keep => scalar( @$menu ) }
                );
                $ax->print_sql_info( $info );
                if ( ! defined $chosen ) {
                    return;
                }
                elsif ( $chosen eq $new_name ) {
                    next FILE_NAME;
                }
            }
            my ( $yes, $no ) = ( '- YES', '- NO' );
            my $hidden;
            if ( defined $chosen && $chosen eq $overwrite ) {
                $hidden = 'Overwrite "' . decode( 'locale_fs', $file_fs ) . '"?';
            }
            else {
                $hidden = 'Write data to "' . decode( 'locale_fs', $file_fs ) . '"?';
            }
            # Choose
            my $choice = $tc->choose(
                [ $hidden, undef, $yes, $no ],
                { info => $info, prompt => '', default => 1, layout => 2, undef => '  <<' }
            );
            $ax->print_sql_info( $info );
            if ( ! defined $choice ) {
                next FILE_NAME;
            }
            elsif ( $choice eq $hidden ) {
                my $op = App::DBBrowser::Options->new( $sf->{i}, $sf->{o} );
                my $op_rw = App::DBBrowser::Options::ReadWrite->new( $sf->{i}, $sf->{o} );
                $op->config_groups( [ { name => 'group_export', text => "- Export" } ], $sf->{i}{plugin} );
                $op_rw->read_config_file( $sf->{i}{driver}, $sf->{i}{plugin} );
                next FULL_FILE_NAME;
            }
            elsif ( $choice eq $no ) {
                return;
            }
            else {
                return $file_fs;
            }
        }
    }
}


1;


__END__