File Coverage

blib/lib/MP3/Tag/CDDB_File.pm
Criterion Covered Total %
statement 120 130 92.3
branch 67 98 68.3
condition 36 78 46.1
subroutine 18 22 81.8
pod 8 15 53.3
total 249 343 72.5


line stmt bran cond sub pod time code
1             package MP3::Tag::CDDB_File;
2              
3 6     6   36 use strict;
  6         11  
  6         168  
4 6     6   31 use File::Basename;
  6         10  
  6         304  
5 6     6   34 use File::Spec;
  6         21  
  6         170  
6 6     6   29 use vars qw /$VERSION @ISA/;
  6         10  
  6         14784  
7              
8             $VERSION="1.00";
9             @ISA = 'MP3::Tag::__hasparent';
10              
11             =pod
12              
13             =head1 NAME
14              
15             MP3::Tag::CDDB_File - Module for parsing CDDB files.
16              
17             =head1 SYNOPSIS
18              
19             my $db = MP3::Tag::CDDB_File->new($filename, $track); # Name of audio file
20             my $db = MP3::Tag::CDDB_File->new_from($record, $track); # Contents of CDDB
21              
22             ($title, $artist, $album, $year, $comment, $track) = $db->parse();
23              
24             see L
25              
26             =head1 DESCRIPTION
27              
28             MP3::Tag::CDDB_File is designed to be called from the MP3::Tag module.
29              
30             It parses the content of CDDB file.
31              
32             The file is found in the same directory as audio file; the list of possible
33             file names is taken from the field C if set by MP3::Tag config()
34             method.
35              
36             =over 4
37              
38             =cut
39              
40              
41             # Constructor
42              
43             sub new_from {
44 0     0 0 0 my ($class, $data, $track) = @_;
45 0         0 bless {data => [split /\n/, $data], track => $track}, $class;
46             }
47              
48             sub new_setdir {
49 85     85 0 150 my $class = shift;
50 85         136 my $filename = shift;
51 85 50       324 $filename = $filename->filename if ref $filename;
52 85         2513 $filename = dirname($filename);
53 85         418 return bless {dir => $filename}, $class; # bless to enable get_config()
54             }
55              
56             sub new_fromdir {
57 85     85 0 134 my $class = shift;
58 85         115 my $h = shift;
59 85         154 my $dir = $h->{dir};
60 85         150 my ($found, $e);
61 85         243 my $l = $h->get_config('cddb_files');
62 85         249 for my $file (@$l) {
63 219         1527 my $f = File::Spec->catdir($dir, $file);
64 219 100       2390 $found = $f, last if -r $f;
65             }
66 85 100       451 return unless $found;
67 36         105 local *F;
68 36 50       1053 open F, "< $found" or die "Can't open `$found': $!";
69 36 0 33     192 if ($e = $h->get_config('decode_encoding_cddb_file') and $e->[0]) {
70 0         0 eval "binmode F, ':encoding($e->[0])'"; # old binmode won't compile...
71             }
72 36         1347 my @data = ;
73 36 50       458 close F or die "Error closing `$found': $!";
74             bless {filename => $found, data => \@data, track => shift,
75 36         437 parent => $h->{parent}}, $class;
76             }
77              
78             sub new {
79 0     0 0 0 my $class = shift;
80 0         0 my $h = $class->new_setdir(@_);
81 0         0 $class->new_fromdir($h);
82             }
83              
84             sub new_with_parent {
85 85     85 0 258 my ($class, $filename, $parent) = @_;
86 85         244 my $h = $class->new_setdir($filename);
87 85         217 $h->{parent} = $parent;
88 85         235 $class->new_fromdir($h);
89             }
90              
91             # Destructor
92              
93       0     sub DESTROY {}
94              
95             =item parse()
96              
97             ($title, $artist, $album, $year, $comment, $track) =
98             $db->parse($what);
99              
100             parse_filename() extracts information about artist, title, track number,
101             album and year from the CDDB record. $what is optional; it maybe title,
102             track, artist, album, year, genre or comment. If $what is defined parse() will return
103             only this element.
104              
105             Additionally, $what can take values C (returns the value of
106             artist in the disk-info field DTITLE, but only if author is specified in the
107             track-info field TTITLE), C (returns the title specifically from
108             track-info field - the C may fall back to the info from disk-info
109             field), C (processed EXTD comment), C
110             (processed EXTT comment).
111              
112             The returned year and genre is taken from DYEAR, DGENRE, EXTT, EXTD fields;
113             recognized prefixes in the two last fields are YEAR, ID3Y, ID3G.
114             The declarations of this form are stripped from the returned comment.
115              
116             An alternative
117             syntax "Recorded"/"Recorded on"/"Recorded in"/ is also supported; the format
118             of the date recognized by ID3v2::year(), or just a date field without a prefix.
119              
120             =cut
121              
122             sub return_parsed {
123 26     26 0 42 my ($self,$what) = @_;
124 26 50       95 if (defined $what) {
125 26 100       65 return $self->{parsed}{a_in_title} if $what =~/^artist_collection/i;
126 23 50       42 return $self->{parsed}{t_in_track} if $what =~/^title_track/i;
127 23 100       47 return $self->{parsed}{extt} if $what =~/^comment_track/i;
128 21 100       44 return $self->{parsed}{extd} if $what =~/^comment_collection/i;
129 20 50       75 return $self->{parsed}{DISCID} if $what =~/^cddb_id/i;
130 20 100       62 return $self->{parsed}{album} if $what =~/^al/i;
131 18 100       54 return $self->{parsed}{artist} if $what =~/^a/i;
132 14 50       28 return $self->{parsed}{track} if $what =~/^tr/i;
133 14 100       40 return $self->{parsed}{year} if $what =~/^y/i;
134 11 100       37 return $self->{parsed}{comment}if $what =~/^c/i;
135 8 100       21 return $self->{parsed}{genre} if $what =~/^g/i;
136 6         32 return $self->{parsed}{title};
137             }
138            
139 0 0       0 return $self->{parsed} unless wantarray;
140 0         0 return map $self->{parsed}{$_} , qw(title artist album year comment track);
141             }
142              
143             my %r = ( 'n' => "\n", 't' => "\t", '\\' => "\\" );
144              
145             sub parse_lines {
146 8     8 0 13 my ($self) = @_;
147 8 50       20 return if $self->{fields};
148 8         15 for my $l (@{$self->{data}}) {
  8         20  
149 384 100       992 next unless $l =~ /^\s*(\w+)\s*=(\s*(.*))/;
150 224         393 my $app = $2;
151 224 50       711 $self->{fields}{$1} = "", $app = $3 unless exists $self->{fields}{$1};
152 224         435 $self->{fields}{$1} .= $app;
153 224 100       731 $self->{last} = $1 if $1 =~ /\d+$/;
154             }
155 8         15 s/\\([nt\\])/$r{$1}/g for values %{$self->{fields}};
  8         90  
156             }
157              
158             sub parse {
159 26     26 1 56 my ($self,$what) = @_;
160 26 100       114 return $self->return_parsed($what) if exists $self->{parsed};
161 8         24 $self->parse_lines;
162 8         15 my %parsed;
163 8         44 my ($t1, $c1, $t2, $c2) = map $self->{fields}{$_}, qw(DTITLE EXTD);
164 8         23 my $track = $self->track;
165 8 50       23 if ($track) {
166 8         17 my $t = $track - 1;
167 8         51 ($t2, $c2) = map $self->{fields}{$_}, "TTITLE$t", "EXTT$t";
168             }
169 8         18 my ($a, $t, $aa, $tt, $a_in_title, $t_in_track);
170 8 50       53 ($a, $t) = split /\s+\/\s+/, $t1, 2 if defined $t1;
171 8 50       23 ($a, $t) = ($t, $a) unless defined $t;
172 8 50       34 ($aa, $tt) = split /\s+\/\s+/, $t2, 2 if defined $t2;
173 8 100       23 ($aa, $tt) = ($tt, $aa) unless defined $tt;
174 8 50 33     33 undef $a if defined $a and $a =~
175             /^\s*(<<\s*)?(Various Artists|compilation disc)\s*(>>\s*)?$/i;
176 8 50 66     31 undef $aa if defined $aa and $aa =~
177             /^\s*(<<\s*)?(Various Artists|compilation disc)\s*(>>\s*)?$/i;
178 8 100 33     43 $a_in_title = $a if defined $a and length $a and defined $aa and length $aa;
      66        
      66        
179 8 100 66     26 $aa = $a unless defined $aa and length $aa;
180 8         11 $t_in_track = $tt;
181 8 50 33     26 $tt = $t unless defined $tt and length $tt;
182              
183 8         22 my ($y, $cat) = ($self->{fields}{DYEAR}, $self->{fields}{DGENRE});
184 8         17 for my $f ($c2, $c1) {
185 16 50 33     50 if (defined $f and length $f) { # Process old style declarations
186 16   100     163 while ($f =~ s/^\s*((YEAR|ID3Y)|ID3G)\b:?\s*(\d+)\b\s*(([;.,]|\s-\s)\s*)?//i
187             || $f =~ s/(?:\s*(?:[;.,]|\s-\s))?\s*\b((YEAR|ID3Y)|ID3G)\b:?\s*(\d+)\s*([;.,]\s*)?$//i) {
188 6 100 100     25 $y = $3 if $2 and not $y;
189 6 50 66     75 $cat = $3 if not $2 and not $cat;
190             }
191 16 100 33     105 if ($f =~ s{
      66        
192             ((^|[;,.]|\s+-\s) # 1,2
193             \s*
194             (Recorded (\s+[io]n)? \s* (:\s*)? )? # 3, 4, 5
195             (\d{4}([-,][-\d\/,]+)?) # 6, 7
196             \b \s* (?: [.;] \s* )?
197             ((?:[;.,]|\s-\s|$)\s*)) # 8
198             }
199 2 100 66     13 {
    50 33        
200             ((($self->{parent}->get_config('comment_remove_date'))->[0]
201             and not ($2 and $8))
202             ? '' : $1) . ($2 && $8 ? $8 : '')
203             }xeim and not ($2 and $8)) {
204 2 0 33     9 # Overwrite the disk year for longer forms
      0        
      0        
      0        
205             $y = $6 if $3 or $7 or not $y or $c2 and $f eq $c2;
206 16         28 }
207 16         32 $f =~ s/^\s+//;
208 16 50       40 $f =~ s/\s+$//;
209             undef $f unless length $f;
210             }
211 8         25 }
212 8 50 33     37 my ($cc1, $cc2) = ($c1, $c2);
213 8 50 33     59 if (defined $c2 and length $c2) { # Merge unless one is truncation of another
      33        
      33        
214             if ( defined $c1 and length $c1
215             and $c1 ne substr $c2, 0, length $c1
216 8         19 and $c1 ne substr $c2, -length $c1 ) {
217 8 50       22 $c2 =~ s/\s*[.,:;]$//;
218 8         21 my $sep = (("$c1$c2" =~ /\n/) ? "\n" : '; ');
219             $c1 = "$c2$sep$c1";
220 0         0 } else {
221             $c1 = $c2;
222             }
223 8 100 66     56 }
224 3         20 if (defined $cat and $cat =~ /^\d+$/) {
225 3 50       14 require MP3::Tag::ID3v1;
226             $cat = $MP3::Tag::ID3v1::winamp_genres[$cat] if $cat < scalar @MP3::Tag::ID3v1::winamp_genres;
227             }
228 8         60  
229             @parsed{ qw( title artist album year comment track genre
230             a_in_title t_in_track extt extd) } =
231 8         23 ($tt, $aa, $t, $y, $c1, $track, $cat, $a_in_title, $t_in_track, $cc2, $cc1);
232 8         16 $parsed{DISCID} = $self->{fields}{DISCID};
233 8         26 $self->{parsed} = \%parsed;
234             $self->return_parsed($what);
235             }
236              
237              
238             =pod
239              
240             =item title()
241              
242             $title = $db->title();
243              
244             Returns the title, obtained from the C<'Tracktitle'> entry of the file.
245              
246             =cut
247              
248             *song = \&title;
249              
250 6     6 1 19 sub title {
251             return shift->parse("title");
252             }
253              
254             =pod
255              
256             =item artist()
257              
258             $artist = $db->artist();
259              
260             Returns the artist name, obtained from the C<'Performer'> or
261             C<'Albumperformer'> entries (the first which is present) of the file.
262              
263             =cut
264              
265 4     4 1 11 sub artist {
266             return shift->parse("artist");
267             }
268              
269             =pod
270              
271             =item track()
272              
273             $track = $db->track();
274              
275             Returns the track number, stored during object creation, or queried from
276             the parent.
277              
278              
279             =cut
280              
281 19     19 1 32 sub track {
282 19 50       42 my $self = shift;
283 19 100 66     75 return $self->{track} if defined $self->{track};
284 10         35 return if $self->{recursive} or not $self->parent_ok;
285 10         51 local $self->{recursive} = 1;
286             return $self->{parent}->track1;
287             }
288              
289             =item year()
290              
291             $year = $db->year();
292              
293             Returns the year, obtained from the C<'Year'> entry of the file. (Often
294             not present.)
295              
296             =cut
297              
298 3     3 1 9 sub year {
299             return shift->parse("year");
300             }
301              
302             =pod
303              
304             =item album()
305              
306             $album = $db->album();
307              
308             Returns the album name, obtained from the C<'Albumtitle'> entry of the file.
309              
310             =cut
311              
312 2     2 1 8 sub album {
313             return shift->parse("album");
314             }
315              
316             =item comment()
317              
318             $comment = $db->comment();
319              
320             Returns the C<'Trackcomment'> entry of the file. (Often not present.)
321              
322             =cut
323              
324 3     3 1 11 sub comment {
325             return shift->parse("comment");
326             }
327              
328             =item genre()
329              
330             $genre = $db->genre($filename);
331              
332             =cut
333              
334 2     2 1 7 sub genre {
335             return shift->parse("genre");
336             }
337              
338 6     6   55 for my $elt ( qw( cddb_id ) ) {
  6         11  
  6         573  
339             no strict 'refs';
340 0     0     *$elt = sub (;$) {
341             return shift->parse($elt);
342             }
343             }
344              
345             1;