view release on metacpan or  search on metacpan

script/rrjson.pl  view on Meta::CPAN

	if ( $tokens && !$parser->is_error ) {
	    my $tokens = $parser->tokens;
	    dumper( $tokens, as => "Tokens" );
	}
	$data = $parser->structure unless $parser->is_error;
    }

    elsif ( $prp ) {
	require ChordPro::Config::Properties;
	*Data::Properties::_data_internal = \&Data::Properties::__data_internal;
	my $cfg = new Data::Properties;
	$cfg->parse_lines( $json, $file );
	$data = $cfg->data;
#	use DDumper; DDumper($data);exit;
    }

    elsif ( $have_yaml && $file =~ /\.yaml$/i  ) {
	$data = YAML::PP->new
	  ( boolean => 'JSON::PP,boolean' )->load_string($json);
    }

    elsif ( $have_toml && $file =~ /\.toml$/i  ) {
	my $p = TOML::Tiny->new
	  ( inflate_boolean => sub { $_[0] eq 'true'
				     ? $JSON::PP::true
				     : $JSON::PP::false;
				    }
				);
	( $data, my $error ) = $p->decode($json);
    }

    # Normal call.
    else {
	$data = $parser->decode($json);
    }

    if ( $parser->is_error ) {
	warn( $execute ? "$file: JSON error: " : "",
	      "[", $parser->err_id, "] ", $parser->err_msg, "\n" );
	next;
    }

    if ( $mode eq "dump" || $mode eq "dumper" ) {
	dumper($data);
    }

    elsif ( $mode eq "rrjson" ) {
	print $parser->encode( data => $data,
			       indent => $indent,
			       maybe schema => $schema );
	print "\n" unless $pretty;
    }
    elsif ( $mode eq "rjson" ) {
	print $parser->encode( data => $data,
			       strict => 1,
			       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