File Coverage

blib/lib/Data/Dataset/ChordProgressions.pm
Criterion Covered Total %
statement 41 41 100.0
branch 3 6 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 4 4 100.0
total 58 63 92.0


line stmt bran cond sub pod time code
1             package Data::Dataset::ChordProgressions;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Provide access to hundreds of possible chord progressions
5              
6             our $VERSION = '0.0201';
7              
8 1     1   730 use strict;
  1         3  
  1         28  
9 1     1   6 use warnings;
  1         2  
  1         24  
10              
11 1     1   957 use Text::CSV_XS ();
  1         19745  
  1         29  
12 1     1   516 use File::ShareDir qw(dist_dir);
  1         27042  
  1         60  
13 1     1   470 use Music::Scales qw(get_scale_notes);
  1         5455  
  1         580  
14              
15              
16              
17             sub as_file {
18 3     3 1 969 my $file = eval { dist_dir('Data-Dataset-ChordProgressions') . '/Chord-Progressions.csv' };
  3         11  
19              
20 3 50 33     394 $file = 'share/Chord-Progressions.csv'
21             unless $file && -e $file;
22              
23 3         11 return $file;
24             }
25              
26              
27             sub as_list {
28 1     1 1 307 my $file = as_file();
29              
30 1         6 my @data;
31              
32 1         8 my $csv = Text::CSV_XS->new({ binary => 1 });
33              
34 1 50       164 open my $fh, '<', $file
35             or die "Can't read $file: $!";
36              
37 1         54 while (my $row = $csv->getline($fh)) {
38 777         33064 push @data, $row;
39             }
40              
41 1         54 close $fh;
42              
43 1         104 return @data;
44             }
45              
46              
47             sub as_hash {
48 1     1 1 1044 my $file = as_file();
49              
50 1         3 my %data;
51              
52 1         8 my $csv = Text::CSV_XS->new({ binary => 1 });
53              
54 1 50       158 open my $fh, '<', $file
55             or die "Can't read $file: $!";
56              
57 1         40 while (my $row = $csv->getline($fh)) {
58             # Row = Genre, Key, Type, Chords, Roman
59 777         19543 push @{ $data{ $row->[0] }{ $row->[1] }{ $row->[2] } }, [ $row->[3], $row->[4] ];
  777         15949  
60             }
61              
62 1         94 close $fh;
63              
64 1         20 return %data;
65             }
66              
67              
68             sub transpose {
69 1     1 1 941 my ($note, $scale, $progression) = @_;
70              
71 1         2 my %note_map;
72 1         5 @note_map{ get_scale_notes('C', $scale) } = get_scale_notes($note, $scale);
73              
74             # transpose the progression chords from C
75 1         402 (my $named = $progression->[0]) =~ s/([A-G][#b]?)/$note_map{$1}/g;
76              
77 1         6 return $named;
78             }
79              
80             1;
81              
82             __END__