App-Music-ChordPro/script/rrjson.pl
#!/usr/bin/perl
# Author : Johan Vromans
# Created On : Sun Mar 10 18:02:02 2024
# Last Modified By: Johan Vromans
# Last Modified On: Fri Oct 24 14:30:04 2025
# Update Count : 189
# Status : Unknown, Use with caution!
################ Common stuff ################
use v5.26;
use feature 'signatures';
no warnings 'experimental::signatures';
# Package name.
my $my_package = 'JSON::Relaxed';
# Program name and version.
my ($my_name, $my_version) = qw( rrjson 0.03 );
################ Command line parameters ################
use Getopt::Long 2.13;
# Command line options.
my $mode = "rrjson";
my $execute; # direct JSON from command line
my $schema; # schema (optional)
# Parser options.
my $strict;
my $pretty = 1;
my $croak_on_error;
my $extra_tokens_ok;
# Encoder.
my $indent = 2;
# Extension properties.
my $order;
my $prp;
my $combined_keys;
my $implied_outer_hash;
my $verbose = 1; # verbose processing
# Development options (not shown with -help).
my $pretoks = 0;
my $tokens = 0;
my $debug = 0; # debugging
my $trace = 0; # trace (show process)
my $test = 0; # test mode.
my $have_yaml = eval { require YAML::PP };
my $have_toml = eval { require TOML::Tiny };
# Process command line options.
app_options();
# Post-processing.
# Default is non-strict.
$strict //= 0;
if ( $strict ) {
# No extensions.
$order = 0;
$prp = 0;
$combined_keys = 0;
$implied_outer_hash = 0;
}
else {
# Default is all extensions.
$order //= 1;
$prp //= 1;
$combined_keys //= 1;
$implied_outer_hash //= 1;
}
$trace |= ($debug || $test);
################ Presets ################
use FindBin;
# @INC construction...
# Standard paths are lib and lib/ChordPro/lib relative to the parent
# of the script directory. This may fail if the ChordPro files are installed
# in another directory than next to the script.
# Directories in CHORDPRO_XLIBS follow, to augment the path.
# For example, to add custom delegates.
# Directories in CHORDPRO_XXLIBS are put in front, these can be used
# to overrule standard modules. For example, to provide a patches
# module to an installed kit. Caveat emptor.
my @inc;
BEGIN {
for my $lib ( "$FindBin::Bin/../lib", "$FindBin::Bin/../lib/ChordPro/lib", @INC ) {
next unless -d $lib;
# Is our main module here?
if ( -s "$lib/ChordPro.pm" ) {
# Add ChordPro libs.
push( @inc, $lib, "$lib/ChordPro/lib" );
}
else {
# Copy.
push( @inc, $lib );
}
}
}
use lib @inc;
# For conditional filling of hashes.
sub maybe ( $key, $value, @rest ) {
if (defined $key and defined $value) {
return ( $key, $value, @rest );
}
else {
( defined($key) || @rest ) ? @rest : ();
}
}
################ The Process ################
use FindBin;
use lib "$FindBin::Bin/../lib";
use JSON::Relaxed;
use JSON::PP;
use File::LoadLines;
use Encode qw(decode_utf8);
binmode STDOUT => ':utf8';
binmode STDERR => ':utf8';
if ( $schema ) {
my $parser = JSON::Relaxed::Parser->new( strict => 0 );
my $data = loadlines( $schema, { split => 0 } );
$data = $parser->decode($data);
warn("Schema $schema loaded\n") if $verbose;
$schema = $data;
}
my $parser = JSON::Relaxed::Parser->new
( booleans => 1, # force default
strict => $strict,
prp => $prp,
combined_keys => $combined_keys,
implied_outer_hash => $implied_outer_hash,
prp => $prp,
pretty => $pretty,
key_order => $order && $mode !~ /^json/,
maybe croak_on_error => $croak_on_error,
maybe extra_tokens_ok => $extra_tokens_ok,
);
if ( $mode eq "dumper" ) {
$parser->booleans = [0,1];
}
if ( $verbose > 1 ) {
my @opts;
for ( qw( strict pretty prp combined_keys implied_outer_hash
croak_on_error extra_tokens_ok booleans ) ) {
push( @opts, $_ ) if $parser->$_;
}
if ( @opts ) {
warn( "Parser options: ", join(", ", @opts), ".\n");
}
}
for my $file ( @ARGV ) {
my $json;
my $prp;
if ( $execute ) {
$json = decode_utf8($file);
}
else {
$prp = $file =~ /\.prp$/i;
my $opts = { split => 1, fail => "soft" };
$json = loadlines( $file, $opts );
die( "$file: $opts->{error}\n") if $opts->{error};
$json = join( "\n", @$json, '' ) unless $prp;
if ( ($pretoks || $tokens) && $file !~ /\.r?r?json$/i ) {
warn( "$file: not JSON data, ignoring tokens\n" );
}
}
my $data;
# For debugging/development.
if ( ( $pretoks || $tokens ) && !$prp ) {
$parser->croak_on_error = 0;
$parser->data = $json;
$parser->pretokenize;
if ( $pretoks ) {
my $pretoks = $parser->pretoks;
dumper( $pretoks, as => "Pretoks" );
}
$parser->tokenize;
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
################ 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
--json JSON output
--json_xs JSON_XS output
EndOfUsage
print STDERR <<EndOfUsage if $have_yaml;
--yaml YAML output
EndOfUsage
print STDERR <<EndOfUsage if $have_toml;
--toml TOML output
EndOfUsage
print STDERR <<EndOfUsage;
--no-pretty compact (non-pretty) output
--indent=N indent for output
--order retain order of hash keys
--dump dump structure (Data::Printer)
--dumper dump structure (Data::Dumper)
Parser options
--strict see the docs
Miscellaneous
--ident shows identification
--help shows a brief help message and exits
--verbose provides more verbose information
--quiet runs as silently as possible
EndOfUsage
exit $exit if defined $exit && $exit != 0;
}
################ Documentation ################
=head1 NAME
rrjson - convert from/to miscellaneous JSON formats
=head1 SYNOPSIS
Usage: script/rrjson.pl [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
--json JSON output
--json_xs JSON_XS output
--yaml YAML output
--toml TOML output
--no-pretty compact (non-pretty) output
--indent=N indent for output
--order retain order of hash keys
--dump dump structure (Data::Printer)
--dumper dump structure (Data::Dumper)
Parser options
--strict see the docs
Miscellaneous
--ident shows identification
--help shows a brief help message and exits
--verbose provides more verbose information
--quiet runs as silently as possible
=head1 OPTIONS
See L<SYNOPSIS>.
=head1 DESCRIPTION
B<rrjson> will read the given file and output it in the format
designated by one of the output modes, see L<SYNOPSIS>.
Default output format is RRJSON; default output is standard output.
If a schema is supplied, descriptions from the schema will be used to
supply comments in the RRJSON output.
=cut