#!/usr/bin/perl

#
# Written by Sébastien Millet
# July, August 2016
#

#
# Copy a CSV file using Text::AutoCSV module
#

use strict;
use warnings;

use lib '../lib';

my $PRG = "csvcopy.pl";

use Getopt::Long;
use Text::AutoCSV;

use feature 'say';
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

my $infoh = \*STDERR;

	#
	# Each element of @PARAMS is an array ref made of:
	#   0: help option as passed to GetOptions
	#   1: option type when displaying option value in verbose mode,
	#      can be undef (meaning: not applicable), 'STR' or 'BOOL'
	#   2: Text::AutoCSV attribute of option (undef if not applicable)
	#   3: option default value (for display only ; *not* passed to Text::AutoCSV attributes)
	#   4: help of option, displayed by -h
	#   5: (rarely used): enforce passing attribute to Text::AutoCSV even if option
	#      is not in use ; used to enforce attributes values for which this script
	#      default value does not match Text::AutoCSV default value
my @PARAMS = (
	['help|h', undef, undef, undef, 'print a short help screen'],
	['Help|hh', undef, undef, undef, 'print a bigger help screen'],
	['verbose|v', 'BOOL', undef, 'no', 'verbose output'],
	['id', undef, undef, undef, 'Don\'t copy, instead, print information about input'],
	['i=s', 'STR', 'in_file', '<stdin>', 'input file (default: stdin)'],
	['o=s', 'STR', 'out_file', '<stdout>', 'output file (default: stdout)'],
	['encoding|e=s', 'STR', 'encoding', 'UTF-8,latin1', 'encoding (default: auto-detection)'],
	['sep_char|s=s', 'STR', 'sep_char', '<auto-detect>', 'CSV separator (default: auto-detection)'],
	['quote_char=s', 'STR', 'quote_char', '"', 'CSV quote character (default: ")'],

	['escape_char=s', 'STR', 'escape_char', '<auto-detect>',
		'CSV escape character (default: auto-detection)'],

	['out_encoding=s', 'STR', 'out_encoding', '<same as input>',
		'output encoding (default: same as input)'],

	['out_utf8_bom=i', 'BOOL', 'out_utf8_bom', 'no',
		'add BOM on UTF-8 output (default: no)'],

	['out_sep_char=s', 'STR', 'out_sep_char', '<same as input>',
		'output CSV separator (default: same as input)'],

	['out_quote_char=s', 'STR', 'out_quote_char', '<same as input>',
		'output quote char (default: same as input)'],

	['out_escape_char=s', 'STR', 'out_escape_char', '<same as input>',
		'output escape char (default: same as input)'],

	['out_always_quote=i', 'BOOL', 'out_always_quote', '<same as input>',
		"always surround each output field with quote chars\n" .
		"0 to remove feature \"always quote\", 1 to enforce it\n" .
		"(default: same as input)"],

	['dont_mess_with_encoding=i', 'BOOL', 'dont_mess_with_encoding', 'no',
		"if set to 1, completely ignore encoding aspects, meaning,\n" .
		"leave it to perl default\n" .
		"(default: input encoding auto-detection)"],

	['dates_auto=i', 'BOOL', 'fields_dates_auto', 'yes',
		"if set to 0, turn off datetime formats auto-detection\n" .
		"(default: datetime formats auto-detection is on)",
	1],

	['dates_formats=s', 'ARRAYREF', 'dates_formats_to_try', '<plenty of formats>',
		"list of formats to try when detecting datetime formats\n" .
		"you can specify multiple formats by separating them with ||\n" .
		"as in \"%d-%m-%y||%m-%d-%y\"\n" .
		"formats rely on Strptime syntax\n" .
		"(default: numerous formats are checked)"],

	['out_dates_format=s', 'STR', 'out_dates_format', '<same as input>',
		"dates format on output, in Strptime syntax\n" .
		"(default: use format detected on input)"],

	['out_dates_locale=s', 'STR', 'out_dates_locale', '<same as input>',
		"use only in addition to out_dates_format\n" .
		"dates locale on output\n" .
		"(default: use locale detected on input)"],

	['search_time=i', 'BOOL', 'dates_search_time', 'yes',
		"if set to 0, detect only dates (don't look for times) when \n" .
		"detecting datetime formats\n" .
		"(default: auto-detect date and time)",
	1],

	['dates_locales=s', 'STR', 'dates_locales', '<none>',
		"comma-separated list of locales to try when detecting\n" .
		"datetime formats, for example \"fr,en\"\n" .
		"(default: use default perl locale)"],

	['croak_if_error=i', 'BOOL', 'croak_if_error', 'yes',
		"croak if an error occurs in Text::AutoCSV (useless in\n" .
		"this script, put here for the sake of pedagogy)"],

	['debug|d', 'BOOL', '_debug', 'no', 'debug output'],
);

