view release on metacpan or  search on metacpan

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

#!/usr/bin/perl

package main;

our $options;
our $config;

package ChordPro::Songbook;

use strict;
use warnings;
use feature 'state';

use ChordPro;
use ChordPro::Config;
use ChordPro::Files;
use ChordPro::Song;
use ChordPro::Utils qw(progress);

use Carp;
use List::Util qw(any);
use Storable qw(dclone);
use Ref::Util qw(is_arrayref is_plain_hashref);
use MIME::Base64;

my $regtest = defined($ENV{PERL_HASH_SEED}) && $ENV{PERL_HASH_SEED} == 0;

sub new {
    my ($pkg) = @_;
    bless { songs => [ ] }, $pkg;
}

sub parse_file {
    my ( $self, $filename, $opts ) = @_;
    $opts //= {};
    my $meta = { %{$config->{meta}}, %{delete $opts->{meta}//{}} };
    my $defs = { %{delete $opts->{defs}//{}} };

    # Check for PDF embedding.
    if ( $filename =~ /\.pdf$/i ) {
	return $self->embed_file( $filename, $meta, $defs );
    }

    # fs_load sets $opts->{_filesource}.
    $opts->{fail} = "soft";
    my $lines = is_arrayref($filename) ? $filename
      : fs_load( $filename, $opts );
    die( $filename, ": ", $opts->{error}, "\n" ) if $opts->{error};

    # Sense crd input and convert if necessary.
    if ( !(defined($options->{a2crd}) && !$options->{a2crd}) and
	 !$options->{fragment}
	 and any { /\S/ } @$lines	# non-blank lines
	 and $options->{crd} || !any { /^{\s*\w+/ } @$lines ) {
	warn("Converting $filename to ChordPro format\n")
	  if $options->{verbose} || !($options->{a2crd}||$options->{crd});
	require ChordPro::A2Crd;
	$lines = ChordPro::A2Crd::a2crd( { lines => $lines } );
    }

    $opts //= {};

    for ( "transpose", "transcode" ) {
	next unless exists $opts->{$_};
	$config->{settings}->{$_} = $opts->{$_};
    }
    for ( "no-substitute", "no-transpose" ) {
	next unless exists $opts->{$_};
	$options->{$_} = $opts->{$_};
    }
    bless $config => ChordPro::Config:: if is_plain_hashref($config);

    my $linecnt = 0;
    my $songs = 0;

    while ( @$lines ) {
	my $song = ChordPro::Song->new($opts)
	  ->parse_song( $lines, \$linecnt,
			{ %{dclone($meta)},
			  "bookmark"   => $opts->{bookmark} //= sprintf( "song_%d", 1 + @{ $self->{songs} } ),
			},
			{ %$defs } );