File Coverage

File:blib/lib/Music/NWC2MusicXML/NWC.pm
Coverage:96.5%

linestmtbrancondsubtimecode
1package Music::NWC2MusicXML::NWC;
2
3
14
14
14
14
393887
11
75
use strict;
4
14
14
14
14
11
4
214
use warnings;
5
14
14
14
14
342
14916
30
use autodie qw(open close);
6
7our $VERSION = '0.002.4';
8
9
14
14
14
14
2062
9
188
use Carp qw(croak carp);
10
14
14
14
14
345
3169
156
use Readonly;
11
14
14
14
14
748
22994
157
use Params::Validate::Strict qw(validate_strict);
12
14
14
14
14
416
20898
111
use Params::Get;
13
14
13
13
14
1550
121457
1098
use Compress::Zlib ();
14
15# ---------------------------------------------------------------------------
16# Binary format constants
17# ---------------------------------------------------------------------------
18
19# The [NWZ] signature bytes at the start of a binary NWC 2.x file.
20# Stored as a Readonly so every comparison in the module uses the same value.
21Readonly::Scalar my $NWC_MAGIC        => '[NWZ]';
22Readonly::Scalar my $NWC_MAGIC_LEN    => length $NWC_MAGIC;
23
24# The text marker that opens the NWCTXT content inside the decompressed stream.
25Readonly::Scalar my $NWCTXT_MARKER    => '!NoteWorthyComposer(';
26
27# Safety limit: reject decompressed payloads larger than this.
28# A 50 MB score would be extraordinary; 256 MB signals something is wrong.
29Readonly::Scalar my $MAX_DECOMP_BYTES => 256 * 1024 * 1024;
30
31# Minimum length of a plausible NWC binary file.
32Readonly::Scalar my $MIN_FILE_BYTES   => $NWC_MAGIC_LEN + 4;
33
34# zlib CMF byte for deflate streams (window size bits 7..4 = 7, CM 3..0 = 8)
35Readonly::Scalar my $ZLIB_CMF         => 0x78;
36
37# Valid FLG bytes that satisfy (CMF*256 + FLG) % 31 == 0 for CMF = 0x78
38Readonly::Array  my @ZLIB_VALID_FLAGS => (0x01, 0x5E, 0x9C, 0xDA);
39
40Readonly::Hash my %MESSAGES => (
41        error_not_a_file       => 'Cannot read file: %s',
42        error_not_nwc          => 'Not a valid NWC file (magic not found): %s',
43        error_truncated        => 'File appears truncated: %s',
44        error_no_zlib_stream   => 'No compressed data stream found in: %s',
45        error_decompress_fail  => 'Decompression failed: %s',
46        error_decomp_too_large => 'Decompressed data exceeds safety limit (%d bytes): %s',
47        error_no_nwctxt_marker => 'NWCTXT marker not found in decompressed data: %s',
48        error_bad_utf8         => 'NWCTXT text is not valid UTF-8: %s',
49        error_internal         => 'Internal error: %s',
50        warn_unknown_version   => 'Unrecognised NWC version %s -- attempting conversion anyway',
51);
52
53 - 94
=head1 NAME

Music::NWC2MusicXML::NWC - Binary NWC container decoder.

=head1 VERSION

0.002.4

=head1 SYNOPSIS

    use Music::NWC2MusicXML::NWC;

    # From a file
    my $nwctxt = Music::NWC2MusicXML::NWC->read('Pilgrim.nwc');

    # From an in-memory buffer (e.g. read from a database blob)
    my $nwctxt = Music::NWC2MusicXML::NWC->decode($binary_data);

    print $nwctxt;   # prints the NWCTXT representation

=head1 DESCRIPTION

Converts a NoteWorthy Composer 2 binary C<.nwc> file into its NWCTXT text
representation.  The NWCTXT string is then passed to
C<Music::NWC2MusicXML::Parser>.