my %opts_vals;
my %opts;
for my $p (@PARAMS) {
	my $k = opt_to_key($p->[0]);
	undef $opts_vals{$k};
	$opts{$p->[0]} = \$opts_vals{$k};
}

Getopt::Long::Configure('no_ignore_case', 'bundling');
usage() unless GetOptions(%opts);

&usage() if ($opts_vals{'help'});
&usage(1) if ($opts_vals{'Help'});
if (@ARGV) {
	print($infoh "Trailing options\n");
	&usage();
}

my $opt_name_max_length = -1;
for my $p (@PARAMS) {
	my $l = length(opt_to_disp($p->[0], 1));
	$opt_name_max_length = $l if $l > $opt_name_max_length;
}

if (defined($opts_vals{'dates_formats'})) {
	$opts_vals{'dates_formats'} = [ split(/\|\|/, $opts_vals{'dates_formats'}) ];
}

for my $p (@PARAMS) {
	next unless defined($p->[2]);

	my $v = $opts_vals{opt_to_key($p->[0])};
	my $vstr;
	if (!defined($v)) {
		$vstr = $p->[3] // '<undef>';
	} elsif ($p->[1] eq 'BOOL') {
		$vstr = ($v ? 'yes' : 'no');
	} elsif ($p->[1] eq 'STR') {
		$vstr = "$v";
	} elsif ($p->[1] eq 'ARRAYREF') {
		$vstr = '[' . join('], [', @{$v}) . ']';
	}
	die "\$vstr is undef, not allowed condition" unless defined($vstr);

	my $opt_disp = opt_to_disp($p->[0], 1);

	printf($infoh "%-${opt_name_max_length}s %s %s\n", $opt_disp, (defined($v) ? '*' : '.'), $vstr)
		if $opts_vals{'verbose'} and !$opts_vals{'id'};

}

my %opts_autocsv;
for my $p (@PARAMS) {
	my $attribute = $p->[2];
	next unless defined($attribute);

	my $v = $opts_vals{opt_to_key($p->[0])};

	$v = $p->[5] if !defined($v) and defined($p->[5]);

	$opts_autocsv{$attribute} = $v if defined($v);
}

my $csv = Text::AutoCSV->new(%opts_autocsv);

if (!$opts_vals{'id'}) {

	$csv->write();

} else {

	printf("sep_char:            " . $csv->get_sep_char() . "\n");
	printf("escape_char:         " . $csv->get_escape_char() . "\n");
	printf("current_in_encoding: " . $csv->get_current_in_encoding() . "\n");
	printf("is_always_quoted:    " . ($csv->get_is_always_quoted() ? 'yes' : 'no') . "\n");

	my @coldata = $csv->get_coldata();
	my @disp;
	push @disp, [ '#', 'FIELD', 'HEADER', 'EXT DATA', 'DATETIME FORMAT', 'DATETIME LOCALE' ];
	push @disp, [ map { my $s = $_; $s =~ s/./-/g; $s } @{$disp[0]} ];
	while (my ($i, $col) = each @coldata) {
		my @row;
		push @row, "$i";
		push @row, (defined($col->[$_]) ? ($col->[$_] . '') : '') for (0..4);
		push @disp, [ @row ];
	}
	my $n = @{$disp[-1]};
	my @max = (-1) x $n;
	for my $l (@disp) {
		do { $max[$_] = length($l->[$_]) if $max[$_] < length($l->[$_]) } for (0 .. $n - 1);
	}
	my $s = join(' ', map { "%-${_}s" } @max);
	print("\n");
	printf("$s\n", @{$_}) for (@disp);
}


