File Coverage

File:blib/lib/Music/NWC2MusicXML/Parser.pm
Coverage:80.3%

linestmtbrancondsubtimecode
1package Music::NWC2MusicXML::Parser;
2
3
14
14
14
112616
6
93
use strict;
4
14
14
14
10
7
229
use warnings;
5
14
14
14
188
7030
30
use autodie qw(:all);
6
7our $VERSION = '0.001.1';
8
9
14
14
14
25498
12
214
use Carp qw(croak carp);
10
14
14
14
270
2040
174
use Readonly;
11
14
14
14
416
17879
161
use Params::Validate::Strict qw(validate_strict);
12
14
14
14
268
4121
125
use Params::Get;
13
14
14
14
1344
13
116
use Music::NWC2MusicXML::Score;
14
14
14
14
16
5
57
use Music::NWC2MusicXML::Staff;
15
14
14
14
10
7
15893
use Music::NWC2MusicXML::Event;
16
17# ---------------------------------------------------------------------------
18# Constants
19# ---------------------------------------------------------------------------
20
21# Maximum number of records to parse before deciding the file is pathological.
22Readonly::Scalar my $MAX_RECORDS => 1_000_000;
23
24# The NWCTXT header line prefix
25Readonly::Scalar my $HEADER_PREFIX => '!NoteWorthyComposer(';
26
27# Dynamic markings recognised by NWC
28Readonly::Hash my %VALID_DYNAMICS => map { $_ => 1 }
29        qw(pppp ppp pp p mp mf f ff fff ffff);
30
31# Clef names recognised by NWC and their canonical spellings
32Readonly::Hash my %VALID_CLEFS => map { $_ => 1 }
33        qw(Treble Bass Alto Tenor Percussion Tab);
34
35# NWC lists key-signature accidentals in the standard circle-of-fifths order.
36# Signature:F#,C#  = 2 sharps = D major  (fifths +2)
37# Signature:Bb     = 1 flat   = F major  (fifths -1)
38# We compute the fifths value by counting the accidentals rather than using
39# a lookup table, which handles any combination and avoids the common mistake
40# of confusing the tonic name with the signature accidental list.
41
42# The 'C' signature token means no accidentals (C major / A minor = fifths 0).
43Readonly::Scalar my $KEY_SIG_NATURAL => 'C';
44
45# Pitch step letters recognised in NWC note records
46Readonly::Hash my %VALID_STEPS => map { $_ => 1 } qw(A B C D E F G);
47
48Readonly::Hash my %MESSAGES => (
49        error_empty_input     => 'NWCTXT input is empty or undefined',
50        error_no_header       => 'NWCTXT does not begin with expected header',
51        error_too_many_records=> 'Input exceeds maximum record limit (%d)',
52        error_bad_record      => 'Malformed NWCTXT record at line %d: %s',
53        error_no_staff        => 'Musical event %s encountered before any AddStaff record',
54        error_internal        => 'Internal error: %s',
55        warn_unknown_record   => 'Unknown NWCTXT record type %s at line %d -- stored as UnsupportedEvent',
56        warn_bad_value        => 'Unrecognised value for %s: %s at line %d',
57);
58
59 - 104
=head1 NAME

Music::NWC2MusicXML::Parser - NWCTXT text parser producing an internal score
representation.

=head1 VERSION

0.001.1

=head1 SYNOPSIS

    use Music::NWC2MusicXML::Parser;

    my $parser = Music::NWC2MusicXML::Parser->new;
    my $score  = $parser->parse($nwctxt);

=head1 DESCRIPTION

C<Music::NWC2MusicXML::Parser> accepts the NWCTXT string produced by
C<Music::NWC2MusicXML::NWC> and returns a C<Music::NWC2MusicXML::Score> object.

The internal representation is completely independent of MusicXML so that
parsing and MusicXML generation can be tested separately.

=head2 NWCTXT record structure

Each record occupies one line and begins with C<|>:

    |RecordType|Field1:Value1|Field2:Value2|...

Fields are pipe-delimited.  Values may be:

=over 4

=item * unquoted single tokens

=item * double-quoted strings (which may contain C<|> and C<:>)

=item * comma-separated lists

=back

The parser does B<not> use C<split(/[|]/)> because quoted values and escape
sequences require a proper tokeniser.

=cut
105
106# ---------------------------------------------------------------------------
107# new
108# ---------------------------------------------------------------------------
109
110 - 145
=head2 new

