#!/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.05'; # VERSION
our $DATE = '2014-04-29'; # DATE

my %Opts = (
    format => undef,
    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 letter+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} = {
        file      => $outfilename,
        orig_file => $filename,
        fmt       => 'csv',
    };
}

sub _add_tsv {
    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");
    my $outfilename = "$tempdir/$tablename";
    csv(in => $aoa, out=>"$tempdir/$tablename");
    $Tables{$tablename} = {
        file      => $outfilename,
        orig_file => $filename,
        fmt       => 'tsv',
    };
}

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} = {
        file      => $outfilename,
        orig_file => $filename,
        fmt       => 'ltsv',
    };
}

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

    my ($res, $filename, $tablename, $fmt) = @_;
    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} = {
        file      => $outfilename,
        orig_file => $filename,
        fmt       => $fmt,
    };
}

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, 'json');
}

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, 'yaml');
}

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

    my $res;
    {
        local $/;
        my $content = <$fh>;
        $res = eval $content;
        die if $@;
    }
    _res_to_csv($res, $filename, $tablename, 'perl');
}

sub parse_cmdline {
    my $res = GetOptions(
        'format|f=s'     => \$Opts{format},
        '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]) },
        'add-perl=s'     => sub { _add_perl($_[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
  --add-perl=s
  --format=s, -f
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("-");
    }

    # pick default format from the most used input format
    unless ($Opts{format}) {
        my %fmts;
        $fmts{$Tables{$_}{fmt}}++ for keys %Tables;
        my @fmts = sort {$fmts{$b} <=> $fmts{$a} || $a cmp $b} keys %fmts;
        $Opts{format} = $fmts[0];
    }
}

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) {
            open my($fh), "<", $Tables{$t}{file}
                or die "fsql: Can't open $Tables{$t}{file}: $!\n";
            my $line1 = <$fh>;
            $line1 =~ s/\r?\n//;
            $Tables{$t}{columns} = [split /,/, $line1];
        }
        $res = [200, "OK", {tables => \%Tables}];
	$Opts{format} = 'text' if $Opts{format} =~ /^(c|t|lt)sv$/;

    } 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 => {
                    map { $_=>{f_file=>$Tables{$_}{file}} }
                        keys %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";

    }

    show_result($res);
}

sub show_result {
    my $res = shift;

    if ($Opts{format} =~ /^[ct]sv$/) {
        csv(in => $res->[2], out => *STDOUT,
	    sep_char => $Opts{format} eq 'tsv' ? "\t" : ',');
    } elsif ($Opts{format} eq 'ltsv') {
        # Text::LTSV expects a format of [[k=>v, k2=>v2, ...], ...]. we might as
        # well print it ourselves.
        for my $row (@{ $res->[2] }) {
            say join("\t", map {"$_:$row->{$_}"} sort keys %$row);
        }
    } elsif ($Opts{format} eq 'perl') {
        require Data::Format::Pretty::Perl;
        print Data::Format::Pretty::Perl::format_pretty($res->[2]);
    } else {
        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

This document describes version 0.05 of module fsql (in distribution App-fsql), released on 2014-04-29.

=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 and table name C<stdin>
(if you want to change the table name, you can use C<--add-json -:somename>.

=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 * --add-perl=FILENAME[:TABLENAME]

Like C<--add-perl>, but will load file as Perl.

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

Set output format.

The value C<csv> or C<tsv> or C<ltsv> will cause query results to be output as a
comma-separated or TAB-separated list or labeled-TAB separated list,
respectively. As this isn't very useful for a schema listing, these values will
be silently converted to C<text> if C<--show-schema> is also present.

The value of C<perl> will format using L<Data::Format::Pretty::Perl>.

Any other value will be passed to L<Perinci::Result::Format>'s C<format()>.

The default value is the most used table format. So if your tables are mostly
CSV, B<fsql> will also output CSV by default.

=item * --show-schema

Instead of running a query, show schema instead. This is useful for debugging.

=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 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