# SUBS ***********************************************************************


sub usage {
	my $bigger = shift;

	print $infoh <<'EOF';
csvcopy.pl [OPTIONS...]
  Copy source to destination, doing CSV parsing in-between.

EOF

	my $max = -1;
	for (@PARAMS) {
		my $l = length(opt_to_disp($_->[0]));
		$max = $l if $l > $max;
	}
	for my $opt (@PARAMS) {
		printf($infoh "  %-${max}s ", opt_to_disp($opt->[0]));
		die "\nPlease write a help for this option!" unless $opt->[4];
		my $s = '';
		print($infoh $s, $_ . "\n"), $s = ' ' x ($max + 3) for (split(/\n/, $opt->[4]));
	}
	print($infoh "\n");

	exit 0 unless $bigger;

	print $infoh <<'EOF';
* ENCODING
  Input encoding "auto-detection" is very basic and could be called "hack it".
  It just tries UTF-8 and if any issues found (= reading triggers at least one
  warning), it falls back to latin1.
  Note that when providing the --encoding option, you can put a list (comma
  separated) of encodings to try: the selected one will be the first with
  which no warning occurs. If all produce warnings, the first one is selected.

  Example:
    csvcopy.pl -i myfile.csv -e "UTF-8,UTF-16LE"
    It'll try UTF-8 and if a warning occurs, try UTF-16LE. If UTF-16LE also
    produces a warning, it'll finally choose UTF-8.

* CSV SEPARATOR
  The CSV separator is detected among ",", ";" and "\t" (tab)

* CSV ESCAPE CHARACTER
  The CSV escape character is detected among "\\" (one backslash) and "\""
  (one ")

* EXAMPLES:
  csvcopy.pl -i a.csv -o t.csv --out_escape_char "\\" --out_sep_char "," --out_always_quote 1 --out_encoding UTF-8
    Copy a.csv into t.csv, enforcing backslash as escape char, comma as
    separator, always quoting fields, and encoding output (whatever input
    encoding is) to UTF-8.

  csvcopy.pl -i a.csv -o t.csv --out_dates_format "%FT%T"
	Copy a.csv into t.csv, enforcing yyyy-mm-ddThh:MM:ss format for any column
	that contains a datetime.

  csvcopy.pl -i a.csv -o t.csv --out_dates_format "%b %d, %Y, %I:%M:%S %p" --out_dates_locale "en"
	Copy a.csv into t.csv, enforcing US datetime format.
EOF
	exit 0;
}

sub opt_to_key {
	my $k = shift;
	$k =~ s/[|=].*//;
	return $k;
}

sub opt_to_disp {
	my $opt = shift;
	my $ltrim = shift;  # ltrim stands for "no space at beginning of return string"

	$opt =~ s/[=].*//;
	my $short_opt_seen = 0;
	my $r = '';
	for (split(/\|/, $opt)) {
		if (length($_) == 1) {
			$r = ", " . $r if length($r) >= 1;
			$r = "-$_" . $r;
			$short_opt_seen = 1;
		} else {
			$r .= ", " if length($r) >= 1;
			$r .= "--$_";
		}
	}
	$r = '    ' . $r if !$short_opt_seen and !$ltrim;
	return $r;
}

