j2tn/j2tn.pl

#!perl
# -------------------------------------------------------------------
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at https://mozilla.org/MPL/2.0/.
# -------------------------------------------------------------------
#
use v5.36;
use utf8;
use strict;
use JSON;
use Text::CSV qw|csv|;
use YAML;
use open qw(:std :utf8);
local $YAML::UseAliases = 0;

sub normalize ($item) {
    die "item must be a HASH reference" unless ref($item) eq 'HASH';
    $item->{rdc}    = [] unless exists $item->{rdc};
    $item->{parsed} = "" unless exists $item->{parsed};
    $item->{nest}   = -1 unless exists $item->{nest};
    return $item unless exists $item->{at};
    my $nest = ++$item->{nest};
    push @{ $item->{rdc} },
      {
        json   => to_json( $item->{at} ),
        type   => ref( $item->{at} ),
        source => $item->{at},
        nest   => $nest,
      };

    if ( ref( $item->{at} ) eq "" ) {
        $item->{parsed} = $item->{at};
    }
    elsif ( ref( $item->{at} ) eq 'HASH' ) {
        my %at     = %{ $item->{at} };
        my $parsed = join ", ", map {
            my $key = $_;
            $item->{at} = $at{$key};
            normalize($item);
            $item->{parsed}
        } sort keys %at;
        $item->{parsed} = $parsed;
    }
    elsif ( ref( $item->{at} ) eq 'ARRAY' ) {
        my @at     = @{ $item->{at} };
        my $parsed = join "; ", map {
            $item->{at} = $_;
            normalize($item);
            $item->{parsed}
        } @at;
        $item->{parsed} = $parsed;
    }
    elsif ( ref( $item->{at} ) eq 'SCALAR' ) {
        $item->{parsed} = normalize( ${ $item->{at} } );
    }
    elsif ( ref( $item->{at} ) eq 'REF' ) {
        $item->{parsed} = normalize( ${ $item->{at} } );
    }
    delete $item->{at} if exists $item->{at};

} ## end sub normalize

sub j2tn ( $json, $lol ) {
    die "lol must be a HASH reference" unless ref($lol) eq 'HASH';
    $lol->{data}  = [ [] ]                 unless exists $lol->{data};
    $lol->{index} = { "_normalized_" => 0 } unless exists $lol->{index};
    my $index   = $lol->{index};
    my $columns = 1;
    my $rows    = 1;
    my $data    = $lol->{data};

    if ( ref $json eq "ARRAY" ) {
        map {
            my $item = $_;
            my @row  = ();
            my $orig = {};
            if ( ref($item) eq "HASH" ) {
                map {
                    my $key   = $_;
                    my $value = { at => $item->{$key} };
                    normalize($value);
                    if ( not defined $index->{$key} ) {
                        $index->{$key} = $columns++;
                    }
                    if ( $value->{rdc}->[0]->{type} =~ /(HASH|ARRAY)/ ) {
                        $orig->{$key} = $value->{rdc}->[0]->{source};
                    }
                    $row[ $index->{$key} ] = $value->{parsed};
                } keys %$item;
            } ## end if ( ref($item) eq "HASH"...)
            if ( scalar keys %$index > scalar @{ $data->[0] } ) {
                map { my $key = $_; $data->[0]->[ $index->{$key} ] = $key }
                  keys %$index;
            }
            $row[0] = to_json($orig);
            $data->[ $rows++ ] = \@row;
        } @$json;
    } ## end if ( ref $json eq "ARRAY"...)
    $lol->{columns} = $columns;
    $lol->{rows}    = $rows;
} ## end sub j2tn

# Standard output with nl
sub speak ( $cmd, $cli, $debug = 0 ) {
    while ( my $s = shift @$cli ) {
        $s =~ s/^\s+[|]//gm;
        say $s;
    }
}

# start
sub main ( $cmd, $cli, $debug = 0 ) {
    my $d =
      { ( my $caller = [ caller(0) ] )->[3] => my $v =
          { cli => [@$cli], debug => $debug }, };
    $d->{caller} = $caller if $debug & 2;
    say Dump($d)           if $debug;
    my $command = shift @$cli;
    if ( defined $command && ref( $cmd->{$command} ) eq "CODE" ) {
        $cmd->{$command}->( $cmd, $cli, $debug );
        exit(0);
    }
    else {
        $cmd->{usage}->( $cmd, $cli, $debug );
        exit(1);
    }
} ## end sub main

# usage
sub usage ( $cmd, $cli, $debug = 0 ) {
    my $caller = [ caller(0) ];
    my $d = { $caller->[3] => my $v = { cli => [@$cli], debug => $debug }, };
    $d->{caller} = $caller if $debug & 2;
    say Dump($d) if $debug;
    $cmd->{speak}->( $cmd, ["$0 help for more information."], $debug );
}

# help
sub help ( $cmd, $cli, $debug = 0 ) {
    my $caller = [ caller(0) ];
    my $d = { $caller->[3] => my $v = { cli => [@$cli], debug => $debug }, };
    $d->{caller} = $caller if $debug & 2;
    say Dump($d) if $debug;
    $cmd->{speak}->(
        $cmd,
        [
            "$0 command [options,...] [arguments,...]",
            " ",
            "commands:",
            "  to-csv in-file-name out-file-name",
            "     use - for the out-file-name to go to std-out",
            "  debug [debug-bit-flag] command",
            "     1 => function calls",
            "     2 => current location",
            "     4 => parsed json",
            "     8 => unparsed json",
            "    16 => internal processed data just before output",
            "  speak command",
            "    echo the command"
        ],
        $debug,
    );
} ## end sub help

# debug
sub debug ( $cmd, $cli, $debug = 0 ) {
    my $caller = [ caller(0) ];
    my $d = { $caller->[3] => my $v = { cli => [@$cli], debug => $debug }, };
    $d->{caller} = $caller if $debug & 2;
    my $dv = ( shift @$cli );
    if ( ( defined $dv ) && ( $dv =~ /\d+/ ) ) {
        $debug = $dv + 0;
    }
    else {
        $debug++;
        # cspell:ignore unshift
        unshift @$cli, $dv if defined $dv;
    }
    $v->{"new-debug"} = $debug;
    say Dump($d) if $debug;
    $cmd->{main}->( $cmd, $cli, $debug );
} ## end sub debug

# to-csv
sub to_csv ( $cmd, $cli, $debug = 0 ) {
    my $caller = [ caller(0) ];
    my $d = { $caller->[3] => my $v = { cli => [@$cli], debug => $debug }, };
    $d->{caller}        = $caller      if $debug & 2;
    $d->{caller}        = [ caller() ] if $debug & 2;
    $v->{"input-file"}  = shift @$cli;
    $v->{"output-file"} = shift @$cli;
    open( my $in, "<", $v->{"input-file"} )
      or die "Could not open $v->{'input-file'} with\n  $!";
    my $js = join( "", <$in> );
    $v->{in} = $js if $debug & 8;
    my $j = from_json($js);
    $v->{json} = $j if $debug & 4;
    close $in;
    j2tn( $j, my $lol = {} );
    $v->{lol} = $lol if $debug & 16;
    say Dump($d)     if $debug;
    csv(
        in  => $lol->{data},
        out =>
          ( ( $v->{"output-file"} eq "-" ) ? *STDOUT : $v->{"output-file"} ),
        encoding => "utf8"
    );
} ## end sub to_csv

# call the main function
main(
    {
        main     => \&main,
        debug    => \&debug,
        usage    => \&usage,
        "to-csv" => \&to_csv,
        help     => \&help,
        speak    => \&speak,
    },
    \@ARGV,
);

# end