File Coverage

blib/lib/Data/Dataset/ChordProgressions.pm
Criterion Covered Total %
statement 44 44 100.0
branch 3 6 50.0
condition 1 3 33.3
subroutine 10 10 100.0
pod 4 4 100.0
total 62 67 92.5


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.0303';
7              
8 1     1   697 use strict;
  1         2  
  1         28  
9 1     1   5 use warnings;
  1         2  
  1         38  
10              
11 1     1   1024 use Text::CSV_XS ();
  1         19524  
  1         32  
12 1     1   472 use File::ShareDir qw(dist_dir);
  1         26116  
  1         67  
13 1     1   501 use Music::Scales qw(get_scale_notes);
  1         5371  
  1         67  
14 1     1   7 use Exporter 'import';
  1         2  
  1         531  
15              
16             our @EXPORT = qw(
17             as_file
18             as_list
19             as_hash
20             transpose
21             );
22              
23              
24              
25             sub as_file {
26 3     3 1 706 my $file = eval { dist_dir('Data-Dataset-ChordProgressions') . '/Chord-Progressions.csv' };
  3         12  
27              
28 3 50 33     438 $file = 'share/Chord-Progressions.csv'
29             unless $file && -e $file;
30              
31 3         12 return $file;
32             }
33              
34              
35             sub as_list {
36 1     1 1 321 my $file = as_file();
37              
38 1         3 my @data;
39              
40 1         11 my $csv = Text::CSV_XS->new({ binary => 1 });
41              
42 1 50       200 open my $fh, '<', $file
43             or die "Can't read $file: $!";
44              
45 1         52 while (my $row = $csv->getline($fh)) {
46 777         33108 push @data, $row;
47             }
48              
49 1         53 close $fh;
50              
51 1         116 return @data;
52             }
53              
54              
55             sub as_hash {
56 1     1 1 1110 my $file = as_file();
57              
58 1         5 my %data;
59              
60 1         10 my $csv = Text::CSV_XS->new({ binary => 1 });
61              
62 1 50       248 open my $fh, '<', $file
63             or die "Can't read $file: $!";
64              
65 1         43 while (my $row = $csv->getline($fh)) {
66             # Row = Genre, Key, Type, Chords, Roman
67 777         19134 push @{ $data{ $row->[0] }{ $row->[1] }{ $row->[2] } }, [ $row->[3], $row->[4] ];
  777         15841  
68             }
69              
70 1         52 close $fh;
71              
72 1         27 return %data;
73             }
74              
75              
76             sub transpose {
77 1     1 1 1187 my ($note, $scale, $progression) = @_;
78              
79 1         3 my %note_map;
80 1         8 @note_map{ get_scale_notes('C', $scale) } = get_scale_notes($note, $scale);
81              
82             # transpose the progression chords from C
83 1         450 $progression =~ s/([A-G][#b]?)/$note_map{$1}/g;
84              
85 1         15 return $progression;
86             }
87              
88             1;
89              
90             __END__