view release on metacpan or  search on metacpan

tkcsvcopy.pl  view on Meta::CPAN

#!/usr/bin/perl

#
# Sébastien Millet, August 2017
#

#
# tkcsvcopy.pl
#
# GUI interface to Text::AutoCSV.
# Works like csvcopy.pl, but so far, does not manage links.
#

use 5.014;
use utf8;

use strict;
use warnings;

use Tk;
use Tk::FileDialog;
use Tk::ROText;
use Tk::BrowseEntry;
use Tk::DropSite;
use Tk::HList;
use Tk::ItemStyle;
use Tk::ProgressBar;
use Tk::StayOnTop;

use File::HomeDir 'my_home';
use File::Spec::Functions 'catfile';
use DB_File;
use Browser::Open qw( open_browser );

use Text::AutoCSV;

my $VERSION = '0.2';

my $DEFAULT_DB_FILE = '.tkcsvcopy.db';

my @encoding_choices =
  qw(utf-8 utf-16 utf-16le utf16-be utf32 utf-32le utf-32be iso-8859-1
  iso-8859-2 iso-8859-3 iso-8859-4 iso-8859-5 iso-8859-6 iso-8859-7 iso-8859-8 iso-8859-9
  iso-8859-10 iso-8859-11 iso-8859-12 iso-8859-13 iso-8859-14 iso-8859-15);

sub usage {
    print( STDERR <<"EOF" );
Usage:
    tkcsvcopy.pl [OPTIONS...]
Perl/Tk GUI to detect settings of, and copy, CSV files.

  -h, --help    Display this help screen.
      --db DB   Enforce location of DB file to save options.
                By default, store in ~/$DEFAULT_DB_FILE.
      --nodb    Don't use a db for options (options are not persistent).
      --read F  Upon start, display input information of file F.
      --excel   Tune output settings to make MS EXCEL happy.
                Have , as separator, " as quote, " as escape,
                UTF-8 encoding with BOM, and ymd/24h for datetime.
      --excelfr Same as --excel, but ; as separator.
EOF
    return;
}

if ( grep { /^--?h(elp)?$/i } @ARGV ) {
    usage();
    exit 0;
}

#
# * ************* *
# * CONFIGURATION *
# * ************* *
#

my %db;
my $read_it = '';
my $excel   = '';

my $db_absolute_file_name = catfile( my_home(), $DEFAULT_DB_FILE );
if ( @ARGV >= 2 and $ARGV[0] =~ /^--?db/i ) {
    $db_absolute_file_name = $ARGV[1];
    splice @ARGV, 0, 2;
}
if ( @ARGV >= 1 and $ARGV[0] =~ /^--?nodb$/i ) {
    $db_absolute_file_name = '';
    shift @ARGV;
}
if ( @ARGV >= 1 and $ARGV[0] =~ /^--?excel$/i ) {
    $excel = 'en';
    shift @ARGV;
}
if ( @ARGV >= 1 and $ARGV[0] =~ /^--?excelfr$/i ) {
    $excel = 'fr';
    shift @ARGV;
}
if ( @ARGV >= 2 and $ARGV[0] =~ /^--?read$/i ) {
    $read_it = $ARGV[1];
    splice @ARGV, 0, 2;
}

if (@ARGV) {
    print
      ( STDERR ( $ARGV[0] =~ /^-/ ? "Unknown option.\n" : "Trailing option.\n" )
      );
    usage();
    exit 1;
}

tie %db => 'DB_File', $db_absolute_file_name if $db_absolute_file_name ne '';

