| File: | blib/lib/Music/NWC2MusicXML/NWC.pm |
| Coverage: | 96.4% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package 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 | ||||||
| 7 | our $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. | |||||
| 21 | Readonly::Scalar my $NWC_MAGIC => '[NWZ]'; | |||||
| 22 | Readonly::Scalar my $NWC_MAGIC_LEN => length $NWC_MAGIC; | |||||
| 23 | ||||||
| 24 | # The text marker that opens the NWCTXT content inside the decompressed stream. | |||||
| 25 | Readonly::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. | |||||
| 29 | Readonly::Scalar my $MAX_DECOMP_BYTES => 256 * 1024 * 1024; | |||||
| 30 | ||||||
| 31 | # Minimum length of a plausible NWC binary file. | |||||
| 32 | Readonly::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) | |||||
| 35 | Readonly::Scalar my $ZLIB_CMF => 0x78; | |||||
| 36 | ||||||
| 37 | # Valid FLG bytes that satisfy (CMF*256 + FLG) % 31 == 0 for CMF = 0x78 | |||||
| 38 | Readonly::Array my @ZLIB_VALID_FLAGS => (0x01, 0x5E, 0x9C, 0xDA); | |||||
| 39 | ||||||
| 40 | Readonly::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 | ||||||
| 131 | sub 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 | ||||||
| 209 | sub 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 | ||||||
| 295 | sub 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 | ||||||
| 347 | sub _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 | ||||||
| 378 | sub _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 | ||||||
| 400 | sub _debug { | |||||
| 401 | 213 | 125 | my ($self, $msg) = @_; | |||
| 402 | 213 | 188 | return unless defined $self->{_diagnostics}; | |||
| 403 | 103 | 115 | $self->{_diagnostics}->debug($msg); | |||
| 404 | } | |||||
| 405 | ||||||
| 406 | sub _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 | ||||||
| 412 | 1; | |||||
| 413 | ||||||