#! /usr/bin/perl
# PODNAME: benchmarkanything-storage
# ABSTRACT: BenchmarkAnything storage cmdline tool

use 5.008;
use strict;
use warnings;

use App::Rad;

######################################################################
#
# App::Rad interface
#
######################################################################

App::Rad->run();

sub setup
{
        my $c = shift;
        $c->unregister_command("help");
        $c->register_commands("help", "search", "add", "createdb");
}

sub help
{
        my ($c) = @_;

        return qq{benchmarkanything-storage [-o|--outtype <TYPE>]
                          [-i|--intype <TYPE>]
                          [-c|--cfgfile <FILE>]
                          [-d|--debug]
                          [-v|--verbose]
                          [--really <DSN>]
                          [search|add|createdb] <DATAFILE>

        -i
        --intype         - input format
                           [json(default), yaml, dumper]
        -o
        --outtype        - output format
                           [json(default), yaml, dumper]
        -c
        --cfgfile        - config file for storage backend

        -b
        --backend        - backend
                           [tapper(default), http]

        --debug          - Pass through debug option to used modules

        --verbose        - print what's going on

        --really         - used for 'createdb' command.
                           Avoids the 'Are you sure?' question. You need to
                           provide the DSN from config that createdb would use,
                           to avoid painful mistakes.

        <DATAFILE>       - input data file ("-" for STDIN)
                           Content depends on the sub command:
                           + for 'search' it is a search query
                           + for 'add' it is BenchmarkAnything data
                           + for 'createdb' no input data is used
};
}

sub _getopt
{
        my ($c) = @_;

        $c->getopt( "cfgfile|c=s",
                    "backend|b=s",
                    "outtype|o=s",
                    "intype|i=s",
                    "debug|d",
                    "verbose|v",
                    "really=s",
                  )
         or help() and return undef;

        require File::HomeDir;
        require File::Slurp;
        require YAML::Any;

        my $opt = $c->options;
        my $configfile  = $opt->{cfgfile}  || $ENV{BENCHMARKANYTHING_CONFIGFILE} || File::HomeDir->my_home . "/.benchmarkanything.cfg";
        my $configyaml  = File::Slurp::read_file($configfile);
        $c->{_config}   = YAML::Any::Load($configyaml);
        $c->{_backend}  = $opt->{backend}  || 'tapper';
        $c->{_file}     = $c->argv->[0]    || '-';
}

sub search :Help(search BenchmarkAnything data)
{
        my ($c) = @_;

        _getopt($c);
        _search($c);
}

sub add :Help(add one or more BenchmarkAnything entries)
{
        my ($c) = @_;

        _getopt($c);
        _add($c);
}

sub createdb :Help(drop and create tables in the backend store)
{
        my ($c) = @_;

        _getopt($c);
        _createdb($c);
}

######################################################################
#
# Implementation
#
######################################################################


sub _read_in
{
        my ($c) = @_;

        my $opt = $c->options;

        my $file = $c->{_file};
        my $intype  = $opt->{intype}  || 'json';
        my $data;
        my $filecontent;
        {
                local $/;
                if ($file eq '-') {
                        $filecontent = <STDIN>;
                }
                else
                {
                        open (my $FH, "<", $file) or die "benchmarkanything-storage: cannot open input file $file.\n";
                        $filecontent = <$FH>;
                        close $FH;
                }
        }

        if (not defined $filecontent or $filecontent !~ /[^\s\t\r\n]/ms) {
                die "benchmarkanything-storage: no meaningful input to read.\n";
        }

        if ($intype eq "yaml") {
                require YAML::Any;
                $data = [YAML::Any::Load($filecontent)];
        }
        elsif ($intype eq "json") {
                require JSON;
                $data = JSON::decode_json($filecontent);
        }
        elsif ($intype eq "dumper") {
                eval '$data = my '.$filecontent;
        }
        else
        {
                die "benchmarkanything-storage: unrecognized input format: $intype.\n";
        }
        return $data;
}


