#!/usr/bin/env perl

use 5.010001;
use strict;
use warnings;
#use experimental 'smartmatch';

use Getopt::Long;
use Text::CSV_XS qw(csv);

our $VERSION = '0.02'; # VERSION
our $DATE = '2014-04-17'; # DATE

my %Opts = (
    format => 'text',
    action => 'query',
);
my %Tables;

our $DEBUG = $ENV{DEBUG};

sub _debug {
    my $msg = shift;

    $msg .= "\n" unless $msg =~ /\n$/;
    warn "DEBUG: $msg" if $DEBUG;
}

sub _prepare_tempdir {
    require File::Temp;

    state $tempdir;

    return $tempdir if $tempdir;
    $tempdir = File::Temp::tempdir(
        CLEANUP => $ENV{FSQL_DEBUG_KEEP_TEMPDIR} ? 0:1);
    _debug("Created tempdir: $tempdir");
    return $tempdir;
}

sub _check_add_arg {
    my $arg = shift;

    state $stdin_specified;

    my ($filename, $tablename);
    if ($arg =~ /(.+):(.+)/) {
        $filename  = $1;
        $tablename = $2;
    } elsif ($arg eq '-') {
        $filename  = '-';
        $tablename = 'stdin';
    } else {
        $filename  = $arg;
        $tablename = $filename;
        $tablename =~ s!.+/!!; # strip path
        $tablename =~ s!\.\w+\z!!; # strip filename extension
        $tablename =~ s/[^A-Za-z_0-9]+/_/g;
    }

    unless ($tablename =~ /\A[A-Za-z_][A-Za-z_0-9]*\z/) {
        warn "fsql: Invalid table name $tablename, please use alphanums only\n";
        exit 99;
    }
    if (exists $Tables{$tablename}) {
        warn "fsql: Duplicate table name $tablename, please use another name\n";
        exit 99;
    }

    my $fh;
    if ($filename eq '-') {
        if ($stdin_specified++) {
            warn "fsql: stdin cannot be specified more than once\n";
            exit 99;
        }
        $fh = *STDIN;
    } else {
        open $fh, "<", $filename
            or die "fsql: Can't open $filename: $!\n";
    }

    return ($filename, $fh, $tablename);
}

sub _add_csv {
    my $arg = shift;
    my ($filename, $fh, $tablename) = _check_add_arg($arg);
    my $outfilename;
    if ($filename eq '-') {
        my $tempdir = _prepare_tempdir();
        $outfilename = "$tempdir/$tablename";
        open my($fh), ">", $outfilename
            or die "fsql: Can't write to $outfilename: $!\n";
        print $fh $_ while <$fh>;
    } else {
        $outfilename = $filename;
    }

    $Tables{$tablename} = {orig_file=>$filename, f_file=>$outfilename};
}

sub _add_tsv {
    # XXX

    my $arg = shift;
    my ($filename, $fh, $tablename) = _check_add_arg($arg);

    my $tempdir = _prepare_tempdir();

    my $outfile;
    my $aoa = csv(in => $filename, sep_char=>"\t");
    csv(in => $aoa, out=>"$tempdir/$tablename");
    $Tables{$tablename} = {orig_file=>$filename, f_file=>$filename};
}

sub _add_ltsv {
    require Text::LTSV;

    my $arg = shift;
    my ($filename, $fh, $tablename) = _check_add_arg($arg);

    my $tempdir = _prepare_tempdir();

    my $ltsv = Text::LTSV->new;
    my $aoh  = $ltsv->parse_file($fh);
    my $outfilename = "$tempdir/$tablename";
    csv(in => $aoh, out => $outfilename);
    $Tables{$tablename} = {orig_file=>$filename, f_file=>$outfilename};
}

