view release on metacpan or  search on metacpan

lib/ChordPro/Output/Common.pm  view on Meta::CPAN

#! perl

package main;

our $config;
our $options;

package ChordPro::Output::Common;

use strict;
use warnings;
use feature qw( state );
use ChordPro::Chords;
use ChordPro::Utils qw( demarkup is_true plural );
use String::Interpolate::Named;
use utf8;
use POSIX qw(setlocale LC_TIME strftime);
use Ref::Util qw( is_arrayref );
use File::LoadLines ();
use Encode qw( encode_utf8 );

use Exporter 'import';
our @EXPORT;
our @EXPORT_OK;

sub fmt_subst {
    my ( $s, $t ) = @_;
    my $res = "";
    my $m = { %{$s->{meta} || {} } };

    $m->{tuning} //= [ join(" ", ChordPro::Chords::get_tuning) ];
    # If config->{instrument} is missing, or null, the program abends with
    # Modification of a read-only value attempted.
    if ( $config->{instrument} ) {
	$m->{instrument} = [ $config->{instrument}->{type} ];
	$m->{"instrument.type"} = [ $config->{instrument}->{type} ];
	$m->{"instrument.description"} = [ $config->{instrument}->{description} ];
    }
    # Same here.
    if ( $config->{user} ) {
	$m->{user} = [ $config->{user}->{name} ];
	$m->{"user.name"} = [ $config->{user}->{name} ];
	$m->{"user.fullname"} = [ $config->{user}->{fullname} ];
    }
    setlocale( LC_TIME, "" );
    $m->{today} //= strftime( $config->{dates}->{today}->{format},
			      localtime(time) );
    $m->{chordpro} = "ChordPro";
    $m->{"chordpro.version"} = $ChordPro::VERSION;
    for ( keys %{ $config->{settings} } ) {
	my $v = $config->{settings}->{$_};
	$v = '' if $v =~ /^(0|false|off)$/i;
	$v = 1  if $v=~ /^(true|on)$/i;
	$m->{"settings.$_"} = $v;
    }

    # Legacy.
    $m->{key_actual} = $m->{key_sound} // [];
    # Modern.
    $m->{'key.print'} = $m->{key_print} // [];
    $m->{'key.sound'} = $m->{key_sound} // [];

    interpolate( { %$s, args => $m,
		   separator => $config->{metadata}->{separator} },
		 $t );
}
push( @EXPORT, 'fmt_subst' );

# Roman - functions for converting between Roman and Arabic numerals
# 
# Stolen from Roman Version 1.24 by OZAWA Sakuro <ozawa at aisoft.co.jp>
# 1995-1997 and Alexandr Ciornii, C<< <alexchorny at gmail.com> >> 2007
# 
# Copyright (c) 1995 OZAWA Sakuro.  All rights reserved.  This program
# is free software; you can redistribute it and/or modify it under the
# same terms as Perl itself.

our %roman2arabic = qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);