File Coverage

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

linestmtbrancondsubtimecode
1package 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
7our $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# ---------------------------------------------------------------------------
25Readonly::Scalar our $EXIT_OK        => 0;
26Readonly::Scalar our $EXIT_WARNINGS  => 1;
27Readonly::Scalar our $EXIT_BAD_INPUT => 2;
28Readonly::Scalar our $EXIT_OUTPUT    => 3;
29Readonly::Scalar our $EXIT_INTERNAL  => 4;
30
31# Default output extension for uncompressed MusicXML
32Readonly::Scalar my $OUTPUT_EXT => '.musicxml';
33
34# Maximum single-file decompressed size (forwarded to NWC decoder)
35Readonly::Scalar my $INPUT_EXT  => '.nwc';
36
37Readonly::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
167sub 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
264sub 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
364sub 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
437sub _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
486sub _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
503sub _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
509sub _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
543sub _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
5491;
550