Construct a parser.

=head3 Arguments

Named parameters:

=over 4

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

=back

=head3 Returns

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

=head3 API SPECIFICATION

=head4 Input

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

=head4 Output

    Music::NWC2MusicXML::Parser object

=head3 FORMAL SPECIFICATION

 [ParserInit]
   diagnostics : Diagnostics

 (placeholder -- populate with Z calculus as implementation matures)

=cut
146
147sub new {
148
216
986804
        my ($class, %input) = @_;
149
216
381
        my $args = validate_strict(
150                schema => {
151                        diagnostics => { type => 'object', optional => 1 },
152                },
153                input => \%input,
154        );
155
216
6233
        croak $@ unless defined $args;
156
157        my $self = bless {
158                _diagnostics => $args->{diagnostics},
159
216
308
                _score       => undef,
160                _line_no     => 0,
161                _record_count => 0,
162        }, $class;
163
164
216
371
        return $self;
165}
166
167# ---------------------------------------------------------------------------
168# Public: parse
169# ---------------------------------------------------------------------------
170
171 - 242
=head2 parse

Parse a complete NWCTXT string and return the corresponding
C<Music::NWC2MusicXML::Score>.

=head3 Purpose

This is the primary entry point.  It iterates over each line of the NWCTXT,
dispatches to a type-specific handler, and accumulates the results into a
Score object.

=head3 Arguments

=over 4

=item C<$nwctxt> -- scalar string containing the full NWCTXT representation
(required).

=back

=head3 Returns

A C<Music::NWC2MusicXML::Score> object.

=head3 Side Effects

Croaks on fatal structural errors (e.g. missing header).
Issues warnings via C<diagnostics> for non-fatal issues (e.g. unknown records).

=head3 Usage Example

    my $score = Music::NWC2MusicXML::Parser->new->parse($nwctxt);

=head3 API SPECIFICATION

=head4 Input

    $nwctxt : SCALAR (UTF-8, required)
                -- Valid domain: non-empty string beginning with the line
                --   '!NoteWorthyComposer(<version>)' followed by pipe-delimited records
                -- Invalid partitions:
                --   undef or '' -> croaks error_empty_input
                --   non-empty but missing header -> croaks error_no_header
                -- Boundary: MAX_RECORDS = 1,000,000 pipe-delimited records
                --   At exactly 1,000,000 records: accepted
                --   At 1,000,001+ records: croaks error_too_many_records

=head4 Output

    Music::NWC2MusicXML::Score

=head3 MESSAGES

| Code                  | Meaning                                  | Resolution                    |
|-----------------------|------------------------------------------|-------------------------------|
| error_empty_input     | Input is undef or zero-length            | Check NWC decoder output      |
| error_no_header       | Header line not found                    | Verify NWC binary decoder     |
| error_too_many_records| Record count exceeds MAX_RECORDS         | Input may be malicious/corrupt|
| error_bad_record      | Record cannot be tokenised               | File may be corrupt           |
| error_no_staff        | Event seen before first AddStaff         | NWCTXT may be truncated       |
| warn_unknown_record   | Unknown record type stored as Unsupported| New NWC version may add types |

=head3 FORMAL SPECIFICATION

 [Parse]
   nwctxt? : NWCTXT
   ----------
   score!  : Score

 (placeholder)

=cut
243
244sub parse {
245
209
2485
        my ($self, $nwctxt) = @_;
246
247
209
386
        croak _fmt_msg('error_empty_input')
248                unless defined $nwctxt && length $nwctxt;
249
250        # Initialise fresh parse state for each call, enabling object reuse.
251
191
367
        $self->{_score}        = Music::NWC2MusicXML::Score->new;
252
191
138
        $self->{_line_no}      = 0;
253
191
121
        $self->{_record_count} = 0;
254
255
191
248466
        my @lines = split /\r?\n/, $nwctxt;
256
257        # First non-blank line must be the NWCTXT header
258
191
193
        my $header = shift @lines;
259
191
139
        $self->{_line_no}++;
260
261
191
379
        croak _fmt_msg('error_no_header')
262                unless defined $header
263                && index($header, $HEADER_PREFIX) == 0;
264
265        # Extract version string from header: !NoteWorthyComposer(2.751)
266
184
2405
        my ($version) = $header =~ /\A\Q$HEADER_PREFIX\E([^)]+)/;
