view release on metacpan or  search on metacpan

script/rrjson.pl  view on Meta::CPAN

			       indent => $indent,
			       maybe schema => $schema );
	print "\n" unless $pretty;
    }
    elsif ( $mode eq "json_xs" ) {
	require JSON::XS;
	print ( JSON::XS->new->canonical->utf8(0)->pretty($pretty)
		->boolean_values( $JSON::PP::false, $JSON::PP::true )
		->convert_blessed->encode($data) );
    }

    elsif ( $mode eq "toml" ) {
	require TOML::Tiny;
	my $parser = TOML::Tiny->new();
	print ( TOML::Tiny::to_toml($data) );
    }

    elsif ( $mode eq "yaml" ) {
	require YAML;
	$YAML::UseAliases = 0;
	$YAML::Stringify = 1;
	print ( YAML::Dump($data) );
    }

    else {			# default JSON
	require JSON::PP;
	print ( JSON::PP->new->canonical->utf8(0)->pretty($pretty)
		->boolean_values( $JSON::PP::false, $JSON::PP::true )
		->convert_blessed->encode($data) );
    }
}

################ 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,