MP3-Tag
view release on metacpan or search on metacpan
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
package MP3::Tag::ID3v2;
# Copyright (c) 2000-2004 Thomas Geffert. All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the Artistic License, distributed
# with Perl.
use strict;
use File::Basename;
# use Compress::Zlib;
use vars qw /%format %long_names %res_inp @supported_majors %v2names_to_v3
$VERSION @ISA %field_map %field_map_back %is_small_int
%back_splt %embedded_Descr
/;
$VERSION = "1.14";
@ISA = 'MP3::Tag::__hasparent';
my $trustencoding = $ENV{MP3TAG_DECODE_UNICODE};
$trustencoding = 1 unless defined $trustencoding;
my $decode_utf8 = $ENV{MP3TAG_DECODE_UTF8};
$decode_utf8 = 1 unless defined $decode_utf8;
my $encode_utf8 = $decode_utf8;
=pod
=head1 NAME
MP3::Tag::ID3v2 - Read / Write ID3v2.x.y tags from mp3 audio files
=head1 SYNOPSIS
MP3::Tag::ID3v2 supports
* Reading of ID3v2.2.0 and ID3v2.3.0 tags (some ID3v2.4.0 frames too)
* Writing of ID3v2.3.0 tags
MP3::Tag::ID3v2 is designed to be called from the MP3::Tag module. If
you want to make calls from user code, please consider using
highest-level wrapper code in MP3::Tag, such as update_tags() and
select_id3v2_frame_by_descr().
Low-level creation code:
use MP3::Tag;
$mp3 = MP3::Tag->new($filename);
# read an existing tag
$mp3->get_tags();
$id3v2 = $mp3->{ID3v2} if exists $mp3->{ID3v2};
# or create a new tag
$id3v2 = $mp3->new_tag("ID3v2");
See L<MP3::Tag|according documentation> for information on the above used functions.
* Reading a tag, very low-level:
$frameIDs_hash = $id3v2->get_frame_ids('truename');
foreach my $frame (keys %$frameIDs_hash) {
my ($name, @info) = $id3v2->get_frames($frame);
for my $info (@info) {
if (ref $info) {
print "$name ($frame):\n";
while(my ($key,$val)=each %$info) {
print " * $key => $val\n";
}
} else {
print "$name: $info\n";
}
}
}
* Adding / Changing / Removing a frame in memory (higher-level)
$t = $id3v2->frame_select("TIT2", undef, undef); # Very flexible
$c = $id3v2->frame_select_by_descr("COMM(fre,fra,eng,#0)[]");
$t = $id3v2->frame_select_by_descr("TIT2");
$id3v2->frame_select_by_descr("TIT2", "MyT"); # Set/Change
$id3v2->frame_select_by_descr("RBUF", $n1, $n2, $n3); # Set/Change
$id3v2->frame_select_by_descr("RBUF", "$n1;$n2;$n3"); # Set/Change
$id3v2->frame_select_by_descr("TIT2", undef); # Remove
* Adding / Changing / Removing a frame in memory (low-level)
$id3v2->add_frame("TIT2", "Title of the audio");
$id3v2->change_frame("TALB","Greatest Album");
$id3v2->remove_frame("TLAN");
* Output the modified-in-memory version of the tag:
$id3v2->write_tag();
* Removing the whole tag from the file
$id3v2->remove_tag();
* Get information about supported frames
%tags = $id3v2->supported_frames();
while (($fname, $longname) = each %tags) {
print "$fname $longname: ",
join(", ", @{$id3v2->what_data($fname)}), "\n";
}
=head1 AUTHOR
Thomas Geffert, thg@users.sourceforge.net
Ilya Zakharevich, ilyaz@cpan.org
=head1 DESCRIPTION
=over 4
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
$self->{frameIDs} =1;
my %return;
foreach (keys %{$self->{frames}}) {
next if $basic and length > 4; # ignore frames with 01 etc. at end
$return{$_}=$long_names{substr($_,0,4)};
}
return \%return;
}
*getFrameIDs = \&get_frame_ids;
=pod
=item get_frame()
($info, $name, @rest) = $tag->get_frame($ID);
($info, $name, @rest) = $tag->get_frame($ID, 'raw');
[old name: getFrame() . The old name is still available, but you should use the new name]
get_frame gets the contents of a specific frame, which must be specified by the
4-character-ID (aka short name). You can use C<get_frame_ids> to get the IDs of
the tag, or use IDs which you hope to find in the tag. If the ID is not found,
C<get_frame> returns empty list, so $info and $name become undefined.
Otherwise it extracts the contents of the frame. Frames in ID3v2 tags can be
very small, or complex and huge. That is the reason, that C<get_frame> returns
the frame data in two ways, depending on the tag.
If it is a simple tag, with only one piece of data, these data is returned
directly as ($info, $name), where $info is the text string, and $name is the
long (english) name of the frame.
If the frame consist of different pieces of data, $info is a hash reference,
$name is again the long name of the frame.
The hash, to which $info points, contains key/value pairs, where the key is
always the name of the data, and the value is the data itself.
If the name starts with a underscore (as eg '_code'), the data is probably
binary data and not printable. If the name starts without an underscore,
it should be a text string and printable.
If the second parameter is given as C<'raw'>, the whole frame data is returned,
but not the frame header. If the second parameter is C<'intact'>, no mangling
of embedded C<"\0"> and trailing spaces is performed. If the second parameter
is C<'hash'>, then, additionally, the result is always in the hash format;
likewise, if it is C<'array'>, the result is an array reference (with C<key
=E<gt> value> pairs same as with C<'hash'>, but ordered as in the frame).
If it is C<'array_nokey'>, only the "value" parts are returned (in particular,
the result is suitable to give to add_frame(), change_frame()); in addition,
if it is C<'array_nodecode'>, then keys are not returned, and the setting of
C<decode_encoding_v2> is ignored. (The "return array" flavors don't massage
the fields for better consumption by humans, so the fields should be in format
suitable for frame_add().)
If the data was stored compressed, it is
uncompressed before it is returned (even in raw mode). Then $info contains a string
with all data (which might be binary), and $name the long frame name.
See also L<MP3::Tag::ID3v2_Data> for a list of all supported frames, and
some other explanations of the returned data structure.
If more than one frame with name $ID is present, @rest contains $info
fields for all consequent frames with the same name. Note that after
removal of frames there may be holes in the list of frame names (as in
C<FRAM FRAM01 FRAM02>) in the case when multiple frames of the given
type were present; the removed frames are returned as C<undef>.
! Encrypted frames are not supported yet !
! Some frames are not supported yet, but the most common ones are supported !
=cut
sub get_frame {
my ($self, $fname, $raw) = @_;
$self->get_frame_ids() unless exists $self->{frameIDs};
my ($e, @extra) = 0; # More frames follow?
$e = $self->{extra_frames}->{$fname} || 0
if wantarray and $self->{extra_frames} and length $fname == 4;
@extra = map scalar $self->get_frame((sprintf "%s%02d", $fname, $_), $raw),
1..$e;
$e = grep defined, @extra;
my $frame = $self->{frames}->{$fname};
return unless defined $frame or $e;
$fname = substr ($fname, 0, 4);
return (undef, $long_names{$fname}, @extra) unless defined $frame;
my $start_offset=0;
if ($frame->{flags}->{encryption}) {
warn "Frame $fname: encryption not supported yet\n" ;
return;
}
my $result = $frame->{data};
# Some frame format flags indicate that additional information fields
# are added to the frame. This information is added after the frame
# header and before the frame data in the same order as the flags that
# indicates them. I.e. the four bytes of decompressed size will precede
# the encryption method byte. These additions affects the 'frame size'
# field, but are not subject to encryption or compression.
if ($frame->{flags}->{groupid}) {
$frame->{gid} = substring $result, 0, 1;
$result = substring $result, 1;
}
if ($frame->{flags}->{compression}) {
my $usize=unpack("N", $result);
require Compress::Zlib;
$result = Compress::Zlib::uncompress(substr ($result, 4));
warn "$fname: Wrong size of uncompressed data\n" if $usize=!length($result);
}
if (($raw ||= 0) eq 'raw') {
return ($result, $long_names{$fname}, @extra) if wantarray;
return $result;
}
my $format = get_format($fname);
if (defined $format) {
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
return 1;
}
=pod
=item remove_tag()
$id3v2->remove_tag();
Removes the whole tag from the file by copying the whole
mp3-file to a temp-file and renaming/moving that to the
original filename.
Do not use remove_tag() if you only want to change a header,
as otherwise the file is copied unnecessarily. Use write_tag()
directly, which will override an old tag.
=cut
sub remove_tag {
my $self = shift;
my $mp3obj = $self->{mp3};
my $tempfile = dirname($mp3obj->{filename}) . "/TMPxx";
my $count = 0;
local $\ = '';
while (-e $tempfile . $count . ".tmp") {
if ($count++ > 999) {
warn "Problems with tempfile\n";
return undef;
}
}
$tempfile .= $count . ".tmp";
if (open (NEW, ">$tempfile")) {
my $buf;
binmode NEW;
$mp3obj->seek($self->{tagsize}+10,0);
while ($mp3obj->read(\$buf,16384)) {
print NEW $buf;
}
close NEW;
$mp3obj->close;
unless (( rename $tempfile, $mp3obj->{filename})||
(system("mv",$tempfile,$mp3obj->{filename})==0)) {
warn "Couldn't rename temporary file $tempfile\n";
}
} else {
warn "Couldn't write temp file\n";
return undef;
}
return 1;
}
=pod
=item add_frame()
$fn = $id3v2->add_frame($fname, @data);
Add a new frame, identified by the short name $fname. The number of
elements of array @data should be as described in the ID3v2.3
standard. (See also L<MP3::Tag::ID3v2_Data>.) There are two
exceptions: if @data is empty, it is filled with necessary number of
C<"">); if one of required elements is C<encoding>, it may be omitted
or be C<undef>, meaning the arguments are in "Plain Perl (=ISOLatin-1
or Unicode) encoding".
It returns the the short name $fn (which can differ from
$fname, when an $fname frame already exists). If no
other frame of this kind is allowed, an empty string is
returned. Otherwise the name of the newly created frame
is returned (which can have a 01 or 02 or ... appended).
You have to call write_tag() to save the changes to the file.
Examples (with C<$id3v2-E<gt>> omitted):
$f = add_frame('TIT2', 0, 'Abba'); # $f='TIT2'
$f = add_frame('TIT2', 'Abba'); # $f='TIT201', encoding=0 implicit
$f = add_frame('COMM', 'ENG', 'Short text', 'This is a comment');
$f = add_frame('COMM'); # creates an empty frame
$f = add_frame('COMM', 'ENG'); # ! wrong ! $f=undef, becaues number
# of arguments is wrong
$f = add_frame('RBUF', $n1, $n2, $n3);
$f = add_frame('RBUF', $n1, $n2); # last field of RBUF is optional
If a frame has optional fields I<and> C<encoding> (only C<COMR> frame
as of ID3v2.4), there may be an ambiguity which fields are omitted.
It is resolved this way: the C<encoding> field can be omitted only if
all other optional frames are omitted too (set it to C<undef>
instead).
=item add_frame_split()
The same as add_frame(), but if the number of arguments is
unsufficient, would split() the last argument on C<;> to obtain the
needed number of arguments. Should be avoided unless it is known that
the fields do not contain C<;> (except for C<POPM RBUF RVRB SYTC>,
where splitting may be done non-ambiguously).
# No ambiguity, since numbers do not contain ";":
$f = add_frame_split('RBUF', "$n1;$n2;$n3");
For C<COMR> frame, in case when the fields are C<join()>ed by C<';'>,
C<encoding> field may be present only if all the other fields are
present.
=cut
# 0 = latin1 (effectively: unknown)
# 1 = UTF-16 with BOM (we always write UTF-16le to cowtow to M$'s bugs)
# 2 = UTF-16be, no BOM
# 3 = UTF-8
my @dec_types = qw( iso-8859-1 UTF-16 UTF-16BE utf8 );
my @enc_types = qw( iso-8859-1 UTF-16LE UTF-16BE utf8 );
my @tail_rex;
# Actually, disable this code: it always triggers unsync...
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
if $c > ($self->{extra_frames}->{$ID} || 0);
}
$self->{frames}->{$fname} = {flags => ($flags || $self->check_flags(0)),
major => $self->{frame_major},
data => $datastring };
$self->{modified}++;
return $fname;
}
=pod
=item change_frame()
$id3v2->change_frame($fname, @data);
Change an existing frame, which is identified by its
short name $fname eg as returned by get_frame_ids().
@data must be same as in add_frame().
If the frame $fname does not exist, undef is returned.
You have to call write_tag() to save the changes to the file.
=cut
sub change_frame {
my ($self, $fname, @data) = @_;
$self->get_frame_ids() unless exists $self->{frameIDs};
return undef unless exists $self->{frames}->{$fname};
$self->remove_frame($fname);
$self->add_frame($fname, @data);
return 1;
}
=pod
=item remove_frame()
$id3v2->remove_frame($fname);
Remove an existing frame. $fname is the short name of a frame,
eg as returned by get_frame_ids().
You have to call write_tag() to save the changes to the file.
=cut
sub remove_frame {
my ($self, $fname) = @_;
$self->get_frame_ids() unless exists $self->{frameIDs};
return undef unless exists $self->{frames}->{$fname};
delete $self->{frames}->{$fname};
$self->{modified}++;
return 1;
}
=item copy_frames($from, $to, $overwrite, [$keep_flags, $f_ids])
Copies specified frames between C<MP3::Tag::ID3v2> objects $from, $to. Unless
$keep_flags, the copied frames have their flags cleared.
If the array reference $f_ids is not specified, all the frames (but C<GRID>
and C<TLEN>) are considered (subject to $overwrite), otherwise $f_ids should
contain short frame ids to consider. Group ID flag is always cleared.
If $overwrite is C<'delete'>, frames with the same descriptors (as
returned by get_frame_descr()) in $to are deleted first, then all the
specified frames are copied. If $overwrite is FALSE, only frames with
descriptors not present in $to are copied. (If one of these two
conditions is not met, the result may be not conformant to standards.)
Returns count of copied frames.
=cut
sub copy_frames {
my ($from, $to, $overwrite, $keep_flags, $f_ids) = @_;
# return 0 unless $from->{ID3v2}; # No need to create it...
my($cp, $expl) = (0, $f_ids);
$f_ids ||= [keys %{$from->get_frame_ids}];
for my $fn (@$f_ids) {
next if not $expl and $fn =~ /^(GRID|TLEN)/;
if (($overwrite || 0) eq 'delete') {
$to->frame_select_by_descr($from->get_frame_descr($fn), undef); # delete
} elsif (not $overwrite) {
next if $to->frame_have($from->get_frame_descr($fn));
}
my $f = $from->{frames}->{$fn};
$fn =~ s/^(\w{4})\d+$/$1/;
my $d = $f->{data};
my %fl = %{$f->{flags}};
(substr $d, 0, 1) = '' if delete $fl{groupid};
$to->add_raw_frame($fn, $d, $keep_flags ? \%fl : undef);
$cp++;
}
return $cp
}
=item is_modified()
$id3v2->is_modified;
Returns true if the tag was modified after it was created.
=cut
sub is_modified {
shift->{modified}
}
=pod
=item supported_frames()
$frames = $id3v2->supported_frames();
Returns a hash reference with all supported frames. The keys of the
hash are the short names of the supported frames, the
according values are the long (english) names of the frames.
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
$resp_inp is a reference to a hash (keyed by the field name) describing
restrictions for the content of the data field.
If the entry is undef, no restriction exists. Otherwise it is a hash.
The keys of the hash are the allowed input, the correspodending value
is the value which is actually stored in this field. If the value
is undef then the key itself is valid for saving.
If the hash contains an entry with "_FREE", the hash contains
only suggestions for the input, but other input is also allowed.
$data_map contains values of $resp_inp in the order of fields of a frame
(including C<_encoding>).
Example for picture types of the APIC frame:
{"Other" => "\x00",
"32x32 pixels 'file icon' (PNG only)" => "\x01",
"Other file icon" => "\x02",
...}
=cut
sub what_data {
my ($self, $fname) = @_;
$fname = substr $fname, 0, 4; # delete 01 etc. at end
return if length($fname)==3; #id3v2.2 tags are read-only and should never be written
my $reswanted = wantarray;
my $format = get_format($fname, "quiet");
return unless defined $format;
my (@data, %res, @datares);
foreach (@$format) {
next unless exists $_->{name};
push @data, $_->{name} unless $_->{name} eq "_encoding";
next unless $reswanted;
my $key = $fname . $_->{name};
$res{$_->{name}} = $field_map{$key} if exists $field_map{$key};
push @datares, $field_map{$key};
}
return(\@data, \%res, \@datares) if $reswanted;
return \@data;
}
sub __format_field {
my ($self, $fname, $nfield, $v) = @_;
# $v =~ s/^(\d+)$/chr $1/e if $is_small_int{"$fname$nfield"}; # Already done by caller
my $m = $field_map_back{my $t = "$fname$nfield"} or return $v; # packed ==> Human
return $v if exists $m->{$v}; # Already of a correct form
my $m1 = $field_map{$t} or die; # Human ==> packed
return $m1->{$v} if exists $m1->{$v}; # translate
return $v if $m->{_FREE}; # Free-form allowed
die "Unsupported value `$v' for field `$nfield' of frame `$fname'";
}
=item title( [@new_title] )
Returns the title composed of the tags configured via C<MP3::Tag-E<gt>config('v2title')>
call (with default 'Title/Songname/Content description' (TIT2)) from the tag.
(For backward compatibility may be called by deprecated name song() as well.)
Sets TIT2 frame if given the optional arguments @new_title. If this is an
empty string, the frame is removed.
=cut
*song = \&title;
sub v2title_order {
my $self = shift;
@{ $self->get_config('v2title') };
}
sub title {
my $self = shift;
if (@_) {
$self->remove_frame('TIT2'); # NOP if it is not there
return if @_ == 1 and $_[0] eq '';
return $self->add_frame('TIT2', @_);
}
my @parts = grep defined && length,
map scalar $self->get_frame($_), $self->v2title_order;
return unless @parts;
my $last = pop @parts;
my $part;
for $part (@parts) {
$part =~ s(\0)(///)g; # Multiple strings
$part .= ',' unless $part =~ /[.,;:\n\t]\s*$/;
$part .= ' ' unless $part =~ /\s$/;
}
return join '', @parts, $last;
}
sub have_one_of_frames {
my $self = shift;
return grep $self->frame_have($_), @_;
}
sub title_have {
my $self = shift;
$self->have_one_of_frames($self->v2title_order)
}
=item _comment([$language])
Returns the file comment (COMM with an empty 'Description') from the tag, or
"Subtitle/Description refinement" (TIT3) frame (unless it is considered a part
of the title).
=cut
sub __comment {
my($self, $check_have) = (shift, shift);
my $language;
$language = lc shift if @_;
my @info = get_frames($self, "COMM");
shift @info;
for my $comment (@info) {
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
Returns the contents of the first frame named $fname with a
'Description' field in the specified array reference $descrs and the
language in the list of specified languages $languages; empty return
otherwise. If the frame is a "simple frame", the frame is returned as
a string, otherwise as a hash reference; a "simple frame" should
consist of one of Text/URL/_Data fields, with possible addition of
Language and Description fields (if the corresponding arguments were
defined).
The lists $descrs and $languages of one element can be flattened to
become this element (as with C<''> above). If the lists are not
defined, no restriction is applied; to get the same effect with
defined arguments, use $languages of C<''>, and/or $descrs a hash
reference. Language of the form C<'#NUMBER'> selects the NUMBER's
(0-based) frame with frame name $fname.
If optional arguments C<$newval1...> are given, B<ALL> the found frames are
removed; if only one such argument C<undef> is given, this is the only action.
Otherwise, a new frame is created afterwards (the first
elements of $descrs and $languages are used as the short description
and the language, defaulting to C<''> and the C<default_language>
configuration variable (which, in turn, defaults to C<XXX>; if not C<XXX>,
this should be lowercase 3-letter abbreviation according to ISO-639-2).
If new frame is created, the frame's name is returned; otherwise the count of
removed frames is returned.
As a generalization, APIC frames are handled too, using C<Picture
Type> instead of C<Language>, and auto-calculating C<MIME type> for
(currently) TIFF/JPEG/GIF/PNG/BMP and octet-stream. Only frames with
C<MIME type> coinciding with the auto-calculated value are considered
as "simple frames". One can use both the 1-byte format for C<Picture
Type>, and the long names used in the ID3v2 documentation; the default
value is C<'Cover (front)'>.
# Choose APIC with empty description, picture_type='Leaflet page'
my $data = $id3v2->frame_select('APIC', '', 'Leaflet page')
or die "no expected APIC frame found";
my $format = ( ref $data ? $data->{'MIME type'}
: $id3v2->_Data_to_MIME($data) );
# I know what to do with application/pdf only (sp?) and 'image/gif'
die "Do not know what to do with this APIC format: `$format'"
unless $format eq 'application/pdf' or $format eq 'image/gif';
$data = $data->{_Data} if ref $data; # handle non-simple frame
# Set APIC frame with empty description (front cover if no other present)
# from content of file.gif
my $data = do { open my $f, '<', 'file.gif' and binmode $f or die;
undef $/; <$f>};
my $new_frame = $id3v2->frame_select('APIC', '', undef, $data);
Frames with multiple "content" fields may be set by providing multiple
values to set. Alternatively, one can also C<join()> the values with
C<';'> if the splitting is not ambiguous, e.g., for C<POPM RBUF RVRB
SYTC>. (For frames C<GEOD> and C<COMR>, which have a C<Description>
field, it should be specified among these values.)
$id3v2->frame_select("RBUF", undef, undef, $n1, $n2, $n3);
$id3v2->frame_select("RBUF", undef, undef, "$n1;$n2;$n3");
(By the way: consider using the method select_id3v2_frame() on the
"parent" MP3::Tag object instead [see L<MP3::Tag/select_id3v2_frame>],
or L<frame_select_by_descr()>.)
=item _Data_to_MIME
Internal method to extract MIME type from a string the image file
content. Returns C<application/octet-stream> for unrecognized data
(unless extra TRUE argument is given).
$format = $id3v2->_Data_to_MIME($data);
Currently, only the first 4 bytes of the string are inspected.
=cut
sub __to_lang($$) {my $l = shift; return $l if shift or $l eq 'XXX'; lc $l}
my %as_lang = ('APIC', ['Picture Type', chr 3, 'small_int']); # "Cover (front)"
my %MT = ("\xff\xd8\xff\xe0" => 'image/jpeg', "MM\0*" => 'image/tiff',
"II*\0" => 'image/tiff', "\x89PNG",
qw(image/png GIF8 image/gif BM image/bmp));
sub _Data_to_MIME ($$;$) {
my($self, $data, $force) = (shift, shift, shift); # Fname, field name remain
my $res = $MT{substr $data, 0, 4} || $MT{substr $data, 0, 2};
return $res if $res;
return 'audio/mpeg' if $data =~ /^\xff[\xe0-\xff]/; # 11 bits are 1
return 'application/octet-stream' unless $force;
return;
}
sub _frame_select { # if $extract_content false, return all found
# "Quadratic" in number of comment frames and select-short/lang specifiers
my ($self, $extract_content, $fname) = (shift, shift, shift);
my ($descr, $languages) = (shift, shift);
# or ($fname eq 'COMM' and return $self->_comment()); # ???
my $any_descr;
if (ref $descr eq 'HASH') { # Special case
$any_descr = 1;
undef $descr;
} elsif (defined $descr and not ref $descr) {
$descr = [$descr];
}
my $lang_special = $as_lang{$fname};
my $lang_field = ($lang_special ? $lang_special->[0] : 'Language');
my $languages_mangled;
if (defined $languages) {
$languages = [$languages] unless ref $languages;
$languages = [@$languages]; # Make a copy: we edit the entries...
if ($lang_special) {
my $m = $field_map{"$fname$lang_field"};
if ($m) { # Below we assume that mapped values are not ''...
# Need to duplicate the logic in add_frame() here, since
# we need a normalized form to compare frames-to-select with...
if ($lang_special->[2]) { # small_int
s/^(\d+)$/chr $1/e for @$languages;
}
@$languages_mangled = map( (exists $m->{$_} ? $m->{$_} : $_), @$languages);
my $m1 = $field_map_back{"$fname$lang_field"} or die;
my $loose = $m->{_FREE};
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
$languages = [$lang_special->[1]];
} else {
$languages = [@{$self->get_config('default_language')}]; # Copy to modify
}
my $format = get_format($fname);
my $have_lang = grep $_->{name} eq $lang_field, @$format;
$#$languages = $have_lang - 1; # Truncate
unshift @$languages, $self->_Data_to_MIME($_[0])
if $lang_special and @_ == 1; # "MIME type" field
$descr = [''] unless defined $descr;
my $have_descr = grep $_->{name} eq 'Description', @$format;
$have_descr = 0 if $embedded_Descr{$fname}; # Must be explicitly provided
$#$descr = $have_descr - 1; # Truncate
$self->add_frame_split($fname, @$languages, @$descr, @_) or die;
}
sub frame_select {
my $self = shift;
$self->_frame_select(1, @_);
}
=item frame_list()
Same as frame_select(), but returns the list of found frames, each an
array reference C<[$N, $f]> with $N the 0-based ordinal (among frames
with the given short name), and $f the contents of a frame.
=item frame_have()
Same as frame_select(), but returns the count of found frames.
=item frame_select_by_descr()
=item frame_have_by_descr()
=item frame_list_by_descr()
$c = $id3v2->frame_select_by_descr("COMM(fre,fra,eng,#0)[]");
$t = $id3v2->frame_select_by_descr("TIT2");
$id3v2->frame_select_by_descr("TIT2", "MyT"); # Set/Change
$id3v2->frame_select_by_descr("RBUF", $n1, $n2, $n3); # Set/Change
$id3v2->frame_select_by_descr("RBUF", "$n1;$n2;$n3"); # Set/Change
$id3v2->frame_select_by_descr("TIT2", undef); # Remove
Same as frame_select(), frame_have(), frame_list(), but take one string
argument instead of $fname, $descrs, $languages. The argument should
be of the form
NAME(langs)[descr]
Both C<(langs)> and C<[descr]> parts may be omitted; I<langs> should
contain comma-separated list of needed languages; no protection by
backslashes is needed in I<descr>. frame_select_by_descr() will
return a hash if C<(lang)> is omited, but the frame has a language
field; likewise for C<[descr]>; see below for alternatives.
Remember that when frame_select_by_descr() is used for modification,
B<ALL> found frames are deleted before a new one is added.
(By the way: consider using the method select_id3v2_frame_by_descr() on the
"parent" MP3::Tag object instead; see L<MP3::Tag/select_id3v2_frame_by_descr>.)
=item frame_select_by_descr_simple()
Same as frame_select_by_descr(), but if no language is given, will not
consider the frame as "complicated" frame even if it contains a
language field.
=item frame_select_by_descr_simpler()
Same as frame_select_by_descr_simple(), but if no C<Description> is
given, will not consider the frame as "complicated" frame even if it
contains a C<Description> field.
=cut
sub frame_have {
my $self = shift;
scalar $self->_frame_select(0, @_);
}
sub frames_list {
my $self = shift;
$self->_frame_select(0, @_);
}
sub _frame_select_by_descr {
my ($self, $what, $d) = (shift, shift, shift);
my($l, $descr) = ('');
if ( $d =~ s/^(\w{4})(?:\(([^()]*(?:\([^()]+\)[^()]*)*)\))?(?:\[(.*)\])?$/$1/ ) {
$l = defined $2 ? [split /,/, $2, -1] : ($what > 1 && !@_ ? '' : undef);
# Use special case in _frame_select:
$descr = defined $3 ? $3 : ($what > 2 && !@_ ? {} : undef);
# $descr =~ s/\\([\\\[\]])/$1/g if defined $descr;
}
return $self->_frame_select($what, $d, $descr, $l, @_);
}
sub frame_have_by_descr {
my $self = shift;
scalar $self->_frame_select_by_descr(0, @_);
}
sub frame_list_by_descr {
my $self = shift;
$self->_frame_select_by_descr(0, @_);
}
sub frame_select_by_descr {
my $self = shift;
$self->_frame_select_by_descr(1, @_);
}
sub frame_select_by_descr_simple {
my $self = shift;
$self->_frame_select_by_descr(2, @_); # 2 ==> prefer $languages eq ''...
}
sub frame_select_by_descr_simpler {
my $self = shift;
$self->_frame_select_by_descr(3, @_); # 2 ==> prefer $languages eq ''...
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
}
sub album_have {
my $self = shift;
return 1 if $self->frame_have('TALB');
return if grep $_ eq 'TIT1', $self->v2title_order;
return $self->frame_have('TIT1');
}
=item genre( [ $new_genre ] )
Returns the genre string from TCON frame of the tag.
Sets TCON frame if given the optional arguments @new_genre. If this is an
empty string, the frame is removed.
=cut
sub genre {
my $self = shift;
if (@_) {
$self->remove_frame('TCON') if defined $self->get_frame( "TCON");
return if @_ == 1 and $_[0] eq '';
return $self->add_frame('TCON', @_); # XXX add genreID 0x00 ?
}
my $g = $self->get_frame('TCON');
return unless defined $g;
$g =~ s/^\d+\0(?:.)//s; # XXX Shouldn't this be done in TCON()?
$g;
}
sub genre_have {
my $self = shift;
$self->frame_have('TCON')
}
=item version()
$version = $id3v2->version();
($major, $revision) = $id3v2->version();
Returns the version of the ID3v2 tag. It returns a formatted string
like "3.0" or an array containing the major part (eg. 3) and revision
part (eg. 0) of the version number.
=cut
sub version {
my ($self) = @_;
if (wantarray) {
return ($self->{major}, $self->{revision});
} else {
return $self->{version};
}
}
=item new()
$tag = new($mp3fileobj);
C<new()> needs as parameter a mp3fileobj, as created by C<MP3::Tag::File>.
C<new> tries to find a ID3v2 tag in the mp3fileobj. If it does not find a
tag it returns undef. Otherwise it reads the tag header, as well as an
extended header, if available. It reads the rest of the tag in a
buffer, does unsynchronizing if necessary, and returns a
ID3v2-object. At this moment only ID3v2.3 is supported. Any extended
header with CRC data is ignored, so no CRC check is done at the
moment. The ID3v2-object can be used to extract information from
the tag.
Please use
$mp3 = MP3::Tag->new($filename);
$mp3->get_tags(); ## to find an existing tag, or
$id3v2 = $mp3->new_tag("ID3v2"); ## to create a new tag
instead of using this function directly
=cut
sub new {
my ($class, $mp3obj, $create, $r_header) = @_;
my $self={mp3=>$mp3obj};
my $header=0;
bless $self, $class;
if (defined $mp3obj) { # Not fake
$mp3obj->open or return unless $mp3obj->is_open;
$mp3obj->seek(0,0);
$mp3obj->read(\$header, 10);
$$r_header = $header if $r_header and 10 == length $header;
}
$self->{frame_start}=0;
# default ID3v2 version
$self->{major}=3;
$self->{frame_major}=3; # major for new frames
$self->{revision}=0;
$self->{version}= "$self->{major}.$self->{revision}";
if (defined $mp3obj and $self->read_header($header)) {
if ($create) {
$self->{tag_data} = '';
$self->{data_size} = 0;
} else {
# sanity check:
my $s = $mp3obj->size;
my $s1 = $self->{tagsize} + $self->{footer_size};
if (defined $s and $s - 10 < $s1) {
warn "Ridiculously large tag size: $s1; file size $s";
return;
}
$mp3obj->read(\$self->{tag_data}, $s1);
$self->{data_size} = $self->{tagsize};
$self->{raw_data} = $header . $self->{tag_data};
# un-unsynchronize comes in all versions first
if ($self->{flags}->{unsync}) {
my $hits = $self->{tag_data} =~ s/\xFF\x00/\xFF/gs;
$self->{data_size} -= $hits;
}
# in v2.2.x complete tag may be compressed, but compression isn't
# described in tag specification, so get out if compression is found
if ($self->{flags}->{compress_all}) {
# can we test if it is simple zlib compression and use this?
warn "ID3v".$self->{version}." [whole tag] compression isn't supported. Cannot read tag\n";
return undef;
}
# read the ext header if it exists
if ($self->{flags}->{extheader}) {
$self->{extheader} = substr ($self->{tag_data}, 0, 14);
unless ($self->read_ext_header()) {
return undef; # ext header not supported
}
}
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
"A bright coloured fish", "Illustration", "Band/artist logotype",
"Publisher/Studio logotype");
my $how = shift;
if (defined $how) { # called by what_data
die unless $how eq 1 and $byte eq 1;
my $c=0;
my %ret = map {$_, chr($c++)} @pictypes;
return \%ret;
}
# called by extract_data
return "Unknown... Error?" if $index > $#pictypes;
return $pictypes[$index];
}
sub COMR { # MAX about 9
my $data = shift;
my $number = unpack ("C", $data);
my @receivedas = ("Other","Standard CD album with other songs",
"Compressed audio on CD","File over the Internet",
"Stream over the Internet","As note sheets",
"As note sheets in a book with other sheets",
"Music on other media","Non-musical merchandise");
my $how = shift;
if (defined $how) {
die unless $how eq 1 and $data eq 1;
my $c=0;
my %ret = map {$_, chr($c++)} @receivedas;
return \%ret;
}
return $number if ($number>8);
return $receivedas[$number];
}
sub PIC {
# ID3v2.2 stores only 3 character Image format for pictures
# and not mime type: Convert image format to mime type
my $data = shift;
my $how = shift;
if (defined $how) { # called by what_data
die unless $how eq 1 and $data eq 1;
my %ret={};
return \%ret;
}
# called by extract_data
if ($data eq "-->") {
warn "ID3v2.2 PIC frame with link not supported\n";
$data = "text/plain";
} else {
$data = "image/".(lc $data);
}
return $data;
}
sub TCON {
my $data = shift;
my $how = shift;
if (defined $how) { # called by what_data
die unless $how eq 1 and $data eq 1;
my $c=0;
my %ret = map {$_, "(".$c++.")"} @{MP3::Tag::ID3v1::genres()};
$ret{"_FREE"}=1;
$ret{Remix}='(RX)';
$ret{Cover}="(CR)";
return \%ret;
} # called by extract_data
join ' / ', MP3::Tag::Implemenation::_massage_genres($data);
}
sub TCON_back {
my $data = shift;
$data = join ' / ', map MP3::Tag::Implemenation::_massage_genres($_, 'prefer_num'),
split ' / ', $data;
$data =~ s[(?:(?<=\(\d\))|(?<=\(\d\d\d\))|(?<=\((?:RX|CV|\d\d)\))) / ][]ig;
$data =~ s[ / (?=\((?:RX|CV|\d{1,3})\))][]ig;
$data;
}
sub TFLT {
my $text = shift;
my $how = shift;
if (defined $how) { # called by what_data
die unless $how eq 1 and $text eq 1;
my %ret=("MPEG Audio"=>"MPG",
"MPEG Audio MPEG 1/2 layer I"=>"MPG /1",
"MPEG Audio MPEG 1/2 layer II"=>"MPG /2",
"MPEG Audio MPEG 1/2 layer III"=>"MPG /3",
"MPEG Audio MPEG 2.5"=>"MPG /2.5",
"Transform-domain Weighted Interleave Vector Quantization"=>"VQF",
"Pulse Code Modulated Audio"=>"PCM",
"Advanced audio compression"=>"AAC",
"_FREE"=>1,
);
return \%ret;
}
#called by extract_data
return "" if $text eq "";
$text =~ s/MPG/MPEG Audio/;
$text =~ s/VQF/Transform-domain Weighted Interleave Vector Quantization/;
$text =~ s/PCM/Pulse Code Modulated Audio/;
$text =~ s/AAC/Advanced audio compression/;
unless ($text =~ s!/1!MPEG 1/2 layer I!) {
unless ($text =~ s!/2!MPEG 1/2 layer II!) {
unless ($text =~ s!/3!MPEG 1/2 layer III!) {
$text =~ s!/2\.5!MPEG 2.5!;
}
}
}
return $text;
}
sub TMED {
#called by extract_data
my $text = shift;
return "" if $text eq "";
if ($text =~ /(?<!\() \( ([\w\/]*) \) /x) {
my $found = $1;
if ($found =~ s!DIG!Other digital Media! ||
$found =~ /DAT/ ||
$found =~ /DCC/ ||
$found =~ /DVD/ ||
$found =~ s!MD!MiniDisc! ||
$found =~ s!LD!Laserdisc!) {
$found =~ s!/A!, Analog Transfer from Audio!;
}
elsif ($found =~ /CD/) {
$found =~ s!/DD!, DDD!;
$found =~ s!/AD!, ADD!;
$found =~ s!/AA!, AAD!;
}
elsif ($found =~ s!ANA!Other analog Media!) {
$found =~ s!/WAC!, Wax cylinder!;
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
WOAR => "Official artist/performer webpage",
WOAS => "Official audio source webpage",
WORS => "Official internet radio station homepage",
WPAY => "Payment",
WPUB => "Publishers official webpage",
WXXX => "User defined URL link frame",
# ID3v2.2 frames which cannot linked directly to a ID3v2.3 frame
CRM => "Encrypted meta frame",
PIC => "Attached picture",
LNK => "Linked information",
);
# these fields have restricted input (FRAMEfield)
%res_inp=( "APICPicture Type" => \&APIC,
"TCONText" => \&TCON, # Actually, has func_back()...
"TFLTText" => \&TFLT,
"COMRReceived as" => \&COMR,
);
# have small_max
%is_small_int = ("APICPicture Type" => 1, "COMRReceived as" => 1);
for my $k (keys %res_inp) {
my %h = %{ $field_map{$k} = $res_inp{$k}->(1,1) }; # Assign+make copy
delete $h{_FREE};
%h = reverse %h;
$field_map_back{$k} = \%h;
}
# Watch for 'lable':
$field_map{'APICPicture Type'}{'Media (e.g. lable side of CD)'} =
$field_map{'APICPicture Type'}{'Media (e.g. label side of CD)'};
%back_splt = qw(POPM 1); # Have numbers at end
%embedded_Descr = qw(GEOD 1 COMR 1); # Have descr which is not leading
}
=pod
=back
=head1 BUGS
Writing C<v2.4>-layout tags is not supported.
Additionally, one should keep in mind that C<v2.3> and C<v2.4> have differences
in two areas:
=over 4
=item *
layout of information in the byte stream (in other words, in a file
considered as a string) is different;
=item *
semantic of frames is extended in C<v2.4> - more frames are defined, and
more frame flags are defined too.
=back
MP3::Tag does not even try to I<write> frames in C<v2.4>-layout. However,
when I<reading> the frames, MP3::Tag does not assume any restriction on
the semantic of frames - it allows all the semantical extensions
defined in C<v2.4> even for C<v2.3> (and, probably, for C<v2.2>) layout.
C<[*]> (I expect, any sane program would do the same...)
Likewise, when writing frames, there is no restriction imposed on semantic.
If user specifies a frame the meaning of which is defined only in C<v2.4>,
we would happily write it even when we use C<v2.3> layout. Same for frame
flags. (And given the assumption C<[*]>, this is a correct thing to do...)
=head1 SEE ALSO
L<MP3::Tag>, L<MP3::Tag::ID3v1>, L<MP3::Tag::ID3v2_Data>
ID3v2 standard - http://www.id3.org
L<http://www.id3.org/id3v2-00>, L<http://www.id3.org/d3v2.3.0>,
L<http://www.id3.org/id3v2.4.0-structure>,
L<http://www.id3.org/id3v2.4.0-frames>,
L<http://id3lib.sourceforge.net/id3/id3v2.4.0-changes.txt>.
=head1 COPYRIGHT
Copyright (c) 2000-2008 Thomas Geffert, Ilya Zakharevich. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the terms of the Artistic License, distributed
with Perl.
=cut
1;
( run in 0.475 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )