File Coverage

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

linestmtbrancondsubtimecode
1package Music::NWC2MusicXML::NWC;
2
3
14
14
14
411302
8
88
use strict;
4
14
14
14
11
5
223
use warnings;
5
14
14
14
344
18547
38
use autodie qw(open close);
6
7our $VERSION = '0.001.1';
8
9
14
14
14
1884
15
206
use Carp qw(croak carp);
10
14
14
14
298
3178
187
use Readonly;
11
14
14
14
943
45674
178
use Params::Validate::Strict qw(validate_strict);
12
14
14
14
485
27061
137
use Params::Get;
13
14
13
13
1430
127667
3652
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.001.1

=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
144475
        my ($class, %input) = @_;
133
119
237
        my $args = validate_strict(
134                schema => {
135                        diagnostics => { type => 'object', optional => 1 },
136                },
137                input => \%input,
138        );
139
119
4030
        croak $@ unless defined $args;
140
141        my $self = bless {
142                _diagnostics => $args->{diagnostics},
143
119
148
        }, $class;
144
145
119
201
        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
145672
        my ($proto, $filename) = @_;
211
212
87
206
        croak _fmt_msg('error_not_a_file', $filename // '(undef)')
213                unless defined $filename && length $filename;
214
215
81
443
        croak _fmt_msg('error_not_a_file', $filename)
216                unless -f $filename && -r $filename;
217
218
65
45
        my $data;
219        {
220
65
65
34
156
                open my $fh, '<:raw', $filename
221                        or croak _fmt_msg('error_not_a_file', "$filename: $!");
222
65
7389
                local $/;
223
65
10736
                $data = <$fh>;
224
65
122
                close $fh;
225        }
226
227        # Delegate to decode so tests can bypass file I/O entirely.
228
65
3355
        my $self = ref($proto) ? $proto : $proto->new;
229
65
127
        return $self->decode($data, $filename);
230}
231
232 - 293
=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
294
295sub decode {
296
100
125149
        my ($proto, $data, $filename) = @_;
297
100
132
        $filename //= '<buffer>';
298
299
100
119
        my $self = ref($proto) ? $proto : $proto->new;
300
301        # Guard: minimum viable length
302
100
217
        croak _fmt_msg('error_truncated', $filename)
303                if !defined $data || length($data) < $MIN_FILE_BYTES;
304
305        # Verify NWC magic signature at offset 0
306
87
140
        croak _fmt_msg('error_not_nwc', $filename)
307                unless substr($data, 0, $NWC_MAGIC_LEN) eq $NWC_MAGIC;
308
309
77
160
        $self->_debug("magic verified: $filename");
310
311        # Locate the zlib compressed stream within the binary payload.
312        # We scan rather than relying on a fixed offset so that different
313        # NWC versions and padding sizes are handled uniformly.
314
77
99
        my $zlib_offset = $self->_find_zlib_offset(\$data, $filename);
315
316
70
97
        $self->_debug("zlib stream at offset $zlib_offset in $filename");
317
318        # Decompress
319
70
96
        my $raw = $self->_decompress(\$data, $zlib_offset, $filename);
320
321
66
134
        $self->_debug('decompressed ' . length($raw) . ' bytes from ' . $filename);
322
323        # Locate the NWCTXT marker within the decompressed bytes
324
66
76
        my $marker_pos = index($raw, $NWCTXT_MARKER);
325
66
55
        croak _fmt_msg('error_no_nwctxt_marker', $filename)
326                if $marker_pos < 0;
327
328
65
1782
        my $nwctxt = substr($raw, $marker_pos);
329
330        # Validate UTF-8: attempt decode; Perl's utf8 flag approach
331        # We do not blindly assume the file is UTF-8; we verify it.
332        # If it fails, treat as Latin-1 (a common NWC legacy encoding) and warn.
333
65
6485
        if (!utf8::decode($nwctxt)) {
334                # Latin-1 fallback: re-encode as UTF-8
335
1
2
                utf8::upgrade($nwctxt);
336
1
0
                carp _fmt_msg('error_bad_utf8', $filename)
337                        . ' -- assuming Latin-1';
338        }
339
340
65
244
        return $nwctxt;
341}
342
343# ---------------------------------------------------------------------------
344# Private: _find_zlib_offset
345# ---------------------------------------------------------------------------
346
347sub _find_zlib_offset {
348
77
82
        my ($self, $data_ref, $filename) = @_;
349
350        # Strategy: scan the binary for a byte pair (CMF, FLG) that satisfies
351        # the zlib header checksum rule: (CMF*256 + FLG) % 31 == 0.
352        # We look only for CMF=0x78 (deflate, 32K window) which covers all
353        # compression levels produced by NoteWorthy Composer.
354        #
355        # We start at offset NWC_MAGIC_LEN + 2 because at minimum there must
356        # be a two-byte version/header field after the magic.
357
358
77
58
        my $len  = length $$data_ref;
359
77
41
        my $start = $NWC_MAGIC_LEN;    # zlib stream follows immediately after magic
360
361
77
129
        for my $i ($start .. $len - 2) {
362
583
201
                my $cmf = ord(substr($$data_ref, $i,     1));
363
583
184
                my $flg = ord(substr($$data_ref, $i + 1, 1));
364
365
583
269
                next unless $cmf == $ZLIB_CMF;
366
70
98
                next unless ($cmf * 256 + $flg) % 31 == 0;
367
368
70
69
                return $i;
369        }
370
371
7
25
        croak _fmt_msg('error_no_zlib_stream', $filename);
372}
373
374# ---------------------------------------------------------------------------
375# Private: _decompress
376# ---------------------------------------------------------------------------
377
378sub _decompress {
379
70
75
        my ($self, $data_ref, $offset, $filename) = @_;
380
381
70
205
        my $compressed = substr($$data_ref, $offset);
382
383        # Compress::Zlib::uncompress handles a complete zlib stream.
384        # It returns undef on failure.
385
70
164
        my $raw = Compress::Zlib::uncompress(\$compressed);
386
387
70
15491
        croak _fmt_msg('error_decompress_fail', "zlib error in $filename")
388                unless defined $raw;
389
390
66
75
        croak _fmt_msg('error_decomp_too_large', $MAX_DECOMP_BYTES, $filename)
391                if length($raw) > $MAX_DECOMP_BYTES;
392
393
66
215
        return $raw;
394}
395
396# ---------------------------------------------------------------------------
397# Private: _debug
398# ---------------------------------------------------------------------------
399
400sub _debug {
401
213
125
        my ($self, $msg) = @_;
402
213
188
        return unless defined $self->{_diagnostics};
403
103
115
        $self->{_diagnostics}->debug($msg);
404}
405
406sub _fmt_msg {
407
58
52
        my ($key, @args) = @_;
408
58
83
        croak "Unknown message key: $key" unless exists $MESSAGES{$key};
409
58
192
        return sprintf $MESSAGES{$key}, @args;
410}
411
4121;
413