File Coverage

File:blib/lib/Music/NWC2MusicXML/Diagnostics.pm
Coverage:94.7%

linestmtbrancondsubtimecode
1package Music::NWC2MusicXML::Diagnostics;
2
3
10
10
10
10
422
8
62
use strict;
4
10
10
10
10
9
6
146
use warnings;
5
10
10
10
10
6
9
25
use autodie qw(:all);
6
7our $VERSION = '0.001.1';
8
9
10
10
10
10
14697
6
602
use Carp qw(croak carp);
10
10
10
10
10
11
4
114
use Readonly;
11
10
10
10
10
10
4
102
use Params::Validate::Strict qw(validate_strict);
12
10
10
10
10
9
8
3385
use Params::Get;
13
14# ---------------------------------------------------------------------------
15# Log-level constants -- higher value = more output
16# ---------------------------------------------------------------------------
17Readonly::Scalar my $LOG_QUIET   => 0;
18Readonly::Scalar my $LOG_NORMAL  => 1;
19Readonly::Scalar my $LOG_VERBOSE => 2;
20Readonly::Scalar my $LOG_DEBUG   => 3;
21
22Readonly::Hash my %LOG_LEVEL_MAP => (
23        quiet   => $LOG_QUIET,
24        normal  => $LOG_NORMAL,
25        verbose => $LOG_VERBOSE,
26        debug   => $LOG_DEBUG,
27);
28
29# ---------------------------------------------------------------------------
30# Exit-code constants (mirrored from main spec section 2)
31# ---------------------------------------------------------------------------
32Readonly::Scalar our $EXIT_OK       => 0;
33Readonly::Scalar our $EXIT_WARNINGS => 1;
34Readonly::Scalar our $EXIT_BAD_INPUT => 2;
35Readonly::Scalar our $EXIT_OUTPUT   => 3;
36Readonly::Scalar our $EXIT_INTERNAL => 4;
37
38# ---------------------------------------------------------------------------
39# i18n message dictionary -- all user-visible strings live here
40# ---------------------------------------------------------------------------
41Readonly::Hash my %MESSAGES => (
42        error_internal       => 'Internal error: %s',
43        error_open_warn_file => 'Cannot open warnings file %s for writing: %s',
44        warn_unsupported_obj => '[%s] Staff %s at %s: unsupported NWC object %s (%s)',
45        warn_approx_feature  => '[%s] Staff %s at %s: %s approximated as %s',
46        warn_no_equivalent   => '[%s] Staff %s at %s: %s has no MusicXML equivalent -- preserved in diagnostics',
47        info_file_start      => 'Converting: %s',
48        info_file_done       => 'Done: %s -> %s',
49        info_file_failed     => 'FAILED: %s (%s)',
50        info_summary         => 'Files processed: %d  Successful: %d  Warnings: %d  Failed: %d',
51        debug_decode_step    => '[DEBUG] NWC decode: %s',
52        debug_parse_step     => '[DEBUG] Parser: %s',
53        debug_gen_step       => '[DEBUG] MusicXML gen: %s',
54);
55
56# ---------------------------------------------------------------------------
57# new
58# ---------------------------------------------------------------------------
59
60 - 99
=head1 NAME

Music::NWC2MusicXML::Diagnostics - Warning collection, logging, and reporting for
the Music::NWC2MusicXML conversion pipeline.

=head1 VERSION

0.001.1

=head1 SYNOPSIS

    use Music::NWC2MusicXML::Diagnostics;

    my $diag = Music::NWC2MusicXML::Diagnostics->new(
        level        => 'verbose',
        warnings_fh  => \*STDERR,
    );

    $diag->warn_unsupported(
        file   => 'Pilgrim.nwc',
        staff  => 'Staff 1',
        pos    => '4:2',
        object => 'UserTool',
        reason => 'No MusicXML equivalent',
    );

    $diag->summary;

=head1 DESCRIPTION

Centralises all diagnostic output for the Music::NWC2MusicXML pipeline.  No
module should print warnings or debug traces directly; instead each module
receives a C<Diagnostics> instance and routes output through it.

