MP3-Tag
view release on metacpan or search on metacpan
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
=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...
my $use_utf16le = $ENV{MP3TAG_USE_UTF_16LE};
@enc_types = @dec_types unless $use_utf16le;
sub _add_frame {
my ($self, $split, $fname, @data) = @_;
$self->get_frame_ids() unless exists $self->{frameIDs};
my $format = get_format($fname);
return undef unless defined $format;
#prepare the data
my $args = @$format; my $opt = 0;
unless (@data) {
@data = map {''} @$format;
}
my($encoding, $calc_enc, $e, $e_add) = (0,0); # Need to calculate encoding?
# @data may be smaller than @args due to missing encoding, or due
# to optional arguments. Both may be applicable for COMR frames.
if (@data < $args) {
$_->{optional} and $opt++ for @$format;
$e_add++, unshift @data, undef # Encoding skipped
if (@data == $args - 1 - $opt or $split and @data <= $args - 1 - $opt)
and $format->[0]->{name} eq '_encoding';
if ($opt) { # encoding is present only for COMR, require it
die "Data for `encoding' should be between 0 and 3"
if $format->[0]->{name} eq "_encoding"
and defined $data[0] and not $data[0] =~ /^[0-3]?$/;
}
}
if ($split and @data < $args) {
if ($back_splt{$fname}) {
my $c = $args - @data;
my $last = pop @data;
my $rx = ($tail_rex[$c] ||= qr/((?:;[^;]*){0,$c})\z/);
my($tail) = ($last =~ /$rx/); # Will always match
push @data, substr $last, 0, length($last)-length($tail);
if ($tail =~ s/^;//) { # matched >= 1 times
push @data, split ';', $tail;
}
} else {
my $last = pop @data;
push @data, split /;/, $last, $args - @data;
}
# Allow for explicit specification of encoding
shift @data if @data == $args + 1 and not defined $data[0]
and $format->[0]->{name} eq '_encoding'; # Was auto-put there
}
die "Unexpected number of fields: ".@data.", expect $args, optional=$opt"
unless @data <= $args and @data >= $args - $opt;
if ($format->[0]->{name} eq "_encoding" and not defined $data[0]) {
$calc_enc = 1;
shift @data;
}
my ($datastring, $have_high) = "";
if ($calc_enc) {
my @d = @data;
foreach my $fs (@$format) {
$have_high = 1 if $fs->{encoded} and $d[0] and $d[0] =~ /[^\x00-\xff]/;
shift @d unless $fs->{name} eq "_encoding";
}
}
foreach my $fs (@$format) {
next if $fs->{optional} and not @data;
if ($fs->{name} eq "_encoding") {
if ($calc_enc) {
$encoding = ($have_high ? 1 : 0); # v2.3 only has 0, 1
} else {
$encoding = shift @data;
}
$datastring .= chr($encoding);
next;
}
my $d = shift @data;
if ($fs->{isnum}) {
## store data as number
my $num = int($d);
$d="";
while ($num) { $d=pack("C",$num % 256) . $d; $num = int($num/256);}
if ( exists $fs->{len} and $fs->{len}>0 ) {
$d = substr $d, -$fs->{len};
$d = ("\x00" x ($fs->{len}-length($d))) . $d if length($d) < $fs->{len};
}
if ( exists $fs->{mlen} and $fs->{mlen}>0 ) {
$d = ("\x00" x ($fs->{mlen}-length($d))) . $d if length($d) < $fs->{mlen};
}
} elsif ( exists $fs->{len} and not exists $fs->{func}) {
if ($fs->{len}>0) {
$d = substr $d, 0, $fs->{len};
$d .= " " x ($fs->{len}-length($d)) if length($d) < $fs->{len};
} elsif ($fs->{len}==0) {
$d .= chr(0);
}
} elsif (exists $fs->{mlen} and $fs->{mlen}>0) {
$d .= " " x ($fs->{mlen}-length($d)) if length($d) < $fs->{mlen};
}
if (exists $fs->{re2b}) {
while (my ($pat, $rep) = each %{$fs->{re2b}}) {
$d =~ s/$pat/$rep/gis;
}
}
if (exists $fs->{func_back}) {
$d = $fs->{func_back}->($d);
} elsif (exists $fs->{func}) {
if ($fs->{small_max}) { # Allow the old way (byte) and a number
# No conflict possible: byte is always smaller than ord '0'
$d = pack 'C', $d if $d =~ /^\d+$/;
}
$d = $self->__format_field($fname, $fs->{name}, $d)
}
if ($fs->{encoded}) {
if ($encoding) {
# 0 = latin1 (effectively: unknown)
# 1 = UTF-16 with BOM (we write UTF-16le to cowtow to M$'s bugs)
# 2 = UTF-16be, no BOM
# 3 = UTF-8
require Encode;
if ($calc_enc or $encode_utf8) { # e_u8==1 by default
$d = Encode::encode($enc_types[$encoding], $d);
} elsif ($encoding < 3) {
# Reencode from UTF-8
$d = Encode::decode('UTF-8', $d);
$d = Encode::encode($enc_types[$encoding], $d);
}
$d = "\xFF\xFE$d" if $use_utf16le and $encoding == 1;
} elsif (not $self->{fixed_encoding} # Now $encoding == 0...
and $self->get_config1('id3v2_fix_encoding_on_edit')
and $e = $self->botched_encoding()
and do { require Encode; Encode::decode($e, $d) ne $d }) {
# If the current string is interpreted differently
# with botched_encoding, need to unbotch...
$self->fix_frames_encoding();
}
}
$datastring .= $d;
}
return add_raw_frame($self, $fname, $datastring);
}
sub add_frame {
my $self = shift;
_add_frame($self, 0, @_)
}
sub add_frame_split {
my $self = shift;
_add_frame($self, 1, @_)
}
sub add_raw_frame ($$$$) {
my($self, $fname, $datastring, $flags) = (shift,shift,shift,shift);
#add frame to tag
if (exists $self->{frames}->{$fname}) {
my ($c, $ID) = (1, $fname);
$fname .= '01';
while (exists $self->{frames}->{$fname}) {
$fname++, $c++;
}
++$self->{extra_frames}->{$ID}
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);
lib/MP3/Tag/ID3v2.pm view on Meta::CPAN
sub read_ext_header { # XXXX in 2.3, it should be unsyncronized
my $self = shift;
my $ext_header = $self->{extheader};
# flags, padding and crc ignored at this time
my $size;
if ($self->{major}==4) {
$size = un_syncsafe_4bytes substr $ext_header, 0, 4;
} else { # 4 bytes extra for the size field itself
$size = 4 + unpack("N", $ext_header);
}
$self->{frame_start} += $size;
return 1;
}
sub extract_data { # Main sub for getting data from a frame
my ($self, $data, $format, $noDecode, $arr) = @_;
my ($rule, $found,$encoding, @result, $e);
$encoding=0;
$arr ||= 0; # 1: values only; 2: return array
foreach $rule (@$format) {
next if exists $rule->{v3name};
last if $rule->{optional} and not length $data;
# get the data
if ( exists $rule->{mlen} ) { # minlength, data is string
($found, $data) = ($data, ""); # Never with encoding
} elsif ( $rule->{len} == 0 ) { # Till \0
if (exists $rule->{encoded} && ($encoding =~ /^[12]$/)) {
($found, $data) = ($data =~ /^((?:..)*?)(?:\0\0(.*)|\z)/s);
} else {
($found, $data) = split /\x00/, $data, 2;
}
} elsif ($rule->{len} == -1) { # Till end
($found, $data) = ($data, "");
} else {
$found = substr $data, 0,$rule->{len};
substr ($data, 0,$rule->{len}) = '';
}
# was data found?
unless (defined $found && $found ne "") {
$found = "";
$found = $rule->{default} if exists $rule->{default};
}
# work with data
if ($rule->{name} eq "_encoding") {
$encoding=unpack ("C", $found);
push @result, 'encoding' unless $arr == 1;
push @result, $encoding;
} else {
if (exists $rule->{encoded}) { # decode data
if ( $encoding > 3 ) {
warn "Encoding type '$encoding' not supported: found in $rule->{name}\n";
next;
} elsif ($encoding and not $trustencoding) {
warn "UTF encoding types disabled via MP3TAG_DECODE_UNICODE): found in $rule->{name}\n";
next;
} elsif ($encoding) {
# 0 = latin1 (effectively: unknown)
# 1 = UTF-16 with BOM
# 2 = UTF-16be, no BOM
# 3 = UTF-8
require Encode;
if ($decode_utf8) {
$found = Encode::decode($dec_types[$encoding],
$found);
} elsif ($encoding < 3) {
# Reencode in UTF-8
$found = Encode::decode($dec_types[$encoding],
$found);
$found = Encode::encode('UTF-8', $found);
}
} elsif (not $noDecode and $e = $self->botched_encoding) {
require Encode;
$found = Encode::decode( $e, $found );
}
}
$found = toNumber($found) if $rule->{isnum};
unless ($arr) {
$found = $rule->{func}->($found) if exists $rule->{func};
unless (exists $rule->{data} || !defined $found) {
$found =~ s/[\x00]+$//; # some progs pad text fields with \x00
$found =~ s![\x00]! / !g; # some progs use \x00 inside a text string to seperate text strings
$found =~ s/ +$//; # no trailing spaces after the text
}
if (exists $rule->{re2}) {
while (my ($pat, $rep) = each %{$rule->{re2}}) {
$found =~ s/$pat/$rep/gis;
}
}
}
# store data
push @result, $rule->{name} unless $arr == 1;
push @result, $found;
}
}
return {@result} unless $arr;
return \@result;
}
sub botched_encoding ($) {
my($self) = @_;
return if $self->{fixed_encoding};
return unless my $enc = $self->get_config1('decode_encoding_v2');
# Don't recourse into TXXX[*] (inside-[] is encoded,
# and frame_select() reads ALL TXXX frames...)
local $self->{fixed_encoding} = 1;
return unless $self->get_config1('ignore_trusted_encoding0_v2')
or not $self->frame_select('TXXX', 'trusted_encoding0_v2');
$enc;
}
# Make editing in presence of decode_encoding_v2 more predictable:
sub frames_need_fix_encoding ($) {
my($self) = @_;
return unless $self->botched_encoding;
my($fname, $rule, %fix);
( run in 0.507 second using v1.01-cache-2.11-cpan-39bf76dae61 )