sub _write_out
{
        my ($c, $benchmarkanythingdata) = @_;

        my $opt = $c->options;

        my $output = "";
        my $outtype = $opt->{outtype} || 'json';
        if ($outtype eq "yaml")
        {
                require YAML::Any;
                $output .= YAML::Any::Dump($benchmarkanythingdata);
        }
        elsif ($outtype eq "json")
        {
                eval "use JSON -convert_blessed_universally";
                my $json = JSON->new->allow_nonref->pretty->allow_blessed->convert_blessed;
                $output .= $json->encode($benchmarkanythingdata);
        }
        elsif ($outtype eq "ini") {
                require Config::INI::Serializer;
                my $ini = Config::INI::Serializer->new;
                $output .= $ini->serialize($benchmarkanythingdata);
        }
        elsif ($outtype eq "dumper")
        {
                require Data::Dumper;
                $output .= Data::Dumper::Dumper($benchmarkanythingdata);
        }
        elsif ($outtype eq "xml")
        {
                require XML::Simple;
                my $xs = new XML::Simple;
                $output .= $xs->XMLout($benchmarkanythingdata, AttrIndent => 1, KeepRoot => 1);
        }
        elsif ($outtype eq "flat") {
                $output .= _format_flat( $c, $benchmarkanythingdata );
        }
        else
        {
                die "benchmarkanything-storage: unrecognized output format: $outtype.";
        }
        return $output;
}

sub _search
{
        my ($c) = @_;

        my $query = _read_in($c);

        # --- validate ---
        if (not $query)
        {
                die "benchmarkanything-storage: no query data provided.\n";
        }

        if ($c->{_backend} eq "tapper")
        {
                require DBI;
                require Tapper::Benchmark;

                # connect
                my $dbh                   = _connect($c);
                my $tapper_benchmark      = Tapper::Benchmark->new({dbh => $dbh, debug => $c->options->{debug} });

                # query
                my $benchmarkanythingdata = $tapper_benchmark->search_array($query);

                # output
                _write_out($c, $benchmarkanythingdata);
        }
        else
        {
                die "benchmarkanything-storage: backend '.$c->{_backend}.' not yet implemented, available backends are: 'tapper'\n";
        }
}

sub _add
{
        my ($c) = @_;

        my $data = _read_in($c);

        # --- validate ---
        if (not $data)
        {
                die "benchmarkanything-storage: no input data provided.\n";
        }

        require BenchmarkAnything::Schema;
        print "Verify schema...\n" if $c->options->{verbose};
        if (not my $result = BenchmarkAnything::Schema::valid_json_schema($data))
        {
                die "benchmarkanything-storage: add: invalid input: ".join("; ", $result->errors)."\n";
        }


        # --- add to storage ---

        if ($c->{_backend} eq "tapper")
        {
                require Tapper::Benchmark;

                # connect
                print "Connect db...\n" if $c->options->{verbose};
                my $dbh              = _connect($c);
                my $tapper_benchmark = Tapper::Benchmark->new({dbh => $dbh, debug => $c->options->{debug} });

                # add data
                print "Add data...\n" if $c->options->{verbose};
                my $success = $tapper_benchmark->add_multi_benchmark($data->{BenchmarkAnythingData});
                if (not $success)
                {
                        die "benchmarkanything-storage: error while adding data to backend '".$c->{_backend}."': ".$@;
                }
                print "Done.\n" if $c->options->{verbose};
        }
        else
        {
                die "benchmarkanything-storage: backend ".$c->{_backend}." not yet implemented, available backends are: 'tapper'\n";
        }

        return BenchmarkAnything::Schema::valid_json_schema($data);
}

sub _are_you_sure
{
        my ($c) = @_;

        # DSN
        my $dsn = $c->{_config}{benchmarkanything}{backends}{tapper}{benchmark}{dsn};

        # option --really
        if ($c->options->{really})
        {
                if ($c->options->{really} eq $dsn)
                {
                        return 1;
                }
                else
                {
                        print STDERR "DSN does not match - asking interactive.\n";
                }
        }

        # ask on stdin
        print "REALLY DELETE AND RE-CREATE DATABASE [$dsn] (y/N): ";
        read STDIN, my $answer, 1;
        return 1 if $answer && $answer =~ /^y(es)?$/i;

        # default: NO
        return 0;
}

