File Coverage

File:blib/lib/Music/NWC2MusicXML.pm
Coverage:90.6%

linestmtbrancondsubtimecode
1package Music::NWC2MusicXML;
2
3
6
6
6
380457
3
29
use strict;
4
6
6
6
4
3
77
use warnings;
5
6
6
6
375
10008
13
use autodie qw(:all);
6
7
6
6
6
17218
1352
12
use version; our $VERSION = version->declare('0.002.4');
8
9# ---------------------------------------------------------------------------
10# Post-release roadmap
11# ---------------------------------------------------------------------------
12# TODO: emit <time-modification>/<tuplet> for triplet and other tuplet groups
13#       (durations are stored as correct rationals; only the notation element is missing)
14# TODO: read custom page dimensions from PgSetup (Width/Height) instead of
15#       assuming A4 (210 x 297 mm) in _compute_page_layout
16# TODO: multi-voice staves -- split simultaneous RestChord streams into
17#       MusicXML voice 2+ with independent stem directions
18# TODO: verify lyrics end-to-end against a golden NWC file that contains
19#       Lyric records (_annotate_lyrics and emission code both exist)
20# TODO: verify FlowControl round-trip against a golden NWC file that contains
21#       Coda/Segno/DaCapo marks (_emit_flow_control is wired but untested)
22# TODO: fill Z calculus placeholders in FORMAL SPECIFICATION POD sections
23# ---------------------------------------------------------------------------
24
25
6
6
6
182
4
85
use Carp qw(croak carp);
26
6
6
6
159
888
62
use Readonly;
27
6
6
6
5
3
34
use File::Spec ();
28
6
6
6
8
5
111
use File::Basename qw(basename dirname);
29
6
6
6
5
3
62
use File::Path qw(make_path);
30
6
6
6
1192
232593
72
use Object::Configure;
31
6
6
6
18
3
85
use Params::Validate::Strict qw(validate_strict);
32
6
6
6
5
3
44
use Params::Get;
33
6
6
6
987
9
52
use Music::NWC2MusicXML::NWC;
34
6
6
6
1051
7
61
use Music::NWC2MusicXML::Parser;
35
6
6
6
1279
5
65
use Music::NWC2MusicXML::MusicXML;
36
6
6
6
845
6
2648
use Music::NWC2MusicXML::Diagnostics;
37
38# ---------------------------------------------------------------------------
39# Exit codes (also exported for use by the CLI script)
40# ---------------------------------------------------------------------------
41Readonly::Scalar our $EXIT_OK        => 0;
42Readonly::Scalar our $EXIT_WARNINGS  => 1;
43Readonly::Scalar our $EXIT_BAD_INPUT => 2;
44Readonly::Scalar our $EXIT_OUTPUT    => 3;
45Readonly::Scalar our $EXIT_INTERNAL  => 4;
46
47# Default output extension for uncompressed MusicXML
48Readonly::Scalar my $OUTPUT_EXT => '.musicxml';
49
50# Maximum single-file decompressed size (forwarded to NWC decoder)
51Readonly::Scalar my $INPUT_EXT  => '.nwc';
52
53Readonly::Hash my %MESSAGES => (
54        error_no_input       => 'No input file or data specified',
55        error_no_output      => 'No output path could be determined',
56        error_file_not_found => 'Input file not found: %s',
57        error_decode         => 'NWC decoding failed for %s: %s',
58        error_parse          => 'NWCTXT parsing failed for %s: %s',
59        error_generate       => 'MusicXML generation failed for %s: %s',
60        error_write          => 'Cannot write output %s: %s',
61        error_mkdir          => 'Cannot create output directory %s: %s',
62        error_traversal      => 'Path traversal rejected: %s is outside base_dir %s',
63        error_internal       => 'Internal error: %s',
64        info_converting      => 'Converting: %s -> %s',
65        info_done            => 'Done: %s',
66        info_skipped         => 'Skipped (output exists, --overwrite not set): %s',
67);
68
69 - 127
=head1 NAME

Music::NWC2MusicXML - Convert NoteWorthy Composer 2 C<.nwc> score files to MusicXML.

=head1 VERSION

0.002.4

