j2tn/j2tn.pl

225 lines
6.8 KiB
Perl
Raw Permalink Normal View History

2023-06-04 17:49:15 +00:00
#!perl
2023-06-04 16:42:48 +00:00
# -------------------------------------------------------------------
# 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) {
2023-06-09 12:13:05 +00:00
die "item must be a HASH reference" unless ref($item) eq 'HASH';
2023-06-04 16:42:48 +00:00
$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 ) {
2023-06-09 12:13:05 +00:00
die "lol must be a HASH reference" unless ref($lol) eq 'HASH';
2023-06-04 17:17:50 +00:00
$lol->{data} = [ [] ] unless exists $lol->{data};
2023-06-09 12:13:05 +00:00
$lol->{index} = { "_normalized_" => 0 } unless exists $lol->{index};
2023-06-04 16:42:48 +00:00
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] } ) {
2023-06-04 17:17:50 +00:00
map { my $key = $_; $data->[0]->[ $index->{$key} ] = $key }
keys %$index;
2023-06-04 16:42:48 +00:00
}
$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,...]",
2023-06-04 17:17:50 +00:00
" ",
"commands:",
2023-06-04 16:42:48 +00:00
" to-csv in-file-name out-file-name",
2023-06-04 17:17:50 +00:00
" 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"
2023-06-04 16:42:48 +00:00
],
$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++;
2023-06-09 12:13:05 +00:00
# cspell:ignore unshift
2023-06-04 16:42:48 +00:00
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;
2023-06-04 17:17:50 +00:00
csv(
in => $lol->{data},
out =>
( ( $v->{"output-file"} eq "-" ) ? *STDOUT : $v->{"output-file"} ),
encoding => "utf8"
);
2023-06-04 16:42:48 +00:00
} ## 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