1# Copyright (C) 2005-2010 Quentin Sculo <squentin@free.fr> 2# 3# This file is part of Gmusicbrowser. 4# Gmusicbrowser is free software; you can redistribute it and/or modify 5# it under the terms of the GNU General Public License version 3, as 6# published by the Free Software Foundation 7 8#Library to read/write mp3 tags (id3v1 id3v2 APE lyrics3), read mp3 header, find mp3 length by reading VBR header or counting mp3 frames 9# http://www.id3.org/develop.html 10# http://www.dv.co.yu/mpgscript/mpeghdr.htm 11# http://www.multiweb.cz/twoinches/MP3inside.htm 12# http://www.thecodeproject.com/audio/MPEGAudioInfo.asp 13 14#http://www.kevesoft.com/crossref.htm 15#http://www.matroska.org/technical/specs/tagging/othertagsystems/comparetable.html 16#http://hobba.hobba.nl/audio/tag_frame_reference.html 17 18use strict; 19use warnings; 20 21package Tag::MP3; 22 23my (@bitrates,@freq,@versions,@encodings,$regex_t); 24our @Genres; 25 26my $MODIFIEDFILE; 27 28INIT 29{ @bitrates= 30 ([ # version 1 31 [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448], #layer I 32 [0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384], #layer II 33 [0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320], #layer III 34 ], 35 [ #version 2 36 [0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256], #layer I 37 [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160], #layer II 38 #[0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160], #layer III 39 ], 40 ); 41 $bitrates[1][2]=$bitrates[1][1]; #v2 layer 2 & 3 have the same bitrates 42 43 @freq=( [11025,12000,8000], # MPEG version 2.5 (from mp3info) 44 undef, # invalid version 45 [22050,24000,16000], # MPEG version 2 46 [44100,48000,32000], # MPEG version 1 47 ); 48 @versions=(2.5,undef,2,1); 49 my $re8=qr/^(.*?)(?:\x00|$)/s; 50 my $re16=qr/^((?:..)*?)(?:\x00\x00|$)/s; 51 $regex_t=$re8; 52 @encodings= 53 ( ['iso-8859-1', "\x00", $re8 ], 54 ['utf16', "\x00\x00", $re16 ], #with BOM 55 ['utf16be', "\x00\x00", $re16 ], 56 ['utf8', "\x00", $re8 ], 57 ); 58 59 #@index_apic=('other','32x32 PNG file icon','other file icon','front cover','back cover','leaflet page','media','lead artist','artist','conductor','band','composer','lyricist','recording location','during recording','during performance','movie/video screen capture','a bright coloured fish','illustration','band/artist logotype','Publisher/Studio logotype'); 60 61 @Genres=('Blues','Classic Rock','Country','Dance','Disco','Funk','Grunge', 62 'Hip-Hop','Jazz','Metal','New Age','Oldies','Other','Pop','R&B', 63 'Rap','Reggae','Rock','Techno','Industrial','Alternative','Ska', 64 'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient', 65 'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical', 66 'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise', 67 'Alt. Rock','Bass','Soul','Punk','Space','Meditative', 68 'Instrumental Pop','Instrumental Rock','Ethnic','Gothic', 69 'Darkwave','Techno-Industrial','Electronic','Pop-Folk','Eurodance', 70 'Dream','Southern Rock','Comedy','Cult','Gangsta Rap','Top 40', 71 'Christian Rap','Pop/Funk','Jungle','Native American','Cabaret', 72 'New Wave','Psychedelic','Rave','Showtunes','Trailer','Lo-Fi', 73 'Tribal','Acid Punk','Acid Jazz','Polka','Retro','Musical', 74 'Rock & Roll','Hard Rock','Folk','Folk/Rock','National Folk', 75 'Swing','Fast-Fusion','Bebob','Latin','Revival','Celtic', 76 'Bluegrass','Avantgarde','Gothic Rock','Progressive Rock', 77 'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band', 78 'Chorus','Easy Listening','Acoustic','Humour','Speech','Chanson', 79 'Opera','Chamber Music','Sonata','Symphony','Booty Bass','Primus', 80 'Porn Groove','Satire','Slow Jam','Club','Tango','Samba', 81 'Folklore','Ballad','Power Ballad','Rhythmic Soul','Freestyle', 82 'Duet','Punk Rock','Drum Solo','A Cappella','Euro-House', 83 'Dance Hall','Goa','Drum & Bass','Club-House','Hardcore','Terror', 84 'Indie','BritPop','Negerpunk','Polsk Punk','Beat', 85 'Christian Gangsta Rap','Heavy Metal','Black Metal','Crossover', 86 'Contemporary Christian','Christian Rock','Merengue','Salsa', 87 'Thrash Metal','Anime','JPop','Synthpop', 88 ); 89 90} 91 92sub new 93{ my ($class,$file,$findlength)=@_; 94 my $self=bless {}, $class; 95 local $_; 96 # check that the file exists 97 unless (-e $file) 98 { warn "File '$file' does not exist.\n"; 99 return undef; 100 } 101 $self->{filename} = $file; 102 $self->_open or return undef; 103 104 $self->_FindTags; 105 $self->_removeblank; 106 $self->{info}=$self->_FindFirstFrame; 107 return undef unless $self->{info}; 108 if ( $findlength && !$self->{info}{frames} && ( $findlength>1 || !$self->{info}{seconds}) ) 109 #if (1) 110 { warn "No VBR header found, must count all the frames to determine length.\n" if $::debug; 111 my $tries; 112 until (_CountFrames($self)) 113 { warn "** searching another first frame\n" if $::debug; 114 $self->{info}=undef; 115 last if ++$tries>20; 116 last unless $self->{info}=$self->_FindFirstFrame($self->{firstframe}+1); 117 } 118 unless ($self->{info}) { warn "Can't determine number of frames, probably not a valid mp3 file.\n"; } 119 } 120 $self->_close; 121 return $self; 122} 123 124sub _FindTags 125{ my $self=shift; 126 $self->{tags_before}=[]; 127 $self->{tags_after}=[]; 128 $self->{startaudio}=0; 129 my $fh=$self->{fileHandle}; 130 131 #Find ID3 tag(s) at the start of the file 132 { my $tag; 133 seek $fh,$self->{startaudio},0; 134 read $fh,my($header),8; 135 if ($header=~m/^ID3/) { $tag=Tag::ID3v2->new_from_file($self); } 136 elsif ($header=~m/^APETAGEX/) { $tag= Tag::APE->new_from_file($self); } 137 last unless $tag; 138 $tag->{offset}=$self->{startaudio}; 139 $self->{startaudio}+=$tag->{size}; 140 push @{ $self->{tags_before} },$tag; 141 redo if 1; #look for another tag ? 142 } 143 144 #Check end of file for tags 145 seek $fh,0,2; 146 $self->{endaudio}=tell $fh; 147 seek $fh,-128,2; 148 read $fh,my($id3v1),128; 149 my $apefooter= substr($id3v1,-32,8) eq 'APETAGEX' && substr($id3v1,-8) eq ("\x00"x8); 150 if (!$apefooter && substr($id3v1,0,3) eq 'TAG') #ID3v1 tag 151 { $self->{ID3v1}= Tag::ID3v1->new_from_string($id3v1); 152 $self->{endaudio}-=128; 153 } 154 155 # search for tag signatures at the end, repeat until none is found 156 { seek $fh,$self->{endaudio}-32,0; 157 my $read=read $fh,my($footer),32; 158 last unless $read==32; #for bogus files <32 bytes 159 my $tag; 160 if ($footer=~m/^APETAGEX/) { $tag= Tag::APE->new_from_file($self,1); } 161 elsif ('3DI' eq substr $footer,32-10,3) { $tag= Tag::ID3v2->new_from_file($self,1); } 162 elsif ('LYRICS200' eq substr $footer,32-9,9) { $tag=Tag::Lyrics3v2->new_from_file($self); } 163 elsif ('LYRICSEND' eq substr $footer,32-9,9) { $tag=Tag::Lyrics3v1->new_from_file($self); } 164 if ($tag) 165 { $self->{endaudio}-=$tag->{size}; 166 $tag->{offset}=$self->{endaudio}; 167 push @{ $self->{tags_after} },$tag; 168 redo; 169 } 170 } 171 return; 172} 173 174sub SyncID3v1 #auto sync with id3v2 175{ my $self=shift; 176 my $id3v1= $self->{ID3v1} || $self->new_ID3v1; 177 my $genre=$id3v1->[6]; 178 my @genres; 179 $id3v1->[6]=\@genres; 180 if (defined $genre) 181 { if (ref $genre) { push @genres,@$genre } 182 else { push @genres,$genre } 183 } 184 if ($self->{ID3v2}) 185 { my $ref=$self->{ID3v2}{frames}; 186 my $r; 187 if ($ref->{TIT2} and ($r)=(grep defined, @{$ref->{TIT2}})) { $id3v1->[0] = $r->[0]; } 188 if ($ref->{TPE1} and ($r)=(grep defined, @{$ref->{TPE1}})) { $id3v1->[1] = $r->[0]; } 189 if ($ref->{TALB} and ($r)=(grep defined, @{$ref->{TALB}})) { $id3v1->[2] = $r->[0]; } 190 if ($ref->{COMM} and ($r)=(grep defined, @{$ref->{COMM}})) { $id3v1->[4] = $r->[2]; } 191 if ($ref->{TYER}) { for (grep defined, @{$ref->{TYER}}) { if ($_->[0]=~m/(\d{4})/) {$id3v1->[3]=$1;last} }} 192 if ($ref->{TRCK}) { for (grep defined, @{$ref->{TRCK}}) { if ($_->[0]=~m/^(\d\d?)/) {$id3v1->[5]=$1;last} }} 193 if ($ref->{TCON}) { unshift @genres,@$_ for grep defined,@{$ref->{TCON}} } 194 #unshift @genres, @{ $ref->{TCON}[0] } if $ref->{TCON}; 195 } 196} 197 198sub new_ID3v1 { Tag::ID3v1 ->new($_[0]); } 199sub new_Lyrics3v2{ Tag::Lyrics3v2->new($_[0]); } 200sub new_APE { Tag::APE ->new($_[0]); } 201sub new_ID3v2 { Tag::ID3v2 ->new($_[0]); } 202sub add 203{ my $self=shift; 204 my $id3v2=$self->{ID3v2} || $self->new_ID3v2; 205 $id3v2->add(@_); 206} 207sub insert 208{ my $self=shift; 209 my $id3v2=$self->{ID3v2} || $self->new_ID3v2; 210 $id3v2->insert(@_); 211} 212sub edit 213{ my $self=shift; 214 my $id3v2=$self->{ID3v2} || return 0; 215 $id3v2->edit(@_); 216} 217sub remove 218{ my $self=shift; 219 my $id3v2=$self->{ID3v2} || return 0; 220 $id3v2->remove(@_); 221} 222sub remove_all 223{ my $self=shift; 224 my $id3v2=$self->{ID3v2} || return 0; 225 $id3v2->remove_all(@_); 226} 227 228sub write_file 229{ my $self=shift; 230 my @towritebefore=(); 231 my @towriteafter=(); 232 my $id3v2tag; 233 my $copybegin=$self->{startaudio}; 234 my $copyend=$self->{endaudio}; 235 { my $blank=$self->{blank}; #blank before audio 236 my $fh; 237 my $hole=0; 238 for my $tag (reverse @{ $self->{tags_before} }) 239 { #warn "$tag : ".(join ' ',keys %$tag)."\n"; 240 if ($tag->{deleted}) { $hole=1; } 241 elsif ($tag->{edited}) 242 { $hole=1; 243 unshift @towritebefore, $tag->make; 244 $id3v2tag=$towritebefore[0] if ref $tag eq 'Tag::ID3v2'; 245 } 246 elsif ($hole) 247 { #read tag, put it in @towritebefore 248 $fh||=$self->_open or return undef; 249 seek $fh,$tag->{offset},0; 250 my $buffer; 251 read $fh,$buffer,$tag->{size}; 252 unshift @towritebefore, \$buffer; 253 } 254 else { if ($blank) {$copybegin-=$blank; $blank=0;} 255 $copybegin-=$tag->{size}; 256 } 257 } 258 $hole=0; 259 for my $tag (reverse @{ $self->{tags_after} }) 260 { if ($tag->{deleted}) { $hole=1; } 261 elsif ($tag->{edited}) 262 { $hole=1; 263 push @towriteafter, $tag->make; 264 } 265 elsif ($hole) 266 { #read tag, put it in @towriteafter 267 $fh||=$self->_open or return undef; 268 seek $fh,$tag->{offset},0; 269 my $buffer; 270 read $fh,$buffer,$tag->{size}; 271 push @towriteafter,\$buffer; 272 } 273 else { $copyend+=$tag->{size}; } 274 } 275 $self->_close if $fh; 276 } 277 push @towriteafter, $self->{ID3v1}->make if $self->{ID3v1}; 278 warn "startaudio=".$self->{startaudio}." copybegin=$copybegin length(towritebefore)=".join(' ',map(length $$_,@towritebefore))."\n" if $::debug; 279 warn "endaudio=".$self->{endaudio}." copyend=$copyend length(towriteafter)=".join(' ',map(length $$_,@towriteafter))."\n" if $::debug; 280 my $in_place; 281 if ($id3v2tag) 282 { my $padding=$copybegin; 283 $padding-=length($$_) for @towritebefore; 284 if ($padding<0 || $padding>2048) { $padding=256 } 285 else { $in_place=1 } 286 Tag::ID3v2::_SetPadding($id3v2tag,$padding); 287 } 288 if ($in_place) 289 { # in place editing 290 warn "in place editing.\n"; #DEBUG 291 my $fh=$self->_openw or return undef; 292 return undef unless defined $fh; 293 print $fh $$_ or warn $! for @towritebefore; 294 seek $fh,$copyend,0; 295 print $fh $$_ or warn $! for @towriteafter; 296 truncate $fh,tell($fh); 297 $self->_close; 298 return 1; 299 } 300 my $INfh=$self->_open or return undef; 301 # create new file 302 my $OUTfh=$self->_openw(1) or return undef; #open .TEMP file 303 my $werr; 304 print $OUTfh $$_ or warn $! and $werr++ for @towritebefore; 305 # copy audio data + unmodified tags next to audio data 306 seek $INfh,$copybegin,0; 307 #read $INfh,my($buffer),$copyend-$copybegin; 308 #print $OUTfh $buffer or warn $! and $werr++; 309 my $tocopy=$copyend-$copybegin; 310 while ($tocopy>0) 311 { my $size=($tocopy>1048576)? 1048576 : $tocopy; 312 read $INfh,my($buffer),$size; 313 print $OUTfh $buffer or warn $! and $werr++; 314 $tocopy-=$size; 315 } 316 $self->_close; 317 print $OUTfh $$_ or warn $! and $werr++ for @towriteafter; 318 close $OUTfh; 319 if ($werr) {warn "write errors... aborting.\n"; unlink $self->{filename}.'.TEMP'; return 0; } 320 warn "replacing old file with new file.\n"; 321 unlink $self->{filename} && rename $self->{filename}.'.TEMP',$self->{filename}; 322 $MODIFIEDFILE=1; 323 %$self=(); #destroy the object to make sure it is not reused as many of its data are now invalid 324 return 1; 325} 326 327sub _open 328{ my $self=$_[0]; 329 my $file=$self->{filename}; 330 open my$fh,'<',$file or warn "can't open $file : $!\n" and return undef; 331 binmode $fh; 332 $self->{fileHandle} = $fh; 333 return $fh; 334} 335sub _openw 336{ my ($self,$tmp)=@_; 337 my $file=$self->{filename}; 338 my $m='+<'; 339 if ($tmp) {$file.='.TEMP';$m='>';} 340 my $fh; 341 until (open $fh,$m,$file) 342 { my $err="Error opening '$file' for writing :\n$!"; 343 warn $err."\n"; 344 return undef unless $self->{errorsub} && $self->{errorsub}($!,'openwrite',$file) eq 'retry'; 345 } 346 binmode $fh; 347 $self->{fileHandle} = $fh unless $tmp; 348 return $fh; 349} 350 351sub _close 352{ my $self=shift; 353 close delete($self->{fileHandle}); 354} 355 356sub _removeblank #remove blank before audio 357{ my $self=$_[0]; 358 my $fh=$self->{fileHandle}; 359 seek $fh,$self->{startaudio},0; 360 my ($buf,$read); my $blank=0; 361 while (($read=read $fh,$buf,100) && $buf=~m/^\00+/) 362 { $blank+=$+[0]; 363 last unless $read==$+[0]; 364 } 365 $self->{blank}=$blank; 366 return unless $blank; 367 warn "blank before audio : $blank bytes\n" if $::debug; 368 $self->{startaudio}+=$blank; 369} 370 371sub _FindFirstFrame 372{ my ($self,$offset)=@_; 373 my $fh=$self->{fileHandle}; 374 $offset||=$self->{startaudio}; 375 seek $fh,$offset,0; 376 my $pos=0; 377 my %info; 378 read $fh,my$buf,100; 379SEARCH1ST: while ($pos<60000) #only look in the first 60000 bytes (after tag) 380 { while ($buf=~m/\xff(...)/sg) 381 #while ($buf=~m/\xff([\xe0-\xff][\x00-\xef].)/sg) 382 { my ($byte2,$byte3,$byte4)=unpack 'CCC',$1; 383 #print "AAABBCCD EEEEFFGH IIJJKLMM\n"; #DEBUG 384 #@_=unpack 'B8B8B8B8',$1; print "@_\n"; #DEBUG 385 #next if $byte2<0xf0; #not a synchro signal (0b11110000) 386 # next if $byte2<0xe0; #not a synchro signal (0b11100000) 387 # next unless $byte3<0xf0; #invalid bitrate # ($byte3 & 0b11110000)==0b11110000 388 my $mpgversion=($byte2>>3)& 0b11; 389 next if $mpgversion==1; #invalid MPEG version 390 my $layer=($byte2>>1)& 0b11; 391 next if $layer==0; #invalid layer 392 my $freq=($byte3>>2) & 0b11; 393 next if $freq==3; #invalid frequence #warn "unknown sampling rate\n" 394 my $bitrateindex=$byte3>>4; 395 next if $bitrateindex==15; #invalid bitrate index 396 $pos+=$-[0]; 397 $self->{firstframe}=$pos+$offset; 398 warn "skipped $pos, first frame at $self->{firstframe}\n" if $pos && $::debug; 399 $self->{byte2}=$byte2; 400 $info{version2}=($mpgversion & 0b1)? 0 : 1; 401 $info{versionid}=$versions[$mpgversion]; 402 $info{rate}=$freq[ $mpgversion ][ $freq ]; 403 $info{layer}=4-$layer; 404 $info{crc}=($byte2 & 0b1)? 0 : 1; 405 $info{bitrate}=1000*$bitrates[ $info{version2} ][ $info{layer}-1 ][$bitrateindex]; 406 #if ($info{bitrate}==0) { warn "free bitrate not supported\n"; } 407 $info{channels}=($byte4>>6==3)? 1 : 2; 408 $info{sampleperframe}= $info{layer}==1? 384 : 409 $info{version2}? 576 : 410 1152 ; 411 #compute size of first frame 412 my $pad=($info{layer}==1)? 4 : 1; 413 my $firstframe_size=int($info{bitrate}*$info{sampleperframe}/8/$info{rate}); 414 $firstframe_size+=$pad if $byte3 & 0b10; 415 #warn "firstframe_size : $firstframe_size\n"; 416 $self->{audiodatasize}=$self->{endaudio} - $self->{firstframe}; 417 #check for VBRI header #http://www.thecodeproject.com/audio/MPEGAudioInfo.asp 418 { seek $fh,$self->{firstframe}+36,0; 419 read $fh,$_,18; 420 my ($id,$vers,$delay,$quality,undef,$frames)=unpack 'a4nnnNN',$_; 421 #should I $frames-- to remove this info frame ? 422 last unless $id eq 'VBRI'; 423 warn "VBRI header found : version=$vers delay=$delay quality=$quality nbframes=$frames\n" if $::debug; 424 $info{vbr}=1; 425 $self->{audiodatasize}-=$firstframe_size; 426 _calclength(\%info,$frames,$self->{audiodatasize}); 427 last SEARCH1ST 428 } 429 #check if frame is the Xing/LAME header 430 { #offset depends on mpegversion and channels : 431 # 13 for mono v2/2.5 , 36 for stereo v1 , 21 for other 432 $_=(13,21,36)[ (!$info{version2}) + ($info{channels}!=3) ]; 433 seek $fh,$self->{firstframe}+$_,0; 434 read $fh,$_,12; 435 my ($id,$flags,$frames)=unpack 'a4NN',$_; 436 last unless ($id eq 'Xing' || $id eq 'Info'); 437 warn "Xing header found : $id flags=$flags nbframes=$frames\n" if $::debug; 438 last unless $flags & 1; # unless number of frames is stored 439 $info{vbr}=($id eq 'Xing'); 440 $self->{audiodatasize}-=$firstframe_size; 441 _calclength(\%info,$frames,$self->{audiodatasize}); 442 last SEARCH1ST; 443 } 444 #estimating number of frames assuming: found correct first frame and fixed bitrate 445 if ($info{bitrate}) 446 { $info{estimated}=1; 447 $info{seconds}=$self->{audiodatasize}*8/$info{bitrate}; 448 warn "length estimation : $info{seconds} s\n" if $::debug; 449 } 450 last SEARCH1ST; 451 } 452 #read next chunk but keep last 3 bytes 453 $pos+=length($buf)-3; 454 $buf=substr $buf,-3; 455 last unless read $fh,$buf,100,3; 456 } 457 return \%info if defined $self->{firstframe}; 458 warn "no MP3 frame found\n"; 459 return undef; 460} 461 462sub _CountFrames #find and count each frames 463{ my $time=times; #DEBUG 464 $MODIFIEDFILE=undef; 465 my $self=shift; 466 my $info=$self->{info}; 467 return 0 if $info->{bitrate}==0; #if unknown bitrate 468 return undef unless $info->{rate}; 469 my $fh=$self->{fileHandle}; 470 seek $fh,$self->{firstframe},0; 471 my $frames=0; 472 my $skipcount; 473 my $byte1_2="\xff".chr $self->{byte2}; 474 475 # size of padding when present 476 my $pad=($info->{layer}==1)? 4 : 1; 477 # construct @size array, which will contain the size of the frame in function of the EEEE bits 478 my $m=1000*$info->{sampleperframe}/8/$info->{rate}; 479 my @size=map int($_*$m)-4, @{ $bitrates[ $info->{version2} ][ $info->{layer}-1 ] }; 480 # -4 to substract 4 bytes header 481 $size[0]=$size[15]=0; #for free (0) or reserved (15) bitrate -> skip frame header and look for next 482my $count=1000; 483 #search for each frame 484 while (read $fh,$_,4) 485 { if (substr($_,0,2) eq $byte1_2) 486 { #print "AAAAAAAA AAABBCCD EEEEFFGH IIJJKLMM\n"; #DEBUG 487 #@_=unpack "B8B8B8B8",$_; print "@_\n"; #DEBUG 488 #my $pos=tell $fh; #DEBUG 489 #print "$pos frame=$frames size=$s bytes\n"; #DEBUG 490 #my $s=$cache{substr($_,2,1)}||=((vec $_,17,1)? $size[ (vec $_,2,8)>>4 ]+$pad:$size[ (vec $_,2,8)>>4 ])}; # a bit faster, needs a my %cache 491 $_=vec $_,2,8; 492 #seek to the end of the frame : 493 seek $fh,(($_ & 0b10)? $size[ $_>>4 ]+$pad: 494 $size[ $_>>4 ] ),1; 495 $frames++; 496 unless ($count--) { $count=1000; Gtk2->main_iteration while Gtk2->events_pending; } 497 } 498 else #skip 499 { #@_=unpack "B8B8",$byte1_2; warn "@_ ".tell($fh)."\n"; #DEBUG 500 #warn "AAAAAAAA AAABBCCD EEEEFFGH IIJJKLMM\n"; #DEBUG 501 #@_=unpack "B8B8B8B8",$_; warn "@_ doesn't match bytes1_2 frame=$frames\n"; #DEBUG 502 # assume first frame invalid if can't find 3 first frames without skipping 503 return undef if $frames<4; 504 my $skipped=0; 505 my $read; my $pos; 506 while ($read=read $fh,$_,252,4) 507 { if (m/\Q$byte1_2\E/) { $pos=$-[0]; last; }; 508 $skipped+=$read; 509 $_=substr $_,-4; 510 } 511 warn "too much skipping\n" and return undef if $skipcount++>50 && $::debug; 512 last unless $read && tell($fh) < $self->{endaudio}; 513 $skipped+=$pos; 514 warn "skipped $skipped bytes (offset=".tell($fh).")\n" if $::debug; 515 seek $fh,$pos-256,1; 516 } 517 } 518 _calclength($info,$frames,$self->{audiodatasize}); 519 $info->{estimated}=1 if $MODIFIEDFILE; #if a file has been rewrote while reading, mark the info as suspicious 520 $time=times-$time; warn "full scan : $time s\n" if $::debug; #DEBUG 521 return 1; 522} 523 524sub _calclength 525{ my ($info,$frames,$bytes)=@_; 526 $info->{estimated}=undef; 527 $info->{frames}=$frames; 528 my $s=$info->{seconds}=$frames*$info->{sampleperframe}/$info->{rate}; 529 $info->{mmss}=sprintf '%d:%02d',$s/60,$s%60; 530 $info->{bitrate}= ($s==0)? 0 : $bytes*8/$s; 531 warn "total_frames=$info->{frames}, audio_size=$bytes, length=$info->{mmss}, bitrate=$info->{bitrate}\n" if $::debug; 532} 533 534package Tag::ID3v1; 535use Encode qw(decode encode); 536 537sub new 538{ my $file=$_[1]; 539 return $file->{ID3v1}= bless []; 540} 541 542sub new_from_string 543{ my $string=$_[1]; 544 my ($title,$artist,$album,$year,$comment,$vers1_1,$track,$genre) 545 =unpack 'x3 Z30 Z30 Z30 Z4 Z28 C C C',$string; 546 if ($vers1_1!=0) #-> id3v1.0 547 { $comment=unpack 'x97 Z30',$string; 548 $track=''; 549 } 550 s/ *$// for $title,$artist,$album,$comment; 551 $_=decode($::Options{TAG_id3v1_encoding}||'iso-8859-1',$_) for $title,$artist,$album,$comment; 552 $genre=($genre<@Tag::MP3::Genres)? $Tag::MP3::Genres[$genre] : ''; 553 return bless [$title,$artist,$album,$year,$comment,$track,$genre]; 554} 555 556sub make 557{ my $self=shift; 558 my ($title,$artist,$album,$year,$comment,$track,$genre)= @$self; 559 if (defined $genre) 560 { if (ref $genre) { ($genre)=grep defined, map _findgenre($_),@$genre; } 561 elsif ($genre=~m/^\D+$/) { $genre=_findgenre($genre); } 562 } 563 $genre=255 unless defined $genre && $genre ne ''; 564 my $buffer='TAG'; 565 my @length=(30,30,30,4,30); 566 $length[4]=28 if $track; 567 for my $v ($title,$artist,$album,$year,$comment) 568 { $v='' unless defined $v; 569 my $l=shift @length; 570 $v=encode( $::Options{TAG_id3v1_encoding}||'iso-8859-1', $v); 571 if (bytes::length($v)<$l){ $buffer.=pack "Z$l",$v } 572 else { $buffer.=pack "A$l",$v } #FIXME remove partial multi-byte chars 573 } 574 $buffer.="\x00".bytes::chr($track) if $track; 575 $buffer.=bytes::chr $genre; 576 return \$buffer; 577} 578 579sub _findgenre 580{ my $str=shift; 581 my $list=\@Tag::MP3::Genres; 582 $str=lc$str; 583 my $i; 584 for (0..$#$list) 585 { if ($str eq lc$list->[$_]) {$i=$_; last} 586 } 587 return $i; 588} 589 590sub get_values 591{ return $_[0][$_[1]]; 592} 593 594package Tag::Lyrics3v1; 595use Encode qw(decode encode); 596 597sub new_from_file #http://www.id3.org/lyrics3.html #untested 598{ my ($class,$file)=@_; 599 my $fh=$file->{fileHandle}; 600 seek $fh,-5109,1; 601 read $fh,my($buffer),5100; 602 return undef unless $buffer=~m/LYRICSBEGIN(.+)/; 603 warn "found lyrics3 v1 tag (".length($1)." bytes of lyrics)\n" if $::debug; 604 my %tag; 605 $tag{size}=length $1; 606 $tag{lyrics}=decode('iso-8859-1',$1); 607 $tag{makesub}=\&_MakeLyrics3Tag; 608 return $file->{lyrics3}=bless(\%tag,$class); 609} 610sub removetag { $_[0]{deleted}=1; } 611sub make 612{ my $tag=shift; 613 my $tagstring='LYRICSBEGIN'.substr(encode('iso-8859-1',$tag->{lyrics}),0,4096).'LYRICSEND'; 614 return \$tagstring; 615} 616 617package Tag::Lyrics3v2; 618use Encode qw(decode encode); 619 620sub new 621{ my ($class,$file)=@_; 622 my $self={ fields => {}, fields_order => [], edited => 1 }; 623 unshift @{ $file->{tags_after} },$self; 624 $file->{lyrics3v2}=$self; 625 return bless($self,$class); 626} 627 628sub new_from_file #http://www.id3.org/lyrics3200.html 629{ my ($class,$file)=@_; 630 my $fh=$file->{fileHandle}; 631 seek $fh,$file->{endaudio}-15,0; 632 read $fh,my($header),15; 633 my $size=substr $header,0,6; 634 return undef unless $size=~m/^[0-9]+$/; 635 seek $fh,-$size-15,1; 636 read $fh,my($rawtag),$size; 637 return undef unless $rawtag=~s/^LYRICSBEGIN//; 638 my %tag; 639 $tag{size}=$size+15; 640 warn "found lyrics3 v2.00 tag (".$tag{size}." bytes)\n" if $::debug; 641 while ($rawtag=~s/^([A-Z]{3})([0-9]{5})//) 642 { if ($1 eq 'IND') { $tag{IND}=substr($rawtag,0,$2,''); next; } 643 $tag{fields}{$1}=decode('iso-8859-1',substr($rawtag,0,$2,'')); 644 push @{ $tag{fields_order} },$1; 645 warn "Lyrics3 $1 : $tag{fields}{$1}\n" if $::debug; 646 } 647 return $file->{lyrics3v2}=bless(\%tag,$class); 648} 649sub removetag { $_[0]{deleted}=1; } 650sub add 651{ my ($self,$field,$val)=@_; 652 return 0 if $self->{fields}{$field}; 653 push @{ $self->{fields_order} },$field; 654 $self->{fields}{$field}=$val; 655 $self->{edited}=1; 656 return 1; 657} 658sub edit 659{ my ($self,$field,$nb,$val)=@_; 660 return 0 unless $self->{fields}{$field}; 661 $self->{fields}{$field}=$val; 662 $self->{edited}=1; 663 return 1; 664} 665sub remove 666{ my ($self,$field)=@_; 667 delete $self->{fields}{$field}; 668 $self->{edited}=1; 669 return 1; 670} 671 672sub get_keys 673{ keys %{ $_[0]{fields} }; 674} 675sub get_values 676{ return $_[0]{fields}{$_[1]}; 677} 678 679sub make 680{ my $tag=shift; 681 my $tagstring='LYRICSBEGIN'; 682 $tagstring.='IND'.sprintf( '%05d',length($tag->{IND}) ).$tag->{IND} if $tag->{IND}; 683 for my $field (@{ $tag->{fields_order} }) 684 { next unless defined $tag->{fields}{$field}; 685 my $v=substr encode('iso-8859-1',delete $tag->{fields}{$field}),0,99999; 686 $tagstring.=$field.sprintf('%05d',length $v).$v; 687 } 688 if ($tagstring ne 'LYRICSBEGIN') #not empty 689 { $tagstring=$tagstring.sprintf('%06d',length $tagstring).'LYRICS200'; 690 } 691 return \$tagstring; 692} 693 694package Tag::APE; 695# http://wiki.hydrogenaudio.org/index.php?title=APEv2_specification 696use Encode qw(decode encode); 697 698sub new 699{ my ($class,$file)=@_; 700 my $self={ realkey =>{}, item => {}, edited => 1 }; 701 unshift @{ $file->{tags_after} },$self; 702 $file->{APE}=$self; 703 return bless($self,$class); 704} 705sub new_from_file 706{ my ($class,$file,$isfooter)=@_; 707 my $fh=$file->{fileHandle}; 708 if ($isfooter) { seek $fh,$file->{endaudio}-32,0; } 709 else { seek $fh,$file->{startaudio} ,0; } 710 read $fh,my($headorfoot),32; 711 my ($v,$size,$Icount,$flags)=unpack 'x8VVVV',$headorfoot; 712 my $rawtag; 713 $size+=32 if $flags & 0x80000000; #if contains a header 714 return undef unless $size; #for some bogus header with a size=0 715 if ($flags & 0x20000000) #if $headorfoot is a header 716 { read $fh, $rawtag, $size-32; 717 return undef unless ($flags & 0x40000000) || $rawtag=~m/APETAGEX.{24}$/s; #check footer 718 } 719 else # $headorfoot is a footer -> must seek backward 720 { seek $fh,-$size,1; 721 read $fh, $rawtag, $size; 722 return undef if ($flags & 0x80000000) && $rawtag!~m/^APETAGEX.{24}/sg; #check header 723 } 724 my %self=( version=> $v/1000, size=> $size, realkey =>{}, item => {}, ); 725 warn "found APE tag version ".($v/1000)." ($size bytes) ($Icount items)\n" if $::debug; 726 for (1..$Icount) 727 { last unless $rawtag=~m/\G(........[\x20-\x7E]+)\x00/sg; 728 my ($len,$type,$key)=unpack 'VVa*',$1; 729 $key= $self{realkey}{lc$key}||=$key; 730 my $val=substr $rawtag,pos($rawtag),$len; 731 pos($rawtag)+=$len; 732 warn "APE : $key ($len bytes)\n" if $::debug; 733 $type&= 0b111; 734 if ($type & 0b10) #binary 735 { push @{$self{item}{$key}}, [$val,$type]; 736 } 737 else #utf8 string or link 738 { my @v=split /\x00/,$val; 739 push @{$self{item}{$key}}, map {[decode('utf8',$_),$type]} @v; 740 } 741 } 742 return $file->{APE}=bless(\%self,$class); 743} 744sub removetag { $_[0]{deleted}=1; } 745sub insert 746{ my ($self,$key,$val,$type)=@_; 747 $key= $self->{realkey}{lc$key}||=$key; 748 unshift @{$self->{item}{$key}}, [ $val, $type||0]; 749 $self->{edited}=1; 750 return 1; 751} 752sub add 753{ my ($self,$key,$val,$type)=@_; 754 $key= $self->{realkey}{lc$key}||=$key; 755 push @{$self->{item}{$key}}, [ $val, $type||0]; 756 $self->{edited}=1; 757 return 1; 758} 759sub edit 760{ my ($self,$key,$nb,$val,$type)=@_; 761 $key= $self->{realkey}{lc$key}; 762 return unless defined $key && $self->{item}{$key}[$nb]; 763 $self->{item}{$key}[$nb][0]=$val; 764 $self->{item}{$key}[$nb][1]=$type if defined $type; 765 $self->{edited}=1; 766 return 1; 767} 768sub remove 769{ my ($self,$key,$nb)=@_; 770 $key= $self->{realkey}{lc$key}; 771 return unless defined $key && $self->{item}{$key}[$nb]; 772 $self->{item}{$key}[$nb]=undef; 773 $self->{edited}=1; 774 return 1; 775} 776sub remove_all 777{ my ($self,$key)=@_; 778 $key= delete $self->{realkey}{lc$key}; 779 if (defined $key) 780 { delete $self->{item}{$key}; 781 $self->{edited}=1; 782 } 783 return 1; 784} 785 786sub get_keys 787{ keys %{ $_[0]{realkey} }; 788} 789sub get_values 790{ my ($self,$key)=@_; 791 $key= $self->{realkey}{lc$key} || $key; 792 my $v= $self->{item}{$key}; 793 return $v ? (map $_->[0],grep defined, @$v) : (); 794} 795sub is_binary 796{ my ($self,$key,$nb)=@_; 797 $key= $self->{realkey}{lc$key} || $key; 798 return unless defined $key && defined $nb; 799 my $ref= $self->{item}{$key}[$nb]; 800 return $ref ? $ref->[1]&0b10 : undef; 801} 802 803sub make 804{ my $tag=shift; 805 my $tagstring=''; 806 my $nb=0; 807 for my $key (values %{ $tag->{realkey} }) 808 { my $values_types= $tag->{item}{$key}; 809 next unless $values_types; 810 my @towrite; 811 for my $vt (@$values_types) 812 { my ($value,$type)= @$vt; 813 next unless defined $value; 814 $type||=0; 815 unless ($type & 0b10) #if not binary 816 { $value=encode('utf8',$value); 817 my ($prev)= grep $_->[1]==$type, @towrite; #previous one with same type 818 if ($prev) { $prev->[2].= "\x00".$value; next } #append value to previous 819 } 820 push @towrite,[$key,$type,$value]; 821 } 822 for my $w (@towrite) 823 { my ($key,$type,$value)=@$w; 824 $tagstring.=pack('VV',length($value),$type).$key."\x00".$value; 825 $nb++; 826 } 827 } 828 if ($nb) 829 { my $length= 32 + length $tagstring; 830 my $header= 'APETAGEX'.pack('VVVVx8', 2000, $length, $nb, 0xa0000000); 831 my $footer= 'APETAGEX'.pack('VVVVx8', 2000, $length, $nb, 0x80000000); 832 $tagstring= $header.$tagstring.$footer; 833 } 834 return \$tagstring; 835} 836 837package Tag::ID3v2; 838use Encode qw(decode encode); 839 840my %FRAMES; my %FRAME_OLD; my %Special; 841my $Zlib; 842 843INIT 844{ 845eval { require Compress::Zlib; }; 846$Zlib=1 unless $@; 847 848 %FRAMES=( 849generic_text => 'eT', 850generic_url => 'eT', 851unknown => 'u', 852#text => 'eT', 853TXXX => 'eTM', 854WXXX => 'eTt', 855UFID => 'tb', 856MCDI => 'b', 857USLT => 'elTM', 858COMM => 'elTM', 859APIC => 'etCTb', 860GEOB => 'etTTb', 861PCNT => 'c', 862POPM => 'tCc', 863USER => 'elT', 864OWNE => 'ettT', 865PRIV => 'tb', 866WCOM => 't', 867WCOP => 't', 868WOAF => 't', 869WOAR => 't', 870WOAS => 't', 871WORS => 't', 872WPAY => 't', 873WPUB => 't', 874TALB => 'eT', 875TBPM => 'eT', 876TCOM => 'eT', 877TCON => 'eT*', #remplacer (\d+) et (RX) (CR) 878TCOP => 'eT', 879TDLY => 'eT', #[0-9]+ 880TENC => 'eT', 881TEXT => 'eT', 882TFLT => 'eT', #special 883TIT1 => 'eT', 884TIT2 => 'eT', 885TIT3 => 'eT', 886TKEY => 'eT', 887TLAN => 'eT*', #remplacer ([A-Z]{3}) par ISO-639-2 888TLEN => 'eT', 889TMED => 'eT', #special 890TOAL => 'eT', 891TOFN => 'eT', 892TOLY => 'eT', 893TOPE => 'eT', 894TOWN => 'eT', 895TPE1 => 'eT', 896TPE2 => 'eT', 897TPE3 => 'eT', 898TPE4 => 'eT', 899TPOS => 'eT', #numeric(/numeric) 900TPUB => 'eT', 901TRCK => 'eT', #numeric(/numeric) 902TRSN => 'eT', 903TRSO => 'eT', 904TSRC => 'eT', #(12char) ignore 905TSSE => 'eT', 906ETCO => 'u', 907MLLT => 'u', 908SYTC => 'u', 909SYLT => 'u', 910RVRB => 'u', 911RBUF => 'u', 912AENC => 'u', 913LINK => 'u', 914POSS => 'u', 915COMR => 'u', 916ENCR => 'u', 917GRID => 'u', 918 919# deprecated in v4 920TSIZ => 'eT', 921TDAT => 'eT', 922TIME => 'eT', #HHMM 923TRDA => 'eT', #DDMM 924TYER => 'eT', #YYYY 925TORY => 'eT', 926IPLS => 'eT', 927RVAD => 'u', 928EQUA => 'u', 929 930#only v4 931TDRC => 'eT', 932TDOR => 'eT', 933TSST => 'eT', 934TMOO => 'eT*', 935TPRO => 'eT', 936TDEN => 'eT', 937TDRL => 'eT', 938TDTG => 'eT', 939TSOA => 'eT', 940TSOP => 'eT', 941TSOT => 'eT', 942TMCL => 'eT', #(par paires) 943TIPL => 'eT', #(par paires) 944RVA2 => 'u', 945EQU2 => 'u', 946SIGN => 'u', 947SEEK => 'u', 948ASPI => 'u', 949 950#iTunes frames 951TCMP => 'eT', #compilation flag 952TSO2 => 'eT', #Album Artist Sort 953TSOC => 'eT', #Composer Sort 954 955#unconverted id3v2 956#XCRM => 'ttb',#CRM 957); 958 959 # http://www.unixgods.org/~tilo/ID3/docs/ID3_comparison.html 960 %FRAME_OLD= 961 ( TT1 => 'TIT1', TT2 => 'TIT2', TT3 => 'TIT3', 962 TP1 => 'TPE1', TP2 => 'TPE2', TP3 => 'TPE3', TP4 => 'TPE4', 963 TCM => 'TCOM', TXT => 'TEXT', TLA => 'TLAN', TCO => 'TCON', 964 TAL => 'TALB', TRK => 'TRCK', TPA => 'TPOS', TRC => 'TSRC', 965 TDA => 'TDAT', TYE => 'TYER', TIM => 'TIME', TRD => 'TRDA', 966 TOR => 'TORY', TBP => 'TBPM', TMT => 'TMED', TFT => 'TFLT', 967 TCR => 'TCOP', TPB => 'TPUB', TEN => 'TENC', TSS => 'TSSE', 968 TLE => 'TLEN', TSI => 'TSIZ', TDY => 'TDLY', TKE => 'TKEY', 969 TOT => 'TOAL', TOF => 'TOFN', TOA => 'TOPE', TOL => 'TOLY', 970 TXX => 'TXXX', WAF => 'WOAF', WAR => 'WOAR', WAS => 'WOAS', 971 WCM => 'WCOM', WCP => 'WCOP', WPB => 'WPUB', IPL => 'IPLS', 972 ULT => 'USLT', COM => 'COMM', UFI => 'UFID', MCI => 'MCID', 973 ETC => 'ETCO', MLL => 'MLLT', STC => 'SYTC', SLT => 'SYLT', 974 RVA => 'RVAD', EQU => 'EQUA', REV => 'RVRB', PIC => 'APIC', 975 GEO => 'GEOB', CNT => 'PCNT', POP => 'POPM', BUF => 'RBUF', 976 CRA => 'AENC', LNK => 'LINK', 977 ); 978 979 %Special= 980 ( TCON => \&_genreid, 981 ); 982} 983 984sub new 985{ my ($class,$file)=@_; 986 my $self={ frames => {}, framesorder => [], edited => 1 }; 987 unshift @{ $file->{tags_before} },$self; 988 $self->{version}=$::Options{'TAG_write_id3v2.4'}? 4 : 3; 989 $file->{ID3v2}=$self; 990 return bless($self,$class); 991} 992 993sub new_from_file 994{ my ($class,$file,$isfooter)=@_;warn "new : @_\n" if $::debug; 995 my $fh=$file->{fileHandle}; 996 my %tag; 997 #$tag{offset}=shift; 998 #seek $fh,$tag{offset},0; 999 #read $fh,$_,10; 1000 if ($isfooter) { seek $fh,$file->{endaudio}-10,0; } 1001 else { seek $fh,$file->{startaudio} ,0; } 1002 read $fh,my($headorfoot),10; 1003 my ($id,$v1,$v2,$flags,$size)=unpack 'a3 CCC a4',$headorfoot; 1004 #FIXME check sane values 1005 # $49 44 33 yy yy xx zz zz zz zz 1006 # Where yy is less than $FF, xx is the 'flags' byte and zz is less than $80 1007 if ($v1>4) {warn "Unsupported version ID3v2.$v1.$v2 -> skipped\n"; return undef;} 1008 $tag{version}= $v1 . ($v2 ? ".$v2" : ''); 1009 $tag{size}=10+($size=_decodesyncsafe($size)); 1010 my $footorhead; 1011 if ($id eq '3DI') 1012 { seek $fh,-$size-20,1; #id3v2.4 footer -> seek to begining of tag 1013 read $fh,$footorhead,10; #read header 1014 } 1015 elsif ($id ne 'ID3') 1016 { return undef; 1017 } 1018 my $rawtag; 1019 read $fh,$rawtag,$size; 1020 if ($flags & 0b00010000) #footer present 1021 { substr($headorfoot,0,3)=reverse $id; 1022 read $fh,$footorhead,10 unless $footorhead; #read footer 1023 return undef unless $footorhead eq $headorfoot; 1024 $tag{footer}=1; 1025 $tag{size}+=10; 1026 } 1027 warn "ID3v2.$v1.$v2 : ".$tag{size}." bytes\n" if $::debug; 1028 1029 if ($flags & 0b10000000) #unsynchronisation 1030 { warn "unsynchronisation\n" if $::debug; 1031 $rawtag=~s/\xff\x00/\xff/g if $v1<4; 1032 $tag{unsync}=1; 1033 } 1034 if ($flags & 0b01000000) #Extended header #currently unused & untested 1035 { return undef if $v1==2; #means compressed tag -> ignore 1036 warn "extended header\n" if $::debug; 1037 my $extsize=substr $rawtag,0,4,''; 1038 $extsize=($v1==4)? _decodesyncsafe($extsize)-4 1039 : unpack 'N',$extsize; 1040 my $extheader=substr $rawtag,0,$extsize,''; 1041 if ($v1==3) 1042 { my ($f,$padsize,$crc)=unpack 'C2VV',$extheader; #CHECKME V or N 1043 $tag{crc}=$crc if $f & 0x8000; 1044 warn "padding $padsize\n" if $::debug; 1045 #FIXME use remove padding 1046 #substr $rawtag,-$padsize,$padsize,''; #CHECKME find a file who has $padding 1047 } 1048 elsif ($v1==4) 1049 { my ($pos,$f)=unpack 'CC',$extheader; 1050 $pos++; 1051 if ($f & 0b01000000) #update (ignored) #FIXME considered a new tag for now 1052 { $tag{update}=1; 1053 $pos++; warn "v2.4 update\n" if $::debug; 1054 } 1055 if ($f & 0b00100000) #crc (ignored) 1056 { $tag{crc}=_decodesyncsafe(substr $extheader,++$pos,5); 1057 $pos+=5; warn "v2.4 crc\n" if $::debug; 1058 } 1059 if ($f & 0b00010000) #restrictions (ignored) 1060 { $tag{restrictions}=vec $extheader,++$pos,8; 1061 $pos++; warn "v2.4 restrictions\n" if $::debug; 1062 } 1063 } 1064 } 1065 # done reading tag header 1066 my $broken24=0; 1067 my $pos=0; 1068 my $maxpos=length($rawtag)-( ($v1==2)? 6 : 10 ); 1069 # for each frame : 1070 while ( $pos < $maxpos ) 1071 { my ($frame,$fsize,$f1,$f2); 1072 my $convertsub; 1073 warn "........padding\n" if $::debug && (substr($rawtag,$pos,1) eq "\x00"); #DEBUG 1074 last if substr($rawtag,$pos,1) eq "\x00"; #reached padding 1075 if ($v1==2) #v2.2 1076 { ($frame,$fsize,my @size)=unpack 'a3CCC',substr $rawtag,$pos,6; 1077 $pos+=6; 1078 $fsize=($fsize<<8)+$_ for @size; 1079 $convertsub=\&_ConvertPIC if $frame eq 'PIC'; 1080 $frame=$FRAME_OLD{$frame} || 'X'.$frame; 1081 } 1082 else #v2.3 and v2.4 1083 { ($frame,$fsize,$f1,$f2)=unpack 'a4a4CC',substr $rawtag,$pos,10; 1084 #warn " $frame,$fsize,$f1,$f2\n"; 1085 $pos+=10; 1086 $fsize=($v1==4 && !($broken24&1)) ? _decodesyncsafe($fsize) 1087 : unpack 'N',$fsize; 1088 } 1089 my $error; 1090 unless ($frame=~m/^[A-Z0-9]+$/) # check if valid frameID 1091 { if ($frame=~m/^[A-Za-z0-9 ]+$/) 1092 { warn "Invalid frameID '$frame' (lowercase and/or space)\n"; 1093 } 1094 else 1095 { $error="Invalid frameID found"; 1096 } 1097 } 1098 if (!$error && length($rawtag) < $fsize+$pos) #end of tag 1099 { $error="End of tag reached prematurely while reading frame $frame"; 1100 } 1101 if ($error) 1102 { my $erroraction="skipping rest of tag"; 1103 if ($v1!=4) { warn "$error -> $erroraction\n";last } 1104 if ($broken24<3) 1105 { $broken24++; 1106 warn "$error, trying broken id3v2.4 mode$broken24\n"; 1107 $pos=0; 1108 $tag{brokenframes}=delete $tag{frames}; 1109 $tag{brokenframesorder}=delete $tag{framesorder}; 1110 if ($tag{unsync}) {$rawtag=~s/\xff\x00/\xff/g if $broken24==2;} 1111 else {$broken24=3} 1112 next; 1113 } 1114 else 1115 { warn "$error -> $erroraction\n"; 1116 if ( @{$tag{brokenframesorder}} >= @{$tag{framesorder}} ) #keep the best 1117 { $tag{frames}=delete $tag{brokenframes}; 1118 $tag{framesorder}=delete $tag{brokenframesorder}; 1119 } 1120 last; 1121 } 1122 } 1123 #Read frame 1124 warn "$frame ($fsize bytes)\n" if $::debug; 1125 my $rawf=substr $rawtag,$pos,$fsize; 1126 #warn unpack('H*',$rawf)."\n"; #DEBUG 1127 $pos+=$fsize; 1128 if ($v1==3) #frame flags v2.3 1129 { if ($f2 & 0b10000000) 1130 { warn "Frame $frame is compressed\n" if $::debug; 1131 my $unc_size=unpack 'N',$rawf; 1132 unless ($Zlib) {warn "Compressed frame $frame can't be read because Compress::Zlib is not found.\n";next;} 1133 $rawf = Compress::Zlib::uncompress( substr($rawf,4) ); 1134 unless (defined $rawf) {warn "frame decompression failed\n"; next}; 1135 warn "$frame: Wrong size of uncompressed data\n" if $unc_size =! length($rawf); 1136 } 1137 if ($f2 & 0b1000000) #Encryption 1138 { #my $e=substr $rawf,0,1,''; 1139 warn "Frame $frame is encrypted, unsupported -> skipped\n"; 1140 next; 1141 } 1142 if ($f2 & 0b100000) #Grouping identity 1143 { warn "frame $frame has Grouping identity\n" if $::debug; 1144 my $g=substr $rawf,0,1,''; #FIXME unused 1145 } 1146 } 1147 elsif ($v1==4) #frame flags v2.4 1148 { if ($f2 & 0b1) #Data length indicator 1149 { my $size=unpack 'N',$rawf; #not used 1150 warn "v2.4 Data length indicator : frame Data length=$size\n" if $::debug; 1151 $rawf=substr $rawf,4; 1152 } 1153 if (($f2 & 0b10) || $tag{unsync} && !$broken24) #Unsynchronisation 1154 { $rawf=~s/\xff\x00/\xff/g; 1155 warn "v2.4 frame unsync\n" if $::debug; 1156 } 1157 if ($f2 & 0b1000) 1158 { warn "Frame $frame is compressed\n" if $::debug; 1159 unless ($Zlib) {warn "Compressed frame $frame can't be read because Compress::Zlib is not found.\n";next;} 1160 my $unc_rawf=Compress::Zlib::uncompress($rawf); 1161 $unc_rawf=Compress::Zlib::uncompress( substr($rawf,4) ) unless defined $unc_rawf; #try to decompress frames which include undeclared Data length indicator (like in v2.3) 1162 unless (defined $unc_rawf) {warn "frame decompression failed\n"; next}; 1163 $rawf=$unc_rawf; 1164 warn 'decompressed frame size = '.length($rawf)." bytes\n" if $::debug; 1165 } 1166 if ($f2 & 0b100) #Encryption 1167 { warn "Frame $frame is encrypted, unsupported -> skipped\n"; 1168 next; 1169 } 1170 if ($f2 & 0b1000000) #Grouping identity 1171 { warn "frame $frame has Grouping identity\n" if $::debug; 1172 } 1173 } 1174 $convertsub->(\$rawf) if $convertsub; 1175 my @data; 1176 my $type= exists $FRAMES{$frame} ? $frame : 1177 $frame=~m/^T[A-Z]+$/ ? 'generic_text': 1178 $frame=~m/^W[A-Z]+$/ ? 'generic_url' : 1179 'unknown'; 1180 my $fields=$FRAMES{$type}; 1181 my ($encoding,$regex_T); 1182 my $joker=$fields=~s/\*$//; 1183 for my $t (split //, $fields) 1184 { if ($t eq 'e') #encoding for T and M 1185 { my $e=ord substr $rawf,0,1,''; 1186 if ($e>$#encodings) { warn "unknown encoding ($e)\n"; $e=0; } 1187 ($encoding,undef,$regex_T)=@{ $encodings[$e] }; 1188 } 1189 elsif ($t eq 't') #text 1190 { $rawf=~s/$regex_t//; 1191 push @data,decode('iso-8859-1',$1); 1192 } 1193 elsif ($t eq 'T') #text 1194 { $joker=0 unless $rawf=~s/$regex_T//; 1195 my $text=eval {decode($encoding,$1)}; 1196 if ($@) {warn $@;$text=''} #happens if no BOM in utf16 1197 #$text=~s/\n/ /g; #is it needed ? 1198 $text=~s/\s+$//; 1199 push @data,$text; 1200 } 1201 elsif ($t eq 'M') #multi-line text 1202 { $rawf=~s/$regex_T//; 1203 my $text=eval {decode($encoding,$1)}; 1204 if ($@) {warn $@;$text=''} 1205 $text=~s/\s+$//; 1206 push @data,$text; 1207 } 1208 elsif ($t eq 'l') #language code 1209 { push @data,substr $rawf,0,3,''; 1210 } 1211 elsif ($t eq 'C') #char value 1212 { push @data, ord(substr $rawf,0,1,''); 1213 } 1214 elsif ($t eq 'c') #counter #must be last field 1215 { my ($c,@bytes)=unpack 'C*',$rawf; 1216 $c=($c<<8)+$_ for @bytes; 1217 push @data,$c; 1218 } 1219 else #elsif ($t eq 'b' || $t eq 'u') #binary or unknown #must be last field 1220 { push @data,$rawf; } 1221 #warn "-- $frame -- $t ".($debug_pos-length($rawf))." bytes\n"; #DEBUG 1222 redo if ($joker && $t ne 'e' && length($rawf)>0); 1223 } 1224 $Special{$frame}(\@data,$v1) if $Special{$frame}; 1225 if ($joker) 1226 { for (@data) 1227 { push @{ $tag{frames}{$frame} },$_; 1228 push @{ $tag{framesorder} },$frame; 1229 } 1230 } 1231 else 1232 { push @{ $tag{frames}{$frame} }, @data>1 ? \@data : $data[0]; 1233 push @{ $tag{framesorder} },$frame; 1234 } 1235 } 1236 if ($file->{ID3v2}) { push @{ $file->{ID3v2s} },\%tag; warn "found another ID3v2 tag\n"; } 1237 else { $file->{ID3v2}=\%tag; } #the first found is the main tag 1238 return bless(\%tag,$class); 1239} 1240sub removetag { $_[0]{deleted}=1; } 1241sub add 1242{ my ($self,$fname,$data)=@_; 1243 ($fname,$data)=_prepare_data($fname,$data); 1244 unless ($fname) { warn "Invalid frame\n"; return; } 1245 push @{ $self->{frames}{$fname} },$data; 1246 push @{ $self->{framesorder} },$fname; 1247 $self->{edited}=1; 1248 return 1; 1249} 1250sub insert #same as add but put it first (of its kind) 1251{ my ($self,$fname,$data)=@_; 1252 ($fname,$data)=_prepare_data($fname,$data); 1253 unless ($fname) { warn "Invalid frame\n"; return; } 1254 return unless $fname; 1255 unshift @{ $self->{frames}{$fname} },$data; 1256 push @{ $self->{framesorder} }, $fname; 1257 $self->{edited}=1; 1258 return 1; 1259} 1260sub edit 1261{ my ($self,$fname,$nb,$data)=@_; 1262 ($fname,$data)=_prepare_data($fname,$data); 1263 return unless $fname; 1264 unless (defined $self->{frames}{$fname}[$nb]) { warn "Frame doesn't exist\n"; return; } 1265 $self->{frames}{$fname}[$nb]=$data; 1266 $self->{edited}=1; 1267 return 1; 1268} 1269sub remove 1270{ my ($self,$fname,$nb)=@_; 1271 unless (defined $self->{frames}{$fname}[$nb]) { warn "Frame doesn't exist\n"; return; } 1272 $self->{frames}{$fname}[$nb]=undef; 1273 $self->{edited}=1; 1274 return 1; 1275} 1276sub remove_all 1277{ my ($self,$fname)=@_; 1278 ($fname,my @extra)=split /;/,$fname,-1; #-1 to keep empty trailing fields #COMM;;%v; => key="COMM" and @extra=("","%v","") 1279 my $ref=$self->{frames}{$fname}; 1280 return unless $ref; 1281 my @toremove; 1282 if (@extra) 1283 { for my $i (0..$#$ref) 1284 { next unless $ref->[$i]; 1285 my $keep; 1286 for my $j (0..$#extra) 1287 { my $extra= $extra[$j]; 1288 next if $extra eq '%v' || $extra eq ''; 1289 $keep=1 if $extra ne $ref->[$i][$j]; 1290 } 1291 push @toremove,$i unless $keep; 1292 } 1293 } 1294 else { @toremove= 0..$#$ref; } 1295 $ref->[$_]=undef for @toremove; 1296 $self->{edited}=1 if @toremove; 1297 return 1; 1298} 1299 1300sub get_keys 1301{ keys %{ $_[0]{frames} }; 1302} 1303sub get_values 1304{ my ($self,$key)=@_; 1305 ($key,my @extra)= split /;/,$key,-1; #-1 to keep empty trailing fields 1306 my $v= $self->{frames}{$key}; 1307 return unless $v; 1308 my @values= grep defined, @$v; 1309 return unless @values; 1310 if (@extra && ref $v->[0]) #for multi fields (COMM for example) 1311 { @values= map 1312 { my $v_ok; my $notok; 1313 for my $j (0..$#extra) 1314 { my $p=$extra[$j]; 1315 my $vj=$_->[$j]; 1316 if ($p eq '%v') { $v_ok=$vj; } 1317 elsif ($p ne '' && $p ne $vj) {$notok=1;last} 1318 } 1319 $notok ? () : ($v_ok); 1320 } @values; 1321 } 1322 return @values; 1323} 1324 1325sub make 1326{ my $tag=shift; 1327 my $v1=$::Options{'TAG_write_id3v2.4'}? 4 : 3; 1328 if ($::Options{'TAG_keep_id3v2_ver'} && $tag->{version}=~m/^([34])\./) { $v1=$1; } 1329 my $check=$::Options{'TAG_use_latin1_if_possible'}? 1 : 0; 1330 my $def_encoding=($v1==4)? 3 : 1; #use utf8 for v2.4, utf16 for v2.3 1331 my $tagstring=''; 1332 my %framecount; 1333 my $unsync24all; 1334 for my $frameid ( @{ $tag->{framesorder} } ) 1335 { my $data=$tag->{frames}{$frameid}[ $framecount{$frameid}++ ]; 1336 next unless defined $data; 1337 my $framestring; 1338 my $type= exists $FRAMES{$frameid} ? $frameid : 1339 $frameid=~m/^T[A-Z]+$/ ? 'generic_text' : 1340 $frameid=~m/^W[A-Z]+$/ ? 'generic_url' : 1341 'unknown'; 1342 my @fields=split //,$FRAMES{$type}; 1343 if ($fields[-1] eq '*') 1344 { pop @fields; 1345 if ($v1==4) #put all values in the same frame 1346 { next if $framecount{$frameid}>1; 1347 $data= [grep defined, @{$tag->{frames}{$frameid}}]; 1348 push @fields,($fields[-1]) x $#$data; 1349 } 1350 } 1351 my ($encoding,$term); 1352 $data=[$data] unless ref $data; 1353 my $datai=0; 1354 for my $t (@fields) 1355 { if ($t eq 'e') #encoding for T and M 1356 { #check if strings to be encoded use 8th bit 1357 use bytes; 1358 if ($check && !(grep $fields[$_]=~m/[TM]/ && $data->[$_-1]=~m/[\x80-\xff]/, 1..$#fields)) 1359 { #use iso-8859-1 encoding if 8th bit not used 1360 $framestring.="\x00"; 1361 ($encoding,$term)=@{$encodings[0]}; 1362 } 1363 else #use def_encoding 1364 { $framestring.=chr $def_encoding; 1365 ($encoding,$term)=@{ $encodings[$def_encoding] }; 1366 } 1367 next; 1368 } 1369 my $val=$data->[$datai++]; 1370 if ($t eq 't') #text 1371 { $val=~s#\n+# #g; 1372 $framestring.=encode('iso-8859-1',$val)."\x00"; 1373 } 1374 elsif ($t eq 'T') #text 1375 { $val=~s#\n+# #g; 1376 $framestring.=encode($encoding,$val).$term; 1377 } 1378 elsif ($t eq 'M') #multi-line text 1379 { $framestring.=encode($encoding,$val).$term; 1380 } 1381 elsif ($t eq 'l') #language code 1382 { $framestring.=pack 'a3', encode('iso-8859-1',$val); 1383 } 1384 elsif ($t eq 'C') #char value 1385 { $val||=0; 1386 $val=255 if $val>255; 1387 $framestring.=chr $val; 1388 } 1389 elsif ($t eq 'c') #counter 1390 { my $string=''; 1391 while ($val>256) { $string.=chr($val&0xff); $val>>=8; } 1392 $string.=chr($val).("\x00"x(3-length $string)); #must be at least 4 bytes 1393 $framestring.=reverse $string; 1394 } 1395 else #elsif ($t eq 'b' || $t eq 'u') #binary or unknown 1396 { $framestring.=$val; } 1397 #FIXME call special case sub 1398 #warn "-- $frameid -- $t framepos=".length($framestring)."\n"; #DEBUG 1399 } 1400 my $ffflag=0; 1401 unless ($::Options{TAG_no_desync} || $v1<4) 1402 { my $size=length $framestring; 1403 if ($tagstring=~s/\xFF(?=[\x00\xE0-\xFF])/\xFF\x00/g) 1404 { $ffflag|=0b11; 1405 $size=_encodesyncsafe(4,$size); 1406 $framestring=$size.$framestring; 1407 $unsync24all=1 unless defined $unsync24all; 1408 } 1409 else {$unsync24all=0} 1410 } 1411 my $fsize=length $framestring; 1412 $fsize=($v1==4)? _encodesyncsafe(4,$fsize) : pack('N',$fsize); 1413 $tagstring.=$frameid.$fsize."\x00".chr($ffflag).$framestring; 1414 #warn "-- $frameid 10+".length($framestring)." bytes added tagpos=".length($tagstring)."\n"; #DEBUG 1415 } 1416 my $flag=0; 1417 #warn "==tag ".length($tagstring)." bytes before unsync\n"; #DEBUG 1418 unless ($::Options{TAG_no_desync} || $v1>3) 1419 { $flag|=0b10000000 if $tagstring=~s/\xFF(?=[\x00\xE0-\xFF])/\xFF\x00/g; } 1420 $flag|=0b10000000 if $unsync24all; 1421 $tagstring.="\x00" if substr($tagstring,-1,1) eq "\xff"; #1-byte padding to avoid false sync 1422 #warn "==tag ".length($tagstring)." bytes after unsync (flag=$flag)\n"; #DEBUG 1423 $tagstring="ID3".chr($v1)."\x00".chr($flag)._encodesyncsafe(4, length($tagstring) ).$tagstring; 1424 return \$tagstring; 1425} 1426sub _SetPadding 1427{ my ($stringref,$padding)=@_; 1428 substr($$stringref,6,4)= _encodesyncsafe(4, length($$stringref)+$padding-10 ); 1429 $$stringref.=("\x00"x$padding); 1430} 1431 1432sub get_fieldtypes 1433{ my $frameid=shift; 1434 my $type= exists $FRAMES{$frameid} ? $frameid : 1435 $frameid=~m/^T[A-Z]+$/ ? 'generic_text' : 1436 $frameid=~m/^W[A-Z]+$/ ? 'generic_url' : 1437 'unknown'; 1438 $type= $FRAMES{$type}; 1439 $type=~s/^e//; 1440 $type=~s/\*$//; 1441 return $type; 1442} 1443 1444sub _encodesyncsafe 1445{ my ($bytes,$int)=@_; 1446 my @result; 1447 while ($bytes--) 1448 { unshift @result,chr($int & 0x7f); 1449 $int>>=7; 1450 } 1451 die "integer too big : $_[1]\n" if $int>0; #FIXME when >256MB 1452 return join('',@result); 1453} 1454sub _decodesyncsafe 1455{ my ($int,@bytes)=unpack 'C*',$_[0]; 1456 $int=($int<<7)+$_ for @bytes; 1457 return $int; 1458} 1459 1460sub _prepare_data 1461{ my ($fname,$data)=@_; 1462 ($fname,my @extra)=split /;/,$fname,-1; 1463 if ($fname!~m/^[A-Z0-9]{4}$/) { warn "Invalid id3v2 frameID '$fname', ignoring\n"; return } 1464 if (@extra && !ref $data) 1465 { $data= [ map {$_ eq '%v' ? $data : $_} @extra ]; 1466 } 1467 my $type=get_fieldtypes($fname); 1468 my $n= ref $data ? scalar @$data : 1; 1469 if (length($type) != $n) 1470 { warn "Not the right number of subtags for this frame ($fname $n)\n"; 1471 return; 1472 } 1473 return $fname, $data; 1474} 1475 1476sub _ConvertPIC 1477{ my $raw=$_[0]; 1478 my $type=uc substr($$raw,1,3); 1479 if ($type eq 'PNG') { $type='image/png'; } 1480 elsif ($type eq 'JPG') { $type='image/jpeg'; } 1481 else { $type=~s/[ \x00]//g;} 1482 substr($$raw,1,3)=$type."\x00"; 1483} 1484 1485sub _genreid #to convert TCON from id3v2.3 (and from id3v2.2) to id3v2.4, and replace numerical or CR/RX genres by the corresponding string genre 1486{ my ($ref,$version)=@_; 1487 for my $g (@$ref) 1488 { if ($g=~s#^\((\d+|RX|CR)\)##) # id3v2.2/3 format (NUMBER) (CR) or (RX), shouldn't use this format in id3v2.4 but support it anyway 1489 { push @$ref, $g if length $g; # possible second genre following (NUMBER) 1490 $g=$1; 1491 } 1492 elsif ($version!=4) { $g=~s#^\(\(#(#; } # only un-escape '((' into '(' for id3v2.2/3 tags, not supposed to be used in id3v2.4 tags 1493 if ($g=~m/^\d+$/ && $g<@Genres) { $g=$Genres[$g] } 1494 elsif ($g eq 'RX') { $g='Remix' } 1495 elsif ($g eq 'CR') { $g='Cover' } 1496 } 1497} 1498 1499 1500 15011; 1502__END__ 1503 1504AAAAAAAA AAABBCCD EEEEFFGH IIJJKLMM 1505A frame sync =1 1506B MPEG Audio version ID 1507C Layer description 1508D Protection bit 1509 1510E Bitrate index 1511F Sampling rate frequency index 1512G Padding bit 1513H Private bit 1514 1515I Channel Mode 1516J Mode extension (Only if Joint stereo) 1517K Copyright 1518L Original 1519M Emphasis 1520 1521