Supports four severity levels: quiet, normal (default), verbose, debug.
Warnings can be written to an optional file handle (C<--warnings FILE>).
A summary count (processed / successful / warnings / failed) is maintained
and can be printed at batch completion.

=cut
100
101 - 139
=head2 new

Construct a Diagnostics instance.

=head3 Arguments

Named parameters:

=over 4

=item C<level> -- log verbosity (optional, default C<'normal'>).

=item C<warnings_fh> -- writable filehandle for per-warning output (optional).

=back

=head3 Returns

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

=head3 API SPECIFICATION

=head4 Input

    level        : SCALAR (optional, default 'normal')
                     -- Valid domain (4 values only, case-sensitive):
                     --   'quiet', 'normal', 'verbose', 'debug'
                     -- Invalid: undef, '' (empty), wrong-case ('QUIET', 'Normal'),
                     --   numeric (0, 1, 2, 3), or any other string -> croak
                     --   error_internal 'Unknown log level: ...'
    warnings_fh  : filehandle (optional)
                     -- Valid: any writable filehandle, or undef/absent (no file output)
                     -- The caller retains ownership; this module never closes it

=head4 Output

    Music::NWC2MusicXML::Diagnostics object

=cut
140
141sub new {
142
127
127
67392
        my ($class, %input) = @_;
143
127
119
        my $warnings_fh = delete $input{warnings_fh};   # glob refs can't be typed
144
127
228
        my $args = validate_strict(
145                schema => {
146                        level => { type => 'scalar', optional => 1, default => 'normal' },
147                },
148                input => \%input,
149        );
150
127
50
5102
        croak $@ unless defined $args;
151
152
127
100
123
        my $level_key = $args->{level} // '';
153        croak _fmt_msg('error_internal', 'Unknown log level: ' . ($level_key || '(undef)'))
154
127
100
100
223
                unless exists $LOG_LEVEL_MAP{$level_key};
155
156        my $self = bless {
157
114
411
                _level       => $LOG_LEVEL_MAP{$level_key},
158                _warnings_fh => $warnings_fh,
159                _warnings    => [],
160                _counts      => { processed => 0, successful => 0, warnings => 0, failed => 0 },
161        }, $class;
162
163
114
525
        return $self;
164}
165
166# ---------------------------------------------------------------------------
167# Public: logging methods
168# ---------------------------------------------------------------------------
169
170 - 207
=head2 info

Log an informational message (suppressed at C<quiet> level).

=head3 Purpose

Emit progress / status information to STDERR.

=head3 Arguments

=over 4

=item C<message> -- the text to emit.

=back

=head3 Returns

C<$self> (for chaining).

=head3 API SPECIFICATION

=head4 Input

    message : SCALAR (required)

=head4 Output

    $self (Music::NWC2MusicXML::Diagnostics)

=head3 FORMAL SPECIFICATION

 [DiagInfo]
   DiagInfo == message : String

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

=cut
208
209sub info {
210
76
76
375
        my ($self, $message) = @_;
211
76
100
136
        return $self if $self->{_level} < $LOG_NORMAL;
212
1
14
        print STDERR $message, "\n";
213
1
1
        return $self;
214}
215
216 - 251
=head2 verbose

Log a verbose message (emitted only at C<verbose> or C<debug> level).

=head3 Purpose

Emit per-file detail that is too chatty for normal output but useful when
diagnosing conversion issues.

=head3 Arguments

=over 4

=item C<message> -- the text to emit.

=back

=head3 Returns

C<$self>.

=head3 API SPECIFICATION

=head4 Input

    message : SCALAR (required)

=head4 Output

    $self (Music::NWC2MusicXML::Diagnostics)

=head3 FORMAL SPECIFICATION

 (placeholder)

=cut
252
253sub verbose {
254
5
5
22
        my ($self, $message) = @_;
255
5
100
12
        return $self if $self->{_level} < $LOG_VERBOSE;
256
1
8
        print STDERR $message, "\n";
257
1
1
        return $self;
258}
259
260 - 294
=head2 debug

Log a debug trace (emitted only at C<debug> level).

=head3 Purpose

Emit low-level pipeline tracing for developer use.

=head3 Arguments

=over 4

=item C<message> -- the text to emit.

