view release on metacpan or  search on metacpan

script/rrjson.pl  view on Meta::CPAN

################ Subroutines ################

package Data::Properties {

sub __data_internal {
    my ( $self, $orig ) = @_;
    my $cur = $orig // '';
    $cur .= "." if $cur ne '';
    my $all = $cur;
    $all .= '@';
    if ( my $res = $self->{_props}->{lc($all)} ) {
	if ( _check_array($res) ) {
	    my $ret = [];
	    foreach my $prop ( @$res ) {
		$ret->[$prop] = $self->_data_internal($cur.$prop);
	    }
	    return $ret;
	}
	else {
	    my $ret = @$res > 1 ? { " key order " => $res } : {};
	    foreach my $prop ( @$res ) {
		$ret->{$prop} = $self->_data_internal($cur.$prop);
	    }
	    return $ret;
	}
    }
    else {
	my $val = $self->{_props}->{lc($orig)};
	$val = $self->expand($val) if defined $val;
	return $val;
    }
}

}	# Data::Properties

################ Subroutines ################

sub dumper($data, %opts) {
    if ( $mode eq "dump" || %opts ) {
	my %opts = ( %opts );
	require Data::Printer;
	if ( -t STDOUT ) {
	    Data::Printer::p( $data, %opts );
	}
	else {
	    print( Data::Printer::np( $data, %opts ) );
	}
    }

    elsif ( $mode eq "dumper" ) {
	require Data::Dumper;
	local $Data::Dumper::Sortkeys  = 1;
	local $Data::Dumper::Indent    = 1;
	local $Data::Dumper::Quotekeys = 0;
	local $Data::Dumper::Deparse   = 1;
	local $Data::Dumper::Purity    = 1;
	local $Data::Dumper::Terse     = 1;
	local $Data::Dumper::Trailingcomma = 1;
	local $Data::Dumper::Useperl = 1;
	local $Data::Dumper::Useqq     = 0; # I want unicode visible
	print( Data::Dumper->Dump( [$data] ) );
    }
}

################ Subroutines ################

sub app_options() {
    my $help = 0;		# handled locally
    my $ident = 0;		# handled locally

    # Process options, if any.
    if ( !GetOptions(
     'schema=s'		    => \$schema,
     'rrjson'		    => sub { $mode = "rrjson"  },
     'rjson'		    => sub { $mode = "rjson"   },
     'json|json_pp'	    => sub { $mode = "json"    },
     'json_xs'		    => sub { $mode = "json_xs" },
     $have_toml ? ( toml => sub { $mode = "toml" } ) : (),
     $have_yaml ? ( yaml => sub { $mode = "yaml" } ) : (),
     'dump'		    => sub { $mode = "dump"    },
     'dumper'		    => sub { $mode = "dumper"  },
     'execute|e'	    => \$execute,
     'strict!'		    => \$strict,
     'prp!'		    => \$prp,
     'combined_keys!'	    => \$combined_keys,
     'implied_outer_hash!'  => \$implied_outer_hash,
     'croak_on_error!'	    => \$croak_on_error,
     'extra_tokens_ok!'	    => \$extra_tokens_ok,
     'pretty!'		    => \$pretty,
     'order!'		    => \$order,
     'pretoks+'		    => \$pretoks,
     'tokens+'		    => \$tokens,
     'indent=i'		    => \$indent,
     'ident'		    => \$ident,
     'verbose+'		    => \$verbose,
     'quiet'		    => sub { $verbose = 0 },
     'trace'		    => \$trace,
     'help|?'		    => \$help,
     'debug'		    => \$debug ) or $help) {
	app_usage(2);
    }
    app_ident() if $ident;
    app_usage(2) unless @ARGV;
}

sub app_ident() {
    print STDERR ("This is $my_package [$my_name $my_version]\n");
    print STDERR ("JSON::Relaxed version $JSON::Relaxed::VERSION\n");
}

sub app_usage( $exit ) {
    app_ident();
    print STDERR <<EndOfUsage;
Usage: $0 [options] [file ...]
  Inputs
   --execute -e		args are JSON, not filenames
   --schema=XXX		optional JSON schema
  Output modes
   --rrjson		pretty printed RRJSON output (default)
   --rjson		pretty printed RJSON output