sub _res_to_csv {
    require Perinci::Result::Util;

    my ($res, $filename, $tablename) = @_;
    my $tf;
    if (Perinci::Result::Util::is_env_res($res)) {
        $tf = $res->[3]{"table.fields"}
            if $res->[3] && $res->[3]{"table.fields"};
        $res = $res->[2];
    }

    unless (ref($res) eq 'ARRAY') {
        warn "fsql: Data is not an array: $filename\n";
        exit 99;
    }

    my $tempdir = _prepare_tempdir();
    my $outfilename = "$tempdir/$tablename";

    # handle special case of zero rows
    unless (@$res) {
        csv(in => [], headers => $tf ? $tf : ["column0"],
            out => $outfilename);
        goto END;
    }

    my $row0 = $res->[0];

    # handle another special case of array of scalars
    unless (ref($row0) eq 'ARRAY' || ref($row0) eq 'HASH') {
        csv(in => [map {[$_]} @$res], headers=>["column0"],
            out => $outfilename);
        goto END;
    }

    # produce headers for aoa without tf
    if (ref($row0) eq 'ARRAY' && !$tf) {
        $tf = [map {"column$_"} 0..@$row0-1];
    }

    csv(in=>$res, headers=>$tf, out=>$outfilename);

  END:
    $Tables{$tablename} = {orig_file=>$filename, f_file=>$outfilename};
}

sub _add_json {
    require JSON;

    my $arg = shift;
    my ($filename, $fh, $tablename) = _check_add_arg($arg);

    state $json = JSON->new->allow_nonref;
    my $res;
    {
        local $/;
        my $content = <$fh>;
        $res = $json->decode($content);
    }
    _res_to_csv($res, $filename, $tablename);
}

sub _add_yaml {
    require YAML::XS;

    my $arg = shift;
    my ($filename, $fh, $tablename) = _check_add_arg($arg);

    # YAML::XS::LoadFile doesn't accept filehandle
    my $res;
    if ($filename eq '-') {
        local $/;
        my $content = <$fh>;
        $res = YAML::XS::Load($content);
    } else {
        $res = YAML::XS::LoadFile($filename);
    }
    _res_to_csv($res, $filename, $tablename);
}

