| File: | blib/lib/Music/NWC2MusicXML.pm |
| Coverage: | 90.0% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Music::NWC2MusicXML; | |||||
| 2 | ||||||
| 3 | 6 6 6 | 385683 3 34 | use strict; | |||
| 4 | 6 6 6 | 4 4 88 | use warnings; | |||
| 5 | 6 6 6 | 284 10447 10 | use autodie qw(:all); | |||
| 6 | ||||||
| 7 | our $VERSION = '0.001.1'; | |||||
| 8 | ||||||
| 9 | 6 6 6 | 17856 4 81 | use Carp qw(croak carp); | |||
| 10 | 6 6 6 | 145 995 57 | use Readonly; | |||
| 11 | 6 6 6 | 5 3 25 | use File::Spec (); | |||
| 12 | 6 6 6 | 6 1 98 | use File::Basename qw(basename dirname); | |||
| 13 | 6 6 6 | 8 4 56 | use File::Path qw(make_path); | |||
| 14 | 6 6 6 | 1061 199689 77 | use Object::Configure; | |||
| 15 | 6 6 6 | 13 2 82 | use Params::Validate::Strict qw(validate_strict); | |||
| 16 | 6 6 6 | 7 3 46 | use Params::Get; | |||
| 17 | 6 6 6 | 867 11 53 | use Music::NWC2MusicXML::NWC; | |||
| 18 | 6 6 6 | 884 8 68 | use Music::NWC2MusicXML::Parser; | |||
| 19 | 6 6 6 | 1241 6 93 | use Music::NWC2MusicXML::MusicXML; | |||
| 20 | 6 6 6 | 841 6 2963 | use Music::NWC2MusicXML::Diagnostics; | |||
| 21 | ||||||
| 22 | # --------------------------------------------------------------------------- | |||||
| 23 | # Exit codes (also exported for use by the CLI script) | |||||
| 24 | # --------------------------------------------------------------------------- | |||||
| 25 | Readonly::Scalar our $EXIT_OK => 0; | |||||
| 26 | Readonly::Scalar our $EXIT_WARNINGS => 1; | |||||
| 27 | Readonly::Scalar our $EXIT_BAD_INPUT => 2; | |||||
| 28 | Readonly::Scalar our $EXIT_OUTPUT => 3; | |||||
| 29 | Readonly::Scalar our $EXIT_INTERNAL => 4; | |||||
| 30 | ||||||
| 31 | # Default output extension for uncompressed MusicXML | |||||
| 32 | Readonly::Scalar my $OUTPUT_EXT => '.musicxml'; | |||||
| 33 | ||||||
| 34 | # Maximum single-file decompressed size (forwarded to NWC decoder) | |||||
| 35 | Readonly::Scalar my $INPUT_EXT => '.nwc'; | |||||
| 36 | ||||||
| 37 | Readonly::Hash my %MESSAGES => ( | |||||
| 38 | error_no_input => 'No input file or data specified', | |||||
| 39 | error_no_output => 'No output path could be determined', | |||||
| 40 | error_file_not_found => 'Input file not found: %s', | |||||
| 41 | error_decode => 'NWC decoding failed for %s: %s', | |||||
| 42 | error_parse => 'NWCTXT parsing failed for %s: %s', | |||||
| 43 | error_generate => 'MusicXML generation failed for %s: %s', | |||||
| 44 | error_write => 'Cannot write output %s: %s', | |||||
| 45 | error_mkdir => 'Cannot create output directory %s: %s', | |||||
| 46 | error_traversal => 'Path traversal rejected: %s is outside base_dir %s', | |||||
| 47 | error_internal => 'Internal error: %s', | |||||
| 48 | info_converting => 'Converting: %s -> %s', | |||||
| 49 | info_done => 'Done: %s', | |||||
| 50 | info_skipped => 'Skipped (output exists, --overwrite not set): %s', | |||||
| 51 | ); | |||||
| 52 | ||||||
| 53 - 111 | =head1 NAME
Music::NWC2MusicXML - Convert NoteWorthy Composer 2 C<.nwc> score files to MusicXML.
=head1 VERSION
0.001.1
=head1 SYNOPSIS
# Simple conversion
use Music::NWC2MusicXML;
my $converter = Music::NWC2MusicXML->new;
$converter->convert(
input => 'Pilgrim.nwc',
output => 'Pilgrim.musicxml',
);
# Batch conversion
$converter->batch_convert(
inputs => [ glob('*.nwc') ],
output_dir => 'musicxml',
overwrite => 1,
);
=head1 DESCRIPTION
C<Music::NWC2MusicXML> is the top-level facade for the NWC-to-MusicXML conversion
pipeline. It coordinates three independent stages:
=over 4
=item 1. B<NWC binary decoding> (C<Music::NWC2MusicXML::NWC>) -- reads the C<.nwc>
binary container, verifies the magic signature, decompresses the zlib payload,
and extracts the NWCTXT text representation.
=item 2. B<NWCTXT parsing> (C<Music::NWC2MusicXML::Parser>) -- parses the NWCTXT into
an internal representation (C<Music::NWC2MusicXML::Score>).
=item 3. B<MusicXML generation> (C<Music::NWC2MusicXML::MusicXML>) -- serialises the
internal representation to a well-formed UTF-8 MusicXML document.
=back
Each stage is independently testable. The facade wires them together,
handles batch processing, and routes all diagnostics through a single
C<Music::NWC2MusicXML::Diagnostics> instance.
=head1 PRESERVATION PRINCIPLE
The guiding principle of the conversion is:
I<Preserve musical meaning rather than graphical appearance.>
Priority order: notes and rhythm > voices > measures > articulations >
dynamics > lyrics > structural markings > instrument info > graphical layout.
=cut | |||||
| 112 | ||||||
| 113 | # --------------------------------------------------------------------------- | |||||
| 114 | # new | |||||
| 115 | # --------------------------------------------------------------------------- | |||||
| 116 | ||||||
| 117 - 165 | =head2 new Construct a converter. =head3 Purpose Creates a configured converter instance that can be reused for multiple conversions without reconstructing the pipeline components each time. =head3 Arguments Named parameters: =over 4 =item C<log_level> -- C<quiet>, C<normal> (default), C<verbose>, C<debug>. =item C<warnings_fh> -- filehandle for warning output (optional; defaults to STDERR in the C<Diagnostics> object). =item C<validate> -- perform extended consistency checks (boolean, default 0). =back =head3 Returns Blessed C<Music::NWC2MusicXML> object. =head3 Usage Example my $c = Music::NWC2MusicXML->new(log_level => 'verbose', validate => 1); =head3 API SPECIFICATION =head4 Input log_level : SCALAR (optional, default 'normal') warnings_fh : (filehandle, optional) validate : SCALAR (optional, default 0) =head4 Output Music::NWC2MusicXML object =head3 MESSAGES None. =cut | |||||
| 166 | ||||||
| 167 | sub new { | |||||
| 168 | 44 | 292615 | my $class = shift; | |||
| 169 | 44 | 151 | my $input = Params::Get::get_params(undef, \@_) // {}; | |||
| 170 | 44 | 678 | my $warnings_fh = delete $input->{warnings_fh}; # must be extracted before validate_strict (no glob type) | |||
| 171 | 44 | 202 | my $args = validate_strict( | |||
| 172 | input => $input, | |||||
| 173 | schema => { | |||||
| 174 | log_level => { type => 'scalar', optional => 1, default => 'normal' }, | |||||
| 175 | validate => { type => 'scalar', optional => 1, default => 0 }, | |||||
| 176 | }, | |||||
| 177 | ); | |||||
| 178 | 44 | 2769 | croak $@ unless defined $args; | |||
| 179 | ||||||
| 180 | 44 | 108 | $args = Object::Configure::configure($class, $args); | |||
| 181 | ||||||
| 182 | my $diag = Music::NWC2MusicXML::Diagnostics->new( | |||||
| 183 | level => $args->{log_level}, | |||||
| 184 | 44 | 153681 | (defined $warnings_fh ? (warnings_fh => $warnings_fh) : ()), | |||
| 185 | ); | |||||
| 186 | ||||||
| 187 | return bless { | |||||
| 188 | _diagnostics => $diag, | |||||
| 189 | _validate => $args->{validate}, | |||||
| 190 | 44 | 157 | _decoder => Music::NWC2MusicXML::NWC->new(diagnostics => $diag), | |||
| 191 | _parser => Music::NWC2MusicXML::Parser->new(diagnostics => $diag), | |||||
| 192 | _generator => Music::NWC2MusicXML::MusicXML->new(diagnostics => $diag), | |||||
| 193 | }, $class; | |||||
| 194 | } | |||||
| 195 | ||||||
| 196 | # --------------------------------------------------------------------------- | |||||
| 197 | # Public: convert | |||||
| 198 | # --------------------------------------------------------------------------- | |||||
| 199 | ||||||
| 200 - 262 | =head2 convert Convert a single C<.nwc> file to MusicXML. =head3 Purpose Main single-file conversion entry point. Chains decoder -> parser -> generator, writes the output file, and updates the internal diagnostic counters. =head3 Arguments Named parameters: =over 4 =item C<input> -- path to the C<.nwc> input file (required). =item C<output> -- path for the C<.musicxml> output file (optional). Defaults to the input path with the extension replaced by C<.musicxml>. =item C<overwrite> -- if false (default), skip conversion when the output file already exists. =back =head3 Returns Scalar string -- the output file path if conversion succeeded, or undef on failure. =head3 Side Effects Writes the output file. Updates diagnostic counters. Croaks on fatal errors; non-fatal issues are issued as warnings. =head3 Usage Example my $out = $c->convert(input => 'Pilgrim.nwc', overwrite => 1); =head3 API SPECIFICATION =head4 Input input : SCALAR (path, required) output : SCALAR (path, optional) overwrite : boolean (optional, default false) =head4 Output SCALAR (output path) or undef =head3 MESSAGES | Code | Meaning | Resolution | |--------------------|--------------------------------------|-------------------------------| | error_no_input | C<input> parameter missing | Provide input path | | error_file_not_found| Input file does not exist | Check path | | error_decode | NWC decoding stage failed | See error detail | | error_parse | NWCTXT parsing stage failed | See error detail | | error_generate | MusicXML generation failed | See error detail | | error_write | Cannot write output file | Check permissions / disk space| =cut | |||||
| 263 | ||||||
| 264 | sub convert { | |||||
| 265 | 57 | 1003957 | my ($self, %input) = @_; | |||
| 266 | 57 | 180 | my $args = validate_strict( | |||
| 267 | schema => { | |||||
| 268 | input => { type => 'scalar' }, | |||||
| 269 | output => { type => 'scalar', optional => 1 }, | |||||
| 270 | overwrite => { type => 'boolean', optional => 1, default => 0 }, | |||||
| 271 | }, | |||||
| 272 | input => \%input, | |||||
| 273 | ); | |||||
| 274 | 57 | 3926 | croak $@ unless defined $args; | |||
| 275 | ||||||
| 276 | 57 | 45 | my $in = $args->{input}; | |||
| 277 | 57 | 78 | my $output = $args->{output} // _default_output($in); | |||
| 278 | 57 | 58 | my $diag = $self->{_diagnostics}; | |||
| 279 | ||||||
| 280 | 57 | 258 | croak _fmt_msg('error_file_not_found', $in) | |||
| 281 | unless -f $in; | |||||
| 282 | ||||||
| 283 | 41 | 99 | if (!$args->{overwrite} && -f $output) { | |||
| 284 | 3 | 8 | $diag->verbose(_fmt_msg('info_skipped', $output)); | |||
| 285 | 3 | 8 | return $output; | |||
| 286 | } | |||||
| 287 | ||||||
| 288 | 38 | 75 | $diag->count(outcome => 'processed'); | |||
| 289 | 38 | 60 | $diag->info(_fmt_msg('info_converting', $in, $output)); | |||
| 290 | ||||||
| 291 | 38 | 77 | return $self->_single_convert($in, $output); | |||
| 292 | } | |||||
| 293 | ||||||
| 294 | # --------------------------------------------------------------------------- | |||||
| 295 | # Public: batch_convert | |||||
| 296 | # --------------------------------------------------------------------------- | |||||
| 297 | ||||||
| 298 - 362 | =head2 batch_convert
Convert multiple C<.nwc> files, optionally into a separate output directory.
=head3 Purpose
Processes a list of input files in sequence. Failures on individual files
are caught and counted; conversion continues with remaining files.
A summary is printed at the end.
=head3 Arguments
Named parameters:
=over 4
=item C<inputs> -- arrayref of input file paths (required).
=item C<output_dir> -- directory for output files (optional; defaults to each
file's own directory).
=item C<overwrite> -- overwrite existing output files (boolean, default 0).
=item C<recursive> -- preserve relative directory structure under
C<output_dir> (boolean, default 0).
=item C<base_dir> -- base directory stripped when computing relative paths
for recursive mode (optional).
=back
=head3 Returns
Hashref: C<< { processed => N, successful => N, warnings => N, failed => N } >>.
=head3 Side Effects
Writes output files. Prints a summary to STDERR.
Does not croak on per-file failures.
=head3 Usage Example
$c->batch_convert(
inputs => [ glob('scores/**/*.nwc') ],
output_dir => 'musicxml',
recursive => 1,
base_dir => 'scores',
overwrite => 1,
);
=head3 API SPECIFICATION
=head4 Input
inputs : ARRAYREF of SCALAR paths (required)
output_dir : SCALAR (optional)
overwrite : SCALAR bool (optional, default 0)
recursive : SCALAR bool (optional, default 0)
base_dir : SCALAR (optional)
=head4 Output
HASHREF { processed:int, successful:int, warnings:int, failed:int }
=cut | |||||
| 363 | ||||||
| 364 | sub batch_convert { | |||||
| 365 | 16 | 1122 | my ($self, %input) = @_; | |||
| 366 | 16 | 80 | my $args = validate_strict( | |||
| 367 | schema => { | |||||
| 368 | inputs => { | |||||
| 369 | type => 'arrayref', | |||||
| 370 | element_type => 'string' | |||||
| 371 | }, | |||||
| 372 | output_dir => { type => 'string', optional => 1 }, | |||||
| 373 | overwrite => { type => 'boolean', optional => 1, default => 0 }, | |||||
| 374 | recursive => { type => 'boolean', optional => 1, default => 0 }, | |||||
| 375 | base_dir => { type => 'string', optional => 1 }, | |||||
| 376 | }, | |||||
| 377 | input => \%input, | |||||
| 378 | ); | |||||
| 379 | 16 | 1717 | croak $@ unless defined $args; | |||
| 380 | ||||||
| 381 | 16 | 15 | my $diag = $self->{_diagnostics}; | |||
| 382 | 16 | 12 | my @results; | |||
| 383 | 16 | 27 | my %counts = (processed => 0, successful => 0, warnings => 0, failed => 0); | |||
| 384 | ||||||
| 385 | 16 16 | 10 17 | for my $file (@{ $args->{inputs} }) { | |||
| 386 | 25 | 20 | $counts{processed}++; | |||
| 387 | ||||||
| 388 | # A per-file failure must not abort the batch. | |||||
| 389 | # Output-path computation is inside the eval so traversal errors | |||||
| 390 | # are caught per-file rather than aborting the whole batch. | |||||
| 391 | 25 | 13 | my $output; | |||
| 392 | 25 | 13 | my $ok = eval { | |||
| 393 | $output = $self->_batch_output_path( | |||||
| 394 | input => $file, | |||||
| 395 | output_dir => $args->{output_dir}, | |||||
| 396 | recursive => $args->{recursive}, | |||||
| 397 | base_dir => $args->{base_dir}, | |||||
| 398 | 25 | 79 | ); | |||
| 399 | $self->convert( | |||||
| 400 | input => $file, | |||||
| 401 | output => $output, | |||||
| 402 | overwrite => $args->{overwrite}, | |||||
| 403 | 24 | 50 | ); | |||
| 404 | }; | |||||
| 405 | ||||||
| 406 | 25 | 837 | if ($@ || !defined $ok) { | |||
| 407 | 10 | 20 | $diag->info(_fmt_msg('info_done', "FAILED: $file -- $@")) if $@; | |||
| 408 | 10 | 19 | $diag->count(outcome => 'failed'); | |||
| 409 | 10 | 10 | $counts{failed}++; | |||
| 410 | } else { | |||||
| 411 | 15 | 19 | $diag->count(outcome => 'successful'); | |||
| 412 | 15 | 23 | $counts{successful}++; | |||
| 413 | } | |||||
| 414 | ||||||
| 415 | 25 | 56 | push @results, { input => $file, output => $output, ok => !!$ok }; | |||
| 416 | } | |||||
| 417 | ||||||
| 418 | 16 16 | 15 31 | $counts{warnings} = scalar @{ $diag->warnings }; | |||
| 419 | ||||||
| 420 | 16 | 32 | $diag->summary; | |||
| 421 | ||||||
| 422 | 16 | 81 | return { %counts, results => \@results }; | |||
| 423 | } | |||||
| 424 | ||||||
| 425 - 429 | =head2 diagnostics Return the C<Music::NWC2MusicXML::Diagnostics> instance. =cut | |||||
| 430 | ||||||
| 431 | 0 | 0 | sub diagnostics { return $_[0]->{_diagnostics} } | |||
| 432 | ||||||
| 433 | # --------------------------------------------------------------------------- | |||||
| 434 | # Private helpers | |||||
| 435 | # --------------------------------------------------------------------------- | |||||
| 436 | ||||||
| 437 | sub _single_convert { | |||||
| 438 | 38 | 46 | my ($self, $input, $output) = @_; | |||
| 439 | 38 | 28 | my $diag = $self->{_diagnostics}; | |||
| 440 | ||||||
| 441 | # Stage 1: Decode binary NWC -> NWCTXT | |||||
| 442 | 38 38 | 28 71 | my $nwctxt = eval { $self->{_decoder}->read($input) }; | |||
| 443 | 38 | 884 | if ($@) { | |||
| 444 | 7 | 10 | carp _fmt_msg('error_decode', $input, $@); | |||
| 445 | 7 | 614 | $diag->count(outcome => 'failed'); | |||
| 446 | 7 | 17 | return undef; | |||
| 447 | } | |||||
| 448 | ||||||
| 449 | # Stage 2: Parse NWCTXT -> IR | |||||
| 450 | 31 31 | 24 71 | my $score = eval { $self->{_parser}->parse($nwctxt) }; | |||
| 451 | 31 | 116 | if ($@) { | |||
| 452 | 0 | 0 | carp _fmt_msg('error_parse', $input, $@); | |||
| 453 | 0 | 0 | $diag->count(outcome => 'failed'); | |||
| 454 | 0 | 0 | return undef; | |||
| 455 | } | |||||
| 456 | ||||||
| 457 | # Optional: extended validation | |||||
| 458 | 31 | 212 | if ($self->{_validate}) { | |||
| 459 | 1 | 3 | my $issues = $score->validate; | |||
| 460 | 1 | 2 | for my $issue (@$issues) { | |||
| 461 | 0 | 0 | carp $issue; | |||
| 462 | } | |||||
| 463 | } | |||||
| 464 | ||||||
| 465 | # Stage 3: Generate MusicXML | |||||
| 466 | 31 31 | 82 105 | my $xml = eval { $self->{_generator}->generate($score) }; | |||
| 467 | 31 | 172 | if ($@) { | |||
| 468 | 1 | 1 | carp _fmt_msg('error_generate', $input, $@); | |||
| 469 | 1 | 69 | $diag->count(outcome => 'failed'); | |||
| 470 | 1 | 2 | return undef; | |||
| 471 | } | |||||
| 472 | ||||||
| 473 | # Write output | |||||
| 474 | 30 30 | 34 87 | eval { $self->_write_output($output, $xml, $input) }; | |||
| 475 | 30 | 61 | if ($@) { | |||
| 476 | 0 | 0 | carp _fmt_msg('error_write', $output, $@); | |||
| 477 | 0 | 0 | $diag->count(outcome => 'failed'); | |||
| 478 | 0 | 0 | return undef; | |||
| 479 | } | |||||
| 480 | ||||||
| 481 | 30 | 63 | $diag->info(_fmt_msg('info_done', $output)); | |||
| 482 | 30 | 95 | $diag->count(outcome => 'successful'); | |||
| 483 | 30 | 125 | return $output; | |||
| 484 | } | |||||
| 485 | ||||||
| 486 | sub _write_output { | |||||
| 487 | 30 | 56 | my ($self, $output, $xml, $source) = @_; | |||
| 488 | ||||||
| 489 | # Ensure parent directory exists. make_path is idempotent (no error if dir | |||||
| 490 | # already exists), so no -d pre-check is needed and the TOCTOU race is closed. | |||||
| 491 | 30 | 1071 | my $dir = dirname($output); | |||
| 492 | 30 30 | 24 1526 | eval { make_path($dir) }; | |||
| 493 | 30 | 46 | croak _fmt_msg('error_mkdir', $dir, $@) if $@; | |||
| 494 | ||||||
| 495 | 30 | 87 | open my $fh, '>:encoding(UTF-8)', $output | |||
| 496 | or croak _fmt_msg('error_write', $output, $!); | |||||
| 497 | 30 | 120763 | print $fh $xml; | |||
| 498 | 30 | 106 | close $fh; | |||
| 499 | ||||||
| 500 | 30 | 2829 | return; | |||
| 501 | } | |||||
| 502 | ||||||
| 503 | sub _default_output { | |||||
| 504 | 13 | 9 | my ($input) = @_; | |||
| 505 | 13 | 90 | (my $base = $input) =~ s/\Q$INPUT_EXT\E\z//i; | |||
| 506 | 13 | 72 | return $base . $OUTPUT_EXT; | |||
| 507 | } | |||||
| 508 | ||||||
| 509 | sub _batch_output_path { | |||||
| 510 | 25 | 46 | my ($self, %input) = @_; | |||
| 511 | 25 | 79 | my $args = validate_strict( | |||
| 512 | schema => { | |||||
| 513 | input => { type => 'scalar' }, | |||||
| 514 | output_dir => { type => 'scalar', optional => 1 }, | |||||
| 515 | recursive => { type => 'scalar', optional => 1, default => 0 }, | |||||
| 516 | base_dir => { type => 'scalar', optional => 1 }, | |||||
| 517 | }, | |||||
| 518 | input => \%input, | |||||
| 519 | ); | |||||
| 520 | 25 | 2128 | croak $@ unless defined $args; | |||
| 521 | ||||||
| 522 | 25 | 382 | my $out_name = basename($args->{input}); | |||
| 523 | 25 | 98 | $out_name =~ s/\Q$INPUT_EXT\E\z//i; | |||
| 524 | 25 | 24 | $out_name .= $OUTPUT_EXT; | |||
| 525 | ||||||
| 526 | 25 | 28 | unless (defined $args->{output_dir}) { | |||
| 527 | 0 | 0 | return File::Spec->catfile(dirname($args->{input}), $out_name); | |||
| 528 | } | |||||
| 529 | ||||||
| 530 | 25 | 45 | if ($args->{recursive} && defined $args->{base_dir}) { | |||
| 531 | # Compute relative path from base_dir to preserve directory structure | |||||
| 532 | 3 | 172 | my $rel = File::Spec->abs2rel(dirname($args->{input}), $args->{base_dir}); | |||
| 533 | # Guard: any '..' component means the input sits outside base_dir; | |||||
| 534 | # writing there would escape output_dir (path traversal). | |||||
| 535 | croak _fmt_msg('error_traversal', $args->{input}, $args->{base_dir}) | |||||
| 536 | 3 11 | 8 9 | if grep { $_ eq '..' } File::Spec->splitdir($rel); | |||
| 537 | 2 | 10 | return File::Spec->catfile($args->{output_dir}, $rel, $out_name); | |||
| 538 | } | |||||
| 539 | ||||||
| 540 | 22 | 117 | return File::Spec->catfile($args->{output_dir}, $out_name); | |||
| 541 | } | |||||
| 542 | ||||||
| 543 | sub _fmt_msg { | |||||
| 544 | 102 | 116 | my ($key, @args) = @_; | |||
| 545 | 102 | 182 | croak "Unknown message key: $key" unless exists $MESSAGES{$key}; | |||
| 546 | 102 | 409 | return sprintf $MESSAGES{$key}, @args; | |||
| 547 | } | |||||
| 548 | ||||||
| 549 | 1; | |||||
| 550 | ||||||