=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
128
129# ---------------------------------------------------------------------------
130# new
131# ---------------------------------------------------------------------------
132
133 - 181
=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
182
183sub new {
184
44
395777
        my $class = shift;
185
44
124
        my $input = Params::Get::get_params(undef, \@_) // {};
186
44
665
        my $warnings_fh = delete $input->{warnings_fh};   # must be extracted before validate_strict (no glob type)
187
44
179
        my $args = validate_strict(
188                input => $input,
189                schema => {
190                        log_level => { type => 'scalar', optional => 1, default  => 'normal' },
191                        validate  => { type => 'scalar', optional => 1, default  => 0 },
192                },
193        );
194
44
3507
        croak $@ unless defined $args;
195
196
44
106
        $args = Object::Configure::configure($class, $args);
197
198        my $diag = Music::NWC2MusicXML::Diagnostics->new(
199                level       => $args->{log_level},
200
44
110842
                (defined $warnings_fh ? (warnings_fh => $warnings_fh) : ()),
201        );
202
203        return bless {
204                _diagnostics => $diag,
205                _validate    => $args->{validate},
206
44
171
                _decoder     => Music::NWC2MusicXML::NWC->new(diagnostics => $diag),
207                _parser      => Music::NWC2MusicXML::Parser->new(diagnostics => $diag),
208                _generator   => Music::NWC2MusicXML::MusicXML->new(diagnostics => $diag),
209        }, $class;
210}
211
212# ---------------------------------------------------------------------------
213# Public: convert
214# ---------------------------------------------------------------------------
215
216 - 278
=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
279
280sub convert {
281
57
1003926
        my ($self, %input) = @_;
282
57
146
        my $args = validate_strict(
283                schema => {
284                        input     => { type => 'scalar' },
285                        output    => { type => 'scalar', optional => 1 },
286                        overwrite => { type => 'boolean', optional => 1, default  => 0 },
287                },
288                input => \%input,
289        );
290
57
4133
        croak $@ unless defined $args;
291
292
57
99
        my $in     = $args->{input};
293
57
90
        my $output = $args->{output} // _default_output($in);
294
57
51
        my $diag   = $self->{_diagnostics};
295
296
57
295
        croak _fmt_msg('error_file_not_found', $in)
297                unless -f $in;
298
299
41
96
        if (!$args->{overwrite} && -f $output) {
300
3
6
                $diag->verbose(_fmt_msg('info_skipped', $output));
301
3
7
                return $output;
302        }
303
304
38
72
        $diag->count(outcome => 'processed');
305
38
56
        $diag->info(_fmt_msg('info_converting', $in, $output));
306
307
38
58
        return $self->_single_convert($in, $output);
308}
309
310# ---------------------------------------------------------------------------
311# Public: batch_convert
312# ---------------------------------------------------------------------------
313
314 - 378
=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
379
380sub batch_convert {
381
16
1242
        my ($self, %input) = @_;
382
16
181
        my $args = validate_strict(
383                schema => {
384                        inputs     => {
385                                type => 'arrayref',
386                                element_type => 'string'
387                        },
388                        output_dir => { type => 'string', optional => 1 },
389                        overwrite  => { type => 'boolean', optional => 1, default  => 0 },
390                        recursive  => { type => 'boolean', optional => 1, default  => 0 },
391                        base_dir   => { type => 'string', optional => 1 },
392                },
393                input => \%input,
394        );
395
16
1825
        croak $@ unless defined $args;
396
397
16
17
        my $diag = $self->{_diagnostics};
398
16
9
        my @results;
399
16
21
        my %counts = (processed => 0, successful => 0, warnings => 0, failed => 0);
400
401
16
16
7
22
        for my $file (@{ $args->{inputs} }) {
402
25
21
                $counts{processed}++;
403
404                # A per-file failure must not abort the batch.
405                # Output-path computation is inside the eval so traversal errors
406                # are caught per-file rather than aborting the whole batch.
407
25
14
                my $output;
408
25
12
                my $ok = eval {
409                        $output = $self->_batch_output_path(
410                                input      => $file,
411                                output_dir => $args->{output_dir},
412                                recursive  => $args->{recursive},
413                                base_dir   => $args->{base_dir},
414
25
61
                        );
415                        $self->convert(
416                                input     => $file,
417                                output    => $output,
418                                overwrite => $args->{overwrite},
419
24
45
                        );
420                };
421
422
25
803
                if ($@ || !defined $ok) {
423
10
27
                        $diag->info(_fmt_msg('info_done', "FAILED: $file -- $@")) if $@;
424
10
18
                        $diag->count(outcome => 'failed');
425
10
8
                        $counts{failed}++;
426                } else {
427
15
22
                        $diag->count(outcome => 'successful');
428
15
23
                        $counts{successful}++;
429                }
430
431
25
66
                push @results, { input => $file, output => $output, ok => !!$ok };
432        }
433
434
16
16
14
42
        $counts{warnings} = scalar @{ $diag->warnings };
435
436
16
34
        $diag->summary;
437
438
16
84
        return { %counts, results => \@results };
439}
440
441 - 445
=head2 diagnostics

Return the C<Music::NWC2MusicXML::Diagnostics> instance.

