App-Music-ChordPro
view release on metacpan or search on metacpan
lib/ChordPro/Config.pm view on Meta::CPAN
# $cfg = hmerge( $cfg, prp2cfg( $options->{define}, $cfg ) );
# use DDP; p $options->{define}, as => "clo";
prpadd2cfg( $cfg, %{$options->{define}} );
migrate_songbook_pagectrl($cfg);
# use DDP; p $cfg->{pdf}->{songbook}, as => "accum after clo";
# Sanitize added extra entries.
for my $format ( qw(title subtitle footer) ) {
delete($cfg->{pdf}->{formats}->{first}->{$format})
if ($cfg->{pdf}->{formats}->{first}->{$format} // 1) eq "";
for my $c ( qw(title first default filler) ) {
for my $class ( $c, $c."-even" ) {
my $t = $cfg->{pdf}->{formats}->{$class}->{$format};
# Allowed: null, false, [3], [[3], ...].
next unless defined $t;
$cfg->{pdf}->{formats}->{$class}->{$format} = ["","",""], next
unless $t;
die("Config error in pdf.formats.$class.$format: not an array\n")
unless is_arrayref($t);
$t = [ $t ] unless is_arrayref($t->[0]);
for ( @$t) {
die("Config error in pdf.formats.$class.$format: ",
scalar(@$_), " fields instead of 3\n")
if @$_ && @$_ != 3;
}
$cfg->{pdf}->{formats}->{$class}->{$format} = $t;
}
}
}
if ( $cfg->{pdf}->{fontdir} ) {
my @a;
if ( ref($cfg->{pdf}->{fontdir}) eq 'ARRAY' ) {
@a = @{ $cfg->{pdf}->{fontdir} };
}
else {
@a = ( $cfg->{pdf}->{fontdir} );
}
$cfg->{pdf}->{fontdir} = [];
my $split = $^O =~ /^MS*/ ? qr(;) : qr(:);
foreach ( @a ) {
push( @{ $cfg->{pdf}->{fontdir} },
map { expand_tilde($_) } split( $split, $_ ) );
}
}
else {
$cfg->{pdf}->{fontdir} = [];
}
my @allfonts = keys(%{$cfg->{pdf}->{fonts}});
for my $ff ( @allfonts ) {
# Derived chords can have size or color only. Disable
# this test for now.
unless ( 1 || $cfg->{pdf}->{fonts}->{$ff}->{name}
|| $cfg->{pdf}->{fonts}->{$ff}->{description}
|| $cfg->{pdf}->{fonts}->{$ff}->{file} ) {
delete( $cfg->{pdf}->{fonts}->{$ff} );
next;
}
$cfg->{pdf}->{fonts}->{$ff}->{color} //= "foreground";
$cfg->{pdf}->{fonts}->{$ff}->{background} //= "background";
for ( qw(name file description size) ) {
delete( $cfg->{pdf}->{fonts}->{$ff}->{$_} )
unless defined( $cfg->{pdf}->{fonts}->{$ff}->{$_} );
}
}
if ( defined $options->{diagrams} ) {
warn( "Invalid value for diagrams: ",
$options->{diagrams}, "\n" )
unless $options->{diagrams} =~ /^(all|none|user)$/i;
$cfg->{diagrams}->{show} = lc $options->{'diagrams'};
}
elsif ( defined $options->{'user-chord-grids'} ) {
$cfg->{diagrams}->{show} =
$options->{'user-chord-grids'} ? "user" : 0;
}
elsif ( defined $options->{'chord-grids'} ) {
$cfg->{diagrams}->{show} =
$options->{'chord-grids'} ? "all" : 0;
}
for ( qw( transpose transcode decapo lyrics-only strict ) ) {
next unless defined $options->{$_};
$cfg->{settings}->{$_} = $options->{$_};
}
for ( "cover", "front-matter", "back-matter" ) {
next unless defined $options->{$_};
$cfg->{pdf}->{songbook}->{$_} = $options->{$_};
}
if ( defined $options->{'chord-grids-sorted'} ) {
$cfg->{diagrams}->{sorted} = $options->{'chord-grids-sorted'};
}
# For convenience...
bless( $cfg, __PACKAGE__ );
return $cfg if $options->{'cfg-print'};
# Backend specific configs.
$backend_configurator->($cfg) if $backend_configurator;
# Locking the hash is mainly for development.
$cfg->lock;
if ( $options->{verbose} > 1 ) {
my $cp = ChordPro::Chords::get_parser() // "";
warn("Parsers:\n");
while ( my ($k, $v) = each %{ChordPro::Chords::Parser->parsers} ) {
warn( " $k",
$v eq $cp ? " (active)": "",
"\n");
}
}
return $cfg;
}
# Get the decoded contents of a single config file.
lib/ChordPro/Config.pm view on Meta::CPAN
$cfg->split_fc_aliases;
$cfg->expand_font_shortcuts;
push( @res, $cfg );
return @res;
}
sub process_config ( $cfg, $file ) {
my $verbose = $options->{verbose};
warn("Process: $file\n") if $verbose > 1;
if ( $cfg->{tuning} ) {
my $res =
ChordPro::Chords::set_tuning( $cfg );
warn( "Invalid tuning in config: ", $res, "\n" ) if $res;
$cfg->{_tuning} = $cfg->{tuning};
$cfg->{tuning} = [];
}
ChordPro::Chords::reset_parser;
ChordPro::Chords::Parser->reset_parsers;
local $::config = dclone(hmerge( $::config, $cfg ));
if ( $cfg->{chords} ) {
ChordPro::Chords::push_parser($cfg->{notes}->{system});
my $c = $cfg->{chords};
if ( @$c && $c->[0] eq "append" ) {
shift(@$c);
}
foreach ( @$c ) {
my $res =
ChordPro::Chords::add_config_chord($_);
warn( "Invalid chord in config: ",
$_->{name}, ": ", $res, "\n" ) if $res;
}
if ( $verbose > 1 ) {
warn( "Processed ", scalar(@$c), " chord entries\n");
warn( "Totals: ",
ChordPro::Chords::chord_stats(), "\n" );
}
$cfg->{_chords} = delete $cfg->{chords};
ChordPro::Chords::pop_parser();
}
$cfg->split_fc_aliases;
$cfg->expand_font_shortcuts;
}
# Expand pdf.fonts.foo: bar to pdf.fonts.foo { description: bar }.
sub expand_font_shortcuts ( $cfg ) {
return unless exists $cfg->{pdf}->{fonts};
for my $f ( keys %{$cfg->{pdf}->{fonts}} ) {
next if ref($cfg->{pdf}->{fonts}->{$f}) eq 'HASH';
for ( $cfg->{pdf}->{fonts}->{$f} ) {
my $v = $_;
$v =~ s/\s*;\s*$//;
my $i = {};
# Break out ;xx=yy properties.
while ( $v =~ s/\s*;\s*(\w+)\s*=\s*(.*?)\s*(;|$)/$3/ ) {
my ( $k, $v ) = ( $1, $2 );
if ( $k =~ /^(colou?r|background|frame|numbercolou?r|size)$/ ) {
$k =~ s/colour/color/;
$v =~ s/^(['"]?)(.*)\1$/$2/;
$i->{$k} = $v;
}
else {
warn("Unknown font property: $k (ignored)\n");
}
}
# Break out size.
if ( $v =~ /(.*?)(?:\s+(\d+(?:\.\d+)?))?\s*(?:;|$)/ ) {
$i->{size} //= $2 if $2;
$v = $1;
}
# Check for filename.
if ( $v =~ /^.*\.(ttf|otf)$/i ) {
$i->{file} = $v;
}
# Check for corefonts.
elsif ( is_corefont($v) ) {
$i->{name} = is_corefont($v);
}
else {
$i->{description} = $v;
$i->{description} .= " " . delete($i->{size})
if $i->{size};
}
$_ = $i;
}
}
}
use Storable qw(dclone);
# Split fontconfig aliases into separate entries.
sub split_fc_aliases ( $cfg ) {
if ( $cfg->{pdf}->{fontconfig} ) {
# Orig.
my $fc = $cfg->{pdf}->{fontconfig};
# Since we're going to delete/insert keys, we need a copy.
my %fc = %$fc;
while ( my($k,$v) = each(%fc) ) {
# Split on comma.
my @k = split( /\s*,\s*/, $k );
if ( @k > 1 ) {
# We have aliases. Delete the original.
delete( $fc->{$k} );
# And insert individual entries.
$fc->{$_} = dclone($v) for @k;
}
}
}
}
# Reverse of config_expand_font_shortcuts.
sub simplify_fonts( $cfg ) {
return $cfg unless $cfg->{pdf}->{fonts};
foreach my $font ( keys %{$cfg->{pdf}->{fonts}} ) {
for ( $cfg->{pdf}->{fonts}->{$font} ) {
next unless is_hashref($_);
delete $_->{color}
if $_->{color} && $_->{color} eq "foreground";
delete $_->{background}
if $_->{background} && $_->{background} eq "background";
if ( exists( $_->{file} ) ) {
delete $_->{description};
delete $_->{name};
}
elsif ( exists( $_->{description} ) ) {
delete $_->{name};
if ( $_->{size} && $_->{description} !~ /\s+[\d.]+$/ ) {
$_->{description} .= " " . $_->{size};
}
delete $_->{size};
$_ = $_->{description} if keys %$_ == 1;
}
elsif ( exists( $_->{name} )
&& exists( $_->{size})
&& keys %$_ == 2
) {
$_ = $_->{name} .= " " . $_->{size};
}
}
}
}
sub migrate_songbook_pagectrl( $self, $ps = undef ) {
# Migrate old to new.
$ps //= $self->{pdf};
my $sb = $ps->{songbook} // {};
for ( qw( front-matter back-matter ) ) {
$sb->{$_} = delete($ps->{$_}) if $ps->{$_};
}
for ( $ps->{'even-odd-pages'} ) {
next unless defined;
$sb->{'dual-pages'} = !!$_;
$sb->{'align-songs-spread'} = 1 if $_ < 0;
}
for ( $ps->{'pagealign-songs'} ) {
next unless defined;
$sb->{'align-songs'} = !!$_;
$sb->{'align-songs-extend'} = $_ > 1;
}
for ( $ps->{'sort-pages'} ) {
next unless defined;
my $a = $_;
$a =~ s/\s+//g;
my ( $sort, $desc, $spread, $compact );
$sort = $desc = "";
for ( split( /,/, lc $a ) ) {
if ( $_ eq "title" ) {
$sort = "title";
}
elsif ( $_ eq "subtitle" ) {
$sort //= "subtitle";
}
elsif ( $_ eq "2page" ) {
$spread++;
}
elsif ( $_ eq "desc" ) {
$desc = "-";
}
elsif ( $_ eq "compact" ) {
$compact++;
}
else {
warn("??? \"$_\"\n");
}
}
$sb->{'sort-songs'} = "${desc}${sort}";
$sb->{'compact-songs'} = 1 if $compact;
$sb->{'align-songs-spread'} = 1 if $spread;
}
$ps->{songbook} = $sb;
# Remove the obsoleted entries.
delete( $ps->{$_} )
for qw( even-odd-pages sort-pages pagealign-songs );
}
sub config_final ( %args ) {
my $delta = $args{delta} || 0;
my $default = $args{default} || 0;
$options->{'cfg-print'} = 1;
my $defcfg; # pristine config
my $cfg; # actual config
if ( $default || $delta ) {
local $options->{nosysconfig} = 1;
local $options->{nouserconfig} = 1;
local $options->{noconfig} = 1;
$defcfg = pristine_config();
split_fc_aliases($defcfg);
expand_font_shortcuts($defcfg);
if ( $delta ) {
delete $defcfg->{chords};
delete $defcfg->{include};
}
bless $defcfg => __PACKAGE__;
$cfg = $defcfg if $default;
}
$cfg //= configurator($options);
# Remove unwanted data.
$cfg->unlock;
$cfg->{tuning} = delete $cfg->{_tuning};
if ( $delta ) {
for ( qw( tuning ) ) {
delete($cfg->{$_}) unless defined($cfg->{$_});
}
for my $f ( keys( %{$cfg->{pdf}{fonts}} ) ) {
for ( qw( background color ) ) {
next if defined($defcfg->{pdf}{fonts}{$f}{$_});
delete($cfg->{pdf}{fonts}{$f}{$_});
delete($defcfg->{pdf}{fonts}{$f}{$_});
}
}
}
delete $cfg->{_chords};
delete $cfg->{chords};
delete $cfg->{_src};
my $parser = JSON::Relaxed::Parser->new( key_order => 1 );
# 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
( run in 1.686 second using v1.01-cache-2.11-cpan-d8267643d1d )