view release on metacpan or  search on metacpan

lib/Data/iRealPro/Input/MusicXML.pm  view on Meta::CPAN

#! perl

use warnings;
use strict;
use Carp qw( carp croak );
use utf8;

package Data::iRealPro::Input::MusicXML;

use XML::LibXML;
#use DDumper;
use Encode qw( decode_utf8 encode_utf8 );

sub encode {
    my ( $self, $xml ) = @_;
    $self->{transpose} //= 0;
    my $parser = XML::LibXML->new;
    my $opts = { no_cdata => 1 };
    if ( $self->{catalog} && -r  $self->{catalog} ) {
	$parser->load_catalog( $self->{catalog} );
    }
    else {
	$opts->{load_ext_dtd} = 0;
    }
    $parser->set_options( $opts );
    my $data = $parser->load_xml( string => $xml );

    # <score-partwise>
    #   <work>
    #      <work-title>Yellow Dog Blues</work-title>
    #   </work>
    #   <movement-title>Yellow Dog Blues</movement-title>
    #   <identification>
    #     <encoding>
    #        <software>MuseScore 2.0.3</software>
    #        ...
    #     </encoding>
    #   </identification>
    #   <defaults ... />
    #   <credit page="1" ... />
    #   <credit page="1" ... />
    #   <part-list>
    #      <score-part id="P1" ... />
    #   </part-list>
    #   <part id="P1" ... />
    # </score-partwise>

    # print DDumper($data);

    $self = bless { %$self }, __PACKAGE__;
#    $self->{debug} = 1;		# ####
    my $root = "/score-partwise";
    my $rootnode = $data->findnodes($root)->[0];

    my $song = { title => 'NoName',
		 composer => 'NoBody',
		 tempo => 100,
		 index => $self->{songix},
		 parts => [] };

    if ( my $d = $rootnode->fn1('movement-title') ) {
	$song->{title} = $song->{'movement-title'} = $d->to_literal;
	warn( "Title: ", decode_utf8($song->{title}), "\n" )
	  if $self->{debug};
    }
    if ( my $d = $rootnode->fn1('work/work-title') ) {
	$song->{title} = $song->{'work-title'} = $d->to_literal;
	warn( "Title: ", decode_utf8($song->{title}), "\n" )
	  if $self->{debug};
    }

    if ( my $d = $rootnode->fn1('identification/creator[@type=\'composer\']') ) {
	$song->{composer} = $d->to_literal;
	warn( "Composer: ", decode_utf8($song->{composer}), "\n" )
	  if $self->{debug};
    }

    if ( my $d = $rootnode->fn1('identification/encoding/software') ) {