Package: libmp3-tag-perl
Version: 1.13-1.1
Severity: normal
Tags: patch pending
Dear maintainer,
I've prepared an NMU for libmp3-tag-perl (versioned as 1.14-1)
Regards.
diff -Nru libmp3-tag-perl-1.13/Changes libmp3-tag-perl-1.14/Changes
--- libmp3-tag-perl-1.13/Changes 2010-07-13 13:37:26.000000000 +1000
+++ libmp3-tag-perl-1.14/Changes 2016-09-17 16:50:09.000000000 +1000
@@ -1,3 +1,27 @@
+Release Name: 1.14
+====================
+
+Tag.pm: Quiet warnings from 5.22.
+ Start implementing handlers: instead of FRAM(langs)[opts], one can use, e.g., func_name(ID3v1,Cue)[arg1][arg2]
+ # ID3v2::_frame_select_by_descr is missing //s
+ New configuration variable ampersand_joiner (default '; ').
+ New method _auto_field_from() (abstracted from _auto_field()).
+ Change logic of calling ->can() in _auto_field_from().
+ _parse_rex_microinterpolate() would not update $ecount on seeing %%.
+ When parsing with %=c etc: with %==c the match fails if there is no comment.
+ (Checked the same way as for %{c:}.)
+ Support some of %-escapes not being matched (e.g, due to alternatives in a REx).
+ (0-length matches were ignored anyway [when join()ing].)
+ parse_rex(), parse_rex_match() may return an extra result (if %{handler}s are present).
+ Recognize ID3v2 frame names as [A-Z]{3}[A-Z\d] (was \w{4}).
+ (Detection frame/vs/handler happens via PACKAGES; so if lang codes inf/cue appear, we may be in trouble.)
+ Use the same code in parse(_rex)?_prepare. (Now parse() allows the same %-constructs as parse_rex().)
+ID3v2.pm:
+ New method have_one_of_frames().
+ New methods *_have() (for simplest fields: title, comment, track, artist, album, genre, year).
+ImageExifTool.pm:
+ Comprehensive docs.
+
Release Name: 1.13
====================
diff -Nru libmp3-tag-perl-1.13/debian/changelog libmp3-tag-perl-1.14/debian/changelog
--- libmp3-tag-perl-1.13/debian/changelog 2017-07-13 05:25:22.000000000 +1000
+++ libmp3-tag-perl-1.14/debian/changelog 2018-07-02 16:57:02.000000000 +1000
@@ -1,3 +1,9 @@
+libmp3-tag-perl (1.14-1) UNRELEASED; urgency=medium
+
+ * New upstream release
+
+ -- jason <[email protected]> Mon, 02 Jul 2018 16:57:02 +1000
+
libmp3-tag-perl (1.13-1.1) unstable; urgency=medium
* Non-maintainer upload.
diff -Nru libmp3-tag-perl-1.13/debian/patches/01_spelling.patch libmp3-tag-perl-1.14/debian/patches/01_spelling.patch
--- libmp3-tag-perl-1.13/debian/patches/01_spelling.patch 2012-02-05 17:46:29.000000000 +1100
+++ libmp3-tag-perl-1.14/debian/patches/01_spelling.patch 2018-07-02 16:57:02.000000000 +1000
@@ -2,11 +2,11 @@
Author: Ian Beckwith <[email protected]>
Last-Update: 2012-020-5
-Index: restore/lib/MP3/Tag.pm
+Index: libmp3-tag-perl-1.14/lib/MP3/Tag.pm
===================================================================
---- restore.orig/lib/MP3/Tag.pm 2012-02-05 03:08:33.000000000 +0000
-+++ restore/lib/MP3/Tag.pm 2012-02-05 03:09:24.000000000 +0000
-@@ -523,7 +523,7 @@
+--- libmp3-tag-perl-1.14.orig/lib/MP3/Tag.pm
++++ libmp3-tag-perl-1.14/lib/MP3/Tag.pm
+@@ -527,7 +527,7 @@ Returns the second part of track number
=item track0()
Same as track1(), but pads with leading 0s to width of track2(); takes an
@@ -15,7 +15,7 @@
=item disk1(), disk2()
-@@ -1784,7 +1784,7 @@
+@@ -1814,7 +1814,7 @@ frames).
Strings C<n1> and C<n2> are replaced by "pure track number" and
"max track number" (this allows for both formats C<N1> and C<N1/N2> of "track",
the latter meaning track N1 of N2); use C<n0> to pad C<n1> with leading 0
@@ -24,7 +24,7 @@
but with disk (media) number instead of track number; use C<mA> to encode
C<m1> as a letter (see L<disk_alphanum()>).
-@@ -3337,7 +3337,7 @@
+@@ -3473,7 +3473,7 @@ method.
The customization modules have an opportunity to change global
configuration variables on load. To allow more flexibility, they may
diff -Nru libmp3-tag-perl-1.13/debian/patches/series libmp3-tag-perl-1.14/debian/patches/series
--- libmp3-tag-perl-1.13/debian/patches/series 2017-07-13 05:22:53.000000000 +1000
+++ libmp3-tag-perl-1.14/debian/patches/series 2018-07-02 16:57:02.000000000 +1000
@@ -1,2 +1 @@
01_spelling.patch
-02_fix_escape.patch
diff -Nru libmp3-tag-perl-1.13/lib/MP3/Tag/ID3v2.pm libmp3-tag-perl-1.14/lib/MP3/Tag/ID3v2.pm
--- libmp3-tag-perl-1.13/lib/MP3/Tag/ID3v2.pm 2010-01-03 04:12:40.000000000 +1100
+++ libmp3-tag-perl-1.14/lib/MP3/Tag/ID3v2.pm 2016-09-28 19:43:14.000000000 +1000
@@ -15,7 +15,7 @@
%back_splt %embedded_Descr
/;
-$VERSION = "1.12";
+$VERSION = "1.14";
@ISA = 'MP3::Tag::__hasparent';
my $trustencoding = $ENV{MP3TAG_DECODE_UNICODE};
@@ -1398,6 +1398,16 @@
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
@@ -1406,8 +1416,8 @@
=cut
-sub _comment {
- my $self = shift;
+sub __comment {
+ my($self, $check_have) = (shift, shift);
my $language;
$language = lc shift if @_;
my @info = get_frames($self, "COMM");
@@ -1417,10 +1427,20 @@
next unless exists $comment->{Description} and not length $comment->{Description};
next if defined $language and (not exists $comment->{Language}
or lc $comment->{Language} ne $language);
- return $comment->{Text};
+ return $check_have ? 1 : $comment->{Text} ;
}
return if grep $_ eq 'TIT3', $self->v2title_order;
- return scalar $self->get_frame("TIT3");
+ return $check_have ? $self->frame_have("TIT3") : scalar $self->get_frame("TIT3");
+}
+
+sub _comment {
+ my $self = shift;
+ $self->__comment(!'only_check', @_);
+}
+
+sub comment_have {
+ my $self = shift;
+ $self->__comment('only_check', @_);
}
=item comment()
@@ -1857,6 +1877,11 @@
return $y;
}
+sub year_have {
+ my $self = shift;
+ $self->have_one_of_frames(qw( TDRC TYER ))
+}
+
=pod
=item track( [$new_track] )
@@ -1878,6 +1903,11 @@
return scalar $self->get_frame("TRCK");
}
+sub track_have {
+ my $self = shift;
+ $self->frame_have('TRCK')
+}
+
=pod
=item artist( [ $new_artist ] )
@@ -1911,6 +1941,11 @@
return;
}
+sub artist_have {
+ my $self = shift;
+ $self->have_one_of_frames(qw( TPE1 TPE2 TCOM TPE3 TEXT ))
+}
+
=pod
=item album( [ $new_album ] )
@@ -1937,6 +1972,13 @@
return scalar $self->get_frame("TIT1");
}
+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.
@@ -1959,6 +2001,11 @@
$g;
}
+sub genre_have {
+ my $self = shift;
+ $self->frame_have('TCON')
+}
+
=item version()
$version = $id3v2->version();
diff -Nru libmp3-tag-perl-1.13/lib/MP3/Tag/ImageExifTool.pm libmp3-tag-perl-1.14/lib/MP3/Tag/ImageExifTool.pm
--- libmp3-tag-perl-1.13/lib/MP3/Tag/ImageExifTool.pm 2009-05-11 14:44:58.000000000 +1000
+++ libmp3-tag-perl-1.14/lib/MP3/Tag/ImageExifTool.pm 2016-09-28 19:43:34.000000000 +1000
@@ -5,14 +5,14 @@
#use File::Spec;
use vars qw /$VERSION @ISA/;
-$VERSION="0.01";
+$VERSION="1.14";
@ISA = 'MP3::Tag::__hasparent';
=pod
=head1 NAME
-MP3::Tag::ImageExifTool - extract size info from image files via L<Image::Size|Image::Size>.
+MP3::Tag::ImageExifTool - extract size info from image files via L<Image::ExifTool|Image::ExifTool>.
=head1 SYNOPSIS
@@ -24,9 +24,12 @@
MP3::Tag::ImageExifTool is designed to be called from the MP3::Tag module.
-It implements width(), height() and mime_type() methods (sizes in pixels).
+It implements the (standard) methods qw(title track artist album year genre comment),
+as well as width(), height(), bit_depth(), _duration() and mime_type() methods (sizes in pixels).
-They return C<undef> if C<Image::Size> is not available, or does not return valid data.
+Use method C<field('FieldName')> to access a particular field provided by C<Image::ExifTool>.
+
+These methods return C<undef> if C<Image::ExifTool> is not available, or does not return valid data.
=cut
diff -Nru libmp3-tag-perl-1.13/lib/MP3/Tag.pm libmp3-tag-perl-1.14/lib/MP3/Tag.pm
--- libmp3-tag-perl-1.13/lib/MP3/Tag.pm 2010-07-14 00:10:38.000000000 +1000
+++ libmp3-tag-perl-1.14/lib/MP3/Tag.pm 2016-09-28 19:42:55.000000000 +1000
@@ -27,6 +27,7 @@
return $self->{parent}->get_config(@_);
}
*get_config1 = \&MP3::Tag::Implemenation::get_config1;
+ *get_config1 = 0 if 0; # quiet a warning
}
use MP3::Tag::ID3v1;
@@ -41,7 +42,7 @@
use MP3::Tag::LastResort;
use vars qw/$VERSION @ISA/;
-$VERSION="1.13";
+$VERSION="1.14";
@ISA = qw( MP3::Tag::User MP3::Tag::Site MP3::Tag::Vendor
MP3::Tag::Implemenation ); # Make overridable
*config = \%MP3::Tag::Implemenation::config;
@@ -89,6 +90,7 @@
# ExifTool says: ID3 may be in MP3/MPEG/AIFF/OGG/FLAC/APE/RealAudio (MPC).
writable_extensions => [qw(mp3 mp2 id3 tag ogg mpg mpeg
mp4 aiff flac ape ram mpc)],
+ ampersand_joiner => ['; '],
);
{
my %e;
@@ -307,6 +309,7 @@
# keep old name for a while
*getTags = \&get_tags;
+*getTags = 0 if 0; # quiet a warning
=item new_fake
@@ -360,6 +363,7 @@
# keep old name for a while
*newTag = \&new_tag;
+*newTag = 0 if 0; # quiet a warning
#only as a shortcut to {filename}->close to explicitly close a file
@@ -590,24 +594,50 @@
my %ignore_0length = qw(ID3v1 1 CDDB_File 1 Inf 1 Cue 1 ImageSize 1 ImageExifTool 1);
-sub auto_field($;$) {
- my ($self, $elt, $from) = (shift, shift, shift);
+sub _auto_field_from($$$;$$$$) {
+ my ($self, $check_only, $packs, $rwhat, $ret_from, $args, $all) = (shift, shift, shift, shift, shift, shift || [], shift);
+ my @what = ref $rwhat ? @$rwhat : $rwhat;
+ my @out;
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN};
- my $parts = $self->get_config($elt) || $self->get_config('autoinfo');
$self->get_tags;
- my $do_can = ($elt =~ /^(cd\w+_id|height|width|bit_depth|mime_type|img_type|_duration)$/);
- foreach my $part (@$parts) {
- next unless exists $self->{$part};
- next if $do_can and not $self->{$part}->can($elt);
- next unless defined (my $out = $self->{$part}->$elt());
- # Ignore 0-length answers from ID3v1, ImageExifTool, CDDB_File, Cue, ImageSize, and Inf
- next if not length $out and $ignore_0length{$part}; # These return ''
- return [$out, $part] if $from;
+ # ID3v1 has AUTOLOAD
+# my $do_can = ($what =~ /^(cd\w+_id|height|width|bit_depth|mime_type|img_type|_duration)$/);
+ foreach my $pack (@$packs) {
+ next unless exists $self->{$pack};
+ my $do_can = $pack ne 'ID3v1';
+ my $out;
+ for my $what (@what) {
+ next if $pack eq 'ID3v1' and not $MP3::Tag::ID3v1::ok_length{$what}; # dup of a warning in AUTOLOAD
+ next if $do_can and not $self->{$pack}->can($what);
+ if ($check_only and $self->{$pack}->can(my $m = $what . '_have')) {
+ next unless $self->{$pack}->$m(@$args);
+ return $ret_from ? [1, $pack] : 1;
+ }
+ next unless defined ($out = $self->{$pack}->$what(@$args));
+ # Ignore 0-length answers from ID3v1, ImageExifTool, CDDB_File, Cue, ImageSize, and Inf
+ undef $out, next if not length $out and $ignore_0length{$pack}; # These return ''
+ }
+ next unless defined $out;
+ $out = 1 if $check_only;
+ if ($all) { # Currently, @out is not used by our callers
+ push @out, ($ret_from ? [$out, $pack] : $out);
+ next;
+ }
+ return [$out, $pack] if $ret_from;
return $out;
}
- return '';
+ return @out if $all;
+ return;
+}
+
+sub auto_field($;$$) {
+ my ($self, $what, $ret_from) = (shift, shift, shift);
+ my $packs = $self->get_config($what) || $self->get_config('autoinfo');
+ my $o = $self->_auto_field_from(!'check_only', $packs, $what, $ret_from);
+ return '' unless defined $o;
+ $o;
}
for my $elt ( qw( title track artist album comment year genre ) ) {
@@ -1182,7 +1212,7 @@
decode_encoding_filename decode_encoding_files
decode_encoding_inf decode_encoding_cddb_file
name_for_field_normalization is_writable writable_extensions
- id3v2_frames_autofill local_cfg_file);
+ id3v2_frames_autofill local_cfg_file ampersand_joiner);
my @tr = map "translate_$_", qw( title track artist album comment
year genre comment_collection
comment_track title_track
@@ -1797,7 +1827,7 @@
=item *
-Strings of the form C<FRAM(list,of,languages)[description]'> are
+Strings of the form C<FRAM(list,of,languages)[description]> are
replaced by the first FRAM frame with the descriptor "description" in
the specified comma-separated list of languages. Instead of a
language (ID3v2 uses lowercase 3-char ISO-639-2 language notations) one can use
@@ -1815,15 +1845,29 @@
=item *
Several descriptors of the form
-C<FRAM(list,of,languages)[description]'> discussed above may be
+C<FRAM(list,of,languages)[description]> discussed above may be
combined together with C<&>; the non-empty expansions are joined
-together with C<"; ">. Example:
+together with the value of configuration variable C<ampersand_joiner>
+(default C<"; ">). Example:
%{TXXX[pre-title]&TIT1&TIT2&TIT3&TXXX[post-title]}
=item *
+Strings of the form C<method(list,of,packages)[arg1][arg2]> are replaced
+by the result of C<method> (with the given arguments) in one of the specified
+known subpackages (e.g., for C<Inf>, C<MP3::Tag::Inf> is used). Arbitrary number
+of arguments is supported. Instead of a long name C<method> one can use its
+standard shortcut (e.g., C<t> for C<title>). For example,
+
+ $mp3->interpolate('%{t(ID3v1,Cue)}')
+
+returns the title from the ID3v1 tag, or (if not there) from a cue sheet.
+One can use this in conditionals etc as well.
+
+=item *
+
C<d>I<NUMBER> is replaced by I<NUMBER>-th component of the directory name (with
0 corresponding to the last component).
@@ -1884,7 +1928,7 @@
C<frames> is replaced by space-separated list of "long names" of ID3v2
frames (see id3v2_frame_descriptors()). (To use a different separator,
-put it after slash, as in %{frames/, }, where separator is COMMA
+put it after slash, as in C<%{frames/, }>, where separator is COMMA
SPACE).
=item *
@@ -1981,6 +2025,8 @@
=cut
+# `
+
my %trans = qw( t title
a artist
l album
@@ -2057,8 +2103,22 @@
# %O Original material flag (string)
# %G Musical genre (integer)
-my $frame_bra = # FRAM | FRAM03 | FRAM(lang)[
- qr{\w{4}(?:(?:\d\d)|(?:\([^()]*(?:\([^()]+\)[^()]*)*\))?(?:(\[)|(?=[\}:|&])))}s; # 1 group for begin-descr
+# Made as tags: ParseData ID3v2 ID3v1 ImageExifTool Inf CDDB_File Cue ImageSize LastResort
+my %handlers = map {($_, 1)} qw(
+ CDDB_File File ID3v2 ImageExifTool Inf ParseData
+ Cue ID3v1 ImageSize LastResort
+); # Inf/Cue are not in language list: https://www.loc.gov/standards/iso639-2/php/code_list.php
+
+#$handler_r = qr/$handler_r/;
+#
+#my $frame_bra = # FRAM | FRAM03 | FRAM(lang)[
+# qr{\w{4}(?:(?:\d\d)|(?:\([^()]*(?:\([^()]+\)[^()]*)*\))?(?:(\[)|(?=[\}:|&])))}s; # 1 group for begin-descr
+
+my $at_end_frame_name = qr/(?=[\}:|&])/;
+my $lang_or_handlers_rex = qr/\(([^()]*(?:\([^()]+\)[^()]*)*)\)/;
+my $frame_bra = # FRAM | FRAM03 | FRAM(lang)[ | cmd(PACKAGES) | cmd(PACKAGES)[args]
+ qr{(?:\w{4}(?=\d\d\b|\b)|(?!I\b)\w+(?=\())(?:\d\d|$lang_or_handlers_rex?(?:(\[)|$at_end_frame_name))}s; # 2 groups for descr + bra
+
# used with offset by 1: 2: fill, 3: same, 4: $left, 5..6 width, 7: key
my $pat_rx = qr/^%(?:(?:\((.)\)|([^-.1-9%a-zA-Z]))?(-)?(\d+))?(?:\.(\d+))?([talgcynfFeEABDNvLrqQSmsCpouMHwh{%])/s;
# XXXX Partially repeated below, search for `talgc'??? vLrqQSmsCpouMH miss???
@@ -2067,6 +2127,16 @@
# (a[CR]|tT|c[TC]|[mMS]L|SML|i[DIT]|n[012]|m[A12T]|bD)
# a[CR]|tT|c[TC]|i[DIT]|n[012]|m[A12T]|bD
+sub process_handlers ($$$$;$$) { # only 1 level of parens allowed in flags
+ my ($self, $h, $handlers, $args, $cond, $set) = (shift, shift, shift, shift, shift, shift);
+# die "Conditionals with handlers not supported yet" if $cond;
+ die "Handlers with arguments not supported yet" if @$args;
+ my (@f) = ($h =~ /^(\w+)/) or die "Panic: `$h' as a handler";
+ push @f, $trans{$f[0]} if exists $trans{$f[0]};
+ $set and $_ .= '__set' for @f;
+ $self->_auto_field_from($cond, $handlers, \@f, undef, $args, $set); # if $set, calls a method in all packages where possible
+}
+
# $upto TRUE: parse the part including $upto char
# Very restricted backslashitis: only $upto and \ before $upto-or-end
# $upto defined but FALSE: interpolate only one %-escape.
@@ -2079,8 +2149,8 @@
my $ids;
die "upto=`$upto' not supported" if $upto and $upto ne ']' and $upto ne'}';
die "upto=`$upto' not supported with skip"
- if $upto and not defined $upto and $skip;
- my $cnt = ($upto or not defined $upto) ? -1 : 1; # upto eq '': 1 escape
+ if $upto and not defined $upto and $skip; # XXXX Unreachable???
+ my $cnt = ($upto or not defined $upto) ? -1 : 1; # upto eq '': 1 escape
while ($cnt-- and ($upto # undef and '' use the same code
? ($upto eq ']'
@@ -2115,49 +2185,53 @@
next if $skip;
my $meth = $trans{$1};
$str = $self->$meth();
- } elsif ($what eq '{' and # $frame_bra has 1 group, No. 5
+ } elsif ($what eq '{' and # $frame_bra has 2 groups, No. 5, 6
# 2-char fields as above, except for [mMS]L|SML (XXX: vLrqQSmsCpouMH ???)
$_[1] =~ s/^(!)?(([talgcynfFeEABDNvLrqQSmsCpouMHwh]|ID3v[12]|ID3v2-modified|$longer_f|U\d+)(:|\|\|?)|$frame_bra)//o) {
# Alternation with simple/complicated stuff
- my ($neg, $id, $simple, $delim) = ($1, $2, $3, $4);
- if ($delim) { # Not a frame id...
+ my ($neg, $id, $simple, $delim, $lang_or_packages, $have_bra) = ($1, $2, $3, $4, $5, $6);
+
+ my(@_handlers, @args) = split /,/, ($lang_or_packages || '');
+ my @handlers = grep $handlers{$_}, @_handlers;
+ $delim or $id =~ /^[A-Z]{3}[A-Z\d](\d\d)?\b/ or @handlers and @handlers == @_handlers
+ or die "Cannot parse frame descriptor: <<<$id>>>";
+
+ if ($delim) { # Not a frame/cmd id...
$id = $simple;
- } else { # Frame: maybe trailed by :, |, ||, maybe not
- $id .= ($self->_interpolate($_[1], ']', $skip) . ']') if $5;
+ } else { # Frame/cmd: maybe trailed by :, |, ||, maybe not
+ while (@handlers and $have_bra) {
+ push @args, $self->_interpolate($_[1], ']', $skip);
+ $have_bra = ($_[1] =~ s/^\[//);
+ }
+ $id .= ($self->_interpolate($_[1], ']', $skip) . ']') if $have_bra; # unreachable if handler present!
$_[1] =~ s/^(:|\|\|?)// and $delim = $1;
unless ($delim) {
die "Can't parse negated conditional: I see `$_[1]'" if $neg;
my $nonesuch = 0;
- unless ($self->{ID3v2} or $neg) {
+ unless (@handlers or $self->{ID3v2} or $neg) {
die "No ID3v2 present"
if $self->get_config('id3v2_missing_fatal');
$nonesuch = 1;
}
- if ($_[1] =~ s/^}//) { # frame with optional (lang)/[descr]
- next if $skip or $nonesuch;
- $str = $self->select_id3v2_frame_by_descr($id);
- #$str = $str->{_Data} if $str and ref $str and exists $str->{_Data};
- } elsif ($_[1] =~ /^&/o) {
- # join of frames with optional (language)/[descriptor]
- my @id = $id;
- while ($_[1] =~ s/^&($frame_bra)//o) {
- $id = $1;
- $id .= ($self->_interpolate($_[1], ']', $skip) . ']') if $2;
- next if $skip or $nonesuch;
- push @id, $id;
- }
- die "Can't parse &-list; I see `$_[1]'" unless $_[1] =~ s/^}//;
- next if $skip or $nonesuch;
- my @out;
- for my $in (@id) {
- $in = $self->select_id3v2_frame_by_descr($in);
- #$in = $in->{_Data} if $in and ref $in and exists $in->{_Data};
- push @out, $in if defined $in and length $in;
+ next if ($skip or $nonesuch) and $_[1] =~ s/^\}//;
+ if ($_[1] =~ /^[\}&]/) { # frame with optional (lang)/[descr], or a package-handled descriptor
+ if (@handlers) {
+ $str = $self->process_handlers($id, \@handlers, \@args) unless $skip;
+# $str = '' if not defined $str and $1 eq '&';
+ } else {
+ $str = $self->select_id3v2_frame_by_descr($id);
}
- $str = join '; ', @out;
} else {
die "unknown frame terminator; I see `$_[1]'";
}
+ if ($_[1] =~ s/^&/%\{/) { # join of frames with optional (language)/[descriptor], etc
+ my $rest = $self->_interpolate($_[1], '', $skip);
+ next if $skip;
+ my $joiner = $self->get_config1('ampersand_joiner'); # default '; '
+ $str = join $joiner, map {(defined and length) ? $_ : ()} $str, $rest;
+ } else {
+ $_[1] =~ s/^\}//;
+ }
}
}
if ($delim) { # Conditional
@@ -2176,13 +2250,17 @@
die "ID3v2 or ID3v1 as conditionals incompatible with $alt"
if $alt;
$have = !! $self->{$simple}; # Make logical
- } else {
- $have = $self->have_id3v2_frame_by_descr($id);
- }
- my $skipping = $skip || (not $alt and $1 ? $have : !$have);
+ } elsif (@handlers) {
+# warn "\t!!! Handlers";
+ $have = $self->process_handlers($id, \@handlers, \@args, 'cond');
+ } else {
+ $have = $self->have_id3v2_frame_by_descr($id);
+# warn "\t!!! Cond: <<$id>> <<$have>>";
+ }
+ my $skipping = $skip || (not $alt and $neg ? $have : !$have);
my $s;
if ($alt and $alt ne '||') { # Need to prepend %
- if ($_[1] =~ s/^([^\\])}//) { # One-char escape
+ if ($_[1] =~ s/^([^\\])\}//) { # One-char escape
$s = $self->interpolate("%$1") unless $skipping;
} else { # Understood with {}; prepend %{
$_[1] =~ s/^/%\{/ or die;
@@ -2192,8 +2270,13 @@
$s = $self->_interpolate($_[1], '}', $skipping);
}
next if $skipping;
- $str = $self->select_id3v2_frame_by_descr($id)
- if $alt and $have and not $simple;
+ if ($alt and $have and not $simple) {
+ if (@handlers) {
+ $str = $self->process_handlers($id, \@handlers, \@args);
+ } else {
+ $str = $self->select_id3v2_frame_by_descr($id);
+ }
+ }
$str = $s unless $have and $alt;
$str = $str->{_Data}
if $str and ref $str and exists $str->{_Data};
@@ -2398,11 +2481,13 @@
=item parse_rex($pattern, $string)
Parse $string according to the regular expression $pattern with
-C<%>-escapes C<%%, %a, %t, %l, %y, %g, %c, %n, %e, %E>. The meaning
-of escapes is the same as for method L<"interpolate">(); but they are
+C<%>-escapes C<%%, %a, %t, %l, %y, %g, %c, %n, %e, %E> etc. The meaning
+of escapes is the same as for method L<"interpolate">(); but (with
+the exception of C<%%>) they are
used not for I<expansion>, but for I<matching> a part of $string
suitable to be a value for these fields. Returns false on failure, a
-hash reference with parsed fields otherwise.
+hash reference with parsed fields otherwise (with C<%a> setting the
+field C<author>, etc).
Some more escapes are supported: C<%=a, %=t, %=l, %=y, %=g, %=c, %=n, %=e,
%=E, %=A, %=B, %=D, %=f, %=F, %=N, %={WHATEVER}> I<match>
@@ -2413,10 +2498,12 @@
and are case-insensitive if configuration variable
C<parse_filename_ignore_case> is true (default); moreover, C<%n>,
C<%y>, C<%=n>, C<%=y> will not match if the string-to-match is
-adjacent to a digit).
+adjacent to a digit). Double C<=> if you want to match to fail when
+the corresponding conditional C<%>-escape would fail (a missing field,
+or a zero-length field for required fields).
The escapes C<%{UE<lt>numberE<gt>}> and escapes of the forms
-C<%{ABCD}>, C<%{ABCDE<lt>numberE<gt>}> match any string; the
+C<%{ABCD}> match any string; the
corresponding hash key in the result hash is what is inside braces;
here C<ABCD> is a 4-letter word possibly followed by 2-digit number
(as in names of ID3v2 tags), or what can be put in
@@ -2433,6 +2520,13 @@
timestamps in the format understood by ID3v2 method year() (see
L<MP3::Tag::ID3v2/"year">).
+The escape C<%E> matches the REx in the configuration variable C<extension>;
+the escape C<%e> matches the part of %E after the leading dot.
+
+In list context, also returns an array reference with %{handler} groups
+parsed (if present). Such groups can match everything, and a successful match gives an
+array element with C<[$method, $packages, $args, $matched]>.
+
Currently the regular expressions with capturing parens are not supported.
=item parse_rex_prepare($pattern)
@@ -2487,9 +2581,17 @@
$t
}
-sub _parse_rex_microinterpolate { # $self->idem($code, $groups, $ecount)
+sub _parse_rex_microinterpolate ($$$;$) { # $self->idem($code, $groups, $have_non_trivial__not_group)
my ($self, $code, $groups) = (shift, shift, shift);
- return '%' if $code eq '%';
+ if ($_[1]) { # handler
+ my ($check, $fail, $id) = ($code =~ /^(=(=)?)?(\w+)/) or die "Panic: <<$code>>";
+# die "Setting via handler not suppored, handler=<<<$id>>>" unless $check;
+ (push @$groups, [$id, $_[1], $_[2]]), return $self->_parse_rex_anything($code) unless $check;
+ return '(?!)' if $fail and not (my($o) = $self->process_handlers($id, $_[1], $_[2]));
+ $o = '' unless defined $o;
+ $_[0]++, return quotemeta $o;
+ }
+ $_[0]++, return '%' if $code eq '%';
# In these two, allow setting to '', and to 123/789 too...
push(@$groups, $code), return '((?<!\d)\d{1,3}(?:/\d{1,3})?(?!\d)|\A\Z)' if $code eq 'n';
(push @$groups, $code), return '((?<!\d)[12]\d{3}(?:(?:--|[-:/T\0,])\d(?:|\d|\d\d\d))*(?!\d)|\A\Z)'
@@ -2500,15 +2602,17 @@
(push @$groups, $code), return $self->_parse_rex_anything($code)
if $code =~ /^[talgc]$/;
$_[0]++, return $self->_rex_protect_filename($self->interpolate("%$1"), $1)
- if $code =~ /^=([ABDfFN]|{d\d+})$/;
+ if $code =~ /^=([ABDfFN]|\{d\d+\})$/;
$_[0]++, return quotemeta($self->interpolate("%$1"))
- if $code =~ /^=([talgceEwhvLrqQSmsCpouMH]|{.*})$/;
+ if $code =~ /^=([talgceEwhvLrqQSmsCpouMH]|\{.*\})$/;
+ $_[0]++, return $self->interpolate("%{$+:1}") ? quotemeta($self->interpolate("%$1")) : '(?!)'
+ if $code =~ /^==(([talgcynfFeEABDNvLrqQSmsCpouMHwh])|\{(.*)\})$/;
$_[0]++, return '(?<!\d)0*' . $self->__pure_track_rex . '(?!\d)'
if $code eq '=n';
$_[0]++, return '(?<!\d)' . quotemeta($self->year) . '(?!\d)'
if $code eq '=y';
(push @$groups, $1), return $self->_parse_rex_anything()
- if $code =~ /^{(U\d+|\w{4}(\d\d+|(?:\([^\)]*\))?(?:\[.*\])?)?)}$/s;
+ if $code =~ /^\{(U\d+|\w{4}(\d\d+|(?:\([^\)]*\))?(?:\[.*\])?)?)\}$/s;
# What remains is extension
my $e = $self->get_config('extension')->[0];
(push @$groups, $code), return "($e)" if $code eq 'E';
@@ -2520,32 +2624,61 @@
die "unknown escape `%$code'";
}
-sub parse_rex_prepare {
- my ($self, $pattern) = @_;
- my ($codes, $exact, $p) = ([], 0, '');
+sub _parse_rex_prepare ($$$) {
+ my ($self, $is_rex, $pattern) = @_;
+ my ($codes, $exact, $p) = ([], 0, ($is_rex ? '' : '^'));
my $o = $pattern;
- # (=? is correct! Group 4 is inside $frame_bra
- while ($pattern =~ s<^([^%]+)|%(=?{(?:($frame_bra)|[^}]+})|=?.)><>so) {
+ # (=? is correct! Groups 4(descr), 5(have_bra) are inside $frame_bra
+ while ($pattern =~ s< ^ ( [^%]+ ) # 1: no %-escapes
+ | % ( ={0,2} \{ # 2: %-group (beg-of-{FRAME}, or full {non-frame}), or single-letter
+ (?: ($frame_bra) # 3: beg-FRAME (up to leading [, if present)
+ | [^}]+ \} # or full non-frame
+ )
+ | =? . # or single letter
+ )
+ ><>sox) {
if (defined $1) {
- $p .= $1;
+ $p .= ($is_rex ? $1 : quotemeta $1);
} else {
my $group = $2;
- # description begins
- $group .= ($self->_interpolate($pattern, ']') . ']') if $4;
if ($3) {
+ my ($id, $langs_or_packs, $have_bra) = ($3, $4, $5);
+ my(@_handlers, @args) = split /,/, ($4 || '');
+ my @handlers = grep $handlers{$_}, @_handlers;
+ $id =~ /^[A-Z]{3}[A-Z\d](\d\d)?\b/ or @handlers and @handlers == @_handlers
+ or die "Cannot parse frame descriptor: <<<$id>>>";
+ my ($meth) = ($id =~ /^(\w+)/) or die "Panic: meth";
+
+ while (@handlers and $have_bra) { # process []-arguments of a handler ($group is not terminated!)
+ push @args, $self->_interpolate($_[1], ']', !'skip');
+ $have_bra = ($_[1] =~ s/^\[//);
+ } # append []-arguments of a frame:
+ $group .= ($self->_interpolate($pattern, ']') . ']') if $have_bra;
$pattern =~ s/^}// or die "Can't find end of frame name, I see `$p'";
+ $p .= $self->_parse_rex_microinterpolate($group, $codes, $exact, \@handlers, \@args), next if @handlers;
$group .= '}';
}
$p .= $self->_parse_rex_microinterpolate($group, $codes, $exact);
}
}
+ $p .= '$' unless $is_rex;
die "Can't parse pattern, I see `$pattern'" if length $pattern;
#$pattern =~ s<%(=?{(?:[^\\{}]|\\[\\{}])*}|{U\d+}|=?.)> # (=? is correct!
# ( $self->_parse_rex_microinterpolate($1, $codes, $exact) )seg;
- my @tags = map { length == 1 ? $trans{$_} : $_ } @$codes;
+ my @tags = map { (not ref and length == 1) ? $trans{$_} : $_ } @$codes;
return [$o, $p, \@tags, $exact];
}
+sub parse_rex_prepare ($$) {
+ my ($self) = shift;
+ $self->_parse_rex_prepare('REx', @_)
+}
+
+sub parse_prepare ($$) {
+ my ($self) = shift;
+ $self->_parse_rex_prepare(!'REx', @_)
+}
+
sub parse_rex_match { # pattern = [Original, Interpolated, Fields, NumExact]
my ($self, $pattern, $data) = @_;
return unless @{$pattern->[2]} or $pattern->[3];
@@ -2553,16 +2686,19 @@
my $cv = @vals - 1;
die "Unsupported %-regular expression `$pattern->[0]' (catching parens? Got $cv vals) (converted to `$pattern->[1]')"
unless $cv == @{$pattern->[2]};
- my ($c, %h) = 0;
+ my ($c, %h, @a) = 0;
for my $k ( @{$pattern->[2]} ) {
+ next unless defined (my $v = $vals[$c++]);
+ push(@a, [@$k, $v]), next if ref $k;
$h{$k} ||= [];
- push @{ $h{$k} }, $vals[$c++]; # Support multiple occurences
+ push @{ $h{$k} }, $v; # Support multiple occurences
}
my $j = $self->get_config('parse_join')->[0];
for $c (keys %h) {
$h{$c} = join $j, grep length, @{ $h{$c} };
}
$h{track} =~ s/^0+(?=\d)// if exists $h{track};
+ return \%h, \@a if wantarray and @a;
return \%h;
}
@@ -2603,11 +2739,11 @@
#my %unquote = ('\\%' => '%', '\\%\\=' => '%=');
sub __unquote ($) { (my $k = shift) =~ s/\\(\W)/$1/g; $k }
-sub parse_prepare {
+sub __parse_prepare { # obsolete parse_prepare
my ($self, $pattern) = @_;
$pattern = "^\Q$pattern\E\$";
- # unquote %. and %=. and %={WHATEVER} and %{WHATEVER}
- $pattern =~ s<(\\%(?:\\=)?(\w|\\{(?:\w|\\[^\w\\{}]|\\\\\\[\\{}])*\\}|\\\W))>
+ # unquote %. and %=. and %={WHATEVER} and %{WHATEVER}; look for quoted \w or [^\w\\{}] or \[\\{}]
+ $pattern =~ s<(\\%(?:\\=){0,2}(\w|\\\{(?:\w|\\[^\w\\{}]|\\\\\\[\\{}])*\\\}|\\[^\w=\{]))>
( __unquote($1) )ge;
# $pattern =~ s/(\\%(?:\\=)?)(\w|\\(\W))/$unquote{$1}$+/g;
return $self->parse_rex_prepare($pattern);
@@ -3543,12 +3679,12 @@
L<MP3::Tag::ID3v1>, L<MP3::Tag::ID3v2>, L<MP3::Tag::File>,
L<MP3::Tag::ParseData>, L<MP3::Tag::Inf>, L<MP3::Tag::CDDB_File>,
-L<MP3::Tag::Cue>, L<mp3info2>,
-L<typeset_audio_dir>.
+L<MP3::Tag::Cue>, L<MP3::Tag::ImageExifTool>, L<MP3::Tag::ImageSize>,
+L<MP3::Tag::LastResort>, L<mp3info2>, L<typeset_audio_dir>.
=head1 COPYRIGHT
-Copyright (c) 2000-2008 Thomas Geffert, Ilya Zakharevich. All rights reserved.
+Copyright (c) 2000-2016 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
diff -Nru libmp3-tag-perl-1.13/MANIFEST libmp3-tag-perl-1.14/MANIFEST
--- libmp3-tag-perl-1.13/MANIFEST 2009-11-28 16:17:06.000000000 +1100
+++ libmp3-tag-perl-1.14/MANIFEST 2016-09-28 19:44:56.000000000 +1000
@@ -63,3 +63,4 @@
README.shrink
lib/MP3/Tag/ImageSize.pm
lib/MP3/Tag/ImageExifTool.pm
+META.json Module JSON meta-data (added by MakeMaker)
diff -Nru libmp3-tag-perl-1.13/META.json libmp3-tag-perl-1.14/META.json
--- libmp3-tag-perl-1.13/META.json 1970-01-01 10:00:00.000000000 +1000
+++ libmp3-tag-perl-1.14/META.json 2016-09-28 19:44:56.000000000 +1000
@@ -0,0 +1,40 @@
+{
+ "abstract" : "unknown",
+ "author" : [
+ "\"Thomas Geffert\" <[email protected]>, \"Ilya Zakharevich\" [email protected]"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 7.14, CPAN::Meta::Converter version 2.150005",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
+ "version" : "2"
+ },
+ "name" : "MP3-Tag",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {}
+ }
+ },
+ "release_status" : "stable",
+ "version" : "1.14",
+ "x_serialization_backend" : "JSON::PP version 2.27400"
+}
diff -Nru libmp3-tag-perl-1.13/META.yml libmp3-tag-perl-1.14/META.yml
--- libmp3-tag-perl-1.13/META.yml 2010-07-14 00:12:14.000000000 +1000
+++ libmp3-tag-perl-1.14/META.yml 2016-09-28 19:44:54.000000000 +1000
@@ -1,21 +1,22 @@
---- #YAML:1.0
-name: MP3-Tag
-version: 1.13
-abstract: ~
+---
+abstract: unknown
author:
- - "Thomas Geffert" <[email protected]>, "Ilya Zakharevich" [email protected]
-license: unknown
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
+ - '"Thomas Geffert" <[email protected]>, "Ilya Zakharevich" [email protected]'
build_requires:
- ExtUtils::MakeMaker: 0
-requires: {}
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.54
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.14, CPAN::Meta::Converter version 2.150005'
+license: unknown
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: MP3-Tag
+no_index:
+ directory:
+ - t
+ - inc
+requires: {}
+version: '1.14'
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -Nru libmp3-tag-perl-1.13/t/mp3tag.t libmp3-tag-perl-1.14/t/mp3tag.t
--- libmp3-tag-perl-1.13/t/mp3tag.t 2008-10-24 12:25:42.000000000 +1100
+++ libmp3-tag-perl-1.14/t/mp3tag.t 2016-09-17 12:06:05.000000000 +1000
@@ -7,7 +7,7 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-BEGIN { $| = 1; print "1..137\n"; $ENV{MP3TAG_SKIP_LOCAL} = 1}
+BEGIN { $| = 1; print "1..139\n"; $ENV{MP3TAG_SKIP_LOCAL} = 1}
END {print "MP3::Tag not loaded :(\n" unless $loaded;}
use MP3::Tag;
$loaded = 1;
@@ -113,10 +113,16 @@
ok($v2 && $v2->_comment('ENG') eq 'Another test...', "Checking ENG comment");
ok($v2 && $mp3->comment() eq 'Another test...', "Checking ID3 comment");
-my $s = $mp3->interpolate('%%02t_Title: `%012.12t\'; %{TLAN} %{TLAN01: have %{TLAN01}} %{!TLAN02:, do not have TLAN02}');
+my $s = $mp3->interpolate('%%02t_Title: `%012.12t\'; %{TLAN} %{TLAN01: have %{TLAN01}} %{!TLAN02:, do not have TLAN02}'); #'
print "# `$s'\n";
# %02t_Title: `000000000New'; ENG have ENG , do not have TLAN02
ok($s && $s eq "%02t_Title: `000000000New'; ENG have GER , do not have TLAN02", "Checking ID3 interpolation");
+$s = $mp3->interpolate('%%02{t(ID3v1)}_Title: `%012.12{t(ID3v1)}\'; %{TLAN} %{TLAN01: have %{TLAN01}} %{!TLAN02:, do not have TLAN02}'); #'
+print "# `$s'\n";
+ok($s && $s eq "%02{t(ID3v1)}_Title: `000000000New'; ENG have GER , do not have TLAN02", "Checking handler ID3v1 interpolation");
+$s = $mp3->interpolate('%%02{t(ID3v2)}_Title: `%012.12{t(ID3v2)}\'; %{TLAN} %{TLAN01: have %{TLAN01}} %{!TLAN02:, do not have TLAN02}'); #'
+print "# `$s'\n";
+ok($s && $s eq "%02{t(ID3v2)}_Title: `000000000000'; ENG have GER , do not have TLAN02", "Checking handler ID3v2 interpolation");
#back to original tag
open (FH, ">test2.mp3") or warn;
binmode FH;
diff -Nru libmp3-tag-perl-1.13/t/set_v2.t libmp3-tag-perl-1.14/t/set_v2.t
--- libmp3-tag-perl-1.13/t/set_v2.t 2008-10-25 10:41:56.000000000 +1100
+++ libmp3-tag-perl-1.14/t/set_v2.t 2016-09-10 20:29:37.000000000 +1000
@@ -240,7 +240,11 @@
ok($mp3->interpolate("%{TXXX[o$id]||$id0}") eq $id1, "Frame is ||-interpolatable with complicated expansion");
ok($mp3->interpolate("%{TXXX[$id]||$id0}") eq 'Val', "Frame is ||-interpolatable with complicated expansion");
ok($mp3->interpolate("%{TXXX[o$id]||%{TXXX[$id]}}") eq 'Val', "Frame is ||-interpolatable with a frame in expansion");
-ok($mp3->interpolate("%{TXXX[$id]&TXXX[$id]&TXXX[o$id]&TXXX[$id]}") eq 'Val; Val; Val', "Frame is &-interpolatable");
+
+$res = $mp3->interpolate("%{TXXX[$id]&TXXX[$id]&TXXX[o$id]&TXXX[$id]}");
+print "# %{TXXX[$id]&TXXX[$id]&TXXX[o$id]&TXXX[$id]} -> <$res>\n";
+ok($res eq 'Val; Val; Val', "Frame is &-interpolatable");
+
ok($mp3->update_tags(), 'update');
my $gif = <<EOF;
diff -Nru libmp3-tag-perl-1.13/TODO libmp3-tag-perl-1.14/TODO
--- libmp3-tag-perl-1.13/TODO 2009-07-20 08:18:44.000000000 +1000
+++ libmp3-tag-perl-1.14/TODO 2016-09-25 13:44:55.000000000 +1000
@@ -4,6 +4,15 @@
* perhaps restructuring of this wrapper module, as it
should be easier to say which Tag::modules should be used
+ Arguments in handlers
+
+ Direct handlers through __handler_read, __handler_write(). (To avoid security risks, writing-when-read-is-assumed etc.)
+ Possibly needed on ID3v1/ID3v2 only (others cannot write yet).
+ Take into account that title() etc take arguments (write!).
+ Be draconian when rejecting method calls; allow slack via config.
+ Allow Packages=*, pass through config.
+ Allow passing through field().
+
* more testing
MP3::Tag::ID3v1.pm