=cut
446
447
0
0
sub diagnostics { return $_[0]->{_diagnostics} }
448
449# ---------------------------------------------------------------------------
450# Private helpers
451# ---------------------------------------------------------------------------
452
453sub _single_convert {
454
38
42
        my ($self, $input, $output) = @_;
455
38
23
        my $diag = $self->{_diagnostics};
456
457        # Stage 1: Decode binary NWC -> NWCTXT
458
38
38
27
71
        my $nwctxt = eval { $self->{_decoder}->read($input) };
459
38
884
        if ($@) {
460
7
7
                carp _fmt_msg('error_decode', $input, $@);
461
7
540
                $diag->count(outcome => 'failed');
462
7
15
                return undef;
463        }
464
465        # Stage 2: Parse NWCTXT -> IR
466
31
31
26
62
        my $score = eval { $self->{_parser}->parse($nwctxt) };
467
31
67
        if ($@) {
468
0
0
                carp _fmt_msg('error_parse', $input, $@);
469
0
0
                $diag->count(outcome => 'failed');
470
0
0
                return undef;
471        }
472
473        # Optional: extended validation
474
31
64
        if ($self->{_validate}) {
475
1
4
                my $issues = $score->validate;
476
1
10
                for my $issue (@$issues) {
477
2
229
                        carp $issue;
478                }
479        }
480
481        # Stage 3: Generate MusicXML
482
31
31
188
115
        my $xml = eval { $self->{_generator}->generate($score) };
483
31
169
        if ($@) {
484
1
1
                carp _fmt_msg('error_generate', $input, $@);
485
1
67
                $diag->count(outcome => 'failed');
486
1
2
                return undef;
487        }
488
489        # Write output
490
30
30
32
91
        eval { $self->_write_output($output, $xml, $input) };
491
30
51
        if ($@) {
492
0
0
                carp _fmt_msg('error_write', $output, $@);
493
0
0
                $diag->count(outcome => 'failed');
494
0
0
                return undef;
495        }
496
497
30
60
        $diag->info(_fmt_msg('info_done', $output));
498
30
92
        $diag->count(outcome => 'successful');
499
30
130
        return $output;
500}
501
502sub _write_output {
503
30
60
        my ($self, $output, $xml, $source) = @_;
504
505        # Ensure parent directory exists. make_path is idempotent (no error if dir
506        # already exists), so no -d pre-check is needed and the TOCTOU race is closed.
507
30
1006
        my $dir = dirname($output);
508
30
30
28
1529
        eval { make_path($dir) };
509
30
54
        croak _fmt_msg('error_mkdir', $dir, $@) if $@;
510
511
30
75
        open my $fh, '>:encoding(UTF-8)', $output
512                or croak _fmt_msg('error_write', $output, $!);
513
30
111113
        print $fh $xml;
514
30
79
        close $fh;
515
516
30
2745
        return;
517}
518
519sub _default_output {
520
13
7
        my ($input) = @_;
521
13
82
        (my $base = $input) =~ s/\Q$INPUT_EXT\E\z//i;
522
13
69
        return $base . $OUTPUT_EXT;
523}
524
525sub _batch_output_path {
526
25
46
        my ($self, %input) = @_;
527
25
76
        my $args = validate_strict(
528                schema => {
529                        input      => { type => 'scalar' },
530                        output_dir => { type => 'scalar', optional => 1 },
531                        recursive  => { type => 'scalar', optional => 1, default  => 0 },
532                        base_dir   => { type => 'scalar', optional => 1 },
533                },
534                input => \%input,
535        );
536
25
2242
        croak $@ unless defined $args;
537
538
25
316
        my $out_name = basename($args->{input});
539
25
97
        $out_name =~ s/\Q$INPUT_EXT\E\z//i;
540
25
21
        $out_name .= $OUTPUT_EXT;
541
542
25
30
        unless (defined $args->{output_dir}) {
543
0
0
                return File::Spec->catfile(dirname($args->{input}), $out_name);
544        }
545
546
25
54
        if ($args->{recursive} && defined $args->{base_dir}) {
547                # Compute relative path from base_dir to preserve directory structure
548
3
164
                my $rel = File::Spec->abs2rel(dirname($args->{input}), $args->{base_dir});
549                # Guard: any '..' component means the input sits outside base_dir;
550                # writing there would escape output_dir (path traversal).
551                croak _fmt_msg('error_traversal', $args->{input}, $args->{base_dir})
552
3
11
5
7
                        if grep { $_ eq '..' } File::Spec->splitdir($rel);
553
2
8
                return File::Spec->catfile($args->{output_dir}, $rel, $out_name);
554        }
555
556
22
94
        return File::Spec->catfile($args->{output_dir}, $out_name);
557}
558
559sub _fmt_msg {
560
102
119
        my ($key, @args) = @_;
561
102
202
        croak "Unknown message key: $key" unless exists $MESSAGES{$key};
562
102
392
        return sprintf $MESSAGES{$key}, @args;
563}
564
5651;
566