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 )