my $init = "_initialized_$VERSION";
if ( !$db{$init} ) {
    %db = (
        in_file                     => '',
        sep_char                    => ',',
        sep_char_detect             => 1,
        quote_char                  => '"',
        escape_char                 => '"',

tkcsvcopy.pl  view on Meta::CPAN

$frtopr_quo->Label( -text => "${PADLEFT}Use input", %labopts )
  ->pack( -side => 'left', %stdpad );
my $ctrl_out_quote_char_useinput = $frtopr_quo->Checkbutton(
    -variable => \$db{out_quote_char_useinput},
    -command  => [
        \&cmd_update_enabled_disabled, $ctrl_out_quote_char,
        'out_quote_char_useinput'
    ],
    %chkopts
)->pack( -side => 'left', %stdpad );

my $frtopr_esc =
  $frame_top_R->Frame(%fropts)->pack( -side => 'top', -fill => 'x' );
my $ctrl_out_escape_char = $frtopr_esc->Entry(
    -textvariable => \$db{out_escape_char},
    %entcharwidth,
    -justify => 'right',
    %entopts
)->pack( -side => 'right', %stdpad );
$frtopr_esc->Label( -text => 'Escape char ', %labopts )
  ->pack( -side => 'right', %stdpad );
$frtopr_esc->Label( -text => "${PADLEFT}Use input", %labopts )
  ->pack( -side => 'left', %stdpad );
my $ctrl_out_escape_char_useinput = $frtopr_esc->Checkbutton(
    -variable => \$db{out_escape_char_useinput},
    -command  => [
        \&cmd_update_enabled_disabled, $ctrl_out_escape_char,
        'out_escape_char_useinput'
    ],
    %chkopts
)->pack( -side => 'left', %stdpad );

my $frtopr_enc =
  $frame_top_R->Frame(%fropts)->pack( -side => 'top', -fill => 'x' );
my $ctrl_out_encoding = $frtopr_enc->BrowseEntry(
    -variable   => \$db{out_encoding},
    -width      => 14,
    -background => 'white',
    %entopts
)->pack( -side => 'right', %stdpad );
$frtopr_enc->Label( -text => 'Encoding ', %labopts )
  ->pack( -side => 'right', %stdpad );
$ctrl_out_encoding->choices( \@encoding_choices );
$frtopr_enc->Label( -text => "${PADLEFT}Use input", %labopts )
  ->pack( -side => 'left', %stdpad );
my $ctrl_out_encoding_useinput = $frtopr_enc->Checkbutton(
    -variable => \$db{out_encoding_useinput},
    -command  => [
        \&cmd_update_enabled_disabled, $ctrl_out_encoding,
        'out_encoding_useinput'
    ],
    %chkopts
)->pack( -side => 'left', %stdpad );

my $frtopr_bom =
  $frame_top_R->Frame(%fropts)->pack( -side => 'top', -fill => 'x' );
my $ctrl_out_utf8_bom = $frtopr_bom->Checkbutton(
    -variable => \$db{out_utf8_bom},
    %chkopts
)->pack( -side => 'right' );
$frtopr_bom->Label( -text => 'If UTF-8, write UTF-8 BOM ', %labopts )
  ->pack( -side => 'right', %stdpad );

my $frtopr_iaq =
  $frame_top_R->Frame(%fropts)->pack( -side => 'top', -fill => 'x' );
my $ctrl_out_always_quote = $frtopr_iaq->BrowseEntry(
    -variable   => \$db{out_always_quote},
    -width      => 6,
    -background => 'white',
    %entopts
)->pack( -side => 'right', %stdpad );
$frtopr_iaq->Label( -text => 'Always quote ', %labopts )
  ->pack( -side => 'right', %stdpad );
$ctrl_out_always_quote->choices( [ '', 'yes', 'no' ] );
$frtopr_iaq->Label( -text => "${PADLEFT}Use input", %labopts )
  ->pack( -side => 'left', %stdpad );
my $ctrl_out_always_quote_useinput = $frtopr_iaq->Checkbutton(
    -variable => \$db{out_always_quote_useinput},
    -command  => [
        \&cmd_update_enabled_disabled, $ctrl_out_always_quote,
        'out_always_quote_useinput'
    ],
    %chkopts
)->pack( -side => 'left', %stdpad );

my $frtopr_dt =
  $frame_top_R->Frame(%fropts)->pack( -side => 'top', -fill => 'x' );
my $ctrl_out_dates_format = $frtopr_dt->Entry(
    -textvariable => \$db{out_dates_format},
    -width        => 26,
    %entopts
)->pack( -side => 'right', %stdpad );
$frtopr_dt->Label( -text => 'Datetime format *** ', %labopts )
  ->pack( -side => 'right', %stdpad );
$frtopr_dt->Label( -text => "${PADLEFT}Use input", %labopts )
  ->pack( -side => 'left', %stdpad );
my $ctrl_out_dates_format_useinput = $frtopr_dt->Checkbutton(
    -variable => \$db{out_dates_format_useinput},
    -command  => [
        \&cmd_update_enabled_disabled, $ctrl_out_dates_format,
        'out_dates_format_useinput'
    ],
    %chkopts
)->pack( -side => 'left', %stdpad );

my $frtopr_loc =
  $frame_top_R->Frame(%fropts)->pack( -side => 'top', -fill => 'x' );
my $ctrl_out_dates_locale = $frtopr_loc->Entry(
    -textvariable => \$db{out_dates_locale},
    -width        => 6,
    %entopts
)->pack( -side => 'right', %stdpad );
$frtopr_loc->Label( -text => 'Datetime locale **** ', %labopts )
  ->pack( -side => 'right', %stdpad );
$frtopr_loc->Label( -text => "${PADLEFT}Use input", %labopts )
  ->pack( -side => 'left', %stdpad );
my $ctrl_out_dates_locale_useinput = $frtopr_loc->Checkbutton(
    -variable => \$db{out_dates_locale_useinput},
    -command  => [
        \&cmd_update_enabled_disabled, $ctrl_out_dates_locale,
        'out_dates_locale_useinput'