sub _connect
{
        my ($c) = @_;

        require DBI;
        no warnings 'once'; # avoid 'Name "DBI::errstr" used only once'

        # connect
        my $dsn              = $c->{_config}{benchmarkanything}{backends}{tapper}{benchmark}{dsn};
        my $user             = $c->{_config}{benchmarkanything}{backends}{tapper}{benchmark}{user};
        my $password         = $c->{_config}{benchmarkanything}{backends}{tapper}{benchmark}{password};
        my $dbh              = DBI->connect($dsn, $user, $password, {'RaiseError' => 1})
         or die "benchmarkanything-storage: can not connect: ".$DBI::errstr;

        return $dbh;
}

sub _createdb
{
        my ($c) = @_;

        # --- add to storage ---

        if ($c->{_backend} eq "tapper")
        {
                no warnings 'once'; # avoid 'Name "DBI::errstr" used only once'

                # backend: tapper

                if (_are_you_sure($c))
                {

                        require DBI;
                        require File::Slurp;
                        require File::ShareDir;
                        require Tapper::Benchmark;
                        use DBIx::MultiStatementDo;

                        # connect
                        my $dbh              = _connect($c);
                        my $batch            = DBIx::MultiStatementDo->new(dbh => $dbh);

                        # get schema SQL according to driver
                        my $dsn      = $c->{_config}{benchmarkanything}{backends}{tapper}{benchmark}{dsn};
                        my ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn($dsn)
                         or die "benchmarkanything-storage: can not parse DBI DSN '$dsn'";
                        my ($dbname) = $driver_dsn =~ m/database=(\w+)/g;
                        my $sql_file = File::ShareDir::dist_file('Tapper-Benchmark', "tapper-benchmark-create-schema.$driver");
                        my $sql      = File::Slurp::read_file($sql_file);
                        $sql         =~ s/^use `testrundb`;/use `$dbname`;/m if $dbname; # replace Tapper::Benchmark's default

                        # execute schema SQL
                        my @results = $batch->do($sql);
                        if (not @results)
                        {
                                die "benchmarkanything-storage: error while creating DB on backend '".$c->{_backend}."': ".$batch->dbh->errstr;;
                        }
                        ;
                }
        }
        else
        {
                # backend: unknown

                die "benchmarkanything-storage: backend ".$c->{_backend}." not yet implemented.\nAvailable backends are: 'tapper'\n";
        }

        return;
}

__END__

=pod

=encoding utf-8

=head1 NAME

benchmarkanything-storage - BenchmarkAnything storage cmdline tool

=head1 SYNOPSIS

Default data format (in and out) is JSON, other formats can be
specified.

Add data to configured backend storage:

  $ benchmarkanything-storage add data.json

Query backend storage for data:

  $ echo 'json_search_query' | benchmarkanything-storage search -

Declare input format YAML:

  $ benchmarkanything-storage add -i yaml data.yaml

=head2 Input formats

The following B<input formats> are allowed, with their according
modules used to convert the input into a data structure:

 yaml   - YAML::Any (default)
 json   - JSON
 dumper - Data::Dumper (including the leading $VAR1 variable assignment)

=head2 _read_in

This function reads in a data structure. The meaning of the data
depends on the sub command: for C<search> it is a search query, for
C<add> it is an array of BenchmarkAnything data points.

=head2 _write_out

This function writes a data structure in requested output format.

=head1 ABOUT

Cmdline tool to handle BenchmarkAnything data, see
L<http://benchmarkanything.org|http://benchmarkanything.org>

=head1 SEE ALSO

For more information about the BenchmarkAnything schema, see
L<http://www.benchmarkanything.org/|http://www.benchmarkanything.org/>.

=head1 AUTHOR

Steffen Schwigon <ss5@renormalist.net>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Steffen Schwigon.

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
