Info.pm 74 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940
  1. package MP3::Info;
  2. # JRF: Added support for ID3v2.4 spec-valid frame size processing (falling back to old
  3. # non-spec valid frame size processing)
  4. # Added support for ID3v2.4 footers.
  5. # Updated text frames to correct mis-terminated frame content.
  6. # Added ignoring of encrypted frames.
  7. # TODO: sort out flags for compression / DLI
  8. require 5.006;
  9. use strict;
  10. use overload;
  11. use Carp;
  12. use Fcntl qw(:seek);
  13. use vars qw(
  14. @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $REVISION
  15. @mp3_genres %mp3_genres @winamp_genres %winamp_genres $try_harder
  16. @t_bitrate @t_sampling_freq @frequency_tbl %v1_tag_fields
  17. @v1_tag_names %v2_tag_names %v2_to_v1_names $AUTOLOAD
  18. @mp3_info_fields %rva2_channel_types
  19. $debug_24 $debug_Tencoding
  20. );
  21. @ISA = 'Exporter';
  22. @EXPORT = qw(
  23. set_mp3tag get_mp3tag get_mp3info remove_mp3tag
  24. use_winamp_genres
  25. );
  26. @EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8);
  27. %EXPORT_TAGS = (
  28. genres => [qw(@mp3_genres %mp3_genres)],
  29. utf8 => [qw(use_mp3_utf8)],
  30. all => [@EXPORT, @EXPORT_OK]
  31. );
  32. # $Id: Info.pm 28 2008-11-09 01:08:44Z dsully $
  33. ($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
  34. $VERSION = '1.24';
  35. # JRF: Whether we're debugging the ID3v2.4 support
  36. $debug_24 = 0;
  37. $debug_Tencoding = 0;
  38. =pod
  39. =head1 NAME
  40. MP3::Info - Manipulate / fetch info from MP3 audio files
  41. =head1 SYNOPSIS
  42. #!perl -w
  43. use MP3::Info;
  44. my $file = 'Pearls_Before_Swine.mp3';
  45. set_mp3tag($file, 'Pearls Before Swine', q"77's",
  46. 'Sticks and Stones', '1990',
  47. q"(c) 1990 77's LTD.", 'rock & roll');
  48. my $tag = get_mp3tag($file) or die "No TAG info";
  49. $tag->{GENRE} = 'rock';
  50. set_mp3tag($file, $tag);
  51. my $info = get_mp3info($file);
  52. printf "$file length is %d:%d\n", $info->{MM}, $info->{SS};
  53. =cut
  54. {
  55. my $c = -1;
  56. # set all lower-case and regular-cased versions of genres as keys
  57. # with index as value of each key
  58. %mp3_genres = map {($_, ++$c, lc, $c)} @mp3_genres;
  59. # do it again for winamp genres
  60. $c = -1;
  61. %winamp_genres = map {($_, ++$c, lc, $c)} @winamp_genres;
  62. }
  63. =pod
  64. my $mp3 = new MP3::Info $file;
  65. $mp3->title('Perls Before Swine');
  66. printf "$file length is %s, title is %s\n",
  67. $mp3->time, $mp3->title;
  68. =head1 DESCRIPTION
  69. =over 4
  70. =item $mp3 = MP3::Info-E<gt>new(FILE)
  71. OOP interface to the rest of the module. The same keys
  72. available via get_mp3info and get_mp3tag are available
  73. via the returned object (using upper case or lower case;
  74. but note that all-caps "VERSION" will return the module
  75. version, not the MP3 version).
  76. Passing a value to one of the methods will set the value
  77. for that tag in the MP3 file, if applicable.
  78. =cut
  79. sub new {
  80. my($pack, $file) = @_;
  81. my $info = get_mp3info($file) or return undef;
  82. my $tags = get_mp3tag($file) || { map { ($_ => undef) } @v1_tag_names };
  83. my %self = (
  84. FILE => $file,
  85. TRY_HARDER => 0
  86. );
  87. @self{@mp3_info_fields, @v1_tag_names, 'file'} = (
  88. @{$info}{@mp3_info_fields},
  89. @{$tags}{@v1_tag_names},
  90. $file
  91. );
  92. return bless \%self, $pack;
  93. }
  94. sub can {
  95. my $self = shift;
  96. return $self->SUPER::can(@_) unless ref $self;
  97. my $name = uc shift;
  98. return sub { $self->$name(@_) } if exists $self->{$name};
  99. return undef;
  100. }
  101. sub AUTOLOAD {
  102. my($self) = @_;
  103. (my $name = uc $AUTOLOAD) =~ s/^.*://;
  104. if (exists $self->{$name}) {
  105. my $sub = exists $v1_tag_fields{$name}
  106. ? sub {
  107. if (defined $_[1]) {
  108. $_[0]->{$name} = $_[1];
  109. set_mp3tag($_[0]->{FILE}, $_[0]);
  110. }
  111. return $_[0]->{$name};
  112. }
  113. : sub {
  114. return $_[0]->{$name}
  115. };
  116. no strict 'refs';
  117. *{$AUTOLOAD} = $sub;
  118. goto &$AUTOLOAD;
  119. } else {
  120. carp(sprintf "No method '$name' available in package %s.",
  121. __PACKAGE__);
  122. }
  123. }
  124. sub DESTROY {
  125. }
  126. =item use_mp3_utf8([STATUS])
  127. Tells MP3::Info to (or not) return TAG info in UTF-8.
  128. TRUE is 1, FALSE is 0. Default is TRUE, if available.
  129. Will only be able to turn it on if Encode is available. ID3v2
  130. tags will be converted to UTF-8 according to the encoding specified
  131. in each tag; ID3v1 tags will be assumed Latin-1 and converted
  132. to UTF-8.
  133. Function returns status (TRUE/FALSE). If no argument is supplied,
  134. or an unaccepted argument is supplied, function merely returns status.
  135. This function is not exported by default, but may be exported
  136. with the C<:utf8> or C<:all> export tag.
  137. =cut
  138. my $unicode_base_module = eval { require Encode; require Encode::Guess };
  139. my $UNICODE = use_mp3_utf8($unicode_base_module ? 1 : 0);
  140. eval { require Encode::Detect::Detector };
  141. my $unicode_detect_module = $@ ? 0 : 1;
  142. sub use_mp3_utf8 {
  143. my $val = shift;
  144. $UNICODE = 0;
  145. if ($val == 1) {
  146. if ($unicode_base_module) {
  147. $Encode::Guess::NoUTFAutoGuess = 1;
  148. $UNICODE = 1;
  149. }
  150. }
  151. return $UNICODE;
  152. }
  153. =pod
  154. =item use_winamp_genres()
  155. Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres>
  156. (adds 68 additional genres to the default list of 80).
  157. This is a separate function because these are non-standard
  158. genres, but they are included because they are widely used.
  159. You can import the data structures with one of:
  160. use MP3::Info qw(:genres);
  161. use MP3::Info qw(:DEFAULT :genres);
  162. use MP3::Info qw(:all);
  163. =cut
  164. sub use_winamp_genres {
  165. %mp3_genres = %winamp_genres;
  166. @mp3_genres = @winamp_genres;
  167. return 1;
  168. }
  169. =pod
  170. =item remove_mp3tag (FILE [, VERSION, BUFFER])
  171. Can remove ID3v1 or ID3v2 tags. VERSION should be C<1> for ID3v1
  172. (the default), C<2> for ID3v2, and C<ALL> for both.
  173. For ID3v1, removes last 128 bytes from file if those last 128 bytes begin
  174. with the text 'TAG'. File will be 128 bytes shorter.
  175. For ID3v2, removes ID3v2 tag. Because an ID3v2 tag is at the
  176. beginning of the file, we rewrite the file after removing the tag data.
  177. The buffer for rewriting the file is 4MB. BUFFER (in bytes) ca
  178. change the buffer size.
  179. Returns the number of bytes removed, or -1 if no tag removed,
  180. or undef if there is an error.
  181. =cut
  182. sub remove_mp3tag {
  183. my($file, $version, $buf) = @_;
  184. my($fh, $return);
  185. $buf ||= 4096*1024; # the bigger the faster
  186. $version ||= 1;
  187. if (not (defined $file && $file ne '')) {
  188. $@ = "No file specified";
  189. return undef;
  190. }
  191. if (not -s $file) {
  192. $@ = "File is empty";
  193. return undef;
  194. }
  195. if (ref $file) { # filehandle passed
  196. $fh = $file;
  197. } else {
  198. if (not open $fh, '+<', $file) {
  199. $@ = "Can't open $file: $!";
  200. return undef;
  201. }
  202. }
  203. binmode $fh;
  204. if ($version eq 1 || $version eq 'ALL') {
  205. seek $fh, -128, SEEK_END;
  206. my $tell = tell $fh;
  207. if (<$fh> =~ /^TAG/) {
  208. truncate $fh, $tell or carp "Can't truncate '$file': $!";
  209. $return += 128;
  210. }
  211. }
  212. if ($version eq 2 || $version eq 'ALL') {
  213. my $v2h = _get_v2head($fh);
  214. if ($v2h) {
  215. local $\;
  216. seek $fh, 0, SEEK_END;
  217. my $eof = tell $fh;
  218. my $off = $v2h->{tag_size};
  219. while ($off < $eof) {
  220. seek $fh, $off, SEEK_SET;
  221. read $fh, my($bytes), $buf;
  222. seek $fh, $off - $v2h->{tag_size}, SEEK_SET;
  223. print $fh $bytes;
  224. $off += $buf;
  225. }
  226. truncate $fh, $eof - $v2h->{tag_size}
  227. or carp "Can't truncate '$file': $!";
  228. $return += $v2h->{tag_size};
  229. }
  230. # JRF: I've not written the code to strip ID3v2.4 footers.
  231. # Sorry, I'm lazy.
  232. }
  233. _close($file, $fh);
  234. return $return || -1;
  235. }
  236. =pod
  237. =item set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
  238. =item set_mp3tag (FILE, $HASHREF)
  239. Adds/changes tag information in an MP3 audio file. Will clobber
  240. any existing information in file.
  241. Fields are TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE. All fields have
  242. a 30-byte limit, except for YEAR, which has a four-byte limit, and GENRE,
  243. which is one byte in the file. The GENRE passed in the function is a
  244. case-insensitive text string representing a genre found in C<@mp3_genres>.
  245. Will accept either a list of values, or a hashref of the type
  246. returned by C<get_mp3tag>.
  247. If TRACKNUM is present (for ID3v1.1), then the COMMENT field can only be
  248. 28 bytes.
  249. ID3v2 support may come eventually. Note that if you set a tag on a file
  250. with ID3v2, the set tag will be for ID3v1[.1] only, and if you call
  251. C<get_mp3tag> on the file, it will show you the (unchanged) ID3v2 tags,
  252. unless you specify ID3v1.
  253. =cut
  254. sub set_mp3tag {
  255. my($file, $title, $artist, $album, $year, $comment, $genre, $tracknum) = @_;
  256. my(%info, $oldfh, $ref, $fh);
  257. local %v1_tag_fields = %v1_tag_fields;
  258. # set each to '' if undef
  259. for ($title, $artist, $album, $year, $comment, $tracknum, $genre,
  260. (@info{@v1_tag_names}))
  261. {$_ = defined() ? $_ : ''}
  262. ($ref) = (overload::StrVal($title) =~ /^(?:.*\=)?([^=]*)\((?:[^\(]*)\)$/)
  263. if ref $title;
  264. # populate data to hashref if hashref is not passed
  265. if (!$ref) {
  266. (@info{@v1_tag_names}) =
  267. ($title, $artist, $album, $year, $comment, $tracknum, $genre);
  268. # put data from hashref into hashref if hashref is passed
  269. } elsif ($ref eq 'HASH') {
  270. %info = %$title;
  271. # return otherwise
  272. } else {
  273. carp(<<'EOT');
  274. Usage: set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
  275. set_mp3tag (FILE, $HASHREF)
  276. EOT
  277. return undef;
  278. }
  279. if (not (defined $file && $file ne '')) {
  280. $@ = "No file specified";
  281. return undef;
  282. }
  283. if (not -s $file) {
  284. $@ = "File is empty";
  285. return undef;
  286. }
  287. # comment field length 28 if ID3v1.1
  288. $v1_tag_fields{COMMENT} = 28 if $info{TRACKNUM};
  289. # only if -w is on
  290. if ($^W) {
  291. # warn if fields too long
  292. foreach my $field (keys %v1_tag_fields) {
  293. $info{$field} = '' unless defined $info{$field};
  294. if (length($info{$field}) > $v1_tag_fields{$field}) {
  295. carp "Data too long for field $field: truncated to " .
  296. "$v1_tag_fields{$field}";
  297. }
  298. }
  299. if ($info{GENRE}) {
  300. carp "Genre `$info{GENRE}' does not exist\n"
  301. unless exists $mp3_genres{$info{GENRE}};
  302. }
  303. }
  304. if ($info{TRACKNUM}) {
  305. $info{TRACKNUM} =~ s/^(\d+)\/(\d+)$/$1/;
  306. unless ($info{TRACKNUM} =~ /^\d+$/ &&
  307. $info{TRACKNUM} > 0 && $info{TRACKNUM} < 256) {
  308. carp "Tracknum `$info{TRACKNUM}' must be an integer " .
  309. "from 1 and 255\n" if $^W;
  310. $info{TRACKNUM} = '';
  311. }
  312. }
  313. if (ref $file) { # filehandle passed
  314. $fh = $file;
  315. } else {
  316. if (not open $fh, '+<', $file) {
  317. $@ = "Can't open $file: $!";
  318. return undef;
  319. }
  320. }
  321. binmode $fh;
  322. $oldfh = select $fh;
  323. seek $fh, -128, SEEK_END;
  324. # go to end of file if no ID3v1 tag, beginning of existing tag if tag present
  325. seek $fh, (<$fh> =~ /^TAG/ ? -128 : 0), SEEK_END;
  326. # get genre value
  327. $info{GENRE} = $info{GENRE} && exists $mp3_genres{$info{GENRE}} ?
  328. $mp3_genres{$info{GENRE}} : 255; # some default genre
  329. local $\;
  330. # print TAG to file
  331. if ($info{TRACKNUM}) {
  332. print pack 'a3a30a30a30a4a28xCC', 'TAG', @info{@v1_tag_names};
  333. } else {
  334. print pack 'a3a30a30a30a4a30C', 'TAG', @info{@v1_tag_names[0..4, 6]};
  335. }
  336. select $oldfh;
  337. _close($file, $fh);
  338. return 1;
  339. }
  340. =pod
  341. =item get_mp3tag (FILE [, VERSION, RAW_V2, APE2])
  342. Returns hash reference containing tag information in MP3 file. The keys
  343. returned are the same as those supplied for C<set_mp3tag>, except in the
  344. case of RAW_V2 being set.
  345. If VERSION is C<1>, the information is taken from the ID3v1 tag (if present).
  346. If VERSION is C<2>, the information is taken from the ID3v2 tag (if present).
  347. If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and
  348. then, if present, the ID3v2 tag information will override any existing ID3v1
  349. tag info.
  350. If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation
  351. of text encoding. The key name is the same as the frame ID (ID to name mappings
  352. are in the global %v2_tag_names).
  353. If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if
  354. necessary, etc. It also takes multiple values for a given key (such as comments)
  355. and puts them in an arrayref.
  356. If APE is C<1>, an APE tag will be located before all other tags.
  357. If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will
  358. not be read.
  359. Strings returned will be in Latin-1, unless UTF-8 is specified (L<use_mp3_utf8>),
  360. (unless RAW_V2 is C<1>).
  361. Also returns a TAGVERSION key, containing the ID3 version used for the returned
  362. data (if TAGVERSION argument is C<0>, may contain two versions).
  363. =cut
  364. sub get_mp3tag {
  365. my $file = shift;
  366. my $ver = shift || 0;
  367. my $raw = shift || 0;
  368. my $find_ape = shift || 0;
  369. my $fh;
  370. my $has_v1 = 0;
  371. my $has_v2 = 0;
  372. my $has_ape = 0;
  373. my %info = ();
  374. # See if a version number was passed. Make sure it's a 1 or a 2
  375. $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0;
  376. if (!(defined $file && $file ne '')) {
  377. $@ = "No file specified";
  378. return undef;
  379. }
  380. my $filesize = -s $file;
  381. if (!$filesize) {
  382. $@ = "File is empty";
  383. return undef;
  384. }
  385. # filehandle passed
  386. if (ref $file) {
  387. $fh = $file;
  388. } else {
  389. open($fh, $file) || do {
  390. $@ = "Can't open $file: $!";
  391. return undef;
  392. };
  393. }
  394. binmode $fh;
  395. # Try and find an APE Tag - this is where FooBar2k & others
  396. # store ReplayGain information
  397. if ($find_ape) {
  398. $has_ape = _parse_ape_tag($fh, $filesize, \%info);
  399. }
  400. if ($ver < 2) {
  401. $has_v1 = _get_v1tag($fh, \%info);
  402. if ($ver == 1 && !$has_v1) {
  403. _close($file, $fh);
  404. $@ = "No ID3v1 tag found";
  405. return undef;
  406. }
  407. }
  408. if ($ver == 2 || $ver == 0) {
  409. $has_v2 = _get_v2tag($fh, $ver, $raw, \%info);
  410. }
  411. if (!$has_v1 && !$has_v2 && !$has_ape) {
  412. _close($file, $fh);
  413. $@ = "No ID3 or APE tag found";
  414. return undef;
  415. }
  416. unless ($raw && $ver == 2) {
  417. # Strip out NULLs unless we want the raw data.
  418. foreach my $key (keys %info) {
  419. if (defined $info{$key}) {
  420. $info{$key} =~ s/\000+.*//g;
  421. $info{$key} =~ s/\s+$//;
  422. }
  423. }
  424. for (@v1_tag_names) {
  425. $info{$_} = '' unless defined $info{$_};
  426. }
  427. }
  428. if (keys %info && !defined $info{'GENRE'}) {
  429. $info{'GENRE'} = '';
  430. }
  431. _close($file, $fh);
  432. return keys %info ? \%info : undef;
  433. }
  434. sub _get_v1tag {
  435. my ($fh, $info) = @_;
  436. seek $fh, -128, SEEK_END;
  437. read($fh, my $tag, 128);
  438. if (!defined($tag) || $tag !~ /^TAG/) {
  439. return 0;
  440. }
  441. if (substr($tag, -3, 2) =~ /\000[^\000]/) {
  442. (undef, @{$info}{@v1_tag_names}) =
  443. (unpack('a3a30a30a30a4a28', $tag),
  444. ord(substr($tag, -2, 1)),
  445. $mp3_genres[ord(substr $tag, -1)]);
  446. $info->{'TAGVERSION'} = 'ID3v1.1';
  447. } else {
  448. (undef, @{$info}{@v1_tag_names[0..4, 6]}) =
  449. (unpack('a3a30a30a30a4a30', $tag),
  450. $mp3_genres[ord(substr $tag, -1)]);
  451. $info->{'TAGVERSION'} = 'ID3v1';
  452. }
  453. if (!$UNICODE) {
  454. return 1;
  455. }
  456. # Save off the old suspects list, since we add
  457. # iso-8859-1 below, but don't want that there
  458. # for possible ID3 v2.x parsing below.
  459. my $oldSuspects = $Encode::Encoding{'Guess'}->{'Suspects'};
  460. for my $key (keys %{$info}) {
  461. next unless $info->{$key};
  462. # Try and guess the encoding.
  463. if ($unicode_detect_module) {
  464. my $charset = Encode::Detect::Detector::detect($info->{$key}) || 'iso-8859-1';
  465. my $enc = Encode::find_encoding($charset);
  466. if ($enc) {
  467. $info->{$key} = $enc->decode($info->{$key}, 0);
  468. next;
  469. }
  470. }
  471. my $value = $info->{$key};
  472. my $icode = Encode::Guess->guess($value);
  473. if (!ref($icode)) {
  474. # Often Latin1 bytes are
  475. # stuffed into a 1.1 tag.
  476. Encode::Guess->add_suspects('iso-8859-1');
  477. while (length($value)) {
  478. $icode = Encode::Guess->guess($value);
  479. last if ref($icode);
  480. # Remove garbage and retry
  481. # (string is truncated in the
  482. # middle of a multibyte char?)
  483. $value =~ s/(.)$//;
  484. }
  485. }
  486. $info->{$key} = Encode::decode(ref($icode) ? $icode->name : 'iso-8859-1', $info->{$key});
  487. # Trim any trailing nuls
  488. $info->{$key} =~ s/\x00+$//g;
  489. }
  490. Encode::Guess->set_suspects(keys %{$oldSuspects});
  491. return 1;
  492. }
  493. sub _parse_v2tag {
  494. my ($ver, $raw_v2, $v2, $info) = @_;
  495. # Make sure any existing TXXX flags are an array.
  496. # As we might need to append comments to it below.
  497. if ($v2->{'TXXX'} && ref($v2->{'TXXX'}) ne 'ARRAY') {
  498. $v2->{'TXXX'} = [ $v2->{'TXXX'} ];
  499. }
  500. # J.River Media Center sticks RG tags in comments.
  501. # Ugh. Make them look like TXXX tags, which is really what they are.
  502. if (ref($v2->{'COMM'}) eq 'ARRAY' && grep { /Media Jukebox/ } @{$v2->{'COMM'}}) {
  503. for my $comment (@{$v2->{'COMM'}}) {
  504. if ($comment =~ /Media Jukebox/) {
  505. # we only want one null to lead.
  506. $comment =~ s/^\000+//g;
  507. push @{$v2->{'TXXX'}}, "\000$comment";
  508. }
  509. }
  510. }
  511. my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names;
  512. for my $id (keys %{$hash}) {
  513. next if !exists $v2->{$id};
  514. if ($id =~ /^UFID?$/) {
  515. my @ufid_list = split(/\0/, $v2->{$id});
  516. $info->{$hash->{$id}} = $ufid_list[1] if ($#ufid_list > 0);
  517. } elsif ($id =~ /^RVA[D2]?$/) {
  518. # Expand these binary fields. See the ID3 spec for Relative Volume Adjustment.
  519. if ($id eq 'RVA2') {
  520. # ID is a text string
  521. ($info->{$hash->{$id}}->{'ID'}, my $rvad) = split /\0/, $v2->{$id};
  522. my $channel = $rva2_channel_types{ ord(substr($rvad, 0, 1, '')) };
  523. $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_GAIN'} =
  524. sprintf('%f', _grab_int_16(\$rvad) / 512);
  525. my $peakBytes = ord(substr($rvad, 0, 1, ''));
  526. if (int($peakBytes / 8)) {
  527. $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_PEAK'} =
  528. sprintf('%f', _grab_int_16(\$rvad) / 512);
  529. }
  530. } elsif ($id eq 'RVAD' || $id eq 'RVA') {
  531. my $rvad = $v2->{$id};
  532. my $flags = ord(substr($rvad, 0, 1, ''));
  533. my $desc = ord(substr($rvad, 0, 1, ''));
  534. # iTunes appears to be the only program that actually writes
  535. # out a RVA/RVAD tag. Everyone else punts.
  536. for my $type (qw(REPLAYGAIN_TRACK_GAIN REPLAYGAIN_TRACK_PEAK)) {
  537. for my $channel (qw(RIGHT LEFT)) {
  538. my $val = _grab_uint_16(\$rvad) / 256;
  539. # iTunes uses a range of -255 to 255
  540. # to be -100% (silent) to 100% (+6dB)
  541. if ($val == -255) {
  542. $val = -96.0;
  543. } else {
  544. $val = 20.0 * log(($val+255)/255)/log(10);
  545. }
  546. $info->{$hash->{$id}}->{$channel}->{$type} = $flags & 0x01 ? $val : -$val;
  547. }
  548. }
  549. }
  550. } elsif ($id =~ /^A?PIC$/) {
  551. my $pic = $v2->{$id};
  552. # if there is more than one picture, just grab the first one.
  553. # JRF: Should consider looking for either the thumbnail or the front cover,
  554. # rather than just returning the first one.
  555. # Possibly also checking that the format is actually understood,
  556. # but that's really down to the caller - we can't say whether the
  557. # format is understood here.
  558. if (ref($pic) eq 'ARRAY') {
  559. $pic = (@$pic)[0];
  560. }
  561. use bytes;
  562. my $valid_pic = 0;
  563. my $pic_len = 0;
  564. my $pic_format = '';
  565. # look for ID3 v2.2 picture
  566. if ($pic && $id eq 'PIC') {
  567. # look for ID3 v2.2 picture
  568. my ($encoding, $format, $picture_type, $description) = unpack 'Ca3CZ*', $pic;
  569. $pic_len = length($description) + 1 + 5;
  570. # skip extra terminating null if unicode
  571. if ($encoding) { $pic_len++; }
  572. if ($pic_len < length($pic)) {
  573. $valid_pic = 1;
  574. $pic_format = $format;
  575. }
  576. } elsif ($pic && $id eq 'APIC') {
  577. # look for ID3 v2.3/2.4 picture
  578. my ($encoding, $format) = unpack 'C Z*', $pic;
  579. $pic_len = length($format) + 2;
  580. if ($pic_len < length($pic)) {
  581. my ($picture_type, $description) = unpack "x$pic_len C Z*", $pic;
  582. $pic_len += 1 + length($description) + 1;
  583. # skip extra terminating null if UTF-16 (encoding 1 or 2)
  584. if ( $encoding == 1 || $encoding == 2 ) { $pic_len++; }
  585. $valid_pic = 1;
  586. $pic_format = $format;
  587. }
  588. }
  589. # Proceed if we have a valid picture.
  590. if ($valid_pic && $pic_format) {
  591. my ($data) = unpack("x$pic_len A*", $pic);
  592. if (length($data) && $pic_format) {
  593. $info->{$hash->{$id}} = {
  594. 'DATA' => $data,
  595. 'FORMAT' => $pic_format,
  596. }
  597. }
  598. }
  599. } else {
  600. my $data1 = $v2->{$id};
  601. $data1 = [ $data1 ] if ref($data1) ne 'ARRAY';
  602. for my $data (@$data1) {
  603. # TODO : this should only be done for certain frames;
  604. # using RAW still gives you access, but we should be smarter
  605. # about how individual frame types are handled. it's not
  606. # like the list is infinitely long.
  607. $data =~ s/^(.)//; # strip first char (text encoding)
  608. my $encoding = $1;
  609. my $desc;
  610. # Comments & Unsyncronized Lyrics have the same format.
  611. if ($id =~ /^(COM[M ]?|US?LT)$/) { # space for iTunes brokenness
  612. $data =~ s/^(?:...)//; # strip language
  613. }
  614. # JRF: I believe this should probably only be applied to the text frames
  615. # and not every single frame.
  616. if ($UNICODE) {
  617. if ($encoding eq "\001" || $encoding eq "\002") { # UTF-16, UTF-16BE
  618. # text fields can be null-separated lists;
  619. # UTF-16 therefore needs special care
  620. #
  621. # foobar2000 encodes tags in UTF-16LE
  622. # (which is apparently illegal)
  623. # Encode dies on a bad BOM, so it is
  624. # probably wise to wrap it in an eval
  625. # anyway
  626. $data = eval { Encode::decode('utf16', $data) } || Encode::decode('utf16le', $data);
  627. } elsif ($encoding eq "\003") { # UTF-8
  628. # make sure string is UTF8, and set flag appropriately
  629. $data = Encode::decode('utf8', $data);
  630. } elsif ($encoding eq "\000") {
  631. # Only guess if it's not ascii.
  632. if ($data && $data !~ /^[\x00-\x7F]+$/) {
  633. if ($unicode_detect_module) {
  634. my $charset = Encode::Detect::Detector::detect($data) || 'iso-8859-1';
  635. my $enc = Encode::find_encoding($charset);
  636. if ($enc) {
  637. $data = $enc->decode($data, 0);
  638. }
  639. } else {
  640. # Try and guess the encoding, otherwise just use latin1
  641. my $dec = Encode::Guess->guess($data);
  642. if (ref $dec) {
  643. $data = $dec->decode($data);
  644. } else {
  645. # Best try
  646. $data = Encode::decode('iso-8859-1', $data);
  647. }
  648. }
  649. }
  650. }
  651. } else {
  652. # If the string starts with an
  653. # UTF-16 little endian BOM, use a hack to
  654. # convert to ASCII per best-effort
  655. my $pat;
  656. if ($data =~ s/^\xFF\xFE//) {
  657. # strip additional BOMs as seen in COM(M?) and TXX(X?)
  658. $data = join ("",map { ( /^(..)$/ && ! /(\xFF\xFE)/ )? $_: "" } (split /(..)/, $data));
  659. $pat = 'v';
  660. } elsif ($data =~ s/^\xFE\xFF//) {
  661. # strip additional BOMs as seen in COM(M?) and TXX(X?)
  662. $data = join ("",map { ( /^(..)$/ && ! /(\xFF\xFE)/ )? $_: "" } (split /(..)/, $data));
  663. $pat = 'n';
  664. }
  665. if ($pat) {
  666. # strip additional 0s
  667. $data = join ("",map { ( /^(..)$/ && ! /(\x00\x00)/ )? $_: "" } (split /(..)/, $data));
  668. $data = pack 'C*', map {
  669. (chr =~ /[[:ascii:]]/ && chr =~ /[[:print:]]/)
  670. ? $_
  671. : ord('?')
  672. } unpack "$pat*", $data;
  673. }
  674. }
  675. # We do this after decoding so we could be certain we're dealing
  676. # with 8-bit text.
  677. if ($id =~ /^(COM[M ]?|US?LT)$/) { # space for iTunes brokenness
  678. $data =~ s/^(.*?)\000//; # strip up to first NULL(s),
  679. # for sub-comments (TODO:
  680. # handle all comment data)
  681. $desc = $1;
  682. if ($encoding eq "\001" || $encoding eq "\002") {
  683. $data =~ s/^\x{feff}//;
  684. }
  685. } elsif ($id =~ /^TCON?$/) {
  686. my ($index, $name);
  687. # Turn multiple nulls into a single.
  688. $data =~ s/\000+/\000/g;
  689. # Handle the ID3v2.x spec -
  690. #
  691. # just an index number, possibly
  692. # paren enclosed - referer to the v1 genres.
  693. if ($data =~ /^ \(? (\d+) \)?\000?$/sx) {
  694. $index = $1;
  695. # Paren enclosed index with refinement.
  696. # (4)Eurodisco
  697. } elsif ($data =~ /^ \( (\d+) \)\000? ([^\(].+)$/x) {
  698. ($index, $name) = ($1, $2);
  699. # List of indexes: (37)(38)
  700. } elsif ($data =~ /^ \( (\d+) \)\000?/x) {
  701. my @genres = ();
  702. while ($data =~ s/^ \( (\d+) \)//x) {
  703. # The indexes might have a refinement
  704. # not sure why one wouldn't just use
  705. # the proper genre in the first place..
  706. if ($data =~ s/^ ( [^\(]\D+ ) ( \000 | \( | \Z)/$2/x) {
  707. push @genres, $1;
  708. } else {
  709. push @genres, $mp3_genres[$1];
  710. }
  711. }
  712. $data = \@genres;
  713. } elsif ($data =~ /^[^\000]+\000/) {
  714. # name genres separated by nulls.
  715. $data = [ split /\000/, $data ];
  716. }
  717. # Text based genres will fall through.
  718. if ($name && $name ne "\000") {
  719. $data = $name;
  720. } elsif (defined $index) {
  721. $data = $mp3_genres[$index];
  722. }
  723. # Collapse single genres down, as we may have another tag.
  724. if ($data && ref($data) eq 'ARRAY' && scalar @$data == 1) {
  725. $data = $data->[0];
  726. }
  727. } elsif ($id =~ /^T...?$/ && $id ne 'TXXX') {
  728. # In ID3v2.4 there's a slight content change for text fields.
  729. # They can contain multiple values which are nul terminated
  730. # within the frame. We ONLY want to split these into multiple
  731. # array values if they didn't request raw values (1).
  732. # raw_v2 = 0 => parse simply
  733. # raw_v2 = 1 => don't parse
  734. # raw_v2 = 2 => do split into arrayrefs
  735. # Strip off any trailing NULs, which would indicate an empty
  736. # field and cause an array with no elements to be created.
  737. $data =~ s/\x00+$//;
  738. if ($data =~ /\x00/ && ($raw_v2 == 2 || $raw_v2 == 0))
  739. {
  740. # There are embedded nuls in the string, which means an ID3v2.4
  741. # multi-value frame. And they wanted arrays rather than simple
  742. # values.
  743. # Strings are already UTF-8, so any double nuls from 16 bit
  744. # characters will have already been reduced to single nuls.
  745. $data = [ split /\000/, $data ];
  746. }
  747. }
  748. if ($desc)
  749. {
  750. # It's a frame with a description, so we may need to construct a hash
  751. # for the data, rather than an array.
  752. if ($raw_v2 == 2) {
  753. $data = { $desc => $data };
  754. } elsif ($desc =~ /^iTun/) {
  755. # leave iTunes tags alone.
  756. $data = join(' ', $desc, $data);
  757. }
  758. }
  759. if ($raw_v2 == 2 && exists $info->{$hash->{$id}}) {
  760. if (ref $info->{$hash->{$id}} eq 'ARRAY') {
  761. push @{$info->{$hash->{$id}}}, $data;
  762. } else {
  763. $info->{$hash->{$id}} = [ $info->{$hash->{$id}}, $data ];
  764. }
  765. } else {
  766. # User defined frame
  767. if ($id eq 'TXXX') {
  768. my ($key, $val) = split(/\0/, $data);
  769. # Some programs - such as FB2K leave a UTF-16 BOM on the value
  770. if ($encoding eq "\001" || $encoding eq "\002") {
  771. $val =~ s/^\x{feff}//;
  772. }
  773. $info->{uc($key)} = $val;
  774. } elsif ($id eq 'PRIV') {
  775. my ($key, $val) = split(/\0/, $data);
  776. $info->{uc($key)} = unpack('v', $val);
  777. } else {
  778. my $key = $hash->{$id};
  779. # If we have multiple values
  780. # for the same key - turn them
  781. # into an array ref.
  782. if ($ver == 2 && $info->{$key} && !ref($info->{$key})) {
  783. if (ref($data) eq "ARRAY") {
  784. $info->{$key} = [ $info->{$key}, @$data ];
  785. } else {
  786. my $old = delete $info->{$key};
  787. @{$info->{$key}} = ($old, $data);
  788. }
  789. } elsif ($ver == 2 && ref($info->{$key}) eq 'ARRAY') {
  790. if (ref($data) eq "ARRAY") {
  791. push @{$info->{$key}}, @$data;
  792. } else {
  793. push @{$info->{$key}}, $data;
  794. }
  795. } else {
  796. $info->{$key} = $data;
  797. }
  798. }
  799. }
  800. }
  801. }
  802. }
  803. }
  804. sub _get_v2tag {
  805. my ($fh, $ver, $raw, $info, $start) = @_;
  806. my $eof;
  807. my $gotanyv2 = 0;
  808. # First we need to check the end of the file for any footer
  809. seek $fh, -128, SEEK_END;
  810. $eof = (tell $fh) + 128;
  811. # go to end of file if no ID3v1 tag, beginning of existing tag if tag present
  812. if (<$fh> =~ /^TAG/) {
  813. $eof -= 128;
  814. }
  815. seek $fh, $eof, SEEK_SET;
  816. # print STDERR "Checking for footer at $eof\n";
  817. if (my $v2f = _get_v2foot($fh)) {
  818. $eof -= $v2f->{tag_size};
  819. # We have a ID3v2.4 footer. Must read it.
  820. $gotanyv2 |= (_get_v2tagdata($fh, $ver, $raw, $info, $eof) ? 2 : 0);
  821. }
  822. # Now read any ID3v2 header
  823. $gotanyv2 |= (_get_v2tagdata($fh, $ver, $raw, $info, $start) ? 1 : 0);
  824. # Because we've merged the entries it makes sense to trim any duplicated
  825. # values - for example if there's a footer and a header that contain the same
  826. # data then this results in every entry being an array containing two
  827. # identical values.
  828. for my $name (keys %{$info})
  829. {
  830. # Note: We must not sort these elements to do the comparison because that
  831. # changes the order in which they are claimed to appear. Whilst this
  832. # probably isn't important, it may matter for default display - for
  833. # example a lyric should be shown by default with the first entry
  834. # in the tag in the case where the user has not specified a language
  835. # preference. If we sorted the array it would destroy that order.
  836. # This is a longwinded way of checking for duplicates and only writing the
  837. # first element - we check the array for duplicates and clear all subsequent
  838. # entries which are duplicates of earlier ones.
  839. if (ref $info->{$name} eq 'ARRAY')
  840. {
  841. my @array = ();
  842. my ($i, $o);
  843. my @chk = @{$info->{$name}};
  844. for $i ( 0..$#chk )
  845. {
  846. my $ielement = $chk[$i];
  847. if (defined $ielement)
  848. {
  849. for $o ( ($i+1)..$#chk )
  850. {
  851. $chk[$o] = undef if (defined $o && defined $chk[$o] && ($ielement eq $chk[$o]));
  852. }
  853. push @array, $ielement;
  854. }
  855. }
  856. # We may have reduced the array to a single element. If so, just assign
  857. # a regular scalar instead of the array.
  858. if ($#array == 0)
  859. {
  860. $info->{$name} = $array[0];
  861. }
  862. else
  863. {
  864. $info->{$name} = \@array;
  865. }
  866. }
  867. }
  868. return $gotanyv2;
  869. }
  870. # $has_v2 = &_get_v2tagdata($filehandle, $ver, $raw, $info, $startinfile);
  871. # $info is a hash reference which will be updated with the new ID3v2 details
  872. # if the updated bit is set, and set to the new details if the updated bit
  873. # is clear.
  874. # If undefined, $startinfile will be treated as 0 (see _get_v2head).
  875. # $v2h is a reference to a hash of the frames present within the tag.
  876. # Any frames which are repeated within the tag (eg USLT with different
  877. # languages) will be supplied as an array rather than a scalar. All client
  878. # code needs to be aware that any frame may be duplicated.
  879. sub _get_v2tagdata {
  880. my($fh, $ver, $raw, $info, $start) = @_;
  881. my($off, $end, $myseek, $v2, $v2h, $hlen, $num, $wholetag);
  882. $v2 = {};
  883. $v2h = _get_v2head($fh, $start) or return 0;
  884. if ($v2h->{major_version} < 2) {
  885. carp "This is $v2h->{version}; " .
  886. "ID3v2 versions older than ID3v2.2.0 not supported\n"
  887. if $^W;
  888. return 0;
  889. }
  890. # use syncsafe bytes if using version 2.4
  891. my $id3v2_4_frame_size_broken = 0;
  892. my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256;
  893. # alas, that's what the spec says, but iTunes and others don't syncsafe
  894. # the length, which breaks MP3 files with v2.4 tags longer than 128 bytes,
  895. # like every image file.
  896. # Because we should not break the spec conformant files due to
  897. # spec-inconformant programs, we first try the correct form and if the
  898. # data looks wrong we revert to broken behaviour.
  899. if ($v2h->{major_version} == 2) {
  900. $hlen = 6;
  901. $num = 3;
  902. } else {
  903. $hlen = 10;
  904. $num = 4;
  905. }
  906. $off = $v2h->{ext_header_size} + 10;
  907. $end = $v2h->{tag_size} + 10; # should we read in the footer too?
  908. # JRF: If the format was ID3v2.2 and the compression bit was set, then we can't
  909. # actually read the content because there are no defined compression schemes
  910. # for ID3v2.2. Perform no more processing, and return failure because we
  911. # cannot read anything.
  912. return 0 if ($v2h->{major_version} == 2 && $v2h->{compression});
  913. # JRF: If the update flag is set then the input data is the same as that which was
  914. # passed in. ID3v2.4 section 3.2.
  915. if ($v2h->{update}) {
  916. $v2 = $info;
  917. }
  918. # Bug 8939, Trying to read past the end of the file may crash on win32
  919. my $size = -s $fh;
  920. if ( $v2h->{offset} + $end > $size ) {
  921. $end -= $v2h->{offset} + $end - $size;
  922. }
  923. seek $fh, $v2h->{offset}, SEEK_SET;
  924. read $fh, $wholetag, $end;
  925. # JRF: The discrepency between ID3v2.3 and ID3v2.4 is that :
  926. # 2.3: unsync flag indicates that unsync is used on the entire tag
  927. # 2.4: unsync flag indicates that all frames have the unsync bit set
  928. # In 2.4 this means that the size of the frames which have the unsync bit
  929. # set will be the unsync'd size (section 4. in the ID3v2.4.0 structure
  930. # specification).
  931. # This means that when processing 2.4 files we should perform all the
  932. # unsynchronisation processing at the frame level, not the tag level.
  933. # The tag unsync bit is redundant (IMO).
  934. if ($v2h->{major_version} == 4) {
  935. $v2h->{unsync} = 0
  936. }
  937. $wholetag =~ s/\xFF\x00/\xFF/gs if $v2h->{unsync};
  938. # JRF: If we /knew/ there would be something special in the tag which meant
  939. # that the ID3v2.4 frame size was broken we could check it here. If,
  940. # for example, the iTunes files had the word 'iTunes' somewhere in the
  941. # tag and we knew that it was broken for versions below 3.145 (which is
  942. # a number I just picked out of the air), then we could do something like this :
  943. # if ($v2h->{major_version} == 4) &&
  944. # $wholetag =~ /iTunes ([0-9]+\.[0-9]+)/ &&
  945. # $1 < 3.145)
  946. # {
  947. # $id3v2_4_frame_size_broken = 1;
  948. # }
  949. # However I have not included this because I don't have examples of broken
  950. # files - and in any case couldn't guarentee I'd get it right.
  951. $myseek = sub {
  952. return unless $wholetag;
  953. my $bytes = substr($wholetag, $off, $hlen);
  954. # iTunes is stupid and sticks ID3v2.2 3 byte frames in a
  955. # ID3v2.3 or 2.4 header. Ignore tags with a space in them.
  956. if ($bytes !~ /^([A-Z0-9\? ]{$num})/) {
  957. return;
  958. }
  959. my ($id, $size) = ($1, $hlen);
  960. my @bytes = reverse unpack "C$num", substr($bytes, $num, $num);
  961. for my $i (0 .. ($num - 1)) {
  962. $size += $bytes[$i] * $bytesize ** $i;
  963. }
  964. # JRF: Now provide the fall back for the broken ID3v2.4 frame size
  965. # (which will persist for subsequent frames if detected).
  966. # Part 1: If the frame size cannot be valid according to the
  967. # specification (or if it would be larger than the tag
  968. # size allows).
  969. if ($v2h->{major_version}==4 &&
  970. $id3v2_4_frame_size_broken == 0 && # we haven't detected brokenness yet
  971. ((($bytes[0] | $bytes[1] | $bytes[2] | $bytes[3]) & 0x80) != 0 || # 0-bits set in size
  972. $off + $size > $end) # frame size would excede the tag end
  973. )
  974. {
  975. # The frame is definately not correct for the specification, so drop to
  976. # broken frame size system instead.
  977. $bytesize = 128;
  978. $size -= $hlen; # hlen has alread been added, so take that off again
  979. $size = (($size & 0x0000007f)) |
  980. (($size & 0x00003f80)<<1) |
  981. (($size & 0x001fc000)<<2) |
  982. (($size & 0x0fe00000)<<3); # convert spec to non-spec sizes
  983. $size += $hlen; # and re-add header len so that the entire frame's size is known
  984. $id3v2_4_frame_size_broken = 1;
  985. print "Frame size cannot be valid ID3v2.4 (part 1); reverting to broken behaviour\n" if ($debug_24);
  986. }
  987. # Part 2: If the frame size would result in the following frame being
  988. # invalid.
  989. if ($v2h->{major_version}==4 &&
  990. $id3v2_4_frame_size_broken == 0 && # we haven't detected brokenness yet
  991. $size > 0x80+$hlen && # ignore frames that are too short to ever be wrong
  992. $off + $size < $end)
  993. {
  994. print "Frame size might not be valid ID3v2.4 (part 2); checking for following frame validity\n" if ($debug_24);
  995. my $morebytes = substr($wholetag, $off+$size, 4);
  996. if (! ($morebytes =~ /^([A-Z0-9]{4})/ || $morebytes =~ /^\x00{4}/) ) {
  997. # The next tag cannot be valid because its name is wrong, which means that
  998. # either the size must be invalid or the next frame truely is broken.
  999. # Either way, we can try to reduce the size to see.
  1000. my $retrysize;
  1001. print " following frame isn't valid using spec\n" if ($debug_24);
  1002. $retrysize = $size - $hlen; # remove already added header length
  1003. $retrysize = (($retrysize & 0x0000007f)) |
  1004. (($retrysize & 0x00003f80)<<1) |
  1005. (($retrysize & 0x001fc000)<<2) |
  1006. (($retrysize & 0x0fe00000)<<3); # convert spec to non-spec sizes
  1007. $retrysize += $hlen; # and re-add header len so that the entire frame's size is known
  1008. if (length($wholetag) >= ($off+$retrysize+4)) {
  1009. $morebytes = substr($wholetag, $off+$retrysize, 4);
  1010. } else {
  1011. $morebytes = '';
  1012. }
  1013. if (! ($morebytes =~ /^([A-Z0-9]{4})/ ||
  1014. $morebytes =~ /^\x00{4}/ ||
  1015. $off + $retrysize > $end) )
  1016. {
  1017. # With the retry at the smaller size, the following frame still isn't valid
  1018. # so the only thing we can assume is that this frame is just broken beyond
  1019. # repair. Give up right now - there's no way we can recover.
  1020. print " and isn't valid using broken-spec support; giving up\n" if ($debug_24);
  1021. return;
  1022. }
  1023. print " but is fine with broken-spec support; reverting to broken behaviour\n" if ($debug_24);
  1024. # We're happy that the non-spec size looks valid to lead us to the next frame.
  1025. # We might be wrong, generating false-positives, but that's really what you
  1026. # get for trying to handle applications that don't handle the spec properly -
  1027. # use something that isn't broken.
  1028. # (this is a copy of the recovery code in part 1)
  1029. $size = $retrysize;
  1030. $bytesize = 128;
  1031. $id3v2_4_frame_size_broken = 1;
  1032. } else {
  1033. print " looks like valid following frame; keeping spec behaviour\n" if ($debug_24);
  1034. }
  1035. }
  1036. my $flags = {};
  1037. # JRF: was > 3, but that's not true; future versions may be incompatible
  1038. if ($v2h->{major_version} == 4) {
  1039. my @bits = split //, unpack 'B16', substr($bytes, 8, 2);
  1040. $flags->{frame_zlib} = $bits[12]; # JRF: need to know about compressed
  1041. $flags->{frame_encrypt} = $bits[13]; # JRF: ... and encrypt
  1042. $flags->{frame_unsync} = $bits[14];
  1043. $flags->{data_len_indicator} = $bits[15];
  1044. }
  1045. # JRF: version 3 was in a different order
  1046. elsif ($v2h->{major_version} == 3) {
  1047. my @bits = split //, unpack 'B16', substr($bytes, 8, 2);
  1048. $flags->{frame_zlib} = $bits[8]; # JRF: need to know about compressed
  1049. $flags->{data_len_indicator} = $bits[8]; # JRF: and compression implies the DLI is present
  1050. $flags->{frame_encrypt} = $bits[9]; # JRF: ... and encrypt
  1051. }
  1052. return ($id, $size, $flags);
  1053. };
  1054. while ($off < $end) {
  1055. my ($id, $size, $flags) = &$myseek or last;
  1056. my ($hlenextra) = 0;
  1057. # NOTE: Wrong; the encrypt comes after the DLI. maybe.
  1058. # JRF: Encrypted frames need to be decrypted first
  1059. if ($flags->{frame_encrypt}) {
  1060. my ($encypt_method) = substr($wholetag, $off+$hlen+$hlenextra, 1);
  1061. $hlenextra++;
  1062. # We don't actually know how to decrypt anything, so we'll just skip the entire frame.
  1063. $off += $size;
  1064. next;
  1065. }
  1066. my $bytes = substr($wholetag, $off+$hlen+$hlenextra, $size-$hlen-$hlenextra);
  1067. my $data_len;
  1068. if ($flags->{data_len_indicator}) {
  1069. $data_len = 0;
  1070. my @data_len_bytes = reverse unpack 'C4', substr($bytes, 0, 4);
  1071. $bytes = substr($bytes, 4);
  1072. for my $i (0..3) {
  1073. $data_len += $data_len_bytes[$i] * 128 ** $i;
  1074. }
  1075. }
  1076. print "got $id, length " . length($bytes) . " frameunsync: ".$flags->{frame_unsync}." tag unsync: ".$v2h->{unsync} ."\n" if ($debug_24);
  1077. # perform frame-level unsync if needed (skip if already done for whole tag)
  1078. $bytes =~ s/\xFF\x00/\xFF/gs if $flags->{frame_unsync} && !$v2h->{unsync};
  1079. # JRF: Decompress now if compressed.
  1080. # (FIXME: Not implemented yet)
  1081. # if we know the data length, sanity check it now.
  1082. if ($flags->{data_len_indicator} && defined $data_len) {
  1083. carp("Size mismatch on $id\n") unless $data_len == length($bytes);
  1084. }
  1085. # JRF: Apply small sanity check on text elements - they must end with :
  1086. # a 0 if they are ISO8859-1
  1087. # 0,0 if they are unicode
  1088. # (This is handy because it can be caught by the 'duplicate elements'
  1089. # in array checks)
  1090. # There is a question in my mind whether I should be doing this here - it
  1091. # is introducing knowledge of frame content format into the raw reader
  1092. # which is not a good idea. But if the frames are broken we at least
  1093. # recover.
  1094. if (($v2h->{major_version} == 3 || $v2h->{major_version} == 4) && $id =~ /^T/) {
  1095. my $encoding = substr($bytes, 0, 1);
  1096. # Both these cases are candidates for providing some warning, I feel.
  1097. # ISO-8859-1 or UTF-8 $bytes
  1098. if (($encoding eq "\x00" || $encoding eq "\x03") && $bytes !~ /\x00$/) {
  1099. $bytes .= "\x00";
  1100. print "Text frame $id has malformed ISO-8859-1/UTF-8 content\n" if ($debug_Tencoding);
  1101. # # UTF-16, UTF-16BE
  1102. } elsif ( ($encoding eq "\x01" || $encoding eq "\x02") && $bytes !~ /\x00\x00$/) {
  1103. $bytes .= "\x00\x00";
  1104. print "Text frame $id has malformed UTF-16/UTF-16BE content\n" if ($debug_Tencoding);
  1105. } else {
  1106. # Other encodings cannot be fixed up (we don't know how 'cos they're not defined).
  1107. }
  1108. }
  1109. if (exists $v2->{$id}) {
  1110. if (ref $v2->{$id} eq 'ARRAY') {
  1111. push @{$v2->{$id}}, $bytes;
  1112. } else {
  1113. $v2->{$id} = [$v2->{$id}, $bytes];
  1114. }
  1115. } else {
  1116. $v2->{$id} = $bytes;
  1117. }
  1118. $off += $size;
  1119. }
  1120. if (($ver == 0 || $ver == 2) && $v2) {
  1121. if ($raw == 1 && $ver == 2) {
  1122. %$info = %$v2;
  1123. $info->{'TAGVERSION'} = $v2h->{'version'};
  1124. } else {
  1125. _parse_v2tag($ver, $raw, $v2, $info);
  1126. if ($ver == 0 && $info->{'TAGVERSION'}) {
  1127. $info->{'TAGVERSION'} .= ' / ' . $v2h->{'version'};
  1128. } else {
  1129. $info->{'TAGVERSION'} = $v2h->{'version'};
  1130. }
  1131. }
  1132. }
  1133. return 1;
  1134. }
  1135. =pod
  1136. =item get_mp3info (FILE)
  1137. Returns hash reference containing file information for MP3 file.
  1138. This data cannot be changed. Returned data:
  1139. VERSION MPEG audio version (1, 2, 2.5)
  1140. LAYER MPEG layer description (1, 2, 3)
  1141. STEREO boolean for audio is in stereo
  1142. VBR boolean for variable bitrate
  1143. BITRATE bitrate in kbps (average for VBR files)
  1144. FREQUENCY frequency in kHz
  1145. SIZE bytes in audio stream
  1146. OFFSET bytes offset that stream begins
  1147. SECS total seconds
  1148. MM minutes
  1149. SS leftover seconds
  1150. MS leftover milliseconds
  1151. TIME time in MM:SS
  1152. COPYRIGHT boolean for audio is copyrighted
  1153. PADDING boolean for MP3 frames are padded
  1154. MODE channel mode (0 = stereo, 1 = joint stereo,
  1155. 2 = dual channel, 3 = single channel)
  1156. FRAMES approximate number of frames
  1157. FRAME_LENGTH approximate length of a frame
  1158. VBR_SCALE VBR scale from VBR header
  1159. On error, returns nothing and sets C<$@>.
  1160. =cut
  1161. sub get_mp3info {
  1162. my($file) = @_;
  1163. my($off, $byte, $eof, $h, $tot, $fh);
  1164. if (not (defined $file && $file ne '')) {
  1165. $@ = "No file specified";
  1166. return undef;
  1167. }
  1168. my $size = -s $file;
  1169. if (ref $file) { # filehandle passed
  1170. $fh = $file;
  1171. } else {
  1172. if ( !$size ) {
  1173. $@ = "File is empty";
  1174. return undef;
  1175. }
  1176. if (not open $fh, '<', $file) {
  1177. $@ = "Can't open $file: $!";
  1178. return undef;
  1179. }
  1180. }
  1181. $off = 0;
  1182. $tot = 8192;
  1183. # Let the caller change how far we seek in looking for a header.
  1184. if ($try_harder) {
  1185. $tot *= $try_harder;
  1186. }
  1187. binmode $fh;
  1188. seek $fh, $off, SEEK_SET;
  1189. read $fh, $byte, 4;
  1190. if (my $v2h = _get_v2head($fh)) {
  1191. $tot += $off += $v2h->{tag_size};
  1192. if ( $off > $size - 10 ) {
  1193. # Invalid v2 tag size
  1194. $off = 0;
  1195. }
  1196. seek $fh, $off, SEEK_SET;
  1197. read $fh, $byte, 4;
  1198. }
  1199. $h = _get_head($byte);
  1200. my $is_mp3 = _is_mp3($h);
  1201. # the head wasn't where we were expecting it.. dig deeper.
  1202. unless ($is_mp3) {
  1203. # do only one read - it's _much_ faster
  1204. $off++;
  1205. seek $fh, $off, SEEK_SET;
  1206. read $fh, $byte, $tot;
  1207. my $i;
  1208. # now walk the bytes looking for the head
  1209. for ($i = 0; $i < $tot; $i++) {
  1210. last if ($tot - $i) < 4;
  1211. my $head = substr($byte, $i, 4) || last;
  1212. next if (ord($head) != 0xff);
  1213. $h = _get_head($head);
  1214. $is_mp3 = _is_mp3($h);
  1215. last if $is_mp3;
  1216. }
  1217. # adjust where we are for _get_vbr()
  1218. $off += $i;
  1219. if ($off > $tot && !$try_harder) {
  1220. _close($file, $fh);
  1221. $@ = "Couldn't find MP3 header (perhaps set " .
  1222. '$MP3::Info::try_harder and retry)';
  1223. return undef;
  1224. }
  1225. }
  1226. $h->{offset} = $off;
  1227. my $vbr = _get_vbr($fh, $h, \$off);
  1228. my $lame = _get_lame($fh, $h, \$off);
  1229. seek $fh, 0, SEEK_END;
  1230. $eof = tell $fh;
  1231. seek $fh, -128, SEEK_END;
  1232. $eof -= 128 if <$fh> =~ /^TAG/ ? 1 : 0;
  1233. # JRF: Check for an ID3v2.4 footer and if present, remove it from
  1234. # the size.
  1235. seek($fh, $eof, SEEK_SET);
  1236. if (my $v2f = _get_v2foot($fh)) {
  1237. $eof -= $v2f->{tag_size};
  1238. }
  1239. _close($file, $fh);
  1240. $h->{size} = $eof - $off;
  1241. return _get_info($h, $vbr, $lame);
  1242. }
  1243. sub _get_info {
  1244. my($h, $vbr, $lame) = @_;
  1245. my $i;
  1246. # No bitrate or sample rate? Something's wrong.
  1247. unless ($h->{bitrate} && $h->{fs}) {
  1248. return {};
  1249. }
  1250. $i->{VERSION} = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 : $h->{IDR} == 0 ? 2.5 : 0;
  1251. $i->{LAYER} = 4 - $h->{layer};
  1252. if (ref($vbr) eq 'HASH' and $vbr->{is_vbr} == 1) {
  1253. $i->{VBR} = 1;
  1254. } else {
  1255. $i->{VBR} = 0;
  1256. }
  1257. $i->{COPYRIGHT} = $h->{copyright} ? 1 : 0;
  1258. $i->{PADDING} = $h->{padding_bit} ? 1 : 0;
  1259. $i->{STEREO} = $h->{mode} == 3 ? 0 : 1;
  1260. $i->{MODE} = $h->{mode};
  1261. $i->{SIZE} = $i->{VBR} == 1 && $vbr->{bytes} ? $vbr->{bytes} : $h->{size};
  1262. $i->{OFFSET} = $h->{offset};
  1263. my $mfs = $h->{fs} / ($h->{ID} ? 144000 : 72000);
  1264. $i->{FRAMES} = int($i->{VBR} == 1 && $vbr->{frames}
  1265. ? $vbr->{frames}
  1266. : $i->{SIZE} / ($h->{bitrate} / $mfs)
  1267. );
  1268. if ($i->{VBR} == 1) {
  1269. $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale};
  1270. $h->{bitrate} = $i->{SIZE} / $i->{FRAMES} * $mfs;
  1271. if (not $h->{bitrate}) {
  1272. $@ = "Couldn't determine VBR bitrate";
  1273. return undef;
  1274. }
  1275. }
  1276. $h->{'length'} = ($i->{SIZE} * 8) / $h->{bitrate} / 10;
  1277. $i->{SECS} = $h->{'length'} / 100;
  1278. $i->{MM} = int $i->{SECS} / 60;
  1279. $i->{SS} = int $i->{SECS} % 60;
  1280. $i->{MS} = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000);
  1281. # $i->{LF} = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS});
  1282. # int($i->{MS} / 100 * 75); # is this right?
  1283. $i->{TIME} = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'};
  1284. $i->{BITRATE} = int $h->{bitrate};
  1285. # should we just return if ! FRAMES?
  1286. $i->{FRAME_LENGTH} = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES};
  1287. $i->{FREQUENCY} = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}];
  1288. if ($lame) {
  1289. $i->{LAME} = $lame;
  1290. }
  1291. return $i;
  1292. }
  1293. sub _get_head {
  1294. my($byte) = @_;
  1295. my($bytes, $h);
  1296. $bytes = _unpack_head($byte);
  1297. @$h{qw(IDR ID layer protection_bit
  1298. bitrate_index sampling_freq padding_bit private_bit
  1299. mode mode_extension copyright original
  1300. emphasis version_index bytes)} = (
  1301. ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1,
  1302. ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1,
  1303. ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1,
  1304. $bytes&3, ($bytes>>19)&3, $bytes
  1305. );
  1306. $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}];
  1307. $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}];
  1308. return $h;
  1309. }
  1310. sub _is_mp3 {
  1311. my $h = $_[0] or return undef;
  1312. return ! ( # all below must be false
  1313. $h->{bitrate_index} == 0
  1314. ||
  1315. $h->{version_index} == 1
  1316. ||
  1317. ($h->{bytes} & 0xFFE00000) != 0xFFE00000
  1318. ||
  1319. !$h->{fs}
  1320. ||
  1321. !$h->{bitrate}
  1322. ||
  1323. $h->{bitrate_index} == 15
  1324. ||
  1325. !$h->{layer}
  1326. ||
  1327. $h->{sampling_freq} == 3
  1328. ||
  1329. $h->{emphasis} == 2
  1330. ||
  1331. !$h->{bitrate_index}
  1332. ||
  1333. ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000
  1334. ||
  1335. ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1)
  1336. # mode extension should only be applicable when mode = 1
  1337. # however, failing just becuase mode extension is used when unneeded is a bit strict
  1338. # ||
  1339. #($h->{mode_extension} != 0 && $h->{mode} != 1)
  1340. );
  1341. }
  1342. sub _vbr_seek {
  1343. my $fh = shift;
  1344. my $off = shift;
  1345. my $bytes = shift;
  1346. my $n = shift || 4;
  1347. seek $fh, $$off, SEEK_SET;
  1348. read $fh, $$bytes, $n;
  1349. $$off += $n;
  1350. }
  1351. sub _get_vbr {
  1352. my ($fh, $h, $roff) = @_;
  1353. my ($off, $bytes, @bytes);
  1354. my %vbr = (is_vbr => 0);
  1355. $off = $$roff;
  1356. $off += 4;
  1357. if ($h->{ID}) { # MPEG1
  1358. $off += $h->{mode} == 3 ? 17 : 32;
  1359. } else { # MPEG2
  1360. $off += $h->{mode} == 3 ? 9 : 17;
  1361. }
  1362. _vbr_seek($fh, \$off, \$bytes);
  1363. if ($bytes =~ /(?:Xing|Info)/) {
  1364. # Info is CBR
  1365. $vbr{is_vbr} = 1 if $bytes =~ /Xing/;
  1366. _vbr_seek($fh, \$off, \$bytes);
  1367. $vbr{flags} = _unpack_head($bytes);
  1368. if ($vbr{flags} & 1) {
  1369. _vbr_seek($fh, \$off, \$bytes);
  1370. $vbr{frames} = _unpack_head($bytes);
  1371. }
  1372. if ($vbr{flags} & 2) {
  1373. _vbr_seek($fh, \$off, \$bytes);
  1374. $vbr{bytes} = _unpack_head($bytes);
  1375. }
  1376. if ($vbr{flags} & 4) {
  1377. _vbr_seek($fh, \$off, \$bytes, 100);
  1378. # Not used right now ...
  1379. #$vbr{toc} = _unpack_head($bytes);
  1380. }
  1381. if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst)
  1382. _vbr_seek($fh, \$off, \$bytes);
  1383. $vbr{scale} = _unpack_head($bytes);
  1384. } else {
  1385. $vbr{scale} = -1;
  1386. }
  1387. $$roff = $off;
  1388. } elsif ($bytes =~ /(?:VBRI)/) {
  1389. $vbr{is_vbr} = 1;
  1390. # Fraunhofer encoder uses VBRI format
  1391. # start with quality factor at position 8
  1392. _vbr_seek($fh, \$off, \$bytes, 4);
  1393. _vbr_seek($fh, \$off, \$bytes, 2);
  1394. $vbr{scale} = unpack('l', pack('L', unpack('n', $bytes)));
  1395. # Then Bytes, as position 10
  1396. _vbr_seek($fh, \$off, \$bytes);
  1397. $vbr{bytes} = _unpack_head($bytes);
  1398. # Finally Frames at position 14
  1399. _vbr_seek($fh, \$off, \$bytes);
  1400. $vbr{frames} = _unpack_head($bytes);
  1401. $$roff = $off;
  1402. }
  1403. return \%vbr;
  1404. }
  1405. # Read LAME info tag
  1406. # http://gabriel.mp3-tech.org/mp3infotag.html
  1407. sub _get_lame {
  1408. my($fh, $h, $roff) = @_;
  1409. my($off, $bytes, @bytes, %lame);
  1410. $off = $$roff;
  1411. # Encode version, 9 bytes
  1412. _vbr_seek($fh, \$off, \$bytes, 9);
  1413. $lame{encoder_version} = $bytes;
  1414. return unless $bytes =~ /^LAME/;
  1415. # There's some stuff here but it's not too useful
  1416. _vbr_seek($fh, \$off, \$bytes, 12);
  1417. # Encoder delays (used for gapless decoding)
  1418. _vbr_seek($fh, \$off, \$bytes, 3);
  1419. my $bin = unpack 'B*', $bytes;
  1420. $lame{start_delay} = unpack('N', pack('B32', substr('0' x 32 . substr($bin, 0, 12), -32)));
  1421. $lame{end_padding} = unpack('N', pack('B32', substr('0' x 32 . substr($bin, 12, 12), -32)));
  1422. return \%lame;
  1423. }
  1424. # _get_v2head(file handle, start offset in file);
  1425. # The start offset can be used to check ID3v2 headers anywhere
  1426. # in the MP3 (eg for 'update' frames).
  1427. sub _get_v2head {
  1428. my $fh = $_[0] or return;
  1429. my $v2h = {
  1430. 'offset' => $_[1] || 0,
  1431. 'tag_size' => 0,
  1432. };
  1433. # check first three bytes for 'ID3'
  1434. seek($fh, $v2h->{offset}, SEEK_SET);
  1435. read($fh, my $header, 10);
  1436. my $tag = substr($header, 0, 3);
  1437. # (Note: Footers are dealt with in v2foot)
  1438. if ($v2h->{offset} == 0) {
  1439. # JRF: Only check for special headers if we're at the start of the file.
  1440. if ($tag eq 'RIF' || $tag eq 'FOR') {
  1441. _find_id3_chunk($fh, $tag) or return;
  1442. $v2h->{offset} = tell $fh;
  1443. read($fh, $header, 10);
  1444. $tag = substr($header, 0, 3);
  1445. }
  1446. }
  1447. return if $tag ne 'ID3';
  1448. # get version
  1449. my ($major, $minor, $flags) = unpack ("x3CCC", $header);
  1450. $v2h->{version} = sprintf("ID3v2.%d.%d", $major, $minor);
  1451. $v2h->{major_version} = $major;
  1452. $v2h->{minor_version} = $minor;
  1453. # get flags
  1454. my @bits = split(//, unpack('b8', pack('v', $flags)));
  1455. if ($v2h->{major_version} == 2) {
  1456. $v2h->{unsync} = $bits[7];
  1457. $v2h->{compression} = $bits[6]; # Should be ignored - no defined form
  1458. $v2h->{ext_header} = 0;
  1459. $v2h->{experimental} = 0;
  1460. } else {
  1461. $v2h->{unsync} = $bits[7];
  1462. $v2h->{ext_header} = $bits[6];
  1463. $v2h->{experimental} = $bits[5];
  1464. $v2h->{footer} = $bits[4] if $v2h->{major_version} == 4;
  1465. }
  1466. # get ID3v2 tag length from bytes 7-10
  1467. my $rawsize = substr($header, 6, 4);
  1468. for my $b (unpack('C4', $rawsize)) {
  1469. $v2h->{tag_size} = ($v2h->{tag_size} << 7) + $b;
  1470. }
  1471. $v2h->{tag_size} += 10; # include ID3v2 header size
  1472. $v2h->{tag_size} += 10 if $v2h->{footer};
  1473. # JRF: I think this is done wrongly - this should be part of the main frame,
  1474. # and therefore under ID3v2.3 it's subject to unsynchronisation
  1475. # (ID3v2.3, section 3.2).
  1476. # FIXME.
  1477. # get extended header size (2.3/2.4 only)
  1478. $v2h->{ext_header_size} = 0;
  1479. if ($v2h->{ext_header}) {
  1480. my $filesize = -s $fh;
  1481. read $fh, my $bytes, 4;
  1482. my @bytes = reverse unpack 'C4', $bytes;
  1483. # use syncsafe bytes if using version 2.4
  1484. my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256;
  1485. for my $i (0..3) {
  1486. $v2h->{ext_header_size} += $bytes[$i] * $bytesize ** $i;
  1487. }
  1488. # Bug 4486
  1489. # Don't try to read past the end of the file if we have a
  1490. # bogus extended header size.
  1491. if (($v2h->{ext_header_size} - 10 ) > -s $fh) {
  1492. return $v2h;
  1493. }
  1494. # Read the extended header
  1495. my $ext_data;
  1496. if ($v2h->{major_version} == 3) {
  1497. # On ID3v2.3 the extended header size excludes the whole header
  1498. read $fh, $bytes, 6 + $v2h->{ext_header_size};
  1499. my @bits = split //, unpack 'b16', substr $bytes, 0, 2;
  1500. $v2h->{crc_present} = $bits[15];
  1501. my $padding_size;
  1502. for my $i (0..3) {
  1503. if (defined $bytes[2 + $i]) {
  1504. $padding_size += $bytes[2 + $i] * $bytesize ** $i;
  1505. }
  1506. }
  1507. $ext_data = substr $bytes, 6, $v2h->{ext_header_size} - $padding_size;
  1508. }
  1509. elsif ($v2h->{major_version} == 4) {
  1510. # On ID3v2.4, the extended header size includes the whole header
  1511. read $fh, $bytes, $v2h->{ext_header_size} - 4;
  1512. my @bits = split //, unpack 'b8', substr $bytes, 5, 1;
  1513. $v2h->{update} = $bits[6];
  1514. $v2h->{crc_present} = $bits[5];
  1515. $v2h->{tag_restrictions} = $bits[4];
  1516. $ext_data = substr $bytes, 2, $v2h->{ext_header_size} - 6;
  1517. }
  1518. # JRF: I'm not actually working out what the CRC or the tag
  1519. # restrictions are just yet. It doesn't seem to be
  1520. # all that worthwhile.
  1521. # However, if this is implemented...
  1522. # Under ID3v2.3, the CRC is not sync-safe (4 bytes).
  1523. # Under ID3v2.4, the CRC is sync-safe (5 bytes, excluding the flag data
  1524. # length)
  1525. # Under ID3v2.4, every flag byte that's set is given a flag data byte
  1526. # in the extended data area, the first byte of which is the size of
  1527. # the flag data (see ID3v2.4 section 3.2).
  1528. }
  1529. return $v2h;
  1530. }
  1531. # JRF: We assume that we have seeked to the expected EOF (ie start of the ID3v1 tag)
  1532. # The 'offset' value will hold the start of the ID3v1 header (NOT the footer)
  1533. # The 'tag_size' value will hold the entire tag size, including the footer.
  1534. sub _get_v2foot {
  1535. my $fh = $_[0] or return;
  1536. my($v2h, $bytes, @bytes);
  1537. my $eof;
  1538. $eof = tell $fh;
  1539. # check first three bytes for 'ID3'
  1540. seek $fh, $eof-10, SEEK_SET; # back 10 bytes for footer
  1541. read $fh, $bytes, 3;
  1542. return undef unless $bytes eq '3DI';
  1543. # get version
  1544. read $fh, $bytes, 2;
  1545. $v2h->{version} = sprintf "ID3v2.%d.%d",
  1546. @$v2h{qw[major_version minor_version]} =
  1547. unpack 'c2', $bytes;
  1548. # get flags
  1549. read $fh, $bytes, 1;
  1550. my @bits = split //, unpack 'b8', $bytes;
  1551. if ($v2h->{major_version} != 4) {
  1552. # JRF: This should never happen - only v4 tags should have footers.
  1553. # Think about raising some warnings or something ?
  1554. # print STDERR "Invalid ID3v2 footer version number\n";
  1555. } else {
  1556. $v2h->{unsync} = $bits[7];
  1557. $v2h->{ext_header} = $bits[6];
  1558. $v2h->{experimental} = $bits[5];
  1559. $v2h->{footer} = $bits[4];
  1560. if (!$v2h->{footer})
  1561. {
  1562. # JRF: This is an invalid footer marker; it doesn't make sense
  1563. # for the footer to not be marked as the tag having a footer
  1564. # so strictly it's an invalid tag.
  1565. # A warning might be nice, but for now we'll ignore.
  1566. # print STDERR "Warning: Footer doesn't have footer bit set\n";
  1567. }
  1568. }
  1569. # get ID3v2 tag length from bytes 7-10
  1570. $v2h->{tag_size} = 10; # include ID3v2 header size
  1571. $v2h->{tag_size} += 10; # always account for the footer
  1572. read $fh, $bytes, 4;
  1573. @bytes = reverse unpack 'C4', $bytes;
  1574. foreach my $i (0 .. 3) {
  1575. # whoaaaaaa nellllllyyyyyy!
  1576. $v2h->{tag_size} += $bytes[$i] * 128 ** $i;
  1577. }
  1578. # Note that there are no extended header details on the footer; it's
  1579. # just a copy of it so that clients can seek backward to find the
  1580. # footer's start.
  1581. $v2h->{offset} = $eof - $v2h->{tag_size};
  1582. # Just to be really sure, read the start of the ID3v2.4 header here.
  1583. seek $fh, $v2h->{offset}, 0; # SEEK_SET
  1584. read $fh, $bytes, 3;
  1585. if ($bytes ne "ID3") {
  1586. # Not really an ID3v2.4 tag header; a warning would be nice but ignore
  1587. # for now.
  1588. # print STDERR "Invalid ID3v2 footer (header check) at " . $v2h->{offset} . "\n";
  1589. return undef;
  1590. }
  1591. # We could check more of the header. I'm not sure it's really worth it
  1592. # right now but at some point in the future checking the details match
  1593. # would be nice.
  1594. return $v2h;
  1595. };
  1596. sub _find_id3_chunk {
  1597. my($fh, $filetype) = @_;
  1598. my($bytes, $size, $tag, $pat, @mat);
  1599. # CHANGE 10616 introduced a read optimization in _get_v2head:
  1600. # 10 bytes are read, not 3, so reading one here hoping to get the last letter of the
  1601. # tag is a bad idea, as it always fails...
  1602. # read $fh, $bytes, 1;
  1603. if ($filetype eq 'RIF') { # WAV
  1604. # return 0 if $bytes ne 'F';
  1605. $pat = 'a4V';
  1606. @mat = ('id3 ', 'ID32');
  1607. } elsif ($filetype eq 'FOR') { # AIFF
  1608. # return 0 if $bytes ne 'M';
  1609. $pat = 'a4N';
  1610. @mat = ('ID3 ', 'ID32');
  1611. }
  1612. seek $fh, 12, SEEK_SET; # skip to the first chunk
  1613. while ((read $fh, $bytes, 8) == 8) {
  1614. ($tag, $size) = unpack $pat, $bytes;
  1615. for my $mat ( @mat ) {
  1616. return 1 if $tag eq $mat;
  1617. }
  1618. seek $fh, $size, SEEK_CUR;
  1619. }
  1620. return 0;
  1621. }
  1622. sub _unpack_head {
  1623. unpack('l', pack('L', unpack('N', $_[0])));
  1624. }
  1625. sub _grab_int_16 {
  1626. my $data = shift;
  1627. my $value = unpack('s', pack('S', unpack('n',substr($$data,0,2))));
  1628. $$data = substr($$data,2);
  1629. return $value;
  1630. }
  1631. sub _grab_uint_16 {
  1632. my $data = shift;
  1633. my $value = unpack('S',substr($$data,0,2));
  1634. $$data = substr($$data,2);
  1635. return $value;
  1636. }
  1637. sub _grab_int_32 {
  1638. my $data = shift;
  1639. my $value = unpack('V',substr($$data,0,4));
  1640. $$data = substr($$data,4);
  1641. return $value;
  1642. }
  1643. # From getid3 - lyrics
  1644. #
  1645. # Just get the size and offset, so the APE tag can be parsed.
  1646. sub _parse_lyrics3_tag {
  1647. my ($fh, $filesize, $info) = @_;
  1648. # end - ID3v1 - LYRICSEND - [Lyrics3size]
  1649. seek($fh, (0 - 128 - 9 - 6), SEEK_END);
  1650. read($fh, my $lyrics3_id3v1, 128 + 9 + 6);
  1651. my $lyrics3_lsz = substr($lyrics3_id3v1, 0, 6); # Lyrics3size
  1652. my $lyrics3_end = substr($lyrics3_id3v1, 6, 9); # LYRICSEND or LYRICS200
  1653. my $id3v1_tag = substr($lyrics3_id3v1, 15, 128); # ID3v1
  1654. my ($lyrics3_size, $lyrics3_offset, $lyrics3_version);
  1655. # Lyrics3v1, ID3v1, no APE
  1656. if ($lyrics3_end eq 'LYRICSEND') {
  1657. $lyrics3_size = 5100;
  1658. $lyrics3_offset = $filesize - 128 - $lyrics3_size;
  1659. $lyrics3_version = 1;
  1660. } elsif ($lyrics3_end eq 'LYRICS200') {
  1661. # Lyrics3v2, ID3v1, no APE
  1662. # LSZ = lyrics + 'LYRICSBEGIN'; add 6-byte size field; add 'LYRICS200'
  1663. $lyrics3_size = $lyrics3_lsz + 6 + length('LYRICS200');
  1664. $lyrics3_offset = $filesize - 128 - $lyrics3_size;
  1665. $lyrics3_version = 2;
  1666. } elsif (substr(reverse($lyrics3_id3v1), 0, 9) eq 'DNESCIRYL') {
  1667. # Lyrics3v1, no ID3v1, no APE
  1668. $lyrics3_size = 5100;
  1669. $lyrics3_offset = $filesize - $lyrics3_size;
  1670. $lyrics3_version = 1;
  1671. $lyrics3_offset = $filesize - $lyrics3_size;
  1672. } elsif (substr(reverse($lyrics3_id3v1), 0, 9) eq '002SCIRYL') {
  1673. # Lyrics3v2, no ID3v1, no APE
  1674. # LSZ = lyrics + 'LYRICSBEGIN'; add 6-byte size field; add 'LYRICS200' > 15 = 6 + strlen('LYRICS200')
  1675. $lyrics3_size = reverse(substr(reverse($lyrics3_id3v1), 9, 6)) + 15;
  1676. $lyrics3_offset = $filesize - $lyrics3_size;
  1677. $lyrics3_version = 2;
  1678. }
  1679. return $lyrics3_offset;
  1680. }
  1681. sub _parse_ape_tag {
  1682. my ($fh, $filesize, $info) = @_;
  1683. my $ape_tag_id = 'APETAGEX';
  1684. my $id3v1_tag_size = 128;
  1685. my $ape_tag_header_size = 32;
  1686. my $lyrics3_tag_size = 10;
  1687. my $tag_offset_start = 0;
  1688. my $tag_offset_end = 0;
  1689. if (my $offset = _parse_lyrics3_tag($fh, $filesize, $info)) {
  1690. seek($fh, $offset - $ape_tag_header_size, SEEK_SET);
  1691. $tag_offset_end = $offset;
  1692. } else {
  1693. seek($fh, (0 - $id3v1_tag_size - $ape_tag_header_size - $lyrics3_tag_size), SEEK_END);
  1694. read($fh, my $ape_footer_id3v1, $id3v1_tag_size + $ape_tag_header_size + $lyrics3_tag_size);
  1695. if (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $id3v1_tag_size - $ape_tag_header_size), 8) eq $ape_tag_id) {
  1696. $tag_offset_end = $filesize - $id3v1_tag_size;
  1697. } elsif (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $ape_tag_header_size), 8) eq $ape_tag_id) {
  1698. $tag_offset_end = $filesize;
  1699. }
  1700. seek($fh, $tag_offset_end - $ape_tag_header_size, SEEK_SET);
  1701. }
  1702. read($fh, my $ape_footer_data, $ape_tag_header_size);
  1703. my $ape_footer = _parse_ape_header_or_footer($ape_footer_data);
  1704. if (keys %{$ape_footer}) {
  1705. my $ape_tag_data = '';
  1706. if ($ape_footer->{'flags'}->{'header'}) {
  1707. seek($fh, ($tag_offset_end - $ape_footer->{'tag_size'} - $ape_tag_header_size), SEEK_SET);
  1708. $tag_offset_start = tell($fh);
  1709. read($fh, $ape_tag_data, $ape_footer->{'tag_size'} + $ape_tag_header_size);
  1710. } else {
  1711. $tag_offset_start = $tag_offset_end - $ape_footer->{'tag_size'};
  1712. seek($fh, $tag_offset_start, SEEK_SET);
  1713. read($fh, $ape_tag_data, $ape_footer->{'tag_size'});
  1714. }
  1715. my $ape_header_data = substr($ape_tag_data, 0, $ape_tag_header_size, '');
  1716. my $ape_header = _parse_ape_header_or_footer($ape_header_data);
  1717. if ( defined $ape_header->{'version'} ) {
  1718. if ( $ape_header->{'version'} == 2000 ) {
  1719. $info->{'TAGVERSION'} = 'APEv2';
  1720. }
  1721. else {
  1722. $info->{'TAGVERSION'} = 'APEv1';
  1723. }
  1724. }
  1725. if (defined $ape_header->{'tag_items'} && $ape_header->{'tag_items'} =~ /^\d+$/) {
  1726. for (my $c = 0; $c < $ape_header->{'tag_items'}; $c++) {
  1727. # Loop through the tag items
  1728. my $tag_len = _grab_int_32(\$ape_tag_data);
  1729. my $tag_flags = _grab_int_32(\$ape_tag_data);
  1730. $ape_tag_data =~ s/^(.*?)\0//;
  1731. my $tag_item_key = uc($1 || 'UNKNOWN');
  1732. $info->{$tag_item_key} = substr($ape_tag_data, 0, $tag_len, '');
  1733. }
  1734. }
  1735. }
  1736. seek($fh, 0, SEEK_SET);
  1737. return 1;
  1738. }
  1739. sub _parse_ape_header_or_footer {
  1740. my $bytes = shift;
  1741. my %data = ();
  1742. if (substr($bytes, 0, 8, '') eq 'APETAGEX') {
  1743. $data{'version'} = _grab_int_32(\$bytes);
  1744. $data{'tag_size'} = _grab_int_32(\$bytes);
  1745. $data{'tag_items'} = _grab_int_32(\$bytes);
  1746. $data{'global_flags'} = _grab_int_32(\$bytes);
  1747. # trim the reseved bytes
  1748. _grab_int_32(\$bytes);
  1749. _grab_int_32(\$bytes);
  1750. $data{'flags'}->{'header'} = ($data{'global_flags'} & 0x80000000) ? 1 : 0;
  1751. $data{'flags'}->{'footer'} = ($data{'global_flags'} & 0x40000000) ? 1 : 0;
  1752. $data{'flags'}->{'is_header'} = ($data{'global_flags'} & 0x20000000) ? 1 : 0;
  1753. }
  1754. return \%data;
  1755. }
  1756. sub _close {
  1757. my($file, $fh) = @_;
  1758. unless (ref $file) { # filehandle not passed
  1759. close $fh or carp "Problem closing '$file': $!";
  1760. }
  1761. }
  1762. BEGIN {
  1763. @mp3_genres = (
  1764. 'Blues',
  1765. 'Classic Rock',
  1766. 'Country',
  1767. 'Dance',
  1768. 'Disco',
  1769. 'Funk',
  1770. 'Grunge',
  1771. 'Hip-Hop',
  1772. 'Jazz',
  1773. 'Metal',
  1774. 'New Age',
  1775. 'Oldies',
  1776. 'Other',
  1777. 'Pop',
  1778. 'R&B',
  1779. 'Rap',
  1780. 'Reggae',
  1781. 'Rock',
  1782. 'Techno',
  1783. 'Industrial',
  1784. 'Alternative',
  1785. 'Ska',
  1786. 'Death Metal',
  1787. 'Pranks',
  1788. 'Soundtrack',
  1789. 'Euro-Techno',
  1790. 'Ambient',
  1791. 'Trip-Hop',
  1792. 'Vocal',
  1793. 'Jazz+Funk',
  1794. 'Fusion',
  1795. 'Trance',
  1796. 'Classical',
  1797. 'Instrumental',
  1798. 'Acid',
  1799. 'House',
  1800. 'Game',
  1801. 'Sound Clip',
  1802. 'Gospel',
  1803. 'Noise',
  1804. 'AlternRock',
  1805. 'Bass',
  1806. 'Soul',
  1807. 'Punk',
  1808. 'Space',
  1809. 'Meditative',
  1810. 'Instrumental Pop',
  1811. 'Instrumental Rock',
  1812. 'Ethnic',
  1813. 'Gothic',
  1814. 'Darkwave',
  1815. 'Techno-Industrial',
  1816. 'Electronic',
  1817. 'Pop-Folk',
  1818. 'Eurodance',
  1819. 'Dream',
  1820. 'Southern Rock',
  1821. 'Comedy',
  1822. 'Cult',
  1823. 'Gangsta',
  1824. 'Top 40',
  1825. 'Christian Rap',
  1826. 'Pop/Funk',
  1827. 'Jungle',
  1828. 'Native American',
  1829. 'Cabaret',
  1830. 'New Wave',
  1831. 'Psychadelic',
  1832. 'Rave',
  1833. 'Showtunes',
  1834. 'Trailer',
  1835. 'Lo-Fi',
  1836. 'Tribal',
  1837. 'Acid Punk',
  1838. 'Acid Jazz',
  1839. 'Polka',
  1840. 'Retro',
  1841. 'Musical',
  1842. 'Rock & Roll',
  1843. 'Hard Rock',
  1844. );
  1845. @winamp_genres = (
  1846. @mp3_genres,
  1847. 'Folk',
  1848. 'Folk-Rock',
  1849. 'National Folk',
  1850. 'Swing',
  1851. 'Fast Fusion',
  1852. 'Bebop',
  1853. 'Latin',
  1854. 'Revival',
  1855. 'Celtic',
  1856. 'Bluegrass',
  1857. 'Avantgarde',
  1858. 'Gothic Rock',
  1859. 'Progressive Rock',
  1860. 'Psychedelic Rock',
  1861. 'Symphonic Rock',
  1862. 'Slow Rock',
  1863. 'Big Band',
  1864. 'Chorus',
  1865. 'Easy Listening',
  1866. 'Acoustic',
  1867. 'Humour',
  1868. 'Speech',
  1869. 'Chanson',
  1870. 'Opera',
  1871. 'Chamber Music',
  1872. 'Sonata',
  1873. 'Symphony',
  1874. 'Booty Bass',
  1875. 'Primus',
  1876. 'Porn Groove',
  1877. 'Satire',
  1878. 'Slow Jam',
  1879. 'Club',
  1880. 'Tango',
  1881. 'Samba',
  1882. 'Folklore',
  1883. 'Ballad',
  1884. 'Power Ballad',
  1885. 'Rhythmic Soul',
  1886. 'Freestyle',
  1887. 'Duet',
  1888. 'Punk Rock',
  1889. 'Drum Solo',
  1890. 'Acapella',
  1891. 'Euro-House',
  1892. 'Dance Hall',
  1893. 'Goa',
  1894. 'Drum & Bass',
  1895. 'Club-House',
  1896. 'Hardcore',
  1897. 'Terror',
  1898. 'Indie',
  1899. 'BritPop',
  1900. 'Negerpunk',
  1901. 'Polsk Punk',
  1902. 'Beat',
  1903. 'Christian Gangsta Rap',
  1904. 'Heavy Metal',
  1905. 'Black Metal',
  1906. 'Crossover',
  1907. 'Contemporary Christian',
  1908. 'Christian Rock',
  1909. 'Merengue',
  1910. 'Salsa',
  1911. 'Thrash Metal',
  1912. 'Anime',
  1913. 'JPop',
  1914. 'Synthpop',
  1915. );
  1916. @t_bitrate = ([
  1917. [0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256],
  1918. [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160],
  1919. [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160]
  1920. ],[
  1921. [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448],
  1922. [0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384],
  1923. [0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320]
  1924. ]);
  1925. @t_sampling_freq = (
  1926. [11025, 12000, 8000],
  1927. [undef, undef, undef], # reserved
  1928. [22050, 24000, 16000],
  1929. [44100, 48000, 32000]
  1930. );
  1931. @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 }
  1932. map { @$_ } @t_sampling_freq;
  1933. @mp3_info_fields = qw(
  1934. VERSION
  1935. LAYER
  1936. STEREO
  1937. VBR
  1938. BITRATE
  1939. FREQUENCY
  1940. SIZE
  1941. OFFSET
  1942. SECS
  1943. MM
  1944. SS
  1945. MS
  1946. TIME
  1947. COPYRIGHT
  1948. PADDING
  1949. MODE
  1950. FRAMES
  1951. FRAME_LENGTH
  1952. VBR_SCALE
  1953. );
  1954. %rva2_channel_types = (
  1955. 0x00 => 'OTHER',
  1956. 0x01 => 'MASTER',
  1957. 0x02 => 'FRONT_RIGHT',
  1958. 0x03 => 'FRONT_LEFT',
  1959. 0x04 => 'BACK_RIGHT',
  1960. 0x05 => 'BACK_LEFT',
  1961. 0x06 => 'FRONT_CENTER',
  1962. 0x07 => 'BACK_CENTER',
  1963. 0x08 => 'SUBWOOFER',
  1964. );
  1965. %v1_tag_fields =
  1966. (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4);
  1967. @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE);
  1968. %v2_to_v1_names = (
  1969. # v2.2 tags
  1970. 'TT2' => 'TITLE',
  1971. 'TP1' => 'ARTIST',
  1972. 'TAL' => 'ALBUM',
  1973. 'TYE' => 'YEAR',
  1974. 'COM' => 'COMMENT',
  1975. 'TRK' => 'TRACKNUM',
  1976. 'TCO' => 'GENRE', # not clean mapping, but ...
  1977. # v2.3 tags
  1978. 'TIT2' => 'TITLE',
  1979. 'TPE1' => 'ARTIST',
  1980. 'TALB' => 'ALBUM',
  1981. 'TYER' => 'YEAR',
  1982. 'COMM' => 'COMMENT',
  1983. 'TRCK' => 'TRACKNUM',
  1984. 'TCON' => 'GENRE',
  1985. # v2.3 tags - needed for MusicBrainz
  1986. 'UFID' => 'Unique file identifier',
  1987. 'TXXX' => 'User defined text information frame',
  1988. );
  1989. %v2_tag_names = (
  1990. # v2.2 tags
  1991. 'BUF' => 'Recommended buffer size',
  1992. 'CNT' => 'Play counter',
  1993. 'COM' => 'Comments',
  1994. 'CRA' => 'Audio encryption',
  1995. 'CRM' => 'Encrypted meta frame',
  1996. 'ETC' => 'Event timing codes',
  1997. 'EQU' => 'Equalization',
  1998. 'GEO' => 'General encapsulated object',
  1999. 'IPL' => 'Involved people list',
  2000. 'LNK' => 'Linked information',
  2001. 'MCI' => 'Music CD Identifier',
  2002. 'MLL' => 'MPEG location lookup table',
  2003. 'PIC' => 'Attached picture',
  2004. 'POP' => 'Popularimeter',
  2005. 'REV' => 'Reverb',
  2006. 'RVA' => 'Relative volume adjustment',
  2007. 'SLT' => 'Synchronized lyric/text',
  2008. 'STC' => 'Synced tempo codes',
  2009. 'TAL' => 'Album/Movie/Show title',
  2010. 'TBP' => 'BPM (Beats Per Minute)',
  2011. 'TCM' => 'Composer',
  2012. 'TCO' => 'Content type',
  2013. 'TCR' => 'Copyright message',
  2014. 'TDA' => 'Date',
  2015. 'TDY' => 'Playlist delay',
  2016. 'TEN' => 'Encoded by',
  2017. 'TFT' => 'File type',
  2018. 'TIM' => 'Time',
  2019. 'TKE' => 'Initial key',
  2020. 'TLA' => 'Language(s)',
  2021. 'TLE' => 'Length',
  2022. 'TMT' => 'Media type',
  2023. 'TOA' => 'Original artist(s)/performer(s)',
  2024. 'TOF' => 'Original filename',
  2025. 'TOL' => 'Original Lyricist(s)/text writer(s)',
  2026. 'TOR' => 'Original release year',
  2027. 'TOT' => 'Original album/Movie/Show title',
  2028. 'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group',
  2029. 'TP2' => 'Band/Orchestra/Accompaniment',
  2030. 'TP3' => 'Conductor/Performer refinement',
  2031. 'TP4' => 'Interpreted, remixed, or otherwise modified by',
  2032. 'TPA' => 'Part of a set',
  2033. 'TPB' => 'Publisher',
  2034. 'TRC' => 'ISRC (International Standard Recording Code)',
  2035. 'TRD' => 'Recording dates',
  2036. 'TRK' => 'Track number/Position in set',
  2037. 'TSI' => 'Size',
  2038. 'TSS' => 'Software/hardware and settings used for encoding',
  2039. 'TT1' => 'Content group description',
  2040. 'TT2' => 'Title/Songname/Content description',
  2041. 'TT3' => 'Subtitle/Description refinement',
  2042. 'TXT' => 'Lyricist/text writer',
  2043. 'TXX' => 'User defined text information frame',
  2044. 'TYE' => 'Year',
  2045. 'UFI' => 'Unique file identifier',
  2046. 'ULT' => 'Unsychronized lyric/text transcription',
  2047. 'WAF' => 'Official audio file webpage',
  2048. 'WAR' => 'Official artist/performer webpage',
  2049. 'WAS' => 'Official audio source webpage',
  2050. 'WCM' => 'Commercial information',
  2051. 'WCP' => 'Copyright/Legal information',
  2052. 'WPB' => 'Publishers official webpage',
  2053. 'WXX' => 'User defined URL link frame',
  2054. # v2.3 tags
  2055. 'AENC' => 'Audio encryption',
  2056. 'APIC' => 'Attached picture',
  2057. 'COMM' => 'Comments',
  2058. 'COMR' => 'Commercial frame',
  2059. 'ENCR' => 'Encryption method registration',
  2060. 'EQUA' => 'Equalization',
  2061. 'ETCO' => 'Event timing codes',
  2062. 'GEOB' => 'General encapsulated object',
  2063. 'GRID' => 'Group identification registration',
  2064. 'IPLS' => 'Involved people list',
  2065. 'LINK' => 'Linked information',
  2066. 'MCDI' => 'Music CD identifier',
  2067. 'MLLT' => 'MPEG location lookup table',
  2068. 'OWNE' => 'Ownership frame',
  2069. 'PCNT' => 'Play counter',
  2070. 'POPM' => 'Popularimeter',
  2071. 'POSS' => 'Position synchronisation frame',
  2072. 'PRIV' => 'Private frame',
  2073. 'RBUF' => 'Recommended buffer size',
  2074. 'RVAD' => 'Relative volume adjustment',
  2075. 'RVRB' => 'Reverb',
  2076. 'SYLT' => 'Synchronized lyric/text',
  2077. 'SYTC' => 'Synchronized tempo codes',
  2078. 'TALB' => 'Album/Movie/Show title',
  2079. 'TBPM' => 'BPM (beats per minute)',
  2080. 'TCOM' => 'Composer',
  2081. 'TCON' => 'Content type',
  2082. 'TCOP' => 'Copyright message',
  2083. 'TDAT' => 'Date',
  2084. 'TDLY' => 'Playlist delay',
  2085. 'TENC' => 'Encoded by',
  2086. 'TEXT' => 'Lyricist/Text writer',
  2087. 'TFLT' => 'File type',
  2088. 'TIME' => 'Time',
  2089. 'TIT1' => 'Content group description',
  2090. 'TIT2' => 'Title/songname/content description',
  2091. 'TIT3' => 'Subtitle/Description refinement',
  2092. 'TKEY' => 'Initial key',
  2093. 'TLAN' => 'Language(s)',
  2094. 'TLEN' => 'Length',
  2095. 'TMED' => 'Media type',
  2096. 'TOAL' => 'Original album/movie/show title',
  2097. 'TOFN' => 'Original filename',
  2098. 'TOLY' => 'Original lyricist(s)/text writer(s)',
  2099. 'TOPE' => 'Original artist(s)/performer(s)',
  2100. 'TORY' => 'Original release year',
  2101. 'TOWN' => 'File owner/licensee',
  2102. 'TPE1' => 'Lead performer(s)/Soloist(s)',
  2103. 'TPE2' => 'Band/orchestra/accompaniment',
  2104. 'TPE3' => 'Conductor/performer refinement',
  2105. 'TPE4' => 'Interpreted, remixed, or otherwise modified by',
  2106. 'TPOS' => 'Part of a set',
  2107. 'TPUB' => 'Publisher',
  2108. 'TRCK' => 'Track number/Position in set',
  2109. 'TRDA' => 'Recording dates',
  2110. 'TRSN' => 'Internet radio station name',
  2111. 'TRSO' => 'Internet radio station owner',
  2112. 'TSIZ' => 'Size',
  2113. 'TSRC' => 'ISRC (international standard recording code)',
  2114. 'TSSE' => 'Software/Hardware and settings used for encoding',
  2115. 'TXXX' => 'User defined text information frame',
  2116. 'TYER' => 'Year',
  2117. 'UFID' => 'Unique file identifier',
  2118. 'USER' => 'Terms of use',
  2119. 'USLT' => 'Unsychronized lyric/text transcription',
  2120. 'WCOM' => 'Commercial information',
  2121. 'WCOP' => 'Copyright/Legal information',
  2122. 'WOAF' => 'Official audio file webpage',
  2123. 'WOAR' => 'Official artist/performer webpage',
  2124. 'WOAS' => 'Official audio source webpage',
  2125. 'WORS' => 'Official internet radio station homepage',
  2126. 'WPAY' => 'Payment',
  2127. 'WPUB' => 'Publishers official webpage',
  2128. 'WXXX' => 'User defined URL link frame',
  2129. # v2.4 additional tags
  2130. # note that we don't restrict tags from 2.3 or 2.4,
  2131. 'ASPI' => 'Audio seek point index',
  2132. 'EQU2' => 'Equalisation (2)',
  2133. 'RVA2' => 'Relative volume adjustment (2)',
  2134. 'SEEK' => 'Seek frame',
  2135. 'SIGN' => 'Signature frame',
  2136. 'TDEN' => 'Encoding time',
  2137. 'TDOR' => 'Original release time',
  2138. 'TDRC' => 'Recording time',
  2139. 'TDRL' => 'Release time',
  2140. 'TDTG' => 'Tagging time',
  2141. 'TIPL' => 'Involved people list',
  2142. 'TMCL' => 'Musician credits list',
  2143. 'TMOO' => 'Mood',
  2144. 'TPRO' => 'Produced notice',
  2145. 'TSOA' => 'Album sort order',
  2146. 'TSOP' => 'Performer sort order',
  2147. 'TSOT' => 'Title sort order',
  2148. 'TSST' => 'Set subtitle',
  2149. # grrrrrrr
  2150. 'COM ' => 'Broken iTunes comments',
  2151. );
  2152. }
  2153. 1;
  2154. __END__
  2155. =pod
  2156. =back
  2157. =head1 TROUBLESHOOTING
  2158. If you find a bug, please send me a patch (see the project page in L<"SEE ALSO">).
  2159. If you cannot figure out why it does not work for you, please put the MP3 file in
  2160. a place where I can get it (preferably via FTP, or HTTP, or .Mac iDisk) and send me
  2161. mail regarding where I can get the file, with a detailed description of the problem.
  2162. If I download the file, after debugging the problem I will not keep the MP3 file
  2163. if it is not legal for me to have it. Just let me know if it is legal for me to
  2164. keep it or not.
  2165. =head1 TODO
  2166. =over 4
  2167. =item ID3v2 Support
  2168. Still need to do more for reading tags, such as using Compress::Zlib to decompress
  2169. compressed tags. But until I see this in use more, I won't bother. If something
  2170. does not work properly with reading, follow the instructions above for
  2171. troubleshooting.
  2172. ID3v2 I<writing> is coming soon.
  2173. =item Get data from scalar
  2174. Instead of passing a file spec or filehandle, pass the
  2175. data itself. Would take some work, converting the seeks, etc.
  2176. =item Padding bit ?
  2177. Do something with padding bit.
  2178. =item Test suite
  2179. Test suite could use a bit of an overhaul and update. Patches very welcome.
  2180. =over 4
  2181. =item *
  2182. Revamp getset.t. Test all the various get_mp3tag args.
  2183. =item *
  2184. Test Unicode.
  2185. =item *
  2186. Test OOP API.
  2187. =item *
  2188. Test error handling, check more for missing files, bad MP3s, etc.
  2189. =back
  2190. =item Other VBR
  2191. Right now, only Xing VBR is supported.
  2192. =back
  2193. =head1 THANKS
  2194. Edward Allen,
  2195. Vittorio Bertola,
  2196. Michael Blakeley,
  2197. Per Bolmstedt,
  2198. Tony Bowden,
  2199. Tom Brown,
  2200. Sergio Camarena,
  2201. Chris Dawson,
  2202. Kevin Deane-Freeman,
  2203. Anthony DiSante,
  2204. Luke Drumm,
  2205. Kyle Farrell,
  2206. Jeffrey Friedl,
  2207. brian d foy,
  2208. Ben Gertzfield,
  2209. Brian Goodwin,
  2210. Andy Grundman,
  2211. Todd Hanneken,
  2212. Todd Harris,
  2213. Woodrow Hill,
  2214. Kee Hinckley,
  2215. Roman Hodek,
  2216. Ilya Konstantinov,
  2217. Peter Kovacs,
  2218. Johann Lindvall,
  2219. Alex Marandon,
  2220. Peter Marschall,
  2221. michael,
  2222. Trond Michelsen,
  2223. Dave O'Neill,
  2224. Christoph Oberauer,
  2225. Jake Palmer,
  2226. Andrew Phillips,
  2227. David Reuteler,
  2228. John Ruttenberg,
  2229. Matthew Sachs,
  2230. scfc_de,
  2231. Hermann Schwaerzler,
  2232. Chris Sidi,
  2233. Roland Steinbach,
  2234. Brian S. Stephan,
  2235. Stuart,
  2236. Dan Sully,
  2237. Jeffery Sumler,
  2238. Predrag Supurovic,
  2239. Bogdan Surdu,
  2240. Pierre-Yves Thoulon,
  2241. tim,
  2242. Pass F. B. Travis,
  2243. Tobias Wagener,
  2244. Ronan Waide,
  2245. Andy Waite,
  2246. Ken Williams,
  2247. Ben Winslow,
  2248. Meng Weng Wong,
  2249. Justin Fletcher.
  2250. =head1 CURRENT AUTHOR
  2251. Dan Sully E<lt>daniel | at | cpan.orgE<gt> & Logitech.
  2252. =head1 AUTHOR EMERITUS
  2253. Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/
  2254. =head1 COPYRIGHT AND LICENSE
  2255. Copyright (c) 2006-2008 Dan Sully & Logitech. All rights reserved.
  2256. Copyright (c) 1998-2005 Chris Nandor. All rights reserved.
  2257. This program is free software; you can redistribute it and/or modify it under
  2258. the same terms as Perl itself.
  2259. =head1 SEE ALSO
  2260. =over 4
  2261. =item Logitech/Slim Devices
  2262. http://www.slimdevices.com/
  2263. =item mp3tools
  2264. http://www.zevils.com/linux/mp3tools/
  2265. =item mpgtools
  2266. http://www.dv.co.yu/mpgscript/mpgtools.htm
  2267. http://www.dv.co.yu/mpgscript/mpeghdr.htm
  2268. =item mp3tool
  2269. http://www.dtek.chalmers.se/~d2linjo/mp3/mp3tool.html
  2270. =item ID3v2
  2271. http://www.id3.org/
  2272. =item Xing Variable Bitrate
  2273. http://www.xingtech.com/support/partner_developer/mp3/vbr_sdk/
  2274. =item MP3Ext
  2275. http://rupert.informatik.uni-stuttgart.de/~mutschml/MP3ext/
  2276. =item Xmms
  2277. http://www.xmms.org/
  2278. =back
  2279. =cut