File Coverage

blib/lib/MP3/Tag/File.pm
Criterion Covered Total %
statement 114 176 64.7
branch 48 104 46.1
condition 15 30 50.0
subroutine 24 26 92.3
pod 8 21 38.1
total 209 357 58.5


line stmt bran cond sub pod time code
1             package MP3::Tag::File;
2              
3 6     6   41 use strict;
  6         12  
  6         173  
4 6     6   28 use Fcntl;
  6         9  
  6         1379  
5 6     6   46 use File::Basename;
  6         9  
  6         354  
6 6     6   33 use vars qw /$VERSION @ISA/;
  6         11  
  6         14891  
7              
8             $VERSION="1.00";
9             @ISA = 'MP3::Tag::__hasparent';
10              
11             =pod
12              
13             =head1 NAME
14              
15             MP3::Tag::File - Module for reading / writing files
16              
17             =head1 SYNOPSIS
18              
19             my $mp3 = MP3::Tag->new($filename);
20              
21             ($title, $artist, $no, $album, $year) = $mp3->parse_filename();
22              
23             see L
24              
25             =head1 DESCRIPTION
26              
27             MP3::Tag::File is designed to be called from the MP3::Tag module.
28              
29             It offers possibilities to read/write data from files via read(), write(),
30             truncate(), seek(), tell(), open(), close(); one can find the filename via
31             the filename() method.
32              
33             =cut
34              
35              
36             # Constructor
37              
38             sub new_with_parent {
39 87     87 0 247 my ($class, $filename, $parent) = @_;
40 87 50 33     887 return undef unless -f $filename or -c $filename;
41 87         594 return bless {filename => $filename, parent => $parent}, $class;
42             }
43             *new = \&new_with_parent; # Obsolete handler
44              
45             # Destructor
46              
47             sub DESTROY {
48 81     81   185 my $self=shift;
49 81 50 33     1131 if (exists $self->{FH} and defined $self->{FH}) {
50 0         0 $self->close;
51             }
52             }
53              
54             # File subs
55              
56 860     860 0 10506 sub filename { shift->{filename} }
57              
58             sub open {
59 270     270 0 432 my $self=shift;
60 270         387 my $mode= shift;
61 270 100 66     1044 if (defined $mode and $mode =~ /w/i) {
62 99         175 $mode=O_RDWR; # read/write mode
63             } else {
64 171         253 $mode=O_RDONLY; # read only mode
65             }
66 270 50       552 unless (exists $self->{FH}) {
67 270         626 local *FH;
68 270 50       547 if (sysopen (FH, $self->filename, $mode)) {
69 270         1362 $self->{FH} = *FH;
70 270         904 binmode $self->{FH};
71             } else {
72 0         0 warn "Open `" . $self->filename() . "' failed: $!\n";
73             }
74             }
75 270         1471 return exists $self->{FH};
76             }
77              
78              
79             sub close {
80 330     330 0 550 my $self=shift;
81 330 100       1485 if (exists $self->{FH}) {
82 265         7116 close $self->{FH};
83 265         2123 delete $self->{FH};
84             }
85             }
86              
87             sub write {
88 66     66 0 204 my ($self, $data) = @_;
89 66 50       190 if (exists $self->{FH}) {
90 66         270 local $\ = '';
91 66         98 print {$self->{FH}} $data;
  66         516  
92             }
93             }
94              
95             sub truncate {
96 0     0 0 0 my ($self, $length) = @_;
97 0 0       0 if ($length<0) {
98 0         0 my @stat = stat $self->{FH};
99 0         0 $length = $stat[7] + $length;
100             }
101 0 0       0 if (exists $self->{FH}) {
102 0         0 truncate $self->{FH}, $length;
103             }
104             }
105              
106             sub size {
107 44     44 0 86 my ($self) = @_;
108 44 50       637 return -s $self->{FH} if exists $self->{FH};
109 0         0 return -s ($self->filename);
110             }
111              
112             sub seek {
113 301     301 0 671 my ($self, $pos, $whence)=@_;
114 301 50       670 $self->open unless exists $self->{FH};
115 301         2646 seek $self->{FH}, $pos, $whence;
116             }
117              
118             sub tell {
119 44     44 0 87 my ($self, $pos, $whence)=@_;
120 44 50       120 return undef unless exists $self->{FH};
121 44         168 return tell $self->{FH};
122             }
123              
124             sub read {
125 343     343 0 675 my ($self, $buf_, $length) = @_;
126 343 50       794 $self->open unless exists $self->{FH};
127 343         5570 return read $self->{FH}, $$buf_, $length;
128             }
129              
130             sub is_open {
131 185     185 0 740 return exists shift->{FH};
132             }
133              
134             # keep the old name
135             *isOpen = \&is_open;
136              
137             # read and decode the header of the mp3 part of the file
138             # the raw content of the header fields is stored, the values
139             # are not interpreted in any way (e.g. layer==3 means 'Layer I'
140             # as specified in the mp3 format)
141             sub get_mp3_frame_header {
142 0     0 0 0 my ($self, $start) = @_;
143              
144 0 0       0 $start = 0 unless $start;
145              
146 0 0       0 if (exists $self->{mp3header}) {
147 0         0 return $self->{mp3header};
148             }
149              
150 0         0 $self->seek($start, 0);
151 0         0 my ($data, $bits)="";
152 0         0 while (1) {
153 0         0 my $nextdata;
154 0         0 $self->read(\$nextdata, 512);
155 0 0       0 return unless $nextdata; # no header found
156 0         0 $data .= $nextdata;
157 0 0       0 if ($data =~ /(\xFF[\xE0-\xFF]..)/) {
158 0         0 $bits = unpack("B32", $1);
159 0         0 last;
160             }
161 0         0 $data = substr $data, -3
162             }
163              
164 0         0 my @fields;
165 0         0 for (qw/11 2 2 1 4 2 1 1 1 2 2 1 1 2/) {
166 0         0 push @fields, oct "0b" . substr $bits, 0, $_;
167 0 0       0 $bits = substr $bits, $_ if length $bits > $_;
168             }
169              
170 0         0 $self->{mp3header}={};
171 0         0 for (qw/sync version layer proctection bitrate_id sampling_rate_id padding private
172             channel_mode mode_ext copyright original emphasis/) {
173 0         0 $self->{mp3header}->{$_}=shift @fields;
174             }
175              
176             return $self->{mp3header}
177 0         0 }
178              
179              
180             # use filename to determine information about song/artist/album
181              
182             =pod
183              
184             =over 4
185              
186             =item parse_filename()
187              
188             ($title, $artist, $no, $album, $year) = $mp3->parse_filename($what, $filename);
189              
190             parse_filename() tries to extract information about artist, title,
191             track number, album and year from the filename. (For backward
192             compatibility it may be also called by deprecated name
193             read_filename().)
194              
195             This is likely to fail for a lot of filenames, especially the album will
196             be often wrongly guessed, as the name of the parent directory is taken as
197             album name.
198              
199             $what and $filename are optional. $what maybe title, track, artist, album
200             or year. If $what is defined parse_filename() will return only this element.
201              
202             If $filename is defined this filename will be used and not the real
203             filename which was set by L with
204             Cnew($filename)>. Otherwise the actual filename is used
205             (subject to configuration variable C).
206              
207             Following formats will be hopefully recognized:
208              
209             - album name/artist name - song name.mp3
210              
211             - album_name/artist_name-song_name.mp3
212              
213             - album.name/artist.name_song.name.mp3
214              
215             - album name/(artist name) song name.mp3
216              
217             - album name/01. artist name - song name.mp3
218              
219             - album name/artist name - 01 - song.name.mp3
220              
221             If artist or title end in C<(NUMBER)> with 4-digit NUMBER, it is considered
222             the year.
223              
224             =cut
225              
226             *read_filename = \&parse_filename;
227              
228             sub return_parsed {
229 136     136 0 251 my ($self,$what) = @_;
230 136 50       284 if (defined $what) {
231 136 100       427 return $self->{parsed}{album} if $what =~/^al/i;
232 109 100       314 return $self->{parsed}{artist} if $what =~/^a/i;
233 85 100       297 return $self->{parsed}{no} if $what =~/^tr/i;
234 53 100       200 return $self->{parsed}{year} if $what =~/^y/i;
235 17         84 return $self->{parsed}{title};
236             }
237              
238 0 0       0 return $self->{parsed} unless wantarray;
239 0         0 return map $self->{parsed}{$_} , qw(title artist no album year);
240             }
241              
242             sub parse_filename {
243 80     80 1 176 my ($self,$what,$filename) = @_;
244 80 50       195 unless (defined $filename) {
245 80         175 $filename = $self->filename;
246 80         119 my $e;
247 80 0 33     198 if ($e = $self->get_config('decode_encoding_filename') and $e->[0]) {
248 0         0 require Encode;
249 0         0 $filename = Encode::decode($e->[0], $filename);
250             }
251             }
252 80         156 my $pathandfile = $filename;
253              
254             $self->return_parsed($what) if exists $self->{parsed_filename}
255 80 100 66     398 and $self->{parsed_filename} eq $filename;
256              
257             # prepare pathandfile for easier use
258 80         202 my $ext_rex = $self->get_config('extension')->[0];
259 80         516 $pathandfile =~ s/$ext_rex//; # remove extension
260 80         165 $pathandfile =~ s/ +/ /g; # replace several spaces by one space
261              
262             # Keep two last components of the file name
263 80         1677 my ($file, $path) = fileparse($pathandfile, "");
264 80         1087 ($path) = fileparse($path, "");
265 80         183 my $orig_file = $file;
266              
267             # check which chars are used for seperating words
268             # assumption: spaces between words
269              
270 80 50       234 unless ($file =~/ /) {
271             # no spaces used, find word seperator
272 80         185 my $Ndot = $file =~ tr/././;
273 80         131 my $Nunderscore = $file =~ tr/_/_/;
274 80         134 my $Ndash = $file =~ tr/-/-/;
275 80 50 33     392 if (($Ndot>$Nunderscore) && ($Ndot>1)) {
    50          
    50          
276 0         0 $file =~ s/\./ /g;
277             }
278             elsif ($Nunderscore > 1) {
279 0         0 $file =~ s/_/ /g;
280             }
281             elsif ($Ndash>2) {
282 0         0 $file =~ s/-/ /g;
283             }
284             }
285              
286             # check wich chars are used for seperating parts
287             # assumption: " - " is used
288              
289 80         132 my $partsep = " - ";
290              
291 80 50       192 unless ($file =~ / - /) {
292 80 50       327 if ($file =~ /-/) {
    50          
    100          
293 0         0 $partsep = "-";
294             } elsif ($file =~ /^\(.*\)/) {
295             # replace brackets by -
296 0         0 $file =~ s/^\((.*?)\)/$1 - /;
297 0         0 $file =~ s/ +/ /;
298 0         0 $partsep = " - ";
299             } elsif ($file =~ /_/) {
300 23         35 $partsep = "_";
301             } else {
302 57         95 $partsep = "DoesNotExist";
303             }
304             }
305              
306             # get parts of name
307 80         187 my ($title, $artist, $no, $album, $year)=("","","","","");
308              
309             # try to find a track-number in front of filename
310 80 50       262 if ($file =~ /^ *(\d+)[\W_]/) {
311 0         0 $no=$1; # store number
312 0         0 $file =~ s/^ *\d+//; # and delete it
313 0 0       0 $file =~ s/^$partsep// || $file =~ s/^.//;
314 0         0 $file =~ s/^ +//;
315             }
316              
317 80 100       210 $file =~ s/_+/ /g unless $partsep =~ /_/; #remove underscore unless they are needed for part seperation
318 80         314 my @parts = split /$partsep/, $file;
319 80 100       218 if (@parts == 1) {
    50          
    0          
320 57         112 $title=$parts[0];
321 57 50 33     283 $no = $file if $title and $title =~ /^\d{1,2}$/;
322             } elsif (@parts == 2) {
323 23 50       93 if ($parts[0] =~ /^\d{1,2}$/) {
    100          
324 0         0 $no = $parts[0];
325 0         0 $title = $file;
326             } elsif ($parts[1] =~ /^\d{1,2}$/) {
327 3         6 $no = $parts[1];
328 3         4 $title = $file;
329             } else {
330 20         31 $artist=$parts[0];
331 20         29 $title=$parts[1];
332             }
333             } elsif (@parts > 2) {
334 0         0 my $temp = "";
335 0         0 $artist = shift @parts;
336 0         0 foreach (@parts) {
337 0 0       0 if (/^ *(\d+)\.? *$/) {
338 0 0       0 $artist.= $partsep . $temp if $temp;
339 0         0 $temp="";
340 0         0 $no=$1;
341             } else {
342 0 0       0 $temp .= $partsep if $temp;
343 0         0 $temp .= $_;
344             }
345             }
346 0         0 $title=$temp;
347             }
348              
349 80         156 $title =~ s/ +$//;
350 80         101 $artist =~ s/ +$//;
351 80         113 $no =~ s/ +$//;
352              
353             # Special-case names like audio12 etc created by some software
354             # (cdda2wav, gramofile, etc)
355 80 50 100     431 $no = $+ if not $no and $title =~ /^(\d+)?(?:audio|track|processed)\s*(\d+)?$/i and $+;
      66        
356              
357 80         135 $no =~ s/^0+//;
358              
359 80 50       161 if ($path) {
360 0 0       0 unless ($artist) {
361 0         0 $artist = $path;
362             } else {
363 0         0 $album = $path;
364             }
365             }
366             # Keep the year in the title/artist (XXXX Should we?)
367 80 50 33     299 $year = $1 if $title =~ /\((\d{4})\)/ or $artist =~ /\((\d{4})\)/;
368              
369 80         204 $self->{parsed_filename} = $filename;
370 80         501 $self->{parsed} = { artist=>$artist, song=>$title, no=>$no,
371             album=>$album, title=>$title, year => $year};
372 80         256 $self->return_parsed($what);
373             }
374              
375              
376             =pod
377              
378             =item title()
379              
380             $title = $mp3->title($filename);
381              
382             Returns the title, guessed from the filename. See also parse_filename(). (For
383             backward compatibility, can be called by deprecated name song().)
384              
385             $filename is optional and will be used instead of the real filename if defined.
386              
387             =cut
388              
389             *song = \&title;
390              
391             sub title {
392 13     13 1 29 my $self = shift;
393 13         45 return $self->parse_filename("title", @_);
394             }
395              
396             =pod
397              
398             =item artist()
399              
400             $artist = $mp3->artist($filename);
401              
402             Returns the artist name, guessed from the filename. See also parse_filename()
403              
404             $filename is optional and will be used instead of the real filename if defined.
405              
406             =cut
407              
408             sub artist {
409 12     12 1 26 my $self = shift;
410 12         32 return $self->parse_filename("artist", @_);
411             }
412              
413             =pod
414              
415             =item track()
416              
417             $track = $mp3->track($filename);
418              
419             Returns the track number, guessed from the filename. See also parse_filename()
420              
421             $filename is optional and will be used instead of the real filename if defined.
422              
423             =cut
424              
425             sub track {
426 22     22 1 42 my $self = shift;
427 22         71 return $self->parse_filename("track", @_);
428             }
429              
430             =item year()
431              
432             $year = $mp3->year($filename);
433              
434             Returns the year, guessed from the filename. See also parse_filename()
435              
436             $filename is optional and will be used instead of the real filename if defined.
437              
438             =cut
439              
440             sub year {
441 19     19 1 37 my $self = shift;
442 19         58 my $y = $self->parse_filename("year", @_);
443 19 50       70 return $y if length $y;
444 19         74 return;
445             }
446              
447             =pod
448              
449             =item album()
450              
451             $album = $mp3->album($filename);
452              
453             Returns the album name, guessed from the filename. See also parse_filename()
454             The album name is guessed from the parent directory, so it is very likely to fail.
455              
456             $filename is optional and will be used instead of the real filename if defined.
457              
458             =cut
459              
460             sub album {
461 14     14 1 36 my $self = shift;
462 14         46 return $self->parse_filename("album", @_);
463             }
464              
465             =item comment()
466              
467             $comment = $mp3->comment($filename); # Always undef
468              
469             =cut
470              
471       14 1   sub comment {}
472              
473             =item genre()
474              
475             $genre = $mp3->genre($filename); # Always undef
476              
477             =cut
478              
479       22 1   sub genre {}
480              
481             1;