File Coverage

blib/lib/MP3/Tag/ID3v1.pm
Criterion Covered Total %
statement 136 172 79.0
branch 71 106 66.9
condition 22 63 34.9
subroutine 14 16 87.5
pod 7 11 63.6
total 250 368 67.9


line stmt bran cond sub pod time code
1             package MP3::Tag::ID3v1;
2              
3             # Copyright (c) 2000-2004 Thomas Geffert. All rights reserved.
4             #
5             # This program is free software; you can redistribute it and/or
6             # modify it under the terms of the Artistic License, distributed
7             # with Perl.
8              
9 6     6   44 use strict;
  6         11  
  6         302  
10 6     6   36 use vars qw /@mp3_genres @winamp_genres $AUTOLOAD %ok_length $VERSION @ISA/;
  6         9  
  6         16799  
11              
12             $VERSION="1.00";
13             @ISA = 'MP3::Tag::__hasparent';
14              
15             # allowed fields in ID3v1.1 and max length of this fields (except for track and genre which are coded later)
16             %ok_length = (title => 30, artist => 30, album => 30, comment => 28, track => 3, genre => 3000, year=>4, genreID=>1);
17              
18             =pod
19              
20             =head1 NAME
21              
22             MP3::Tag::ID3v1 - Module for reading / writing ID3v1 tags of MP3 audio files
23              
24             =head1 SYNOPSIS
25              
26             MP3::Tag::ID3v1 is designed to be called from the MP3::Tag module.
27              
28             use MP3::Tag;
29             $mp3 = MP3::Tag->new($filename);
30              
31             # read an existing tag
32             $mp3->get_tags();
33             $id3v1 = $mp3->{ID3v1} if exists $mp3->{ID3v1};
34              
35             # or create a new tag
36             $id3v1 = $mp3->new_tag("ID3v1");
37              
38             See L for information on the above used functions.
39            
40             * Reading the tag
41              
42             print " Title: " .$id3v1->title . "\n";
43             print " Artist: " .$id3v1->artist . "\n";
44             print " Album: " .$id3v1->album . "\n";
45             print "Comment: " .$id3v1->comment . "\n";
46             print " Year: " .$id3v1->year . "\n";
47             print " Genre: " .$id3v1->genre . "\n";
48             print " Track: " .$id3v1->track . "\n";
49              
50             # or at once
51             @tagdata = $mp3->all();
52             foreach $tag (@tagdata) {
53             print $tag;
54             }
55              
56             * Changing / Writing the tag
57              
58             $id3v1->comment("This is only a Test Tag");
59             $id3v1->title("testing");
60             $id3v1->artist("Artest");
61             $id3v1->album("Test it");
62             $id3v1->year("1965");
63             $id3v1->track("5");
64             $id3v1->genre("Blues");
65             # or at once
66             $id3v1->all("song title","artist","album","1900","comment",10,"Ska");
67             $id3v1->write_tag();
68              
69             * Removing the tag from the file
70              
71             $id3v1->remove_tag();
72              
73             =head1 AUTHOR
74              
75             Thomas Geffert, thg@users.sourceforge.net
76              
77             =head1 DESCRIPTION
78              
79             =pod
80              
81             =over
82              
83             =item title(), artist(), album(), year(), comment(), track(), genre()
84              
85             $artist = $id3v1->artist;
86             $artist = $id3v1->artist($artist);
87             $album = $id3v1->album;
88             $album = $id3v1->album($album);
89             $year = $id3v1->year;
90             $year = $id3v1->year($year);
91             $comment = $id3v1->comment;
92             $comment = $id3v1->comment($comment);
93             $track = $id3v1->track;
94             $track = $id3v1->track($track);
95             $genre = $id3v1->genre;
96             $genre = $id3v1->genre($genre);
97              
98             Use these functions to retrieve the date of these fields,
99             or to set the data.
100              
101             $genre can be a string with the name of the genre, or a number
102             describing the genre.
103              
104             =cut
105              
106             sub AUTOLOAD {
107 153     153   443 my $self = shift;
108 153         267 my $attr = $AUTOLOAD;
109              
110             # is it an allowed field
111 153         677 $attr =~ s/.*:://;
112 153 50       533 return unless $attr =~ /[^A-Z]/;
113 153 100       333 $attr = 'title' if $attr eq 'song';
114 153 50       356 warn "invalid field: ->$attr()" unless $ok_length{$attr};
115              
116 153 100       373 if (@_) {
117 79         140 my $new = shift;
118 79         289 $new =~ s/ *$//;
119 79 100       202 if ($attr eq "genre") {
120 17 100       72 if ($new =~ /^\d+$/) {
121 9         21 $self->{genreID} = $new;
122             } else {
123 8         22 $self->{genreID} = genre2id($new);
124             }
125             $new = id2genre($self->{genreID})
126 17 100 66     117 if defined $self->{genreID} and $self->{genreID} < @winamp_genres;
127             }
128 79         170 $new = substr $new, 0, $ok_length{$attr};
129 79         155 $self->{$attr}=$new;
130 79         145 $self->{changed} = 1;
131             }
132 153         307 $self->{$attr} =~ s/ +$//;
133 153         473 return $self->{$attr};
134             }
135              
136             =pod
137              
138             =item all()
139              
140             @tagdata = $id3v1->all;
141             @tagdata = $id3v1->all($title, $artist, $album, $year, $comment, $track, $genre);
142              
143             Returns all information of the tag in a list.
144             You can use this sub also to set the data of the complete tag.
145              
146             The order of the data is always title, artist, album, year, comment, track, and genre.
147             genre has to be a string with the name of the genre, or a number identifying the genre.
148              
149             =cut
150              
151             sub all {
152 1     1 1 10 my $self=shift;
153 1 50       4 if ($#_ == 6) {
154 1         2 my $new;
155 1         5 for (qw/title artist album year comment track genre/) {
156 7         11 $new = shift;
157 7         12 $new =~ s/ +$//;
158 7         12 $new = substr $new, 0, $ok_length{$_};
159 7         16 $self->{$_}=$new;
160             }
161 1 50       15 if ($self->{genre} =~ /^\d+$/) {
162 0         0 $self->{genreID} = $self->{genre};
163             } else {
164 1         4 $self->{genreID} = genre2id($self->{genre});
165             }
166             $self->{genre} = id2genre($self->{genreID})
167 1 50 33     10 if defined $self->{genreID} and $self->{genreID} < @winamp_genres;
168 1         3 $self->{changed} = 1;
169             }
170 1         3 for (qw/title artist album year comment track genre/) {
171 7         14 $self->{$_} =~ s/ +$//;
172             }
173 1 50       7 if (wantarray) {
174             return ($self->{title},$self->{artist},$self->{album},
175 1         8 $self->{year},$self->{comment}, $self->{track}, $self->{genre});
176             }
177 0         0 return $self->{title};
178             }
179              
180             =pod
181              
182             =item fits_tag()
183              
184             warn "data truncated" unless $id3v1->fits_tag($hash);
185              
186             Check whether the info in ID3v1 tag fits into the format of the file.
187              
188             =cut
189              
190             sub fits_tag {
191 35     35 1 93 my ($self, $hash) = (shift, shift);
192 35         51 my $elt;
193 35 100       110 if (defined (my $track = $hash->{track})) {
194 15 100       73 $track = $track->[0] if ref $track;
195 15 100 33     147 return unless $track =~ /^\d{0,3}$/ and ($track eq '' or $track < 256);
      66        
196             }
197 33         72 my $s = '';
198 33         89 for $elt (qw(title artist album comment year)) {
199 153 100       353 next unless defined (my $data = $hash->{$elt});
200 43 100       122 $data = $data->[0] if ref $data;
201 43 50       119 return if $data =~ /[^\x00-\xFF]/;
202 43         68 $s .= $data;
203 43 100       107 next if $ok_length{$elt} >= length $data;
204             next
205 3 0 33     11 if $elt eq 'comment' and not $hash->{track} and length $data <= 30;
      33        
206 3         14 return;
207             }
208 30 100       100 if (defined (my $genre = $hash->{genre})) {
209 16 50       40 $genre = $genre->[0] if ref $genre;
210 16         41 my @g = MP3::Tag::Implemenation::_massage_genres($genre);
211 16 100       58 return if @g > 1;
212 14         33 my $id = MP3::Tag::Implemenation::_massage_genres($genre, 'num');
213 14 50 66     93 return if not defined $id or $id eq '' or $id == 255;
      66        
214             }
215 24 50       70 if ($s =~ /[^\x00-\x7E]/) {
216 0   0     0 my $w = ($self->get_config('encode_encoding_v1') || [0])->[0];
217 0   0     0 my $r = ($self->get_config('decode_encoding_v1') || [0])->[0];
218 0   0     0 $_ = (lc or 'iso-8859-1') for $r, $w;
219             # Safe: per-standard and read+write is idempotent:
220 0 0 0     0 return 1 if $r eq $w and $w eq 'iso-8859-1';
221 0 0 0     0 return !(($self->get_config('encoded_v1_fits')||[0])->[0])
222             if $w eq 'iso-8859-1'; # read+write not idempotent
223 0 0 0     0 return if $w ne $r
      0        
224             and not (($self->get_config('encoded_v1_fits')||[0])->[0]);
225             }
226 24         209 return 1;
227             }
228              
229             =item as_bin()
230              
231             $str = $id3v1->as_bin();
232              
233             Returns the ID3v1 tag as a string.
234              
235             =item write_tag()
236              
237             $id3v1->write_tag();
238              
239             [old name: writeTag() . The old name is still available, but you should use the new name]
240              
241             Writes the ID3v1 tag to the file.
242              
243             =cut
244              
245             sub as_bin {
246 33     33 1 57 my $self = shift;
247 33         108 my($t) = ( $self->{track} =~ m[^(\d+)(?:/|$)], 0 );
248 33         68 my (%f, $f, $e);
249 33         83 for $f (qw(title artist album comment) ) {
250 132         294 $f{$f} = $self->{$f};
251             }
252              
253 33 0 33     100 if ($e = $self->get_config('encode_encoding_v1') and $e->[0]) {
254 0         0 my $field;
255 0         0 require Encode;
256              
257 0         0 for $field (qw(title artist album comment)) {
258 0         0 $f{$field} = Encode::encode($e->[0], $f{$field});
259             }
260             }
261              
262 33 100       126 $f{comment} = pack "a28 x C", $f{comment}, $t if $t;
263 33 50       180 $self->{genreID}=255 unless $self->{genreID} =~ /^\d+$/;
264              
265             return pack("a3a30a30a30a4a30C","TAG",$f{title}, $f{artist},
266 33         322 $f{album}, $self->{year}, $f{comment}, $self->{genreID});
267             }
268              
269             sub write_tag {
270 33     33 1 52 my $self = shift;
271 33 50 33     174 return undef unless exists $self->{title} && exists $self->{changed};
272 33         99 my $data = $self->as_bin();
273 33         73 my $mp3obj = $self->{mp3};
274 33         53 my $mp3tag;
275 33         135 $mp3obj->close;
276 33 50       124 if ($mp3obj->open("write")) {
277 33         148 $mp3obj->seek(-128,2);
278 33         196 $mp3obj->read(\$mp3tag, 3);
279 33 100       175 if ($mp3tag eq "TAG") {
280 19         111 $mp3obj->seek(-125,2); # neccessary for windows
281 19         161 $mp3obj->write(substr $data, 3);
282             } else {
283 14         58 $mp3obj->seek(0,2);
284 14         74 $mp3obj->write($data);
285             }
286             } else {
287 0         0 warn "Couldn't open file `" . $mp3obj->filename() . "' to write tag";
288 0         0 return 0;
289             }
290 33         122 return 1;
291             }
292              
293             *writeTag = \&write_tag;
294              
295             =pod
296              
297             =item remove_tag()
298              
299             $id3v1->remove_tag();
300              
301             Removes the ID3v1 tag from the file. Returns negative on failure,
302             FALSE if no tag was found.
303              
304             (Caveat: only I is removed; some - broken - files may have
305             many chain-loaded one after another; you may need to call remove_tag()
306             in a loop to handle such beasts.)
307              
308             [old name: removeTag() . The old name is still available, but you
309             should use the new name]
310              
311             =cut
312              
313             sub remove_tag {
314 0     0 1 0 my $self = shift;
315 0         0 my $mp3obj = $self->{mp3};
316 0         0 my $mp3tag;
317 0         0 $mp3obj->seek(-128,2);
318 0         0 $mp3obj->read(\$mp3tag, 3);
319 0 0       0 if ($mp3tag eq "TAG") {
320 0         0 $mp3obj->close;
321 0 0       0 if ($mp3obj->open("write")) {
322 0         0 $mp3obj->truncate(-128);
323 0         0 $self->all("","","","","",0,255);
324 0         0 $mp3obj->close;
325 0         0 $self->{changed} = 1;
326 0         0 return 1;
327             }
328 0         0 return -1;
329             }
330 0         0 return 0;
331             }
332              
333             *removeTag = \&remove_tag;
334              
335             =pod
336              
337             =item genres()
338              
339             @allgenres = $id3v1->genres;
340             $genreName = $id3v1->genres($genreID);
341             $genreID = $id3v1->genres($genreName);
342              
343             Returns a list of all genres, or the according name or id to
344             a given id or name.
345              
346             =cut
347              
348             sub genres {
349             # return an array with all genres, of if a parameter is given, the according genre
350 81     81 1 173 my ($self, $genre) = @_;
351 81 50 66     426 if ( (defined $self) and (not defined $genre) and ($self !~ /MP3::Tag/)) {
      66        
352             ## genres may be called directly via MP3::Tag::ID3v1::genres()
353             ## and $self is then not used for an id3v1 object
354 75         131 $genre = $self;
355             }
356              
357 81 100       176 return \@winamp_genres unless defined $genre;
358              
359 75 100       231 if ($genre =~ /^\d+$/) {
360 61 100       257 return $winamp_genres[$genre] if $genre
361 22         88 return undef;
362             }
363              
364 14         26 my ($id, $found)=0;
365 14         33 foreach (@winamp_genres) {
366 1901 100       3023 if (uc $_ eq uc $genre) {
367 2         4 $found = 1;
368 2         5 last;
369             }
370 1899         2399 $id++;
371             }
372 14 100       35 $id=255 unless $found;
373 14         31 return $id;
374             }
375              
376             =item new()
377              
378             $id3v1 = MP3::Tag::ID3v1->new($mp3fileobj[, $create]);
379              
380             Generally called from MP3::Tag, because a $mp3fileobj is needed.
381             If $create is true, a new tag is created. Otherwise undef is
382             returned, if now ID3v1 tag is found in the $mp3obj.
383              
384             Please use
385              
386             $mp3 = MP3::Tag->new($filename);
387             $id3v1 = $mp3->new_tag("ID3v1"); # Empty new tag
388              
389             or
390              
391             $mp3 = MP3::Tag->new($filename);
392             $mp3->get_tags();
393             $id3v1 = $mp3->{ID3v1}; # Existing tag (if present)
394              
395             instead of using this function directly
396              
397             =back
398              
399             =cut
400              
401             # create a ID3v1 object
402             sub new {
403 101     101 1 240 my ($class, $fileobj, $create) = @_;
404 101         269 my $self={mp3=>$fileobj};
405 101         180 my $buffer;
406              
407 101 100       222 if ($create) {
408 16         44 $self->{new} = 1;
409             } else {
410 85 50 50     215 $fileobj->open or return unless $fileobj->is_open;
411 85         368 $fileobj->seek(-128,2);
412 85         394 $fileobj->read(\$buffer, 128);
413 85 100       644 return undef unless substr ($buffer,0,3) eq "TAG";
414             }
415              
416 65         282 bless $self, $class;
417 65         217 $self->read_tag($buffer); # $buffer unused if ->{new}
418 65         191 return $self;
419             }
420              
421             sub new_with_parent {
422 85     85 0 236 my ($class, $filename, $parent) = @_;
423 85 100       340 return unless my $new = $class->new($filename, undef);
424 49         116 $new->{parent} = $parent;
425 49         121 $new;
426             }
427              
428             #################
429             ##
430             ## internal subs
431              
432             # actually read the tag data
433             sub read_tag {
434 65     65 0 174 my ($self, $buffer) = @_;
435 65         109 my ($id3v1, $e);
436              
437 65 100       175 if ($self->{new}) {
438             ($self->{title}, $self->{artist}, $self->{album}, $self->{year},
439 16         130 $self->{comment}, $self->{track}, $self->{genre}, $self->{genreID}) = ("","","","","",'',"",255);
440 16         41 $self->{changed} = 1;
441             } else {
442             (undef, $self->{title}, $self->{artist}, $self->{album}, $self->{year},
443 49 50       648 $self->{comment}, $id3v1, $self->{track}, $self->{genreID}) =
444             unpack (($] < 5.6
445             ? "a3 A30 A30 A30 A4 A28 C C C" # Trailing spaces stripped too
446             : "a3 Z30 Z30 Z30 Z4 Z28 C C C"),
447             $buffer);
448            
449 49 50       190 if ($id3v1!=0) { # ID3v1 tag found: track is not valid, comment two chars longer
450 0         0 $self->{comment} .= chr($id3v1);
451             $self->{comment} .= chr($self->{track})
452 0 0 0     0 if $self->{track} and $self->{track}!=32;
453 0         0 $self->{track} = '';
454             };
455 49 100       175 $self->{track} = '' unless $self->{track};
456 49         152 $self->{genre} = id2genre($self->{genreID});
457 49 0 33     158 if ($e = $self->get_config('decode_encoding_v1') and $e->[0]) {
458 0         0 my $field;
459 0         0 require Encode;
460              
461 0         0 for $field (qw(title artist album comment)) {
462 0         0 $self->{$field} = Encode::decode($e->[0], $self->{$field});
463             }
464             }
465             }
466             }
467              
468             # convert small integer id to genre name
469             sub id2genre {
470 61     61 0 106 my $id=shift;
471 61 100 66     304 return "" unless defined $id and $id < @winamp_genres;
472 33         82 return $winamp_genres[$id];
473             }
474              
475             # convert genre name to small integer id
476             sub genre2id {
477 9     9 0 33 my $genre = MP3::Tag::Implemenation::_massage_genres(shift, 'num');
478 9 100       34 return $genre if defined $genre;
479 3         8 return 255;
480             }
481              
482             # nothing to do for destroy
483       0     sub DESTROY {
484             }
485              
486             1;
487              
488             ######## define all the genres
489              
490 6     6   141 BEGIN { @mp3_genres = ( 'Blues', 'Classic Rock', 'Country', 'Dance',
491             'Disco', 'Funk', 'Grunge', 'Hip-Hop', 'Jazz', 'Metal', 'New Age',
492             'Oldies', 'Other', 'Pop', 'R&B', 'Rap', 'Reggae', 'Rock', 'Techno',
493             'Industrial', 'Alternative', 'Ska', 'Death Metal', 'Pranks',
494             'Soundtrack', 'Euro-Techno', 'Ambient', 'Trip-Hop', 'Vocal',
495             'Jazz+Funk', 'Fusion', 'Trance', 'Classical', 'Instrumental', 'Acid',
496             'House', 'Game', 'Sound Clip', 'Gospel', 'Noise', 'AlternRock',
497             'Bass', 'Soul', 'Punk', 'Space', 'Meditative', 'Instrumental Pop',
498             'Instrumental Rock', 'Ethnic', 'Gothic', 'Darkwave',
499             'Techno-Industrial', 'Electronic', 'Pop-Folk', 'Eurodance', 'Dream',
500             'Southern Rock', 'Comedy', 'Cult', 'Gangsta', 'Top 40',
501             'Christian Rap', 'Pop/Funk', 'Jungle', 'Native American', 'Cabaret', 'New Wave',
502             'Psychadelic', 'Rave', 'Showtunes', 'Trailer', 'Lo-Fi', 'Tribal',
503             'Acid Punk', 'Acid Jazz', 'Polka', 'Retro', 'Musical', 'Rock & Roll',
504             'Hard Rock', );
505              
506 6         328 @winamp_genres = ( @mp3_genres, 'Folk', 'Folk-Rock',
507             'National Folk', 'Swing', 'Fast Fusion', 'Bebob', 'Latin', 'Revival',
508             'Celtic', 'Bluegrass', 'Avantgarde', 'Gothic Rock',
509             'Progressive Rock', 'Psychedelic Rock', 'Symphonic Rock',
510             'Slow Rock', 'Big Band', 'Chorus', 'Easy Listening',
511             'Acoustic', 'Humour', 'Speech', 'Chanson', 'Opera',
512             'Chamber Music', 'Sonata', 'Symphony', 'Booty Bass', 'Primus',
513             'Porn Groove', 'Satire', 'Slow Jam', 'Club', 'Tango', 'Samba',
514             'Folklore', 'Ballad', 'Power Ballad', 'Rhythmic Soul',
515             'Freestyle', 'Duet', 'Punk Rock', 'Drum Solo', 'Acapella',
516             'Euro-House', 'Dance Hall',
517             # More from MP3::Info
518             'Goa', 'Drum & Bass', 'Club-House', 'Hardcore',
519             'Terror', 'Indie', 'BritPop', 'Negerpunk',
520             'Polsk Punk', 'Beat', 'Christian Gangsta Rap',
521             'Heavy Metal', 'Black Metal', 'Crossover',
522             'Contemporary Christian Music', 'Christian Rock',
523             'Merengue', 'Salsa', 'Thrash Metal', 'Anime',
524             'JPop', 'SynthPop', # 149
525             );
526             }
527              
528             =pod
529              
530             =head1 SEE ALSO
531              
532             L, L
533              
534             ID3v1 standard - http://www.id3.org
535              
536             =head1 COPYRIGHT
537              
538             Copyright (c) 2000-2004 Thomas Geffert. All rights reserved.
539              
540             This program is free software; you can redistribute it and/or
541             modify it under the terms of the Artistic License, distributed
542             with Perl.
543              
544             =cut