sub parse_cmdline {
    my $res = GetOptions(
        'format'         => \$Opts{format},
        'json'           => sub { $Opts{format} = 'json' },
        'yaml'           => sub { $Opts{format} = 'yaml' },
        'add-csv=s'      => sub { _add_csv($_[1]) },
        'add-tsv=s'      => sub { _add_tsv($_[1]) },
        'add-ltsv=s'     => sub { _add_ltsv($_[1]) },
        'add-json=s'     => sub { _add_json($_[1]) },
        'add-yaml=s'     => sub { _add_yaml($_[1]) },
        'show-schema'    => sub { $Opts{action} = 'show-schema' },
        'help|h'           => sub {
            print <<USAGE;
Usage:
  fsql [OPTIONS]... [ <QUERY> | --show-schema ]
  fsql --help
  fsql --version
Options:
  --add-csv=s
  --add-tsv=s
  --add-ltsv=s
  --add-json=s
  --add-yaml=s
  --format=s
For more details, see the manpage/documentation.
USAGE
            exit 0;
        },
        'version|v'      => sub {
            say "fsql version ", ($main::VERSION // "dev"),
                ($main::DATE ? " ($main::DATE)" : "");
            exit 0;
        },
    );
    exit 99 if !$res;
    unless (keys %Tables) {
        _add_json("-");
    }
}

sub run {
    require DBI;
    require Perinci::Result::Format;

    my $res;
    if ($Opts{action} eq 'show-schema') {

        if (@ARGV) {
            warn "fsql: show-schema does not require arguments\n";
            exit 99;
        }

        my $tt = {};
        for my $t (sort keys %Tables) {
            my $file = $Tables{$t}{f_file};
            my $orig_file = $Tables{$t}{orig_file};
            open my($fh), "<", $file
                or die "fsql: Can't open $file: $!\n";
            my $line1 = <$fh>;
            $line1 =~ s/\r?\n//;
            my $columns = [split /,/, $line1];
            $tt->{$t} = {
                file => $file,
                ( orig_file => $orig_file ) x
                    ($orig_file eq $file ? 0:1),
                columns => $columns,
            };
        }
        $res = [200, "OK", {tables => $tt}];

    } elsif ($Opts{action} eq 'query') {
        unless (@ARGV) {
            warn "fsql: Please specify query\n";
            exit 99;
        }
        if (@ARGV > 1) {
            warn "fsql: Too many arguments, ".
                "please specify only 1 argument (query)\n";
            exit 99;
        }
        my $query = $ARGV[0];

        my $tempdir = _prepare_tempdir();
        my $dbh = DBI->connect(
            "dbi:CSV:", undef, undef,
            {
                RaiseError => 1,
                csv_tables => \%Tables,
            });
        my $sth = $dbh->prepare($query);
        $sth->execute;
        my @rows;
        while (my $row = $sth->fetchrow_hashref) {
            push @rows, $row;
        }
        $res = [200, "OK", \@rows];

    } else {

        die "BUG: Unknown action\n";

    }

    print Perinci::Result::Format::format($res, $Opts{format});
}

# MAIN

parse_cmdline();
run();

1;
# ABSTRACT: Perform SQL queries against files in CSV/TSV/LTSV/JSON/YAML formats
# PODNAME: fsql

__END__

=pod

=encoding UTF-8

=head1 NAME

fsql - Perform SQL queries against files in CSV/TSV/LTSV/JSON/YAML formats

=head1 VERSION

version 0.02

=head1 SYNOPSIS

 fsql [OPTIONS] [ <QUERY> | --show-schema ]

=head1 DESCRIPTION

B<fsql> lets you perform SQL queries against "flat" files of various formats.
Each file will be regarded as a SQL table. The magic of all this is performed by
L<DBD::CSV> and L<SQL::Statement>.

There must be at least one table specified (either with C<--add-csv>,
C<--add-tsv>, C<--add-ltsv>, C<--add-json>, C<--add-yaml>). If none of those
options are specified, a JSON table is assumed in STDIN.

=head1 OPTIONS

=over

=item * --add-csv=FILENAME[:TABLENAME]

Add a table from a CSV file. If C<TABLENAME> is not specified, it will be taken
from C<FILENAME> (e.g. with filename C<foo-bar.csv>, table name will be
C<foo_bar>). C<FILENAME> can be C<-> to mean the standard input (the default
table name will be C<stdin>). Will croak if duplicate table name is detected.

Table name must match regex C</\A[A-Za-z_][A-Za-z_0-9]*\z/>.

=item * --add-tsv=FILENAME[:TABLENAME]

Like C<--add-csv>, but will load file as TSV (tab-separated value).

=item * --add-ltsv=FILENAME[:TABLENAME]

Like C<--add-csv>, but will load file as LTSV (labeled tab separated value, see
L<Text::LTSV>). Names of columns will be taken from the first row.

=item * --add-json=FILENAME[:TABLENAME]

Like C<--add-csv>, but will load file as JSON.

Data can be array, or array of arrays, or array of hashes, or an enveloped
response (see L<Rinci::function>), so it is suitable to accept piped output of
L<Perinci::CmdLine>-based programs.

=item * --add-yaml=FILENAME[:TABLENAME]

Like C<--add-json>, but will load file as YAML.

=item * --format=FORMAT (default: text)

Set output format. This will be passed to L<Perinci::Result::Format>'s
C<format()>.

=item * --json

Equivalent to C<--format json>.

=item * --yaml

Equivalent to C<--format yaml>.

=back

=head1 EXIT CODES

0 on success.

255 on I/O or SQL error.

99 on command-line options or input data error.

=head1 FAQ

=head1 TODO

Allow customized CSV separator and quoting.

=head1 SEE ALSO

L<uniq>

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/App-fsql>.

=head1 SOURCE

Source repository is at L<https://github.com/sharyanto/perl-App-fsql>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-fsql>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

Steven Haryanto <stevenharyanto@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Steven Haryanto.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
