File Coverage

blib/lib/Music/PitchNum/ASPN.pm
Criterion Covered Total %
statement 25 25 100.0
branch 7 8 87.5
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 41 42 97.6


line stmt bran cond sub pod time code
1             # -*- Perl -*-
2             #
3             # Pitch number roles using the American Standard Pitch Notation (ASPN) format,
4             # or something probably close enough.
5             #
6             # Run perldoc(1) on this file for additional documentation.
7              
8             package Music::PitchNum::ASPN;
9              
10 1     1   12282 use 5.010000;
  1         5  
  1         56  
11 1     1   8 use Moo::Role;
  1         1  
  1         7  
12 1     1   1223 use POSIX qw/floor/;
  1         8089  
  1         12  
13 1     1   1356 use Scalar::Util qw/looks_like_number/;
  1         3  
  1         386  
14              
15             our $VERSION = '0.06';
16              
17             # for pitchnum (TODO make these attributes or otherwise f(x) calls?)
18             my %NOTE2NUM = (
19             C => 0,
20             D => 2,
21             E => 4,
22             F => 5,
23             G => 7,
24             A => 9,
25             B => 11,
26             );
27             my %NUM2NOTE = (
28             0 => 'C',
29             1 => 'C#',
30             2 => 'D',
31             3 => 'D#',
32             4 => 'E',
33             5 => 'F',
34             6 => 'F#',
35             7 => 'G',
36             8 => 'G#',
37             9 => 'A',
38             10 => 'A#',
39             11 => 'B',
40             );
41              
42             ##############################################################################
43             #
44             # METHODS
45              
46             sub pitchname {
47 5     5 1 11045 my ( $self, $number ) = @_;
48 5 100       27 die "need a number for pitchname\n" if !looks_like_number $number;
49              
50 4         41 return $NUM2NOTE{ $number % 12 } . ( floor( $number / 12 ) - 1 );
51             }
52              
53             sub pitchnum {
54 5     5 1 10 my ( $self, $name ) = @_;
55              
56             # already a pitch number, but nix the decimal foo
57 5 50       20 return int $name if looks_like_number $name;
58              
59 5         8 my $pitchnum;
60              
61             # Only sharps, as the Young article only has those. Use the main module for
62             # looser pitch name matching.
63 5 100       32 if ( $name =~ m/ (?[A-G]) (?[#])? (?-?[0-9]{1,2}) /x )
64             {
65 1     1   511 $pitchnum = 12 * ( $+{octave} + 1 ) + $NOTE2NUM{ $+{note} };
  1         376  
  1         70  
  4         37  
66 4 100       17 $pitchnum++ if defined $+{chrome};
67             }
68              
69 5         19 return $pitchnum;
70             }
71              
72             1;
73             __END__