=back

=head3 Returns

C<$self>.

=head3 API SPECIFICATION

=head4 Input

    message : SCALAR (required)

=head4 Output

    $self (Music::NWC2MusicXML::Diagnostics)

=head3 FORMAL SPECIFICATION

 (placeholder)

=cut
295
296sub debug {
297
105
105
75
        my ($self, $message) = @_;
298
105
100
126
        return $self if $self->{_level} < $LOG_DEBUG;
299
1
8
        print STDERR '[DEBUG] ', $message, "\n";
300
1
1
        return $self;
301}
302
303 - 373
=head2 warn_unsupported

Record a warning for an unsupported NWC object.

=head3 Purpose

Called when the parser or generator encounters an NWC object it cannot
represent in MusicXML.  The warning is added to the internal list and, if
a C<warnings_fh> was supplied, written immediately to that handle.

=head3 Arguments

Named parameters (hashref or flat list):

=over 4

=item C<file>   -- input filename (string, required).

=item C<staff>  -- staff name or number (string, required).

=item C<pos>    -- measure:beat position string (string, optional).

=item C<object> -- NWC object type name (string, required).

=item C<reason> -- human-readable reason (string, optional).

=back

=head3 Returns

C<$self>.

=head3 Side Effects

Increments the internal warning counter.  Writes to C<warnings_fh> if set.

=head3 Usage Example

    $diag->warn_unsupported(
        file   => 'Pilgrim.nwc',
        staff  => 'Violin I',
        pos    => '12:1',
        object => 'UserTool',
        reason => 'No MusicXML equivalent',
    );

=head3 API SPECIFICATION

=head4 Input

    file   : SCALAR (required)
    staff  : SCALAR (required)
    pos    : SCALAR (optional, default => '?')
    object : SCALAR (required)
    reason : SCALAR (optional, default => 'unknown')

=head4 Output

    $self (Music::NWC2MusicXML::Diagnostics)

=head3 MESSAGES

| Code                    | Resolution                         |
|-------------------------|------------------------------------|
| warn_unsupported_obj    | NWC object has no MusicXML mapping |

=head3 FORMAL SPECIFICATION

 (placeholder)

=cut
374
375sub warn_unsupported {
376
23
23
1041
        my ($self, %input) = @_;
377
23
81
        my $args = validate_strict(
378                schema => {
379                        file   => { type => 'scalar' },
380                        staff  => { type => 'scalar' },
381                        pos    => { type => 'scalar', optional => 1, default => '?' },
382                        object => { type => 'scalar' },
383                        reason => { type => 'scalar', optional => 1, default => 'unknown' },
384                },
385                input => \%input,
386        );
387
21
50
1682
        croak $@ unless defined $args;
388
389        my $msg = _fmt_msg('warn_unsupported_obj',
390
21
33
                $args->{file}, $args->{staff}, $args->{pos}, $args->{object}, $args->{reason});
391
392
21
1499
        $self->_record_warning($msg);
393
21
37
        return $self;
394}
395
396 - 430
=head2 warn_approximate

Record a warning that an NWC feature was approximated.

=head3 Purpose

Called when an NWC feature maps only approximately to a MusicXML construct.

=head3 Arguments

Named parameters: C<file>, C<staff>, C<pos>, C<feature>, C<approximation>.

=head3 Returns

C<$self>.

=head3 API SPECIFICATION

=head4 Input

    file          : SCALAR (required)
    staff         : SCALAR (required)
    pos           : SCALAR (optional)
    feature       : SCALAR (required)
    approximation : SCALAR (required)

=head4 Output

    $self

=head3 FORMAL SPECIFICATION

 (placeholder)

=cut
431
432sub warn_approximate {
433
4
4
24
        my ($self, %input) = @_;
434
4
13
        my $args = validate_strict(
435                schema => {
436                        file          => { type => 'scalar' },
437                        staff         => { type => 'scalar' },
438                        pos           => { type => 'scalar', optional => 1, default => '?' },
439                        feature       => { type => 'scalar' },
440                        approximation => { type => 'scalar' },
441                },
442                input => \%input,
443        );
444
4
50
313
        croak $@ unless defined $args;
445
446        my $msg = _fmt_msg('warn_approx_feature',
447                $args->{file}, $args->{staff}, $args->{pos},
448
4
7
                $args->{feature}, $args->{approximation});
449
450
4
16
        $self->_record_warning($msg);
451
4
4
        return $self;
452}
453
454 - 489
=head2 count

