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);
}