| File: | blib/lib/Music/NWC2MusicXML/Score.pm |
| Coverage: | 96.8% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Music::NWC2MusicXML::Score; | |||||
| 2 | ||||||
| 3 | 15 15 15 | 193 9 100 | use strict; | |||
| 4 | 15 15 15 | 14 3 237 | use warnings; | |||
| 5 | ||||||
| 6 | our $VERSION = '0.001.1'; | |||||
| 7 | ||||||
| 8 | 15 15 15 | 12 8 145 | use Carp qw(croak carp); | |||
| 9 | 15 15 15 | 16 4 133 | use Readonly; | |||
| 10 | 15 15 15 | 9 10 136 | use Scalar::Util qw(blessed); | |||
| 11 | 15 15 15 | 13 6 109 | use Params::Validate::Strict qw(validate_strict); | |||
| 12 | 15 15 15 | 10 7 85 | use Params::Get; | |||
| 13 | 15 15 15 | 1075 14 2777 | use Music::NWC2MusicXML::Staff; | |||
| 14 | ||||||
| 15 | Readonly::Hash my %MESSAGES => ( | |||||
| 16 | error_bad_staff => 'add_staff: argument must be a Music::NWC2MusicXML::Staff, got: %s', | |||||
| 17 | error_no_staves => 'Score contains no staves', | |||||
| 18 | error_internal => 'Internal error: %s', | |||||
| 19 | ); | |||||
| 20 | ||||||
| 21 | # Recognised SongInfo keys that map to MusicXML metadata elements | |||||
| 22 | Readonly::Array my @SONGINFO_KEYS => qw( | |||||
| 23 | Title | |||||
| 24 | Author | |||||
| 25 | Lyricist | |||||
| 26 | Copyright | |||||
| 27 | Copyright1 | |||||
| 28 | Copyright2 | |||||
| 29 | Comments | |||||
| 30 | ); | |||||
| 31 | ||||||
| 32 - 72 | =head1 NAME
Music::NWC2MusicXML::Score - Internal representation of a complete NWC score.
=head1 VERSION
0.001.1
=head1 SYNOPSIS
use Music::NWC2MusicXML::Score;
my $score = Music::NWC2MusicXML::Score->new(
metadata => { Title => 'To a Pilgrim', Author => 'Trad, Arr Nigel Horne' },
page_setup => { StaffSize => 16, Zoom => 3 },
);
$score->add_staff($staff_object);
my $staves = $score->staves;
=head1 DESCRIPTION
C<Music::NWC2MusicXML::Score> is the root of the internal representation tree.
It holds:
=over 4
=item * B<metadata> -- SongInfo fields (Title, Author, Lyricist, Copyright, Comments).
=item * B<page_setup> -- PgSetup fields, retained but largely informational.
=item * B<properties> -- additional score-level NWC properties.
=item * B<staves> -- ordered list of C<Music::NWC2MusicXML::Staff> objects.
=back
This class is MusicXML-agnostic; it describes the musical content in NWC
terms. The C<Music::NWC2MusicXML::MusicXML> generator translates it to XML.
=cut | |||||
| 73 | ||||||
| 74 | sub new { | |||||
| 75 | 316 | 55652 | my ($class, %input) = @_; | |||
| 76 | 316 | 889 | my $args = validate_strict( | |||
| 77 | schema => { | |||||
| 78 | metadata => { type => 'hashref', optional => 1, default => {} }, | |||||
| 79 | page_setup => { type => 'hashref', optional => 1, default => {} }, | |||||
| 80 | properties => { type => 'hashref', optional => 1, default => {} }, | |||||
| 81 | nwc_version => { type => 'scalar', optional => 1 }, | |||||
| 82 | }, | |||||
| 83 | input => \%input, | |||||
| 84 | ); | |||||
| 85 | 314 | 15894 | croak $@ unless defined $args; | |||
| 86 | ||||||
| 87 | my $self = bless { | |||||
| 88 | _metadata => $args->{metadata}, | |||||
| 89 | _page_setup => $args->{page_setup}, | |||||
| 90 | _properties => $args->{properties}, | |||||
| 91 | _nwc_version => $args->{nwc_version}, | |||||
| 92 | 314 | 1262 | _staves => [], | |||
| 93 | _fonts => [], | |||||
| 94 | }, $class; | |||||
| 95 | ||||||
| 96 | 314 | 11563 | return $self; | |||
| 97 | } | |||||
| 98 | ||||||
| 99 | # --------------------------------------------------------------------------- | |||||
| 100 | # Accessors | |||||
| 101 | # --------------------------------------------------------------------------- | |||||
| 102 | ||||||
| 103 - 114 | =head2 metadata Return the metadata hashref. Keys correspond to NWC SongInfo field names: C<Title>, C<Author>, C<Lyricist>, C<Copyright>, C<Comments>. =head3 Returns Hashref. =cut | |||||
| 115 | ||||||
| 116 | 586 | 1719 | sub metadata { return $_[0]->{_metadata} } | |||
| 117 | ||||||
| 118 - 122 | =head2 page_setup Return the page-setup hashref (NWC PgSetup fields). =cut | |||||
| 123 | ||||||
| 124 | 258 | 318 | sub page_setup { return $_[0]->{_page_setup} } | |||
| 125 | ||||||
| 126 - 130 | =head2 properties Return additional score-level properties hashref. =cut | |||||
| 131 | ||||||
| 132 | 2 | 5 | sub properties { return $_[0]->{_properties} } | |||
| 133 | ||||||
| 134 - 139 | =head2 nwc_version Return the NWC version string extracted from the NWCTXT header (e.g. C<2.751>), or undef if not available. =cut | |||||
| 140 | ||||||
| 141 | 13 | 217 | sub nwc_version { return $_[0]->{_nwc_version} } | |||
| 142 | ||||||
| 143 - 148 | =head2 fonts Return the arrayref of font descriptors parsed from NWC Font records. Each entry is a hashref with keys: style, typeface, size, bold, italic. =cut | |||||
| 149 | ||||||
| 150 | 181 | 631 | sub fonts { return $_[0]->{_fonts} } | |||
| 151 | ||||||
| 152 - 170 | =head2 set_metadata_field Set a single metadata field. =head3 Arguments =over 4 =item C<$key> -- field name (e.g. C<Title>). =item C<$value> -- string value. =back =head3 Returns C<$self>. =cut | |||||
| 171 | ||||||
| 172 | sub set_metadata_field { | |||||
| 173 | 287 | 191 | my ($self, $key, $value) = @_; | |||
| 174 | 287 | 175 | $self->{_metadata}{$key} = $value; | |||
| 175 | 287 | 135 | return $self; | |||
| 176 | } | |||||
| 177 | ||||||
| 178 | # --------------------------------------------------------------------------- | |||||
| 179 | # Staff management | |||||
| 180 | # --------------------------------------------------------------------------- | |||||
| 181 | ||||||
| 182 - 240 | =head2 add_staff Append a C<Music::NWC2MusicXML::Staff> to the score's staff list. =head3 Purpose Called by the parser each time it encounters an C<AddStaff> record; the staff object is populated with subsequent per-staff records and then stays in the list for MusicXML generation. =head3 Arguments =over 4 =item C<$staff> -- a blessed C<Music::NWC2MusicXML::Staff> object (required). =back =head3 Returns C<$self> (for chaining). =head3 Side Effects Appends to C<_staves>. =head3 Usage Example $score->add_staff( Music::NWC2MusicXML::Staff->new(name => 'Violin I') ); =head3 API SPECIFICATION =head4 Input $staff : Music::NWC2MusicXML::Staff (required) =head4 Output $self (Music::NWC2MusicXML::Score) =head3 MESSAGES | Code | Meaning | Resolution | |----------------|----------------------------------|------------------------------| | error_bad_staff| Argument is not a Staff object | Construct Staff before adding | =head3 FORMAL SPECIFICATION [AddStaff] DeltaScore staff? : Staff --------- staves' = staves ^ <staff?> (placeholder -- populate with Z calculus as implementation matures) =cut | |||||
| 241 | ||||||
| 242 | sub add_staff { | |||||
| 243 | 496 | 1015 | my ($self, $staff) = @_; | |||
| 244 | 496 | 1039 | croak _fmt_msg('error_bad_staff', ref($staff) // 'SCALAR') | |||
| 245 | unless blessed($staff) && $staff->isa('Music::NWC2MusicXML::Staff'); | |||||
| 246 | 482 482 | 246 309 | push @{ $self->{_staves} }, $staff; | |||
| 247 | 482 | 522 | return $self; | |||
| 248 | } | |||||
| 249 | ||||||
| 250 - 268 | =head2 staves Return an arrayref of all C<Music::NWC2MusicXML::Staff> objects in score order. =head3 Returns Arrayref of C<Music::NWC2MusicXML::Staff>. =head3 API SPECIFICATION =head4 Input (none) =head4 Output ARRAYREF of Music::NWC2MusicXML::Staff =cut | |||||
| 269 | ||||||
| 270 | sub staves { | |||||
| 271 | 592 | 642 | my ($self) = @_; | |||
| 272 | 592 | 556 | return $self->{_staves}; | |||
| 273 | } | |||||
| 274 | ||||||
| 275 - 280 | =head2 current_staff Return the last staff appended (the one currently being populated by the parser), or undef if no staves have been added. =cut | |||||
| 281 | ||||||
| 282 | sub current_staff { | |||||
| 283 | 1220256 | 357796 | my ($self) = @_; | |||
| 284 | 1220256 | 414559 | return $self->{_staves}[-1]; | |||
| 285 | } | |||||
| 286 | ||||||
| 287 - 291 | =head2 staff_count Return the number of staves. =cut | |||||
| 292 | ||||||
| 293 | sub staff_count { | |||||
| 294 | 238 | 4490 | my ($self) = @_; | |||
| 295 | 238 238 | 138 326 | return scalar @{ $self->{_staves} }; | |||
| 296 | } | |||||
| 297 | ||||||
| 298 - 331 | =head2 validate Perform consistency checks on the score structure. Called when C<--validate> is passed on the command line. =head3 Purpose Checks that every staff has at least one event, that tie/slur relationships are consistent, and that measure durations match the current time signature. =head3 Returns Arrayref of diagnostic strings (empty on success). =head3 API SPECIFICATION =head4 Input (none) =head4 Output ARRAYREF of SCALAR (diagnostic messages) =head3 FORMAL SPECIFICATION [Validate] score : Score --------- forall s : staves @ valid_staff(s) (placeholder) =cut | |||||
| 332 | ||||||
| 333 | sub validate { | |||||
| 334 | 9 | 110 | my ($self) = @_; | |||
| 335 | ||||||
| 336 | # Strategy: iterate staves; for each staff check that: | |||||
| 337 | # - event list is non-empty | |||||
| 338 | # - all Bar events divide time correctly per time signature | |||||
| 339 | # - all Tie/Slur events have matching start/stop pairs | |||||
| 340 | # Return all accumulated diagnostics rather than croaking on first failure. | |||||
| 341 | ||||||
| 342 | 9 | 5 | my @diagnostics; | |||
| 343 | ||||||
| 344 | 9 | 9 | if ($self->staff_count == 0) { | |||
| 345 | 4 | 7 | push @diagnostics, _fmt_msg('error_no_staves'); | |||
| 346 | 4 | 14 | return \@diagnostics; | |||
| 347 | } | |||||
| 348 | ||||||
| 349 | 5 5 | 5 17 | for my $staff (@{ $self->{_staves} }) { | |||
| 350 | # TODO Phase 3: implement per-staff validation checks | |||||
| 351 | # - time signature consistency | |||||
| 352 | # - tie/slur pairing | |||||
| 353 | # - tuplet structure | |||||
| 354 | # - pitch validity | |||||
| 355 | } | |||||
| 356 | ||||||
| 357 | 5 | 5 | return \@diagnostics; | |||
| 358 | } | |||||
| 359 | ||||||
| 360 | # --------------------------------------------------------------------------- | |||||
| 361 | # Private | |||||
| 362 | # --------------------------------------------------------------------------- | |||||
| 363 | ||||||
| 364 | sub _fmt_msg { | |||||
| 365 | 18 | 13 | my ($key, @args) = @_; | |||
| 366 | 18 | 25 | croak "Unknown message key: $key" unless exists $MESSAGES{$key}; | |||
| 367 | 18 | 60 | return sprintf $MESSAGES{$key}, @args; | |||
| 368 | } | |||||
| 369 | ||||||
| 370 | 1; | |||||
| 371 | ||||||