Update the batch summary counters.

=head3 Purpose

Called by the top-level converter to track per-file outcomes.

=head3 Arguments

Named parameter: C<outcome> -- one of C<processed>, C<successful>,
C<warnings>, C<failed>.

=head3 Returns

C<$self>.

=head3 API SPECIFICATION

=head4 Input

    outcome : SCALAR (required)
                -- Valid domain (4 values only, case-sensitive):
                --   'processed', 'successful', 'warnings', 'failed'
                -- Invalid: undef, '' (empty), wrong-case ('Processed'), any other
                --   string -> croak error_internal 'Unknown counter: ...'

=head4 Output

    $self

=head3 FORMAL SPECIFICATION

 (placeholder)

=cut
490
491sub count {
492
1129
1129
2474
        my ($self, %input) = @_;
493
1129
693
        my $args = validate_strict(
494                schema => { outcome => { type => 'scalar' } },
495                input  => \%input,
496        );
497
1128
50
29849
        croak $@ unless defined $args;
498
499        croak _fmt_msg('error_internal', 'Unknown counter: ' . $args->{outcome})
500
1128
100
586
                unless exists $self->{_counts}{ $args->{outcome} };
501
502
1121
369
        $self->{_counts}{ $args->{outcome} }++;
503
1121
521
        return $self;
504}
505
506 - 533
=head2 summary

Print the batch processing summary.

=head3 Purpose

Emits the Files processed / Successful / Warnings / Failed summary to STDERR
at the end of a batch run.

=head3 Returns

C<$self>.

=head3 API SPECIFICATION

=head4 Input

    (none)

=head4 Output

    $self

=head3 FORMAL SPECIFICATION

 (placeholder)

=cut
534
535sub summary {
536
17
17
15
        my ($self) = @_;
537
17
100
35
        return $self if $self->{_level} < $LOG_NORMAL;
538
1
1
        my $c = $self->{_counts};
539        print STDERR _fmt_msg('info_summary',
540
1
1
                $c->{processed}, $c->{successful}, $c->{warnings}, $c->{failed}), "\n";
541
1
10
        return $self;
542}
543
544 - 562
=head2 warnings

Return an arrayref of all collected warning strings.

=head3 Returns

Arrayref of strings.

=head3 API SPECIFICATION

=head4 Input

    (none)

=head4 Output

    arrayref of SCALAR

=cut
563
564sub warnings {
565
40
40
642
        my ($self) = @_;
566
40
72
        return $self->{_warnings};
567}
568
569 - 573
=head2 has_warnings

Return true if any warnings have been collected.

=cut
574
575sub has_warnings {
576
13
13
997
        my ($self) = @_;
577
13
13
8
21
        return scalar @{ $self->{_warnings} } > 0;
578}
579
580# ---------------------------------------------------------------------------
581# Private helpers
582# ---------------------------------------------------------------------------
583
584sub _record_warning {
585
25
25
22
        my ($self, $msg) = @_;
586
25
25
14
20
        push @{ $self->{_warnings} }, $msg;
587
25
16
        $self->{_counts}{warnings}++;
588
25
100
24
        if (defined $self->{_warnings_fh}) {
589
3
3
2
2753
                print { $self->{_warnings_fh} } 'WARNING: ', $msg, "\n";
590        }
591
25
50
26
        if ($self->{_level} >= $LOG_NORMAL) {
592
0
0
                print STDERR 'WARNING: ', $msg, "\n";
593        }
594
25
14
        return;
595}
596
597# Class-level helper; not a method so it can be called before construction.
598sub _fmt_msg {
599
46
46
77
        my ($key, @args) = @_;
600
46
50
42
        croak "Unknown message key: $key" unless exists $MESSAGES{$key};
601
46
131
        return sprintf $MESSAGES{$key}, @args;
602}
603
6041;
605