The conversion pipeline implemented here is:

    NWC binary container
          |
          v  (verify magic + locate zlib stream)
    compressed score data
          |
          v  (Compress::Zlib inflate)
    raw decompressed bytes
          |
          v  (locate !NoteWorthyComposer( marker)
    NWCTXT representation (UTF-8 string)

No NoteWorthy Composer installation is required.

=cut
95
96# ---------------------------------------------------------------------------
97# Constructor
98# ---------------------------------------------------------------------------
99
100 - 129
=head2 new

Construct a decoder object.  Optionally binds diagnostic output to a
C<Music::NWC2MusicXML::Diagnostics> instance.

=head3 Arguments

Named parameters:

=over 4

=item C<diagnostics> -- a C<Music::NWC2MusicXML::Diagnostics> instance (optional).

=back

=head3 Returns

Blessed C<Music::NWC2MusicXML::NWC> object.

=head3 API SPECIFICATION

=head4 Input

    diagnostics : Music::NWC2MusicXML::Diagnostics  (optional)

=head4 Output

    Music::NWC2MusicXML::NWC object

=cut
130
131sub new {
132
119
119
144342
        my ($class, %input) = @_;
133
119
231
        my $args = validate_strict(
134                schema => {
135                        diagnostics => { type => 'object', optional => 1 },
136                },
137                input => \%input,
138        );
139
119
50
4780
        croak $@ unless defined $args;
140
141        my $self = bless {
142                _diagnostics => $args->{diagnostics},
143
119
143
        }, $class;
144
145
119
192
        return $self;
146}
147
148# ---------------------------------------------------------------------------
149# Public: read
150# ---------------------------------------------------------------------------
151
152 - 207
=head2 read

Read a C<.nwc> binary file from disk and return its NWCTXT representation.

Can be called as a class method (C<< Music::NWC2MusicXML::NWC->read($file) >>)
or as an instance method.

=head3 Purpose

Encapsulates file-I/O so that C<decode> can be tested independently with
in-memory data.

=head3 Arguments

=over 4

=item C<$filename> -- path to the C<.nwc> file (required).

=back

=head3 Returns

Scalar string containing the NWCTXT representation (UTF-8).

=head3 Side Effects

Reads from disk.  Croaks on any I/O or format error.

=head3 Usage Example

    my $nwctxt = Music::NWC2MusicXML::NWC->read('Pilgrim.nwc');

=head3 API SPECIFICATION

=head4 Input

    $filename : SCALAR  path (required)
                  -- Valid domain: defined, non-empty string naming a regular,
                  --   readable file in NWC 2.x binary format
                  -- Invalid partitions: undef, '' (empty), directory, non-existent,
                  --   unreadable, or wrong format -> all croak error_not_a_file
                  --   or error_not_nwc / error_truncated depending on failure point

=head4 Output

    SCALAR (UTF-8 string)

=head3 MESSAGES

| Code                | Meaning                             | Resolution                     |
|---------------------|-------------------------------------|--------------------------------|
| error_not_a_file    | File cannot be opened               | Check path and permissions     |
| error_not_nwc       | File does not begin with NWC magic  | Verify file is a real .nwc     |
| error_truncated     | File too short to be valid          | File may be corrupt            |

=cut
208
209sub read {
210
87
87
140818
        my ($proto, $filename) = @_;
211
212
87
100
100
100
214
        croak _fmt_msg('error_not_a_file', $filename // '(undef)')
213                unless defined $filename && length $filename;
214
215
81
100
100
546
        croak _fmt_msg('error_not_a_file', $filename)
216                unless -f $filename && -r $filename;
217
218
65
50
        my $data;
219        {
220
13
13
13
65
13
23
9
40
51
                no autodie 'open';      # autodie would swallow the open failure before or-croak fires
221
65
50
1088
                open my $fh, '<:raw', $filename
222                        or croak _fmt_msg('error_not_a_file', "$filename: $!");
223
65
96
                local $/;
224
65
1261
                $data = <$fh>;
225
65
131
                close $fh;
226        }
227
228        # Delegate to decode so tests can bypass file I/O entirely.
229
65
100
4569
        my $self = ref($proto) ? $proto : $proto->new;
230
65
133
        return $self->decode($data, $filename);
231}
232
233 - 294
=head2 decode

Decode a binary NWC payload (already loaded into a scalar) and return its
NWCTXT representation.

Can be called as a class method or instance method.

Separates decompression logic from file I/O; enables unit testing with
in-memory test vectors.

=head3 Arguments

=over 4

=item C<$data>     -- binary scalar containing the full file content (required).

=item C<$filename> -- source filename for diagnostic messages (optional, default C<< <buffer> >>).

=back

=head3 Returns

Scalar string containing the NWCTXT representation (UTF-8).

=head3 Side Effects

None (no I/O).  Croaks on any format or decompression error.

=head3 Usage Example

    my $nwctxt = Music::NWC2MusicXML::NWC->decode($binary_blob);

=head3 API SPECIFICATION

=head4 Input

    $data     : SCALAR (binary, required)
                  -- Valid domain: length >= MIN_FILE_BYTES (9 bytes)
                  --   Minimum: 5-byte magic '[NWZ]' + 4 bytes = 9 bytes (MIN_FILE_BYTES)
                  --   Below min (length 0..8): croaks error_truncated
                  --   At min (length 9) with wrong magic: croaks error_not_nwc
                  --   MAX decompressed size: 268,435,456 bytes (MAX_DECOMP_BYTES = 256 MB)
    $filename : SCALAR (optional, default '<buffer>')
                  -- Any string; used only in diagnostic messages

=head4 Output

    SCALAR (UTF-8 string)

=head3 MESSAGES

| Code                   | Meaning                                 | Resolution                        |
|------------------------|-----------------------------------------|-----------------------------------|
| error_not_nwc          | Magic signature absent                  | Confirm file is an NWC 2.x binary |
| error_truncated        | Data too short                          | File may be truncated             |
| error_no_zlib_stream   | zlib stream not found in binary         | File may be corrupt               |
| error_decompress_fail  | zlib inflation failed                   | Payload is corrupt                |
| error_decomp_too_large | Decompressed size exceeds safety limit  | Reject; may be a zip bomb         |
| error_no_nwctxt_marker | NWCTXT marker absent after decompression| File structure unexpected         |
| error_bad_utf8         | Decompressed text is not valid UTF-8    | NWC file may use a legacy encoding|

=cut
295
296sub decode {
297
100
100
70825
        my ($proto, $data, $filename) = @_;
298
100
100
124
        $filename //= '<buffer>';
299
300
100
100
114
        my $self = ref($proto) ? $proto : $proto->new;
301
302        # Guard: minimum viable length
303
100
100
100
206
        croak _fmt_msg('error_truncated', $filename)
304                if !defined $data || length($data) < $MIN_FILE_BYTES;
305
306        # Verify NWC magic signature at offset 0
307
87
100
141
        croak _fmt_msg('error_not_nwc', $filename)
308                unless substr($data, 0, $NWC_MAGIC_LEN) eq $NWC_MAGIC;
309
310
77
142
        $self->_debug("magic verified: $filename");
311
312        # Locate the zlib compressed stream within the binary payload.
313        # We scan rather than relying on a fixed offset so that different
314        # NWC versions and padding sizes are handled uniformly.
315
77
113
        my $zlib_offset = $self->_find_zlib_offset(\$data, $filename);
316
317
70
107
        $self->_debug("zlib stream at offset $zlib_offset in $filename");
318
319        # Decompress
320
70
94
        my $raw = $self->_decompress(\$data, $zlib_offset, $filename);
321
322
66
111
        $self->_debug('decompressed ' . length($raw) . ' bytes from ' . $filename);
323
324        # Locate the NWCTXT marker within the decompressed bytes
325
66
78
        my $marker_pos = index($raw, $NWCTXT_MARKER);
326
66
100
94
        croak _fmt_msg('error_no_nwctxt_marker', $filename)
327                if $marker_pos < 0;
328
329
65
1114
        my $nwctxt = substr($raw, $marker_pos);
330
331        # Validate UTF-8: attempt decode; Perl's utf8 flag approach
332        # We do not blindly assume the file is UTF-8; we verify it.
333        # If it fails, treat as Latin-1 (a common NWC legacy encoding) and warn.
334
65
100
7522
        if (!utf8::decode($nwctxt)) {
335                # Latin-1 fallback: re-encode as UTF-8
336
1
1
                utf8::upgrade($nwctxt);
337
1
2
                carp _fmt_msg('error_bad_utf8', $filename)
338                        . ' -- assuming Latin-1';
339        }
340
341
65
228
        return $nwctxt;
342}
343
344# ---------------------------------------------------------------------------
345# Private: _find_zlib_offset
346# ---------------------------------------------------------------------------
347
348sub _find_zlib_offset {
349
77
77
80
        my ($self, $data_ref, $filename) = @_;
350
351        # Strategy: scan the binary for a byte pair (CMF, FLG) that satisfies
352        # the zlib header checksum rule: (CMF*256 + FLG) % 31 == 0.
353        # We look only for CMF=0x78 (deflate, 32K window) which covers all
354        # compression levels produced by NoteWorthy Composer.
355        #
356        # We start at offset NWC_MAGIC_LEN + 2 because at minimum there must
357        # be a two-byte version/header field after the magic.
358
359
77
44
        my $len  = length $$data_ref;
360
77
53
        my $start = $NWC_MAGIC_LEN;    # zlib stream follows immediately after magic
361
362
77
100
        for my $i ($start .. $len - 2) {
363
583
202
                my $cmf = ord(substr($$data_ref, $i,     1));
364
583
188
                my $flg = ord(substr($$data_ref, $i + 1, 1));
365
366
583
100
244
                next unless $cmf == $ZLIB_CMF;
367
70
50
96
                next unless ($cmf * 256 + $flg) % 31 == 0;
368
369
70
64
                return $i;
370        }
371
372
7
7
        croak _fmt_msg('error_no_zlib_stream', $filename);
373}
374
375# ---------------------------------------------------------------------------
376# Private: _decompress
377# ---------------------------------------------------------------------------
378
379sub _decompress {
380
70
70
67
        my ($self, $data_ref, $offset, $filename) = @_;
381
382
70
149
        my $compressed = substr($$data_ref, $offset);
383
384        # Compress::Zlib::uncompress handles a complete zlib stream.
385        # It returns undef on failure.
386
70
132
        my $raw = Compress::Zlib::uncompress(\$compressed);
387
388
70
100
13079
        croak _fmt_msg('error_decompress_fail', "zlib error in $filename")
389                unless defined $raw;
390
391
66
50
79
        croak _fmt_msg('error_decomp_too_large', $MAX_DECOMP_BYTES, $filename)
392                if length($raw) > $MAX_DECOMP_BYTES;
393
394
66
275
        return $raw;
395}
396
397# ---------------------------------------------------------------------------
398# Private: _debug
399# ---------------------------------------------------------------------------
400
401sub _debug {
402
213
213
119
        my ($self, $msg) = @_;
403
213
100
173
        return unless defined $self->{_diagnostics};
404
103
112
        $self->{_diagnostics}->debug($msg);
405}
406
407sub _fmt_msg {
408
58
58
40
        my ($key, @args) = @_;
409
58
50
106
        croak "Unknown message key: $key" unless exists $MESSAGES{$key};
410
58
172
        return sprintf $MESSAGES{$key}, @args;
411}
412
4131;
414