jf

#!/usr/bin/perl

use warnings;
use strict;
use JSON;
use Getopt::Std;

my %opts;
getopts('pl', \%opts);

unless ($opts{l}) {
    $/ = undef;	# slurp whole files at a time
}

if (scalar(@ARGV) < 1) { usage() }

my @fields;
while ((my $field = shift)) {
	if ($field eq '--') { last; }
	push @fields, $field;
}

my $fieldtree = {};
for my $field (@fields) {
	my @nodes = split '/', $field;
	my $tree = $fieldtree;
	for my $node (@nodes) {
		if (!exists($tree->{$node})) {
			$tree->{$node} = {};
		} 
		$tree = $tree->{$node};
	}
}

binmode STDOUT, ":utf8";
my $json_handler = JSON->new;
while (<>) {
	my $wanted = descend($json_handler->decode($_), $fieldtree);
	if ($opts{'p'}) {
		print $json_handler->pretty->encode($wanted)."\n";
	} else {
		print $json_handler->encode($wanted)."\n";
	}
}

sub descend {
	(my $json, my $fields) = @_;
	if (ref($json) =~ /ARRAY/) {
		return [ map { descend($_, $fields) } @$json ];
	} elsif (scalar(keys %$fields) > 0) {
		my %ret;
		while ((my $field, my $subtree) = each %$fields) {
			$ret{$field} = descend($json->{$field}, $subtree);
		}
		return \%ret;
	} else {
		return $json;
	}
}

sub usage {
	print "Usage: $0 field1 field2 .. -- file1 file2 ..\n";
	print "or cat file1 file2 .. | $0 field1 field2 ..\n";
	exit 2;
}