view release on metacpan or  search on metacpan

lib/ChordPro/Config.pm  view on Meta::CPAN

    # Load schema.
    my $schema = do {
	my $schema = CP->findres( "config.schema", class => "config" );
	my $data = fs_load( $schema, { split => 0 } );
	$parser->decode($data);
    };

    # Delta cannot handle reference config yet.
    if ( $delta ) {
	$defcfg->unlock;
	$cfg->reduce( $defcfg );
	return $parser->encode( data => {%$cfg},
				pretty => 1, schema => $schema );
    }

    my $config = do {
	my $config = CP->findres( "chordpro.json", class => "config" );
	my $data = fs_load( $config, { split => 0 } );
	$parser->decode($data);
    };

    #    $cfg = hmerge( $config, $cfg );
    $cfg->simplify_fonts;
    return $parser->encode( data => {%{$cfg}},
			    pretty => 1, schema => $schema );
}

sub convert_config ( $from, $to ) {
    # This is a completely independent function.

    # Establish a key order retaining parser.
    my $parser = JSON::Relaxed::Parser->new( key_order => 1 );

    # First find and process the schema.
    my $schema = CP->findres( "config.schema", class => "config" );
    my $o = { split => 0, fail => 'soft' };
    my $data = fs_load( $schema, $o );
    die("$schema: ", $o->{error}, "\n") if $o->{error};
    $schema = $parser->decode($data);

    # Then load the config to be converted.
    my $new;
    $o = { split => 1, fail => 'soft' };
    $data = fs_load( $from, $o );
    die("Cannot open config $from [", $o->{error}, "]\n") if $o->{error};
    $data = join( "\n", @$data );

    if ( $data =~ /^\s*#/m ) {	# #-comments -> prp
	require ChordPro::Config::Properties;
	my $cfg = Data::Properties->new;
	$cfg->parse_file($from);
	$new = $cfg->data;
    }
    else {			# assume JSON, RJSON, RRJSON
	$new = $parser->decode($data);
    }

    # And re-encode it using the schema.
    my $res = $parser->encode( data => $new, pretty => 1,
			       nounicodeescapes => 1, schema => $schema );
    # use DDP; p $res;
    # Add trailer.
    $res .= "\n// End of Config.\n";

    # Write if out.
    if ( $to && $to ne "-" ) {
	open( my $fd, '>', $to )
	  or die("$to: $!\n");
	print $fd $res;
	$fd->close;
    }
    else {
	print $res;
    }

    1;
}

# Config in properties format.

sub cfg2props ( $o, $path = "" ) {
    $path //= "";
    my $ret = "";
    if ( !defined $o ) {
        $ret .= "$path: undef\n";
    }
    elsif ( is_hashref($o) ) {
        $path .= "." unless $path eq "";
        for ( sort keys %$o ) {
            $ret .= cfg2props( $o->{$_}, $path . $_  );
        }
    }
    elsif ( is_arrayref($o) ) {
        $path .= "." unless $path eq "";
        for ( my $i = 0; $i < @$o; $i++ ) {
            $ret .= cfg2props( $o->[$i], $path . "$i" );
        }
    }
    elsif ( $o =~ /^\d+$/ ) {
        $ret .= "$path: $o\n";
    }
    else {
        $o =~ s/\\/\\\\/g;
        $o =~ s/"/\\"/g;
        $o =~ s/\n/\\n/;
        $o =~ s/\t/\\t/;
        $o =~ s/([^\x00-\xff])/sprintf("\\x{%x}", ord($1))/ge;
        $ret .= "$path: \"$o\"\n";
    }

    return $ret;
}

# Locking/unlocking. Locking the hash is mainly for development, to
# trap accidental modifications and typos.

sub lock ( $self ) {
    Hash::Util::lock_hashref_recurse($self);
}

lib/ChordPro/Config.pm  view on Meta::CPAN

sub get_property ( $p, $prp, $def = undef ) {
    for ( split( /\./,
                 $prp_context eq ""
                 ? $prp
                 : "$prp_context.$prp" ) ) {
        if ( /^\d+$/ ) {
            die("No config $prp\n") unless _ref($p) eq 'ARRAY';
            $p = $p->[$_];
        }
        else {
            die("No config $prp\n") unless _ref($p) eq 'HASH';
            $p = $p->{$_};
        }
    }
    $p //= $def;
    die("No config $prp\n") unless defined $p;
    $p;
}

*gps = \&get_property;

sub set_property  {
    ...;
}

sub set_context ( $self, $ctx = "" ) {
    $prp_context = $ctx;
}

sub get_context () {
    $prp_context;
}

# For testing
use Exporter 'import';
our @EXPORT = qw( _c );
sub _c ( @args ) { $::config->gps(@args) }

# For convenience.
sub diagram_strings ( $self ) {
    # tuning is usually removed from the config.
    # scalar( @{ $self->{tuning} } );
    ChordPro::Chords::strings();
}

sub diagram_keys ( $self ) {
    $self->{kbdiagrams}->{keys};
}

# For debugging messages.
sub qd ( $val, $compact = 0 ) {
    use Data::Dumper qw();
    local $Data::Dumper::Sortkeys  = 1;
    local $Data::Dumper::Indent    = 1;
    local $Data::Dumper::Quotekeys = 0;
    local $Data::Dumper::Deparse   = 1;
    local $Data::Dumper::Terse     = 1;
    local $Data::Dumper::Trailingcomma = !$compact;
    local $Data::Dumper::Useperl = 1;
    local $Data::Dumper::Useqq     = 0; # I want unicode visible
    my $x = Data::Dumper::Dumper($val);
    if ( $compact ) {
        $x =~ s/^bless\( (.*), '[\w:]+' \)$/$1/s;
        $x =~ s/\s+/ /gs;
    }
    defined wantarray ? $x : warn($x,"\n");
}

1;