267
184
205
        $self->{_score}{_nwc_version} = $version;
268
269        # Main parsing loop
270
184
147
        for my $line (@lines) {
271
1218024
350526
                $self->{_line_no}++;
272
1218024
752316
                next unless defined $line && length $line;
273
1218023
583274
                next if $line =~ /\A\s*\z/;    # blank lines are legal
274
275                croak _fmt_msg('error_too_many_records', $MAX_RECORDS)
276
1218022
481036
                        if ++$self->{_record_count} > $MAX_RECORDS;
277
278                # All NWCTXT records begin with '|'
279
1218021
564716
                next unless $line =~ /\A\|/;
280
281
1217968
405816
                $self->_dispatch_record($line);
282        }
283
284
182
17096
        return $self->{_score};
285}
286
287# ---------------------------------------------------------------------------
288# Package-level dispatch table -- built once at module load, not per call.
289# Subs are compile-time symbols; Readonly ensures the table is never mutated.
290# ---------------------------------------------------------------------------
291Readonly::Hash my %DISPATCH => (
292        SongInfo        => \&_handle_song_info,
293        PgSetup         => \&_handle_pg_setup,
294        PgMargins       => \&_handle_pg_setup,
295        Font            => \&_handle_font,
296        AddStaff        => \&_handle_add_staff,
297        StaffProperties => \&_handle_staff_properties,
298        StaffInstrument => \&_handle_staff_instrument,
299        Clef            => \&_handle_clef,
300        Key             => \&_handle_key,
301        TimeSig         => \&_handle_time_sig,
302        Tempo           => \&_handle_tempo,
303        Note            => \&_handle_note,
304        Rest            => \&_handle_rest,
305        Chord           => \&_handle_chord,
306        Bar             => \&_handle_bar,
307        Dynamic         => \&_handle_dynamic,
308        DynVariance     => \&_handle_dyn_variance,
309        Text            => \&_handle_text,
310        Lyric           => \&_handle_lyric,
311        Tie             => \&_handle_tie,
312        Slur            => \&_handle_slur,
313        Beam            => \&_handle_beam,
314        Tuplet          => \&_handle_tuplet,
315        Instrument      => \&_handle_instrument_change,
316        FlowControl     => \&_handle_flow_control,
317        TempoVariance   => \&_handle_tempo_variance,
318        Spacer          => \&_handle_spacer,
319        RestChord       => \&_handle_rest_chord,
320);
321
322# ---------------------------------------------------------------------------
323# Private: record dispatcher
324# ---------------------------------------------------------------------------
325
326# Strategy: extract the record type (first field after the leading |), then
327# call a dedicated _handle_* method.  Unknown types produce UnsupportedEvent
328# records and a warning rather than aborting conversion.
329
330sub _dispatch_record {
331
1217968
390433
        my ($self, $line) = @_;
332
333
1217968
400269
        my $fields = $self->_tokenise_record($line);
334
1217968
727699
        return unless defined $fields && @$fields;
335
336
1217968
358689
        my $type = shift @$fields;
337
338
1217968
635797
        if (exists $DISPATCH{$type}) {
339
1217932
1886414
                $DISPATCH{$type}->($self, $fields);
340        } else {
341
36
160
                my $staff = $self->{_score}->current_staff;
342
36
65
                if (defined $staff) {
343                        # Unknown type within a staff: record and warn.
344
5
8
                        $self->_warn_unknown($type);
345
5
12888
                        $self->_append_event(Music::NWC2MusicXML::Event->new(
346                                type      => 'UnsupportedEvent',
347                                nwc_label => $type,
348                                data      => { raw => join('|', $type, @$fields) },
349                        ));
350                }
351                # else: score-level record (Editor, Font, PgMargins, ...) before any
352                # AddStaff -- silently skip; these are not musical events.
353        }
354}
355
356# ---------------------------------------------------------------------------
357# Private: tokeniser
358# ---------------------------------------------------------------------------
359
360# Strategy: walk character by character to handle quoted strings and escaped
361# characters correctly.  A naive split('|') would break on quoted values
362# that contain '|' or ':'.
363
364sub _tokenise_record {
365
1217971
353878
        my ($self, $line) = @_;
366
367
1217971
301353
        my @fields;
368
1217971
309055
        my $pos = 0;
369
1217971
338421
        my $len = length $line;
370
371        # Skip leading '|'
372
1217971
509729
        $pos++ if substr($line, 0, 1) eq '|';
373
374
1217971
319209
        my $current = '';
375
1217971
322480
        my $in_quote = 0;
376
377
1217971
413320
        while ($pos < $len) {
378
9609848
2697297
                my $ch = substr($line, $pos, 1);
379
380
9609848
2720478
                if ($in_quote) {
381
25633
11038
                        if ($ch eq '"') {
382
1236
363
                                $in_quote = 0;
383                        } elsif ($ch eq '\\' && $pos + 1 < $len) {
384                                # Escape sequence: consume next char literally
385
5
2
                                $pos++;
386
5
2
                                $current .= substr($line, $pos, 1);
387                        } else {
388
24392
6584
                                $current .= $ch;
389                        }
390                } else {
391
9584215
3244307
                        if ($ch eq '"') {
392
1236
356
                                $in_quote = 1;
393                        } elsif ($ch eq '|') {
394
1402447
460298
                                push @fields, $current;
395
1402447
401127
                                $current = '';
396                        } else {
397
8180532
2080449
                                $current .= $ch;
398                        }
399                }
400
9609848
3215603
                $pos++;
401        }
402
403
1217971
382564
        push @fields, $current;
404
405
1217971
413644
        return \@fields;
406}
407
408# Parse a field list (already tokenised) into a key => value hashref.
409# Fields have the form "Key:Value" or just "Value" for positional fields.
410sub _fields_to_hash {
411
1217904
374229
        my ($self, $fields_ref) = @_;
412
1217904
306758
        my %h;
413
1217904
360557
        for my $field (@$fields_ref) {
414
1402320
537761
                if ($field =~ /\A([^:]+):(.*)\z/) {
415
399070
198606
                        $h{$1} = $2;
416                } else {
417
1003250
364253
                        $h{_positional} = $field;
418                }
419        }
420
1217904
365456
        return \%h;
421}
422
423# ---------------------------------------------------------------------------
424# Private: metadata handlers
425# ---------------------------------------------------------------------------
426
427sub _handle_font {
428
360
512
        my ($self, $fields) = @_;
429
360
173
        my $h = $self->_fields_to_hash($fields);
430
360
1146
        push @{ $self->{_score}{_fonts} }, {
431                style    => $h->{Style}    // '',
432                typeface => $h->{Typeface} // '',
433                size     => defined $h->{Size} ? $h->{Size} + 0 : 0,
434                bold     => ($h->{Bold}   // 'N') eq 'Y' ? 1 : 0,
435
360
111
                italic   => ($h->{Italic} // 'N') eq 'Y' ? 1 : 0,
436        };
437}
438
439sub _handle_song_info {
440
98
254
        my ($self, $fields) = @_;
441
98
102
        my $h = $self->_fields_to_hash($fields);
442
98
102
        for my $key (qw(Title Author Lyricist Copyright Copyright1 Copyright2 Comments)) {
443                $self->{_score}->set_metadata_field($key, $h->{$key})
444
686
617
                        if exists $h->{$key};
445        }
446}
447
448sub _handle_pg_setup {
449
73
151
        my ($self, $fields) = @_;
450
73
53
        my $h  = $self->_fields_to_hash($fields);
451
73
86
        my $ps = $self->{_score}->page_setup;
452
73
362
        %$ps = (%$ps, %$h);
453}
454
455sub _handle_add_staff {
456
379
804
        my ($self, $fields) = @_;
457
379
272
        my $h = $self->_fields_to_hash($fields);
458        my $staff = Music::NWC2MusicXML::Staff->new(
459                name  => $h->{Name}  // 'Staff',
460
379
987
                group => $h->{Group} // 'Standard',
461        );
462
379
487
        $self->{_score}->add_staff($staff);
463}
464
465sub _handle_staff_properties {
466
253
478
        my ($self, $fields) = @_;
467
253
171
        my $h = $self->_fields_to_hash($fields);
468
253
228
        my $staff = $self->_current_staff_or_croak('StaffProperties');
469
253
419
        $staff->{_visible}         = ($h->{Visible} // 'Y') eq 'Y' ? 1 : 0;
470
253
281
        $staff->{_lines}           = $h->{Lines} // 5;
471
253
178
        $staff->{_ending_bar}      = $h->{EndingBar};
472
253
239
        $staff->{_channel}         = $h->{Channel} + 0 if defined $h->{Channel};
473
253
306
        $staff->{_with_next_staff} = $h->{WithNextStaff} if defined $h->{WithNextStaff};
474
253
258
        $staff->{_volume}          = $h->{Volume}    + 0 if defined $h->{Volume};
475
253
258
        $staff->{_stereo_pan}      = $h->{StereoPan} + 0 if defined $h->{StereoPan};
476
253
622
        $staff->{_muted}           = ($h->{Muted} // 'N') eq 'Y' ? 1 : 0;
477}
478
479sub _handle_staff_instrument {
480
135
283
        my ($self, $fields) = @_;
481
135
92
        my $h     = $self->_fields_to_hash($fields);
482
135
102
        my $staff = $self->_current_staff_or_croak('StaffInstrument');
483        $staff->{_instrument} = {
484                name  => $h->{Name}  // '',
485                patch => $h->{Patch} // 0,
486
135
409
                trans => $h->{Trans} // 0,
487        };
488
135
237
        if (defined $h->{DynVel} && length $h->{DynVel}) {
489
120
190
                my @keys = qw(ppp pp p mp mf f ff fff);
490
120
190
                my @vels = split /,/, $h->{DynVel};
491
120
116
                if (@vels == @keys) {
492
120
72
                        my %vel_map;
493
120
960
69
760
                        @vel_map{@keys} = map { $_ + 0 } @vels;
494
120
282
                        $staff->{_dyn_vel} = \%vel_map;
495                }
496        }
497}
498
499# ---------------------------------------------------------------------------
500# Private: initial-state handlers (clef/key/time -- before events begin)
501# ---------------------------------------------------------------------------
502
503sub _handle_clef {
504
404
954
        my ($self, $fields) = @_;
505
404
349
        my $h    = $self->_fields_to_hash($fields);
506
404
457
        my $type = $h->{Type} // 'Treble';
507
508
404
414
        unless (exists $VALID_CLEFS{$type}) {
509
0
0
                carp _fmt_msg('warn_bad_value', 'Clef.Type', $type, $self->{_line_no});
510        }
511
512
404
1176
        my $staff = $self->_current_staff_or_croak('Clef');
513
404
388
        if (!$staff->has_notes) {
514
190
241
                $staff->set_initial_clef($type);
515        } else {
516
214
862
                $self->_append_event(Music::NWC2MusicXML::Event->new(
517                        type => 'Clef',
518                        data => { nwc_clef => $type },
519                ));
520        }
521}
522
523sub _handle_key {
524
776
1571
        my ($self, $fields) = @_;
525
776
491
        my $h   = $self->_fields_to_hash($fields);
526
776
668
        my $sig = $h->{Signature} // 'C';
527
528        my $key_data = {
529                signature => $sig,
530
776
1065
                tonic     => $h->{Tonic} // '',
531                fifths    => _fifths_from_signature($sig),
532        };
533
534
776
547
        my $staff = $self->_current_staff_or_croak('Key');
535
776
636
        if (!$staff->has_notes) {
536
175
191
                $staff->set_initial_key($key_data);
537        } else {
538
601
1818
                $self->_append_event(Music::NWC2MusicXML::Event->new(
539                        type => 'Key',
540                        data => $key_data,
541                ));
542        }
543}
544
545sub _handle_time_sig {
546
2577
3811
        my ($self, $fields) = @_;
547
2577
1243
        my $h   = $self->_fields_to_hash($fields);
548
2577
1545
        my $sig = $h->{Signature} // '4/4';
549
550
2577
2794
        my ($beats, $beat_type) = $sig =~ m{\A(\d+)/(\d+)\z};
551
2577
2223
        unless (defined $beats && defined $beat_type) {
552
4
7
                carp _fmt_msg('warn_bad_value', 'TimeSig.Signature', $sig, $self->{_line_no});
553
4
592
                ($beats, $beat_type) = (4, 4);
554        }
555
556
2577
2056
        my $ts_data = { beats => $beats + 0, beat_type => $beat_type + 0 };
557
558
2577
1217
        my $staff = $self->_current_staff_or_croak('TimeSig');
559
2577
1622
        if (!$staff->has_notes) {
560
177
177
                $staff->set_initial_timesig($ts_data);
561        } else {
562
2400
5584
                $self->_append_event(Music::NWC2MusicXML::Event->new(
563                        type => 'TimeSig',
564                        data => $ts_data,
565                ));
566        }
567}
568
569# ---------------------------------------------------------------------------
570# Private: musical event handlers
571# ---------------------------------------------------------------------------
572
573sub _handle_tempo {
574
169
333
        my ($self, $fields) = @_;
575
169
114
        my $h = $self->_fields_to_hash($fields);
576        $self->_append_event(Music::NWC2MusicXML::Event->new(
577                type => 'Tempo',
578                data => {
579                        bpm  => $h->{Tempo} // 120,
580
169
520
                        base => $h->{Base}  // 'Quarter',
581                },
582        ));
583}
584
585sub _handle_note {
586
109632
146910
        my ($self, $fields) = @_;
587
109632
44260
        my $h = $self->_fields_to_hash($fields);
588
589
109632
55866
        my ($base_dur, $dots, $triplet, $artic, $is_grace) = _parse_dur_tokens($h->{Dur} // '4th');
590
109632
56085
        my $rational = Music::NWC2MusicXML::Event->rational_from_nwc_duration($base_dur, $dots);
591
592        $self->_append_event(Music::NWC2MusicXML::Event->new(
593                type     => 'Note',
594                duration => $rational,
595                data     => {
596                        nwc_pos       => $h->{Pos} // '0',
597                        base_dur      => $base_dur,
598                        dots          => $dots,
599                        triplet       => $triplet,
600                        articulations => $artic,
601                        is_grace      => $is_grace,
602
109632
76056
                        opts          => _parse_opts($h->{Opts}),
603                },
604        ));
605}
606
607sub _handle_rest {
608
24270
32659
        my ($self, $fields) = @_;
609
24270
9637
        my $h = $self->_fields_to_hash($fields);
610
611
24270
12601
        my ($base_dur, $dots) = _parse_dur_tokens($h->{Dur} // '4th');
612
24270
14074
        my $rational = Music::NWC2MusicXML::Event->rational_from_nwc_duration($base_dur, $dots);
613
614        $self->_append_event(Music::NWC2MusicXML::Event->new(
615                type     => 'Rest',
616                duration => $rational,
617                data     => {
618                        base_dur => $base_dur,
619                        dots     => $dots,
620
24270
14744
                        opts     => _parse_opts($h->{Opts}),
621                },
622        ));
623}
624
625sub _handle_chord {
626
25770
35377
        my ($self, $fields) = @_;
627
25770
10496
        my $h = $self->_fields_to_hash($fields);
628
629
25770
14095
        my ($base_dur, $dots, $triplet, $artic, $is_grace) = _parse_dur_tokens($h->{Dur} // '4th');
630
25770
14040
        my $rational = Music::NWC2MusicXML::Event->rational_from_nwc_duration($base_dur, $dots);
631
632        # Pos field contains a comma-separated list of position strings.
633        # Each entry: optional accidental prefix (#/b/n/##/bb/x) + signed integer + optional ^ (tie)
634
25770
16261
        my @positions = split /,/, ($h->{Pos} // '0');
635
636        $self->_append_event(Music::NWC2MusicXML::Event->new(
637                type     => 'Chord',
638                duration => $rational,
639                data     => {
640                        nwc_positions => \@positions,
641                        base_dur      => $base_dur,
642                        dots          => $dots,
643                        triplet       => $triplet,
644                        articulations => $artic,
645                        is_grace      => $is_grace,
646
25770
16318
                        opts          => _parse_opts($h->{Opts}),
647                },
648        ));
649}
650
651sub _handle_bar {
652
1049820
1311814
        my ($self, $fields) = @_;
653
1049820
364105
        my $h = $self->_fields_to_hash($fields);
654        # NWC bar records carry an optional Style named field; plain |Bar| has none.
655
1049820
668095
        my $style = $h->{Style} // $h->{_positional} // 'normal';
656
1049820
557248
        $self->_append_event(Music::NWC2MusicXML::Event->new(
657                type => 'Bar',
658                data => { style => $style },
659        ));
660}
661
662# ---------------------------------------------------------------------------
663# Private: duration / options parsing helpers
664# ---------------------------------------------------------------------------
665
666sub _parse_dur_tokens {
667
159678
58794
        my ($dur_str) = @_;
668
159678
75041
        my @tokens   = split /,/, ($dur_str // '4th');
669
159678
68142
        my $base     = shift(@tokens) // '4th';
670
159678
60155
        my ($dots, $triplet, $is_grace) = (0, undef, 0);
671
159678
43497
        my @artic;
672
673
159678
50377
        for my $tok (@tokens) {
674
43727
4262
24524
1646
                if    ($tok eq 'Dotted')                { $dots     = 1 }
675
1
1
                elsif ($tok eq 'DblDotted')             { $dots     = 2 }
676
542
366
                elsif ($tok =~ /\ATriplet(?:=(.+))?\z/) { $triplet  = $1 // 'Middle' }
677
0
0
                elsif ($tok eq 'Grace')                 { $is_grace = 1 }
678
38922
16625
                else                                    { push @artic, $tok }
679        }
680
681
159678
90145
        return ($base, $dots, $triplet, \@artic, $is_grace);
682}
683
684sub _parse_opts {
685
159677
61100
        my ($opts_str) = @_;
686
159677
136747
        return {} unless defined $opts_str && length $opts_str;
687
82235
22660
        my %opts;
688
82235
36017
        for my $opt (split /,/, $opts_str) {
689
159817
134283
81330
73369
                if ($opt =~ /\A(\w+)=(.*)\z/) { $opts{$1} = $2 }
690
25534
10556
                else                        { $opts{$opt} = 1 }
691        }
692
82235
92417
        return \%opts;
693}
694
695sub _handle_dynamic {
696
3002
4521
        my ($self, $fields) = @_;
697
3002
1337
        my $h = $self->_fields_to_hash($fields);
698        $self->_append_event(Music::NWC2MusicXML::Event->new(
699                type => 'Dynamic',
700                data => {
701                        marking   => $h->{Style} // $h->{_positional} // '',
702
3002
4681
                        placement => $h->{Placement} // '',
703                },
704        ));
705}
706
707sub _handle_dyn_variance {
708
3
6
        my ($self, $fields) = @_;
709
3
1
        my $h = $self->_fields_to_hash($fields);
710        $self->_append_event(Music::NWC2MusicXML::Event->new(
711                type => 'DynVariance',
712                data => {
713                        style     => $h->{Style} // $h->{_positional} // '',
714
3
6
                        placement => $h->{Placement} // '',
715                },
716        ));
717}
718
719sub _handle_text {
720
0
0
        my ($self, $fields) = @_;
721
0
0
        my $h = $self->_fields_to_hash($fields);
722        $self->_append_event(Music::NWC2MusicXML::Event->new(
723                type => 'Text',
724
0
0
                data => { text => $h->{Text} // '', placement => $h->{Placement} // '' },
725        ));
726}
727
728sub _handle_lyric {
729
0
0
        my ($self, $fields) = @_;
730
0
0
        my $h    = $self->_fields_to_hash($fields);
731
0
0
        my $text = $h->{Text} // '';
732        # Syllabic type encoded by leading/trailing hyphens: strip them, infer type.
733
0
0
        my $starts_h = ($text =~ s/\A-//);
734
0
0
        my $ends_h   = ($text =~ s/-\z//);
735
0
0
        my $syllabic = $starts_h && $ends_h ? 'middle'
736                     : $starts_h            ? 'end'
737                     : $ends_h              ? 'begin'
738                     :                        'single';
739        $self->_append_event(Music::NWC2MusicXML::Event->new(
740                type => 'Lyric',
741
0
0
                data => { text => $text, verse => $h->{Verse} // 1, syllabic => $syllabic },
742        ));
743}
744
745sub _handle_tie {
746
0
0
        my ($self, $fields) = @_;
747
0
0
        $self->_append_event(Music::NWC2MusicXML::Event->new(
748                type => 'Tie',
749                data => {},
750        ));
751}
752
753sub _handle_slur {
754
0
0
        my ($self, $fields) = @_;
755
0
0
        my $h = $self->_fields_to_hash($fields);
756
0
0
        $self->_append_event(Music::NWC2MusicXML::Event->new(
757                type => 'Slur',
758                data => { _raw_fields => $h },
759        ));
760}
761
762sub _handle_beam {
763
0
0
        my ($self, $fields) = @_;
764
0
0
        my $h = $self->_fields_to_hash($fields);
765
0
0
        $self->_append_event(Music::NWC2MusicXML::Event->new(
766                type => 'Beam',
767                data => { _raw_fields => $h },
768        ));
769}
770
771sub _handle_tuplet {
772
0
0
        my ($self, $fields) = @_;
773
0
0
        my $h = $self->_fields_to_hash($fields);
774
0
0
        $self->_append_event(Music::NWC2MusicXML::Event->new(
775                type => 'Tuplet',
776                data => { _raw_fields => $h },
777        ));
778}
779
780sub _handle_instrument_change {
781
0
0
        my ($self, $fields) = @_;
782
0
0
        my $h = $self->_fields_to_hash($fields);
783        $self->_append_event(Music::NWC2MusicXML::Event->new(
784                type => 'Instrument',
785
0
0
                data => { name => $h->{Name} // '', patch => $h->{Patch} // 0 },
786        ));
787}
788
789sub _handle_flow_control {
790
0
0
        my ($self, $fields) = @_;
791
0
0
        my $h = $self->_fields_to_hash($fields);
792        $self->_append_event(Music::NWC2MusicXML::Event->new(
793                type => 'FlowControl',
794
0
0
                data => { directive => $h->{_positional} // $h->{Style} // '', extra => $h },
795        ));
796}
797
798sub _handle_tempo_variance {
799
121
297
        my ($self, $fields) = @_;
800
121
98
        my $h = $self->_fields_to_hash($fields);
801
802
121
171
        my $style = $h->{Style} // '';
803
121
122
        my $pos   = $h->{Pos}   // 0;
804
121
224
        $self->_append_event(Music::NWC2MusicXML::Event->new(
805                type => 'TempoVariance',
806                data => {
807                        style     => $style,
808                        placement => ($pos >= 0 ? 'above' : 'below'),
809                },
810        ));
811}
812
813sub _handle_spacer {
814        # Spacer is a graphical-layout hint with no MusicXML equivalent.
815        # Per the preservation principle (musical meaning > graphical appearance)
816        # it is silently discarded; no event, no warning.
817
30
91
        return;
818}
819
820sub _handle_rest_chord {
821
60
123
        my ($self, $fields) = @_;
822
60
59
        my $h = $self->_fields_to_hash($fields);
823
824        # RestChord is a multi-voice construct: one layer rests while another
825        # plays.  Full handling requires voice assignment (Phase 4).
826        # Stored as UnsupportedEvent so the raw field data is preserved for
827        # diagnostics and future implementation.
828
60
90
        $self->_append_event(Music::NWC2MusicXML::Event->new(
829                type      => 'UnsupportedEvent',
830                nwc_label => 'RestChord',
831                data      => { _raw_fields => $h },
832        ));
833}
834
835# ---------------------------------------------------------------------------
836# Private: helpers
837# ---------------------------------------------------------------------------
838
839sub _append_event {
840
1216067
369786
        my ($self, $event) = @_;
841
1216067
443361
        my $staff = $self->_current_staff_or_croak($event->type);
842
1216066
486309
        $staff->add_event($event);
843}
844
845sub _current_staff_or_croak {
846
1220212
386843
        my ($self, $context) = @_;
847
1220212
470157
        my $staff = $self->{_score}->current_staff;
848
1220212
432702
        croak _fmt_msg('error_no_staff', $context) unless defined $staff;
849
1220211
346540
        return $staff;
850}
851
852sub _warn_unknown {
853
5
5
        my ($self, $type) = @_;
854
5
12
        carp _fmt_msg('warn_unknown_record', $type, $self->{_line_no});
855}
856
857sub _fifths_from_signature {
858
794
6566
        my ($sig) = @_;
859
794
1126
        return 0 unless defined $sig && length $sig;
860
790
757
        return 0 if $sig eq $KEY_SIG_NATURAL;
861
862        # Signature is a comma-separated list of accidentals in circle-of-fifths order.
863        # Each item ending in '#' is a sharp; each item ending in 'b' (after a letter) is a flat.
864
643
518
        my @acc = split /,/, $sig;
865
643
489
        return 0 unless @acc;
866
867
643
1041
        if (index($acc[0], '#') >= 0) {
868
247
382
                return scalar @acc;       # positive = sharps
869        } elsif (substr($acc[0], -1, 1) eq 'b') {
870
367
657
                return -(scalar @acc);    # negative = flats
871        }
872
29
37
        return 0;
873}
874
875sub _fmt_msg {
876
36
26
        my ($key, @args) = @_;
877
36
50
        croak "Unknown message key: $key" unless exists $MESSAGES{$key};
878
36
128
        return sprintf $MESSAGES{$key}, @args;
879}
880
8811;
882