#!perl

our $DATE = '2017-05-19'; # DATE
our $VERSION = '0.003'; # VERSION

use 5.010001;
use strict;
use warnings;

use Getopt::Long qw(:config gnu_getopt no_ignore_case);

my %Opts = (
    code => undef,
    outputs => [],
    overwrite => 0,
    default_input_format => 'json',
    default_output_format => 'json',
);
our @DATA;
our $DATA;

our $DEBUG = $ENV{DEBUG};

sub _debug {
    my $msg = shift;

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

sub _guess_format_from_filename {
    my $filename = shift;

    # try to detect type from filename
    if ($filename =~ /\.(json|js)\z/i) {
        return 'json';
    } elsif ($filename =~ /\.(yaml|yml)\z/i) {
        return 'yaml';
    } elsif ($filename =~ /\.(perl|pl|pm|pod|dd)\z/i) {
        return 'perl';
    }
    undef;
}

sub _read_file {
    my ($filename) = @_;

    my $fmt;
  DETERMINE_INPUT_FORMAT:
    {
        if ($filename eq '-') {
            $fmt = $Opts{default_input_format};
            last;
        } elsif ($filename =~ s/:(json|yaml|perl)\z//) {
            $fmt = $1;
            last;
        } else {
            $fmt = _guess_format_from_filename($filename);
            last if $fmt;
        }

        # XXX detect format by reading a few lines from it

        $fmt = $Opts{default_input_format};
    }
    _debug("input format=$fmt");

    my $fh;
    if ($filename eq '-') {
        $fh = \*STDIN;
    } else {
        open $fh, "<", $filename
            or die "Can't open '$filename': $!\n";
    }
    my $raw = do {
        local $/;
        scalar <$fh>;
    };

    if ($fmt eq 'json') {
        require JSON::MaybeXS;
        my $json = JSON::MaybeXS->new->allow_nonref;
        return $json->decode($raw);
    } elsif ($fmt eq 'yaml') {
        require YAML::XS;
        return YAML::XS::Load($raw);
    } elsif ($fmt eq 'perl') {
        my $res = scalar eval $raw;
        if ($@) {
            warn "Can't read '$filename' as Perl: $@\n";
            exit 99;
        }
    } else {
        warn "dt: Unknown input format '$fmt'\n";
        exit 99;
    }
}

sub _write_file {
    my ($filename, $data) = @_;

    my $fmt;
  DETERMINE_OUTPUT_FORMAT:
    {
        if ($filename eq '-') {
            $fmt = $Opts{default_output_format};
            last;
        } elsif ($filename =~ s/:(json|yaml|perl)\z//) {
            $fmt = $1;
            last;
        } else {
            $fmt = _guess_format_from_filename($filename);
            last if $fmt;
        }

        $fmt = $Opts{default_output_format};
    }

    my $res;
    if ($fmt eq 'json') {
        require JSON::MaybeXS;
        my $json = JSON::MaybeXS->new->allow_nonref;
        $res = $json->encode($data);
    } elsif ($fmt eq 'yaml') {
        require YAML::XS;
        $res = YAML::XS::Dump($data);
    } elsif ($fmt eq 'perl') {
        require Data::Dump;
        $res = Data::Dump::dump($data);
    } else {
        warn "dt: Unknown output format '$fmt'\n";
        exit 99;
    }

    my $fh;
    if ($filename eq '-') {
        $fh = \*STDOUT;
    } else {
        if ((-f $filename) && !$Opts{overwrite}) {
            warn "dt: Skipped writing to '$filename': already exists\n";
            return;
        }
        open $fh, ">", $filename
            or die "Can't open '$filename': $!\n";
    }
    print $fh $res;
    print $fh "\n" unless $res =~ /\R\z/;
}

sub parse_cmdline {
    my $res = GetOptions(
        'e=s' => \$Opts{code},
        'overwrite' => \$Opts{overwrite},
        'output|o=s@' => \$Opts{outputs},
        'default-input-format|f=s' => \$Opts{default_input_format},
        'default-output-format|F=s' => \$Opts{default_output_format},
        'help|h'         => sub {
            print <<'USAGE';
Usage:
  dt [OPTIONS]... [FILES]...
  dt --help|-h
  dt --version|-v
Options:
  -e=s
  --overwrite
  --input-format=s, -f
  --output-format=s, -F
  --default-input-format=s, -f
  --default-output-format=s, -F
  --output=s@, -o
For more details, see the manpage/documentation.
USAGE
            exit 0;
        },
        'version|v'      => sub {
            say "dt version ", ($main::VERSION // "dev"),
                ($main::DATE ? " ($main::DATE)" : "");
            exit 0;
        },
    );
    exit 99 if !$res;
}

sub run {
    my @filenames = @ARGV;
    @filenames = ("-") if !@filenames && !(-t STDIN);
    for (@filenames) {
        push @DATA, _read_file($_);
    }

    if ($Opts{code}) {
        local $_ = $DATA[0];
        local $DATA = $DATA[0];
        my $orig_data0 = $DATA[0];

        my $res = eval "no strict; no warnings; $Opts{code}";
        die "Code dies: $@\n" if $@;

        # allow user to set $DATA[0] from last expression
        if (!defined($DATA[0])) {
            $DATA[0] = $res;
        }

        # allow user to set $DATA[0] from $DATA or $_
        if (defined $orig_data0) {
            if (defined($DATA) && $DATA != $orig_data0) {
                $DATA[0] = $DATA;
            }
            if (defined($_) && $_ != $orig_data0) {
                $DATA[0] = $_;
            }
        }
    }

    my @outputs = @{ $Opts{outputs} };
    @outputs = (("-") x @DATA) unless @outputs;
    for my $i (0..$#outputs) {
        _write_file($outputs[$i], $DATA[$i]);
    }
}

# MAIN

parse_cmdline();
run();

1;
# ABSTRACT: CLI data transformer
# PODNAME: dt

__END__

=pod

=encoding UTF-8

=head1 NAME

dt - CLI data transformer

=head1 VERSION

This document describes version 0.003 of dt (from Perl distribution App-dt), released on 2017-05-19.

=head1 SYNOPSIS

 % dt [OPTIONS] [FILE]...

=head1 DESCRIPTION

Roughly similar to utilities like L<jq>, L<jt>, the L<App::PipeFilter> suite,
L<jsonsel>, L<ddsel>, L<yamlsel>, this B<dt> utility can be used to transform
data structure on the CLI using Perl code. It accepts zero or more files of
encoded data structures in several formats (JSON, YAML, Perl), lets you specify
Perl code to generate or modify them, and spits them out again in specified
output format. The data structures are put into C<$DATA[0]>, C<$DATA[1]> and so
on. The first data structure is also put in C<$DATA> as well as C<$_>.

Some examples:

=over

=item * Generate some JSON

 % dt -e '[1..100]'
 % dt -e '[1..100]' -o numbers.json
 % dt -e '$n = 100; $DATA = [1..$n]' -o numbers.yaml

Input files are specified as arguments. If you do not specify any argument, and
C<dt> is at the right side of a pipeline, then you can generate data in the
code. The last expression or C<$DATA> or C<$_> will be used.

One or more C<--output> (C<-o>) options can be specified to direct output to
files. The first output file will be set to C<$DATA[0]> (or C<$DATA> or C<$_>),
the second to C<$DATA[1]> and so on. If no output files are specified, will
output to STDOUT.

=item * Convert JSON to YAML

 % dt books.json -o books.yaml

Input and output format are guessed from filename extension. Or, you can also
use C<:FORMAT> notation for input, e.g.:

 % dt books.dat:json -o books.yml

These formats are currently supported: C<json>, C<yaml>, C<perl>.

=item * Convert several YAML files to JSON

 % dt 1.json 2.json 3.json -o 1.yml -o 2.yml -o 3.yml

=item * Convert YAML to Perl: get the YAML from STDIN and output to a file

 % other-cmd | dt -f yaml -F perl -o datafile

If no input files are specified but C<dt> is at the right side of a pipeline,
data will be retrieved from STDIN.

Also, when output filename does not give any hint about format, you can set
output format using C<-F>.

=item * Convert YAML to pretty-printed JSON (see L<pp-json>)

 % dt books.yaml | pp-json

The default output format is JSON.

=item * Get a branch of data structure

 % dt bookstore.json -e '$DATA = $DATA->{store}{book}' -o books.json

=item * Add a field to records, output to STDOUT as JSON

 % dt -e 'my $now = time; for (@$DATA) { $_->{status} = $_->{mtime} >= $now-7*86400 ? "new" : "" }' < books.json

=item * Merge several YAML together as array of data structures

 % dt 1.yaml 2.yaml 3.yaml -e '$DATA = [@DATA]' -o combined.yaml

=back

=head1 EXIT CODES

0 on success.

255 on I/O error.

99 on command-line options or input data error.

=head1 OPTIONS

=over

=item * -e CODE

Specify Perl code to run. These variables are set for the code: C<@DATA> to the
data structures (in the order of the specified files), also C<$DATA> and C<$_>
to the first data structure.

=item * --overwrite

Overwrite existing output files instead of skipping writing to output files when
they already exist.

=item * --default-input-format FORMAT, -f

Set default output format. Default is C<json>. Can also be C<yaml>, C<perl>.

=item * --default-output-format FORMAT, -F

Set default output format. Default is C<json>. Can also be C<yaml>, C<perl>.

=item * --output FILENAME, -o

Add an output. Format will be guessed from .

If not specified, will output all data to STDOUT.

=back

=head1 ENVIRONMENT

=head2 DEBUG => bool

If set to true, print debugging messages.

=head1 HOMEPAGE

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

=head1 SOURCE

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

=head1 BUGS

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

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 SEE ALSO

L<jq>

L<jt>, L<App::PipeFilter>, L<jsonsel>, L<ddsel>, L<yamlsel>

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by perlancar@cpan.org.

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
