| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package MP3::Tag; |
|
3
|
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
# Copyright (c) 2000-2004 Thomas Geffert. All rights reserved. |
|
5
|
|
|
|
|
|
|
# |
|
6
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
|
7
|
|
|
|
|
|
|
# modify it under the terms of the Artistic License, distributed |
|
8
|
|
|
|
|
|
|
# with Perl. |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
################ |
|
11
|
|
|
|
|
|
|
# |
|
12
|
|
|
|
|
|
|
# provides a general interface for different modules, which can read tags |
|
13
|
|
|
|
|
|
|
# |
|
14
|
|
|
|
|
|
|
# at the moment MP3::Tag works with MP3::Tag::ID3v1 and MP3::Tag::ID3v2 |
|
15
|
|
|
|
|
|
|
|
|
16
|
6
|
|
|
6
|
|
5960
|
use strict; |
|
|
6
|
|
|
|
|
6
|
|
|
|
6
|
|
|
|
|
687
|
|
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
{ |
|
19
|
|
|
|
|
|
|
package MP3::Tag::__hasparent; |
|
20
|
|
|
|
|
|
|
sub parent_ok { |
|
21
|
1814
|
|
|
1814
|
|
1283
|
my $self = shift; |
|
22
|
1814
|
100
|
|
|
|
4757
|
$self->{parent} and $self->{parent}->proxy_ok; |
|
23
|
|
|
|
|
|
|
} |
|
24
|
|
|
|
|
|
|
sub get_config { |
|
25
|
1804
|
|
|
1804
|
|
1388
|
my $self = shift; |
|
26
|
1804
|
100
|
|
|
|
1902
|
return $MP3::Tag::config{shift()} unless $self->parent_ok; |
|
27
|
1394
|
|
|
|
|
4480
|
return $self->{parent}->get_config(@_); |
|
28
|
|
|
|
|
|
|
} |
|
29
|
|
|
|
|
|
|
*get_config1 = \&MP3::Tag::Implemenation::get_config1; |
|
30
|
|
|
|
|
|
|
*get_config1 = 0 if 0; # quiet a warning |
|
31
|
|
|
|
|
|
|
} |
|
32
|
|
|
|
|
|
|
|
|
33
|
6
|
|
|
6
|
|
2199
|
use MP3::Tag::ID3v1; |
|
|
6
|
|
|
|
|
9
|
|
|
|
6
|
|
|
|
|
161
|
|
|
34
|
6
|
|
|
6
|
|
3690
|
use MP3::Tag::ID3v2; |
|
|
6
|
|
|
|
|
10
|
|
|
|
6
|
|
|
|
|
179
|
|
|
35
|
6
|
|
|
6
|
|
2206
|
use MP3::Tag::File; |
|
|
6
|
|
|
|
|
10
|
|
|
|
6
|
|
|
|
|
133
|
|
|
36
|
6
|
|
|
6
|
|
1961
|
use MP3::Tag::Inf; |
|
|
6
|
|
|
|
|
9
|
|
|
|
6
|
|
|
|
|
124
|
|
|
37
|
6
|
|
|
6
|
|
2001
|
use MP3::Tag::CDDB_File; |
|
|
6
|
|
|
|
|
7
|
|
|
|
6
|
|
|
|
|
153
|
|
|
38
|
6
|
|
|
6
|
|
1924
|
use MP3::Tag::Cue; |
|
|
6
|
|
|
|
|
7
|
|
|
|
6
|
|
|
|
|
141
|
|
|
39
|
6
|
|
|
6
|
|
1960
|
use MP3::Tag::ParseData; |
|
|
6
|
|
|
|
|
110
|
|
|
|
6
|
|
|
|
|
140
|
|
|
40
|
6
|
|
|
6
|
|
1767
|
use MP3::Tag::ImageSize; |
|
|
6
|
|
|
|
|
7
|
|
|
|
6
|
|
|
|
|
122
|
|
|
41
|
6
|
|
|
6
|
|
1892
|
use MP3::Tag::ImageExifTool; |
|
|
6
|
|
|
|
|
9
|
|
|
|
6
|
|
|
|
|
131
|
|
|
42
|
6
|
|
|
6
|
|
1871
|
use MP3::Tag::LastResort; |
|
|
6
|
|
|
|
|
10
|
|
|
|
6
|
|
|
|
|
125
|
|
|
43
|
|
|
|
|
|
|
|
|
44
|
6
|
|
|
6
|
|
20
|
use vars qw/$VERSION @ISA/; |
|
|
6
|
|
|
|
|
6
|
|
|
|
6
|
|
|
|
|
352
|
|
|
45
|
|
|
|
|
|
|
$VERSION="1.14"; |
|
46
|
|
|
|
|
|
|
@ISA = qw( MP3::Tag::User MP3::Tag::Site MP3::Tag::Vendor |
|
47
|
|
|
|
|
|
|
MP3::Tag::Implemenation ); # Make overridable |
|
48
|
|
|
|
|
|
|
*config = \%MP3::Tag::Implemenation::config; |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
package MP3::Tag::Implemenation; # XXXX Old mispring... |
|
51
|
6
|
|
|
6
|
|
16
|
use vars qw/%config/; |
|
|
6
|
|
|
|
|
4
|
|
|
|
6
|
|
|
|
|
2017
|
|
|
52
|
|
|
|
|
|
|
%config = ( autoinfo => [qw( ParseData ID3v2 ID3v1 ImageExifTool |
|
53
|
|
|
|
|
|
|
CDDB_File Inf Cue ImageSize |
|
54
|
|
|
|
|
|
|
filename LastResort )], |
|
55
|
|
|
|
|
|
|
cddb_files => [qw(audio.cddb cddb.out cddb.in)], |
|
56
|
|
|
|
|
|
|
v2title => [qw(TIT1 TIT2 TIT3)], |
|
57
|
|
|
|
|
|
|
composer => ['TCOM|a'], |
|
58
|
|
|
|
|
|
|
performer => ['TXXX[TPE1]|TPE1|a'], |
|
59
|
|
|
|
|
|
|
extension => ['\.(?!\d+\b)\w{1,4}$'], |
|
60
|
|
|
|
|
|
|
parse_data => [], |
|
61
|
|
|
|
|
|
|
parse_split => ["\n"], |
|
62
|
|
|
|
|
|
|
encoded_v1_fits => [0], |
|
63
|
|
|
|
|
|
|
parse_filename_ignore_case => [1], |
|
64
|
|
|
|
|
|
|
parse_filename_merge_dots => [1], |
|
65
|
|
|
|
|
|
|
parse_join => ['; '], |
|
66
|
|
|
|
|
|
|
year_is_timestamp => [1], |
|
67
|
|
|
|
|
|
|
comment_remove_date => [0], |
|
68
|
|
|
|
|
|
|
id3v2_frame_empty_ok => [0], |
|
69
|
|
|
|
|
|
|
id3v2_minpadding => [128], |
|
70
|
|
|
|
|
|
|
id3v2_sizemult => [512], |
|
71
|
|
|
|
|
|
|
id3v2_shrink => [0], |
|
72
|
|
|
|
|
|
|
id3v2_mergepadding => [0], |
|
73
|
|
|
|
|
|
|
id3v23_unsync_size_w => [0], |
|
74
|
|
|
|
|
|
|
id3v23_unsync => [1], |
|
75
|
|
|
|
|
|
|
parse_minmatch => [0], |
|
76
|
|
|
|
|
|
|
update_length => [1], |
|
77
|
|
|
|
|
|
|
default_language => ['XXX'], |
|
78
|
|
|
|
|
|
|
default_descr_c => [''], |
|
79
|
|
|
|
|
|
|
person_frames => [qw{ TEXT TCOM TXXX[TPE1] TPE1 |
|
80
|
|
|
|
|
|
|
TPE3 TOPE TOLY TMCL TIPL TENC |
|
81
|
|
|
|
|
|
|
TXXX[person-file-by] }], |
|
82
|
|
|
|
|
|
|
id3v2_frames_autofill => [qw{ TXXX[MCDI-fulltoc] 1 TXXX[cddb_id] 0 |
|
83
|
|
|
|
|
|
|
TXXX[cdindex_id] 0 }], |
|
84
|
|
|
|
|
|
|
id3v2_set_trusted_encoding0 => [1], |
|
85
|
|
|
|
|
|
|
id3v2_fix_encoding_on_edit => [1], |
|
86
|
|
|
|
|
|
|
name_for_field_normalization => ['%{composer}'], |
|
87
|
|
|
|
|
|
|
local_cfg_file => ['~/.mp3tagprc'], |
|
88
|
|
|
|
|
|
|
extra_config_keys => [], |
|
89
|
|
|
|
|
|
|
is_writable => ['writable_by_extension'], |
|
90
|
|
|
|
|
|
|
# ExifTool says: ID3 may be in MP3/MPEG/AIFF/OGG/FLAC/APE/RealAudio (MPC). |
|
91
|
|
|
|
|
|
|
writable_extensions => [qw(mp3 mp2 id3 tag ogg mpg mpeg |
|
92
|
|
|
|
|
|
|
mp4 aiff flac ape ram mpc)], |
|
93
|
|
|
|
|
|
|
ampersand_joiner => ['; '], |
|
94
|
|
|
|
|
|
|
); |
|
95
|
|
|
|
|
|
|
{ |
|
96
|
|
|
|
|
|
|
my %e; |
|
97
|
|
|
|
|
|
|
for my $t (qw(V1 V2 FILENAME FILES INF CDDB_FILE CUE)) { |
|
98
|
|
|
|
|
|
|
$e{$t} = $ENV{"MP3TAG_DECODE_${t}_DEFAULT"}; |
|
99
|
|
|
|
|
|
|
$e{$t} = $ENV{MP3TAG_DECODE_DEFAULT} unless defined $e{$t}; |
|
100
|
|
|
|
|
|
|
$config{"decode_encoding_" . lc $t} = [$e{$t}] if $e{$t}; |
|
101
|
|
|
|
|
|
|
} |
|
102
|
|
|
|
|
|
|
$e{eV1} = $ENV{MP3TAG_ENCODE_V1_DEFAULT}; |
|
103
|
|
|
|
|
|
|
$e{eV1} = $ENV{MP3TAG_ENCODE_DEFAULT} unless defined $e{eV1}; |
|
104
|
|
|
|
|
|
|
$e{eV1} = $e{V1} unless defined $e{eV1}; |
|
105
|
|
|
|
|
|
|
$config{encode_encoding_v1} = [$e{eV1}] if $e{eV1}; |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
$e{eF} = $ENV{MP3TAG_ENCODE_FILES_DEFAULT}; |
|
108
|
|
|
|
|
|
|
$e{eF} = $ENV{MP3TAG_ENCODE_DEFAULT} unless defined $e{eF}; |
|
109
|
|
|
|
|
|
|
$e{eF} = $e{FILES} unless defined $e{eF}; |
|
110
|
|
|
|
|
|
|
$config{encode_encoding_files} = [$e{eF}] if $e{eF}; |
|
111
|
|
|
|
|
|
|
} |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=pod |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head1 NAME |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
MP3::Tag - Module for reading tags of MP3 audio files |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
use MP3::Tag; |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
$mp3 = MP3::Tag->new($filename); |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# get some information about the file in the easiest way |
|
126
|
|
|
|
|
|
|
($title, $track, $artist, $album, $comment, $year, $genre) = $mp3->autoinfo(); |
|
127
|
|
|
|
|
|
|
# Or: |
|
128
|
|
|
|
|
|
|
$comment = $mp3->comment(); |
|
129
|
|
|
|
|
|
|
$dedicated_to |
|
130
|
|
|
|
|
|
|
= $mp3->select_id3v2_frame_by_descr('COMM(fre,fra,eng,#0)[dedicated to]'); |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
$mp3->title_set('New title'); # Edit in-memory copy |
|
133
|
|
|
|
|
|
|
$mp3->select_id3v2_frame_by_descr('TALB', 'New album name'); # Edit in memory |
|
134
|
|
|
|
|
|
|
$mp3->select_id3v2_frame_by_descr('RBUF', $n1, $n2, $n3); # Edit in memory |
|
135
|
|
|
|
|
|
|
$mp3->update_tags({year => 1866}); # Edit in-memory, and commit to file |
|
136
|
|
|
|
|
|
|
$mp3->update_tags(); # Commit to file |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
The following low-level access code is discouraged; better use title() |
|
139
|
|
|
|
|
|
|
etc., title_set() etc., update_tags(), select_id3v2_frame_by_descr() |
|
140
|
|
|
|
|
|
|
etc. methods on the wrapper $mp3: |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# scan file for existing tags |
|
143
|
|
|
|
|
|
|
$mp3->get_tags; |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
if (exists $mp3->{ID3v1}) { |
|
146
|
|
|
|
|
|
|
# read some information from the tag |
|
147
|
|
|
|
|
|
|
$id3v1 = $mp3->{ID3v1}; # $id3v1 is only a shortcut for $mp3->{ID3v1} |
|
148
|
|
|
|
|
|
|
print $id3v1->title; |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# change the tag contents |
|
151
|
|
|
|
|
|
|
$id3v1->all("Song","Artist","Album",2001,"Comment",10,"Top 40"); |
|
152
|
|
|
|
|
|
|
$id3v1->write_tag; |
|
153
|
|
|
|
|
|
|
} |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
if (exists $mp3->{ID3v2}) { |
|
156
|
|
|
|
|
|
|
# read some information from the tag |
|
157
|
|
|
|
|
|
|
($name, $info) = $mp3->{ID3v2}->get_frame("TIT2"); |
|
158
|
|
|
|
|
|
|
# delete the tag completely from the file |
|
159
|
|
|
|
|
|
|
$mp3->{ID3v2}->remove_tag; |
|
160
|
|
|
|
|
|
|
} else { |
|
161
|
|
|
|
|
|
|
# create a new tag |
|
162
|
|
|
|
|
|
|
$mp3->new_tag("ID3v2"); |
|
163
|
|
|
|
|
|
|
$mp3->{ID3v2}->add_frame("TALB", "Album title"); |
|
164
|
|
|
|
|
|
|
$mp3->{ID3v2}->write_tag; |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
$mp3->close(); |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Please consider using the script F; it allows simple access |
|
170
|
|
|
|
|
|
|
to most features of this module via command-line options; see |
|
171
|
|
|
|
|
|
|
L. |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head1 AUTHORS |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Thomas Geffert, thg@users.sourceforge.net |
|
176
|
|
|
|
|
|
|
Ilya Zakharevich, ilyaz@cpan.org |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
C is a wrapper module to read different tags of mp3 files. |
|
181
|
|
|
|
|
|
|
It provides an easy way to access the functions of separate modules which |
|
182
|
|
|
|
|
|
|
do the handling of reading/writing the tags itself. |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
At the moment MP3::Tag::ID3v1 and MP3::Tag::ID3v2 are supported for |
|
185
|
|
|
|
|
|
|
read and write; MP3::Tag::ImageExifTool, MP3::Tag::Inf, MP3::Tag::CDDB_File, |
|
186
|
|
|
|
|
|
|
MP3::Tag::File, MP3::Tag::Cue, MP3::Tag::ImageSize, MP3::Tag::LastResort |
|
187
|
|
|
|
|
|
|
are supported for read access (the information obtained by |
|
188
|
|
|
|
|
|
|
L (if present), parsing CDDB files, |
|
189
|
|
|
|
|
|
|
F<.inf> file, the filename, and F<.cue> file, and obtained via |
|
190
|
|
|
|
|
|
|
L) (if present). |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=over 4 |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item new() |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
$mp3 = MP3::Tag->new($filename); |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Creates a mp3-object, which can be used to retrieve/set |
|
199
|
|
|
|
|
|
|
different tags. |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=cut |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub rel2abs ($) { |
|
204
|
174
|
|
|
174
|
|
152
|
shift; |
|
205
|
174
|
50
|
|
|
|
142
|
if (eval {require File::Spec; File::Spec->can('rel2abs')}) { |
|
|
174
|
|
|
|
|
580
|
|
|
|
174
|
|
|
|
|
745
|
|
|
206
|
174
|
|
|
|
|
2580
|
File::Spec->rel2abs(shift); |
|
207
|
|
|
|
|
|
|
} else { |
|
208
|
|
|
|
|
|
|
# require Cwd; |
|
209
|
|
|
|
|
|
|
# Cwd::abs_path(shift); |
|
210
|
0
|
|
|
|
|
0
|
shift; |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
} |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
sub new { |
|
215
|
87
|
|
|
87
|
|
4226
|
my $class = shift; |
|
216
|
87
|
|
|
|
|
95
|
my $filename = shift; |
|
217
|
87
|
|
|
|
|
72
|
my $mp3data; |
|
218
|
87
|
|
|
|
|
108
|
my $self = {}; |
|
219
|
87
|
|
|
|
|
110
|
bless $self, $class; |
|
220
|
87
|
|
|
|
|
302
|
my $proxy = MP3::Tag::__proxy->new($self); |
|
221
|
87
|
50
|
33
|
|
|
960
|
if (-f $filename or -c $filename) { |
|
222
|
87
|
|
|
|
|
410
|
$mp3data = MP3::Tag::File->new_with_parent($filename, $proxy); |
|
223
|
|
|
|
|
|
|
} |
|
224
|
|
|
|
|
|
|
# later it should hopefully possible to support also http/ftp sources |
|
225
|
|
|
|
|
|
|
# with a MP3::Tag::Net module or something like that |
|
226
|
87
|
50
|
|
|
|
178
|
if ($mp3data) { |
|
227
|
87
|
|
|
|
|
178
|
%$self = (filename => $mp3data, |
|
228
|
|
|
|
|
|
|
ofilename => $filename, |
|
229
|
|
|
|
|
|
|
abs_filename => $class->rel2abs($filename), |
|
230
|
|
|
|
|
|
|
__proxy => $proxy); |
|
231
|
87
|
|
|
|
|
246
|
return $self; |
|
232
|
|
|
|
|
|
|
} |
|
233
|
0
|
|
|
|
|
0
|
return undef; |
|
234
|
|
|
|
|
|
|
} |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
{ # Proxy class: to have only one place where to weaken/localize the reference |
|
237
|
|
|
|
|
|
|
# $obj->[0] must be settable to the handle (not needed if weakening succeeds) |
|
238
|
|
|
|
|
|
|
package MP3::Tag::__proxy; |
|
239
|
6
|
|
|
6
|
|
27
|
use vars qw/$AUTOLOAD/; |
|
|
6
|
|
|
|
|
10
|
|
|
|
6
|
|
|
|
|
7564
|
|
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
my $skip_weaken = $ENV{MP3TAG_SKIP_WEAKEN}; |
|
242
|
|
|
|
|
|
|
sub new { |
|
243
|
88
|
|
|
88
|
|
120
|
my ($class, $handle) = (shift,shift); |
|
244
|
88
|
|
|
|
|
138
|
my $self = bless [$handle], $class; |
|
245
|
|
|
|
|
|
|
#warn("weaken() failed, falling back"), |
|
246
|
|
|
|
|
|
|
return bless [], $class if $skip_weaken or not |
|
247
|
88
|
50
|
33
|
|
|
229
|
eval {require Scalar::Util; Scalar::Util::weaken($self->[0]); 1}; |
|
|
88
|
|
|
|
|
408
|
|
|
|
88
|
|
|
|
|
250
|
|
|
|
88
|
|
|
|
|
283
|
|
|
248
|
88
|
|
|
|
|
122
|
$self; |
|
249
|
|
|
|
|
|
|
} |
|
250
|
|
|
|
0
|
|
|
sub DESTROY {} |
|
251
|
1404
|
|
|
1404
|
|
3773
|
sub proxy_ok { shift->[0] } |
|
252
|
|
|
|
|
|
|
sub AUTOLOAD { |
|
253
|
1544
|
|
|
1544
|
|
1095
|
my $self = shift; |
|
254
|
1544
|
50
|
|
|
|
2010
|
die "local_proxy not initialized" unless $self->[0]; |
|
255
|
1544
|
|
|
|
|
4756
|
(my $meth = $AUTOLOAD) =~ s/.*:://; |
|
256
|
1544
|
|
|
|
|
2880
|
my $smeth = $self->[0]->can($meth); |
|
257
|
1544
|
50
|
|
|
|
2105
|
die "proxy can't find the method $meth" unless $smeth; |
|
258
|
1544
|
|
|
|
|
1667
|
unshift @_, $self->[0]; |
|
259
|
1544
|
|
|
|
|
2513
|
goto &$smeth; |
|
260
|
|
|
|
|
|
|
} |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
|
|
263
|
0
|
|
|
0
|
|
0
|
sub proxy_ok { 1 } # We can always be a proxy to ourselves... ;-) |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=pod |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=item get_tags() |
|
268
|
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
[old name: getTags() . The old name is still available, but its use is not advised] |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
@tags = $mp3->get_tags; |
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Checks which tags can be found in the mp3-object. It returns |
|
274
|
|
|
|
|
|
|
a list @tags which contains strings identifying the found tags, like |
|
275
|
|
|
|
|
|
|
"ID3v1", "ID3v2", "Inf", or "CDDB_File" (the last but one if the F<.inf> |
|
276
|
|
|
|
|
|
|
information file with the same basename as MP3 file is found). |
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
Each found tag can then be accessed with $mp3->{tagname} , where tagname is |
|
279
|
|
|
|
|
|
|
a string returned by get_tags ; |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
Use the information found in L, L and |
|
282
|
|
|
|
|
|
|
L, L, L to see what you can do with the tags. |
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=cut |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
################ tag subs |
|
287
|
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub get_tags { |
|
289
|
937
|
|
|
937
|
|
744
|
my $self = shift; |
|
290
|
937
|
100
|
|
|
|
1644
|
return @{$self->{gottags}} if exists $self->{gottags}; |
|
|
852
|
|
|
|
|
1110
|
|
|
291
|
85
|
|
|
|
|
75
|
my (@IDs, $id); |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# Will not create a reference loop |
|
294
|
85
|
0
|
33
|
|
|
147
|
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN}; |
|
295
|
85
|
|
|
|
|
118
|
for $id (qw(ParseData ID3v2 ID3v1 ImageExifTool Inf CDDB_File Cue ImageSize LastResort)) { |
|
296
|
765
|
|
|
|
|
3433
|
my $ref = "MP3::Tag::$id"->new_with_parent($self->{filename}, $self->{__proxy}); |
|
297
|
765
|
100
|
|
|
|
1322
|
next unless defined $ref; |
|
298
|
470
|
|
|
|
|
606
|
$self->{$id} = $ref; |
|
299
|
470
|
|
|
|
|
613
|
push @IDs, $id; |
|
300
|
|
|
|
|
|
|
} |
|
301
|
85
|
|
|
|
|
162
|
$self->{gottags} = [@IDs]; |
|
302
|
85
|
|
|
|
|
126
|
return @IDs; |
|
303
|
|
|
|
|
|
|
} |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub _get_tag { |
|
306
|
12
|
|
|
12
|
|
12
|
my $self = shift; |
|
307
|
12
|
|
|
|
|
42
|
$self->{shift()}; |
|
308
|
|
|
|
|
|
|
} |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# keep old name for a while |
|
311
|
|
|
|
|
|
|
*getTags = \&get_tags; |
|
312
|
|
|
|
|
|
|
*getTags = 0 if 0; # quiet a warning |
|
313
|
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=item new_fake |
|
315
|
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
$obj = MP3::Tag->new_fake(); |
|
317
|
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
This method produces a "fake" MP3::Tag object which behaves as an MP3 |
|
319
|
|
|
|
|
|
|
file without tags. Give a TRUE optional argument if you want to set |
|
320
|
|
|
|
|
|
|
some properties of this object. |
|
321
|
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=cut |
|
323
|
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub new_fake { |
|
325
|
3
|
|
|
3
|
|
28
|
my ($class, $settable) = (shift, shift); |
|
326
|
3
|
|
|
|
|
9
|
my %h = (gottags => []); |
|
327
|
3
|
|
|
|
|
8
|
my $self = bless \%h, $class; |
|
328
|
3
|
100
|
|
|
|
6
|
if ($settable) { |
|
329
|
1
|
|
|
|
|
7
|
$h{__proxy} = MP3::Tag::__proxy->new($self); |
|
330
|
1
|
|
|
|
|
6
|
$h{ParseData} = MP3::Tag::ParseData->new_with_parent(undef, $h{__proxy}); |
|
331
|
|
|
|
|
|
|
} |
|
332
|
3
|
|
|
|
|
6
|
\%h; |
|
333
|
|
|
|
|
|
|
} |
|
334
|
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=pod |
|
337
|
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=item new_tag() |
|
339
|
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
[old name: newTag() . The old name is still available, but its use is not advised] |
|
341
|
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
$tag = $mp3->new_tag($tagname); |
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
Creates a new tag of the given type $tagname. You |
|
345
|
|
|
|
|
|
|
can access it then with $mp3->{$tagname}. At the |
|
346
|
|
|
|
|
|
|
moment ID3v1 and ID3v2 are supported as tagname. |
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Returns an tag-object: $mp3->{$tagname}. |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=cut |
|
351
|
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub new_tag { |
|
353
|
32
|
|
|
32
|
|
29
|
my $self = shift; |
|
354
|
32
|
|
|
|
|
31
|
my $whichTag = shift; |
|
355
|
32
|
100
|
|
|
|
96
|
if ($whichTag =~ /1/) { |
|
|
|
50
|
|
|
|
|
|
|
356
|
16
|
|
|
|
|
74
|
$self->{ID3v1}= MP3::Tag::ID3v1->new($self->{filename},1); |
|
357
|
16
|
|
|
|
|
26
|
return $self->{ID3v1}; |
|
358
|
|
|
|
|
|
|
} elsif ($whichTag =~ /2/) { |
|
359
|
16
|
|
|
|
|
73
|
$self->{ID3v2}= MP3::Tag::ID3v2->new($self->{filename},1); |
|
360
|
16
|
|
|
|
|
25
|
return $self->{ID3v2}; |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
} |
|
363
|
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
# keep old name for a while |
|
365
|
|
|
|
|
|
|
*newTag = \&new_tag; |
|
366
|
|
|
|
|
|
|
*newTag = 0 if 0; # quiet a warning |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
#only as a shortcut to {filename}->close to explicitly close a file |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=pod |
|
371
|
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=item close() |
|
373
|
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
$mp3->close; |
|
375
|
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
You can use close() to explicitly close a file. Normally this is done |
|
377
|
|
|
|
|
|
|
automatically by the module, so that you do not need to do this. |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=cut |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub close { |
|
382
|
0
|
|
|
0
|
|
0
|
my $self=shift; |
|
383
|
0
|
|
|
|
|
0
|
$self->{filename}->close; |
|
384
|
|
|
|
|
|
|
} |
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=pod |
|
387
|
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=item genres() |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
$allgenres = $mp3->genres; |
|
391
|
|
|
|
|
|
|
$genreName = $mp3->genres($genreID); |
|
392
|
|
|
|
|
|
|
$genreID = $mp3->genres($genreName); |
|
393
|
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Returns a list of all genres (reference to an array), or the according |
|
395
|
|
|
|
|
|
|
name or id to a given id or name. |
|
396
|
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
This function is only a shortcut to MP3::Tag::ID3v1->genres. |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
This can be also called as MP3::Tag->genres; |
|
400
|
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=cut |
|
402
|
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
sub genres { |
|
404
|
|
|
|
|
|
|
# returns all genres, or if a parameter is given, the according genre |
|
405
|
0
|
|
|
0
|
|
0
|
my $self=shift; |
|
406
|
0
|
|
|
|
|
0
|
return MP3::Tag::ID3v1::genres(shift); |
|
407
|
|
|
|
|
|
|
} |
|
408
|
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=pod |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=item autoinfo() |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
($title, $track, $artist, $album, $comment, $year, $genre) = $mp3->autoinfo(); |
|
414
|
|
|
|
|
|
|
$info_hashref = $mp3->autoinfo(); |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
autoinfo() returns information about the title, track number, |
|
417
|
|
|
|
|
|
|
artist, album name, the file comment, the year and genre. It can get this |
|
418
|
|
|
|
|
|
|
information from an ID3v1-tag, an ID3v2-tag, from CDDB file, from F<.inf>-file, |
|
419
|
|
|
|
|
|
|
and from the filename itself. |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
It will as default first try to find a ID3v2-tag to get this |
|
422
|
|
|
|
|
|
|
information. If this cannot be found it tries to find a ID3v1-tag, then |
|
423
|
|
|
|
|
|
|
to read an CDDB file, an F<.inf>-file, and |
|
424
|
|
|
|
|
|
|
if these are not present either, it will use the filename to retrieve |
|
425
|
|
|
|
|
|
|
the title, track number, artist, album name. The comment, year and genre |
|
426
|
|
|
|
|
|
|
are found differently, via the C, C and C methods. |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
You can change the order of lookup with the config() command. |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
autoinfo() returns an array with the information or a hashref. The hash |
|
431
|
|
|
|
|
|
|
has four keys 'title', 'track', 'artist' and 'album' where the information is |
|
432
|
|
|
|
|
|
|
stored. If comment, year or genre are found, the hash will have keys |
|
433
|
|
|
|
|
|
|
'comment' and/or 'year' and/or 'genre' too. |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
If an optional argument C<'from'> is given, the returned values (title, |
|
436
|
|
|
|
|
|
|
track number, artist, album name, the file comment, the year and genre) are |
|
437
|
|
|
|
|
|
|
array references with the first element being the value, the second the |
|
438
|
|
|
|
|
|
|
tag (C or C or C or C or C or C) from which |
|
439
|
|
|
|
|
|
|
it is taken. |
|
440
|
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
(Deprecated name 'song' can be used instead of 'title' as well.) |
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=cut |
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub autoinfo() { |
|
446
|
23
|
|
|
23
|
|
31
|
my ($self, $from) = (shift, shift); |
|
447
|
23
|
|
|
|
|
21
|
my (@out, %out); |
|
448
|
|
|
|
|
|
|
|
|
449
|
23
|
|
|
|
|
40
|
for my $elt ( qw( title track artist album comment year genre ) ) { |
|
450
|
161
|
|
|
|
|
345
|
my $out = $self->$elt($from); |
|
451
|
161
|
50
|
66
|
|
|
681
|
if (wantarray) { |
|
|
|
100
|
|
|
|
|
|
|
452
|
0
|
|
|
|
|
0
|
push @out, $out; |
|
453
|
|
|
|
|
|
|
} elsif (defined $out and length $out) { |
|
454
|
111
|
|
|
|
|
214
|
$out{$elt} = $out; |
|
455
|
|
|
|
|
|
|
} |
|
456
|
|
|
|
|
|
|
} |
|
457
|
23
|
50
|
|
|
|
54
|
$out{song} = $out{title} if exists $out{title}; |
|
458
|
|
|
|
|
|
|
|
|
459
|
23
|
50
|
|
|
|
77
|
return wantarray ? @out : \%out; |
|
460
|
|
|
|
|
|
|
} |
|
461
|
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=item comment() |
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
$comment = $mp3->comment(); # empty string unless found |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
comment() returns comment information. It can get this information from an |
|
467
|
|
|
|
|
|
|
ID3v1-tag, or an ID3v2-tag (from C frame with empty field), |
|
468
|
|
|
|
|
|
|
CDDB file (from C or C fields), or F<.inf>-file (from |
|
469
|
|
|
|
|
|
|
C field). |
|
470
|
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
It will as default first try to find a ID3v2-tag to get this |
|
472
|
|
|
|
|
|
|
information. If no comment is found there, it tries to find it in a ID3v1-tag, |
|
473
|
|
|
|
|
|
|
if none present, will try CDDB file, then F<.inf>-file. It returns an empty string if |
|
474
|
|
|
|
|
|
|
no comment is found. |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
You can change the order of this with the config() command. |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
If an optional argument C<'from'> is given, returns an array reference with |
|
479
|
|
|
|
|
|
|
the first element being the value, the second the tag (ID3v2 or ID3v1) from |
|
480
|
|
|
|
|
|
|
which the value is taken. |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=cut |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=item year() |
|
485
|
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
$year = $mp3->year(); # empty string unless found |
|
487
|
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
year() returns the year information. It can get this information from an |
|
489
|
|
|
|
|
|
|
ID3v2-tag, or ID3v1-tag, or F<.inf>-file, or filename. |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
It will as default first try to find a ID3v2-tag to get this |
|
492
|
|
|
|
|
|
|
information. If no year is found there, it tries to find it in a ID3v1-tag, |
|
493
|
|
|
|
|
|
|
if none present, will try CDDB file, then F<.inf>-file, |
|
494
|
|
|
|
|
|
|
then by parsing the file name. It returns an empty string if no year is found. |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
You can change the order of this with the config() command. |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
If an optional argument C<'from'> is given, returns an array reference with |
|
499
|
|
|
|
|
|
|
the first element being the value, the second the tag (ID3v2 or ID3v1 or |
|
500
|
|
|
|
|
|
|
filename) from which the value is taken. |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=item comment_collection(), comment_track(), title_track(). artist_collection() |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
access the corresponding fields returned by parse() method of CDDB_File. |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=item cddb_id(), cdindex_id() |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
access the corresponding methods of C, C or C. |
|
509
|
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=item title_set(), artist_set(), album_set(), year_set(), comment_set(), track_set(), genre_set() |
|
511
|
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
$mp3->title_set($newtitle, [$force_id3v2]); |
|
513
|
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Set the corresponding value in ID3v1 tag, and, if the value does not fit, |
|
515
|
|
|
|
|
|
|
or force_id3v2 is TRUE, in the ID3v2 tag. Changes are made to in-memory |
|
516
|
|
|
|
|
|
|
copy only. To propagate to the file, use update_tags() or similar methods. |
|
517
|
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=item track1() |
|
519
|
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
Same as track(), but strips trailing info: if track() returns C<3/12> |
|
521
|
|
|
|
|
|
|
(which means track 3 of 12), this method returns C<3>. |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=item track2() |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
Returns the second part of track number (compare with track1()). |
|
526
|
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=item track0() |
|
528
|
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
Same as track1(), but pads with leading 0s to width of track2(); takes an |
|
530
|
|
|
|
|
|
|
optional argument (default is 2) giving the pad width in absense of track2(). |
|
531
|
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=item disk1(), disk2() |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Same as track1(), track2(), but with disk-number instead of track-number |
|
535
|
|
|
|
|
|
|
(stored in C ID3v2 frame). |
|
536
|
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=item disk_alphanum() |
|
538
|
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
Same as disk1(), but encodes a non-empty result as a letter (1 maps to C, |
|
540
|
|
|
|
|
|
|
2 to C, etc). If number of disks is more than 26, falls back to numeric |
|
541
|
|
|
|
|
|
|
(e.g, C<3/888> will be encoded as C<003>). |
|
542
|
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=cut |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
sub track1 ($) { |
|
546
|
19
|
|
|
19
|
|
35
|
my $r = track(@_); |
|
547
|
19
|
|
|
|
|
36
|
$r =~ s(/.*)()s; |
|
548
|
19
|
|
|
|
|
46
|
$r; |
|
549
|
|
|
|
|
|
|
} |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub track2 ($) { |
|
552
|
5
|
|
|
5
|
|
9
|
my $r = track(@_); |
|
553
|
5
|
50
|
|
|
|
25
|
return '' unless $r =~ s(^.*?/)()s; |
|
554
|
5
|
|
|
|
|
9
|
$r; |
|
555
|
|
|
|
|
|
|
} |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
sub track0 ($) { |
|
558
|
5
|
|
|
5
|
|
5
|
my $self = shift; |
|
559
|
5
|
50
|
|
|
|
9
|
my $d = (@_ ? shift() : 2); |
|
560
|
5
|
|
|
|
|
7
|
my $r = $self->track(); |
|
561
|
5
|
50
|
|
|
|
10
|
return '' unless defined $r; |
|
562
|
5
|
|
|
|
|
13
|
(my $r1 = $r) =~ s(/.*)()s; |
|
563
|
5
|
50
|
|
|
|
15
|
$r = 'a' x $d unless $r =~ s(^.*?/)()s; |
|
564
|
5
|
|
|
|
|
6
|
my $l = length $r; |
|
565
|
5
|
|
|
|
|
22
|
sprintf "%0${l}d", $r1; |
|
566
|
|
|
|
|
|
|
} |
|
567
|
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
sub disk1 ($) { |
|
569
|
11
|
|
|
11
|
|
9
|
my $self = shift; |
|
570
|
11
|
|
|
|
|
18
|
my $r = $self->select_id3v2_frame('TPOS'); |
|
571
|
11
|
100
|
|
|
|
22
|
return '' unless defined $r; |
|
572
|
5
|
|
|
|
|
14
|
$r =~ s(/.*)()s; |
|
573
|
5
|
|
|
|
|
10
|
$r; |
|
574
|
|
|
|
|
|
|
} |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub disk2 ($) { |
|
577
|
7
|
|
|
7
|
|
9
|
my $self = shift; |
|
578
|
7
|
|
|
|
|
13
|
my $r = $self->select_id3v2_frame('TPOS'); |
|
579
|
7
|
100
|
|
|
|
12
|
return '' unless defined $r; |
|
580
|
5
|
50
|
|
|
|
236
|
return '' unless $r =~ s(^.*?/)()s; |
|
581
|
5
|
|
|
|
|
15
|
$r; |
|
582
|
|
|
|
|
|
|
} |
|
583
|
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
sub disk_alphanum ($) { |
|
585
|
7
|
|
|
7
|
|
7
|
my $self = shift; |
|
586
|
7
|
|
|
|
|
12
|
my $r = $self->select_id3v2_frame('TPOS'); |
|
587
|
7
|
100
|
|
|
|
16
|
return '' unless defined $r; |
|
588
|
5
|
|
|
|
|
13
|
(my $r1 = $r) =~ s(/.*)()s; |
|
589
|
5
|
50
|
|
|
|
14
|
$r = $r1 unless $r =~ s(^.*?/)()s; # max(disk2, disk1) |
|
590
|
5
|
100
|
|
|
|
16
|
return chr(ord('a') - 1 + $r1) if $r <= 26; |
|
591
|
2
|
|
|
|
|
3
|
my $l = length $r; |
|
592
|
2
|
|
|
|
|
10
|
sprintf "%0${l}d", $r1; |
|
593
|
|
|
|
|
|
|
} |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
my %ignore_0length = qw(ID3v1 1 CDDB_File 1 Inf 1 Cue 1 ImageSize 1 ImageExifTool 1); |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub _auto_field_from($$$;$$$$) { |
|
598
|
284
|
|
100
|
284
|
|
875
|
my ($self, $check_only, $packs, $rwhat, $ret_from, $args, $all) = (shift, shift, shift, shift, shift, shift || [], shift); |
|
599
|
284
|
100
|
|
|
|
478
|
my @what = ref $rwhat ? @$rwhat : $rwhat; |
|
600
|
284
|
|
|
|
|
197
|
my @out; |
|
601
|
284
|
0
|
33
|
|
|
494
|
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN}; |
|
602
|
|
|
|
|
|
|
|
|
603
|
284
|
|
|
|
|
372
|
$self->get_tags; |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
# ID3v1 has AUTOLOAD |
|
606
|
|
|
|
|
|
|
# my $do_can = ($what =~ /^(cd\w+_id|height|width|bit_depth|mime_type|img_type|_duration)$/); |
|
607
|
284
|
|
|
|
|
345
|
foreach my $pack (@$packs) { |
|
608
|
1697
|
100
|
|
|
|
2337
|
next unless exists $self->{$pack}; |
|
609
|
1064
|
|
|
|
|
864
|
my $do_can = $pack ne 'ID3v1'; |
|
610
|
1064
|
|
|
|
|
623
|
my $out; |
|
611
|
1064
|
|
|
|
|
901
|
for my $what (@what) { |
|
612
|
1066
|
100
|
100
|
|
|
1728
|
next if $pack eq 'ID3v1' and not $MP3::Tag::ID3v1::ok_length{$what}; # dup of a warning in AUTOLOAD |
|
613
|
1065
|
100
|
100
|
|
|
4260
|
next if $do_can and not $self->{$pack}->can($what); |
|
614
|
1064
|
50
|
33
|
|
|
1606
|
if ($check_only and $self->{$pack}->can(my $m = $what . '_have')) { |
|
615
|
0
|
0
|
|
|
|
0
|
next unless $self->{$pack}->$m(@$args); |
|
616
|
0
|
0
|
|
|
|
0
|
return $ret_from ? [1, $pack] : 1; |
|
617
|
|
|
|
|
|
|
} |
|
618
|
1064
|
100
|
|
|
|
2536
|
next unless defined ($out = $self->{$pack}->$what(@$args)); |
|
619
|
|
|
|
|
|
|
# Ignore 0-length answers from ID3v1, ImageExifTool, CDDB_File, Cue, ImageSize, and Inf |
|
620
|
261
|
100
|
66
|
|
|
640
|
undef $out, next if not length $out and $ignore_0length{$pack}; # These return '' |
|
621
|
|
|
|
|
|
|
} |
|
622
|
1064
|
100
|
|
|
|
1550
|
next unless defined $out; |
|
623
|
228
|
50
|
|
|
|
292
|
$out = 1 if $check_only; |
|
624
|
228
|
50
|
|
|
|
418
|
if ($all) { # Currently, @out is not used by our callers |
|
625
|
0
|
0
|
|
|
|
0
|
push @out, ($ret_from ? [$out, $pack] : $out); |
|
626
|
0
|
|
|
|
|
0
|
next; |
|
627
|
|
|
|
|
|
|
} |
|
628
|
228
|
100
|
|
|
|
424
|
return [$out, $pack] if $ret_from; |
|
629
|
160
|
|
|
|
|
291
|
return $out; |
|
630
|
|
|
|
|
|
|
} |
|
631
|
56
|
50
|
|
|
|
78
|
return @out if $all; |
|
632
|
56
|
|
|
|
|
79
|
return; |
|
633
|
|
|
|
|
|
|
} |
|
634
|
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
sub auto_field($;$$) { |
|
636
|
282
|
|
|
282
|
|
324
|
my ($self, $what, $ret_from) = (shift, shift, shift); |
|
637
|
282
|
|
33
|
|
|
302
|
my $packs = $self->get_config($what) || $self->get_config('autoinfo'); |
|
638
|
282
|
|
|
|
|
426
|
my $o = $self->_auto_field_from(!'check_only', $packs, $what, $ret_from); |
|
639
|
282
|
100
|
|
|
|
472
|
return '' unless defined $o; |
|
640
|
227
|
|
|
|
|
415
|
$o; |
|
641
|
|
|
|
|
|
|
} |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
for my $elt ( qw( title track artist album comment year genre ) ) { |
|
644
|
6
|
|
|
6
|
|
28
|
no strict 'refs'; |
|
|
6
|
|
|
|
|
6
|
|
|
|
6
|
|
|
|
|
618
|
|
|
645
|
|
|
|
|
|
|
*$elt = sub (;$) { |
|
646
|
282
|
|
|
282
|
|
554
|
my $self = shift; |
|
647
|
282
|
|
50
|
282
|
|
653
|
my $translate = ($self->get_config("translate_$elt") || [])->[0] || sub {$_[1]}; |
|
|
282
|
|
|
|
|
852
|
|
|
648
|
282
|
|
|
|
|
600
|
return &$translate($self, $self->auto_field($elt, @_)); |
|
649
|
|
|
|
|
|
|
} |
|
650
|
|
|
|
|
|
|
} |
|
651
|
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my %hide_meth = qw(mime_type _mime_type); |
|
653
|
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
for my $elt ( qw( cddb_id cdindex_id height width bit_depth mime_type img_type _duration ) ) { |
|
655
|
6
|
|
|
6
|
|
20
|
no strict 'refs'; |
|
|
6
|
|
|
|
|
7
|
|
|
|
6
|
|
|
|
|
350
|
|
|
656
|
|
|
|
|
|
|
*{$hide_meth{$elt} || $elt} = sub (;$) { |
|
657
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
658
|
0
|
|
|
|
|
0
|
return $self->auto_field($elt, @_); |
|
659
|
|
|
|
|
|
|
} |
|
660
|
|
|
|
|
|
|
} |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
for my $elt ( qw( comment_collection comment_track title_track artist_collection ) ) { |
|
663
|
6
|
|
|
6
|
|
20
|
no strict 'refs'; |
|
|
6
|
|
|
|
|
6
|
|
|
|
6
|
|
|
|
|
923
|
|
|
664
|
|
|
|
|
|
|
my ($tr) = ($elt =~ /^(\w+)_/); |
|
665
|
|
|
|
|
|
|
*$elt = sub (;$) { |
|
666
|
20
|
|
|
20
|
|
22
|
my $self = shift; |
|
667
|
20
|
0
|
33
|
|
|
38
|
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN}; |
|
668
|
20
|
|
|
|
|
27
|
$self->get_tags; |
|
669
|
20
|
100
|
|
|
|
61
|
return unless exists $self->{CDDB_File}; |
|
670
|
6
|
|
|
|
|
16
|
my $v = $self->{CDDB_File}->parse($elt); |
|
671
|
6
|
100
|
|
|
|
11
|
return unless defined $v; |
|
672
|
5
|
|
50
|
5
|
|
13
|
my $translate = ($self->get_config("translate_$tr") || [])->[0] || sub {$_[1]}; |
|
|
5
|
|
|
|
|
20
|
|
|
673
|
5
|
|
|
|
|
11
|
return &$translate( $self, $v ); |
|
674
|
|
|
|
|
|
|
} |
|
675
|
|
|
|
|
|
|
} |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
for my $elt ( qw(title artist album year comment track genre) ) { |
|
678
|
6
|
|
|
6
|
|
22
|
no strict 'refs'; |
|
|
6
|
|
|
|
|
5
|
|
|
|
6
|
|
|
|
|
1868
|
|
|
679
|
|
|
|
|
|
|
*{"${elt}_set"} = sub ($$;$) { |
|
680
|
4
|
|
|
4
|
|
19
|
my ($mp3, $val, $force2) = (shift, shift, shift); |
|
681
|
|
|
|
|
|
|
|
|
682
|
4
|
|
|
|
|
11
|
$mp3->get_tags; |
|
683
|
4
|
100
|
|
|
|
17
|
$mp3->new_tag("ID3v1") unless exists $mp3->{ID3v1}; |
|
684
|
4
|
|
|
|
|
21
|
$mp3->{ID3v1}->$elt( $val ); |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
return 1 |
|
687
|
|
|
|
|
|
|
if not $force2 and $mp3->{ID3v1}->fits_tag({$elt => $val}) |
|
688
|
4
|
100
|
66
|
|
|
23
|
and not exists $mp3->{ID3v2}; |
|
|
|
|
66
|
|
|
|
|
|
689
|
|
|
|
|
|
|
|
|
690
|
2
|
50
|
|
|
|
12
|
$mp3->new_tag("ID3v2") unless exists $mp3->{ID3v2}; |
|
691
|
2
|
|
|
|
|
11
|
$mp3->{ID3v2}->$elt( $val ); |
|
692
|
|
|
|
|
|
|
} |
|
693
|
|
|
|
|
|
|
} |
|
694
|
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
sub aspect_ratio ($) { |
|
696
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
697
|
0
|
|
|
|
|
0
|
my ($w, $h) = ($self->width, $self->height); |
|
698
|
0
|
0
|
0
|
|
|
0
|
return unless $w and $h; |
|
699
|
0
|
|
|
|
|
0
|
$w/$h; |
|
700
|
|
|
|
|
|
|
} |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub aspect_ratio_inverted ($) { |
|
703
|
0
|
0
|
|
0
|
|
0
|
my $r = shift->aspect_ratio or return; |
|
704
|
0
|
|
|
|
|
0
|
1/$r; |
|
705
|
|
|
|
|
|
|
} |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
sub aspect_ratio3 ($) { |
|
708
|
0
|
|
|
0
|
|
0
|
my $r = shift->aspect_ratio(); |
|
709
|
0
|
0
|
|
|
|
0
|
$r ? sprintf '%.3f', $r : $r; |
|
710
|
|
|
|
|
|
|
} |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
=item mime_type( [$lazy] ) |
|
713
|
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
Returns the MIME type as a string. Returns C |
|
715
|
|
|
|
|
|
|
for unrecognized types. If not $lazy, will try harder (via ExifTool, if |
|
716
|
|
|
|
|
|
|
needed). |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=item mime_Pretype( [$lazy] ) |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
Returns uppercased first component of MIME type. |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=cut |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
sub mime_Pretype ($;$) { |
|
725
|
0
|
|
|
0
|
|
0
|
my $r = shift->mime_type(shift); |
|
726
|
0
|
|
|
|
|
0
|
$r =~ s,/.*,,s; |
|
727
|
0
|
|
|
|
|
0
|
ucfirst lc $r |
|
728
|
|
|
|
|
|
|
} |
|
729
|
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
sub mime_type ($;$) { # _mime_type goes thru auto_field 'mime_type' |
|
731
|
0
|
|
|
0
|
|
0
|
my ($self, $lazy) = (shift, shift); |
|
732
|
0
|
|
|
|
|
0
|
$self->get_tags; |
|
733
|
0
|
|
|
|
|
0
|
my $h = $self->{header}; |
|
734
|
0
|
|
0
|
|
|
0
|
my $t = $h && $self->_Data_to_MIME($h, 1); |
|
735
|
0
|
0
|
|
|
|
0
|
return $t if $t; |
|
736
|
0
|
|
0
|
|
|
0
|
return((!$lazy && $self->_mime_type()) || 'application/octet-stream'); |
|
737
|
|
|
|
|
|
|
} |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=item genre() |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
$genre = $mp3->genre(); # empty string unless found |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
genre() returns the genre string. It can get this information from an |
|
744
|
|
|
|
|
|
|
ID3v2-tag or ID3v1-tag. |
|
745
|
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
It will as default first try to find a ID3v2-tag to get this |
|
747
|
|
|
|
|
|
|
information. If no genre is found there, it tries to find it in a ID3v1-tag, |
|
748
|
|
|
|
|
|
|
if none present, will try F<.inf>-file, |
|
749
|
|
|
|
|
|
|
It returns an empty string if no genre is found. |
|
750
|
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
You can change the order of this with the config() command. |
|
752
|
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
If an optional argument C<'from'> is given, returns an array reference with |
|
754
|
|
|
|
|
|
|
the first element being the value, the second the tag (ID3v2 or ID3v1 or |
|
755
|
|
|
|
|
|
|
filename) from which the value is taken. |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=item composer() |
|
758
|
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
$composer = $mp3->composer(); # empty string unless found |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
composer() returns the composer. By default, it gets from ID3v2 tag, |
|
762
|
|
|
|
|
|
|
otherwise returns artist. |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
You can change the inspected fields with the config() command. |
|
765
|
|
|
|
|
|
|
Subject to normalization via C or |
|
766
|
|
|
|
|
|
|
C configuration variables. |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=item performer() |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
$performer = $mp3->performer(); # empty string unless found |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
performer() returns the main performer. By default, it gets from ID3v2 |
|
773
|
|
|
|
|
|
|
tag C, otherwise from ID3v2 tag C, otherwise |
|
774
|
|
|
|
|
|
|
returns artist. |
|
775
|
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
You can change the inspected fields with the config() command. |
|
777
|
|
|
|
|
|
|
Subject to normalization via C or |
|
778
|
|
|
|
|
|
|
C configuration variables. |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=cut |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
for my $elt ( qw( composer performer ) ) { |
|
783
|
6
|
|
|
6
|
|
24
|
no strict 'refs'; |
|
|
6
|
|
|
|
|
5
|
|
|
|
6
|
|
|
|
|
39708
|
|
|
784
|
|
|
|
|
|
|
*$elt = sub (;$) { |
|
785
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
786
|
|
|
|
|
|
|
my $translate = ($self->get_config("translate_$elt") |
|
787
|
|
|
|
|
|
|
|| $self->get_config("translate_person") |
|
788
|
0
|
|
0
|
0
|
|
0
|
|| [])->[0] || sub {$_[1]}; |
|
|
0
|
|
|
|
|
0
|
|
|
789
|
0
|
|
|
|
|
0
|
my $fields = ($self->get_config($elt))->[0]; |
|
790
|
0
|
|
|
|
|
0
|
return &$translate($self, $self->interpolate("%{$fields}")); |
|
791
|
|
|
|
|
|
|
} |
|
792
|
|
|
|
|
|
|
} |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=item config |
|
795
|
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
MP3::Tag->config(item => value1, value2...); # Set options globally |
|
797
|
|
|
|
|
|
|
$mp3->config(item => value1, value2...); # Set object options |
|
798
|
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
When object options are first time set or get, the global options are |
|
800
|
|
|
|
|
|
|
propagated into object options. (So if global options are changed later, these |
|
801
|
|
|
|
|
|
|
changes are not inherited.) |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
Possible items are: |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=over |
|
806
|
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=item autoinfo |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
Configure the order in which ID3v1-, ID3v2-tag and filename are used |
|
810
|
|
|
|
|
|
|
by autoinfo. The default is C
|
|
811
|
|
|
|
|
|
|
CDDB_File, Inf, Cue, ImageSize, filename, LastResort>. |
|
812
|
|
|
|
|
|
|
Options can be elements of the default list. The order |
|
813
|
|
|
|
|
|
|
in which they are given to config also sets the order how they are |
|
814
|
|
|
|
|
|
|
used by autoinfo. If an option is not present, it will not be used |
|
815
|
|
|
|
|
|
|
by autoinfo (and other auto-methods if the specific overriding config |
|
816
|
|
|
|
|
|
|
command were not issued). |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
$mp3->config("autoinfo","ID3v1","ID3v2","filename"); |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
sets the order to check first ID3v1, then ID3v2 and at last the |
|
821
|
|
|
|
|
|
|
Filename |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
$mp3->config("autoinfo","ID3v1","filename","ID3v2"); |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
sets the order to check first ID3v1, then the Filename and last |
|
826
|
|
|
|
|
|
|
ID3v2. As the filename will be always present ID3v2 will here |
|
827
|
|
|
|
|
|
|
never be checked. |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
$mp3->config("autoinfo","ID3v1","ID3v2"); |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
sets the order to check first ID3v1, then ID3v2. The filename will |
|
832
|
|
|
|
|
|
|
never be used. |
|
833
|
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=item title artist album year comment track genre |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
Configure the order in which ID3v1- and ID3v2-tag are used |
|
837
|
|
|
|
|
|
|
by the corresponding methods (e.g., comment()). Options can be |
|
838
|
|
|
|
|
|
|
the same as for C. The order |
|
839
|
|
|
|
|
|
|
in which they are given to config also sets the order how they are |
|
840
|
|
|
|
|
|
|
used by comment(). If an option is not present, then C option |
|
841
|
|
|
|
|
|
|
will be used instead. |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=item extension |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
regular expression to match the file extension (including the dot). The |
|
846
|
|
|
|
|
|
|
default is to match 1..4 letter extensions which are not numbers. |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=item composer |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
string to put into C<%{}> to interpolate to get the composer. Default |
|
851
|
|
|
|
|
|
|
is C<'TCOM|a'>. |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=item performer |
|
854
|
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
string to put into C<%{}> to interpolate to get the main performer. |
|
856
|
|
|
|
|
|
|
Default is C<'TXXX[TPE1]|TPE1|a'>. |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=item parse_data |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
the data used by L handler; each option is an array |
|
861
|
|
|
|
|
|
|
reference of the form C<[$flag, $string, $pattern1, ...]>. All the options |
|
862
|
|
|
|
|
|
|
are processed in the following way: patterns are matched against $string |
|
863
|
|
|
|
|
|
|
until one of them succeeds; the information obtained from later options takes |
|
864
|
|
|
|
|
|
|
precedence over the information obtained from earlier ones. |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=item parse_split |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
The regular expression to split the data when parsing with C or C flags. |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=item parse_filename_ignore_case |
|
871
|
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
If true (default), calling parse() and parse_rex() with match-filename |
|
873
|
|
|
|
|
|
|
escapes (such as C<%=D>) matches case-insensitively. |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=item parse_filename_merge_dots |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
If true (default), calling parse() and parse_rex() with match-filename |
|
878
|
|
|
|
|
|
|
escapes (such as C<%=D>) does not distinguish a dot and many consequent |
|
879
|
|
|
|
|
|
|
dots. |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=item parse_join |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
string to put between multiple occurences of a tag in a parse pattern; |
|
884
|
|
|
|
|
|
|
defaults to C<'; '>. E.g., parsing C<'1988-1992, Homer (LP)'> with pattern |
|
885
|
|
|
|
|
|
|
C<'%c, %a (%c)'> results in comment set to C<'1988-1992; LP'> with the |
|
886
|
|
|
|
|
|
|
default value of C. |
|
887
|
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=item v2title |
|
889
|
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
Configure the elements of ID3v2-tag which are used by ID3v2::title(). |
|
891
|
|
|
|
|
|
|
Options can be "TIT1", "TIT2", "TIT3"; the present values are combined. |
|
892
|
|
|
|
|
|
|
If an option is not present, it will not be used by ID3v2::title(). |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=item cddb_files |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
List of files to look for in the directory of MP3 file to get CDDB info. |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item year_is_timestamp |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
If TRUE (default) parse() will match complicated timestamps against C<%y>; |
|
901
|
|
|
|
|
|
|
for example, C<2001-10-23--30,2002-02-28> is a range from 23rd to 30th of |
|
902
|
|
|
|
|
|
|
October 2001, I 28th of February of 2002. According to ISO, C<--> can |
|
903
|
|
|
|
|
|
|
be replaced by C> as well. For convenience, the leading 0 can be omited |
|
904
|
|
|
|
|
|
|
from the fields which ISO requires to be 2-digit. |
|
905
|
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=item comment_remove_date |
|
907
|
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
When extracting the date from comment fields, remove the recognized portion |
|
909
|
|
|
|
|
|
|
even if it is human readable (e.g., C) if TRUE. |
|
910
|
|
|
|
|
|
|
Current default: FALSE. |
|
911
|
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=item default_language |
|
913
|
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
The language to use to select ID3v2 frames, and to choose C |
|
915
|
|
|
|
|
|
|
ID3v2 frame accessed in comment() method (default is 'XXX'; if not |
|
916
|
|
|
|
|
|
|
C, this should be lowercase 3-letter abbreviation according to |
|
917
|
|
|
|
|
|
|
ISO-639-2). |
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=item default_descr_c |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
The description field used to choose the C ID3v2 frame accessed |
|
922
|
|
|
|
|
|
|
in comment() method. Defaults to C<''>. |
|
923
|
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=item id3v2_frame_empty_ok |
|
925
|
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
When setting the individual id3v2 frames via ParseData, do not |
|
927
|
|
|
|
|
|
|
remove the frames set to an empty string. Default 0 (empty means 'remove'). |
|
928
|
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=item id3v2_minpadding |
|
930
|
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
Minimal padding to reserve after ID3v2 tag when writing (default 128), |
|
932
|
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=item id3v2_sizemult |
|
934
|
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
Additionally to C, insert padding to make file size multiple |
|
936
|
|
|
|
|
|
|
of this when writing ID3v2 tag (default 512), Should be power of 2. |
|
937
|
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=item id3v2_shrink |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
If TRUE, when writing ID3v2 tag, shrink the file if needed (default FALSE). |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=item id3v2_mergepadding |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
If TRUE, when writing ID3v2 tag, consider the 0-bytes following the |
|
945
|
|
|
|
|
|
|
ID3v2 header as writable space for the tag (default FALSE). |
|
946
|
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=item update_length |
|
948
|
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
If TRUE, when writing ID3v2 tag, create a C tag if the duration |
|
950
|
|
|
|
|
|
|
is known (as it is after calling methods like C, or |
|
951
|
|
|
|
|
|
|
interpolation the duration value). If this field is 2 or more, force |
|
952
|
|
|
|
|
|
|
creation of ID3v2 tag by update_tags() if the duration is known. |
|
953
|
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=item translate_* |
|
955
|
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
FALSE, or a subroutine used to munch a field C<*> (out of C
|
|
957
|
|
|
|
|
|
|
track artist album comment year genre comment_collection comment_track |
|
958
|
|
|
|
|
|
|
title_track artist_collection person>) to some "normalized" form. |
|
959
|
|
|
|
|
|
|
Takes two arguments: the MP3::Tag object, and the current value of the |
|
960
|
|
|
|
|
|
|
field. |
|
961
|
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
The second argument may also have the form C<[value, handler]>, where |
|
963
|
|
|
|
|
|
|
C is the string indentifying the handler which returned the |
|
964
|
|
|
|
|
|
|
value. |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=item short_person |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
Similar to C, but the intent is for this subroutine |
|
969
|
|
|
|
|
|
|
to translate a personal name field to a shortest "normalized" form. |
|
970
|
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=item person_frames |
|
972
|
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
list of ID3v2 frames subject to normalization via C |
|
974
|
|
|
|
|
|
|
handler; current default is C
|
|
975
|
|
|
|
|
|
|
TMCL TIPL TENC TXXX[person-file-by]>. |
|
976
|
|
|
|
|
|
|
Used by select_id3v2_frame_by_descr(), frame_translate(), |
|
977
|
|
|
|
|
|
|
frames_translate(). |
|
978
|
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=item id3v2_missing_fatal |
|
980
|
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
If TRUE, interpolating ID3v2 frames (e.g., by C<%{TCOM}>) when |
|
982
|
|
|
|
|
|
|
the ID3v2 tags is missing is a fatal error. If false (default), in such cases |
|
983
|
|
|
|
|
|
|
interpolation results in an empty string. |
|
984
|
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
=item id3v2_recalculate |
|
986
|
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
If TRUE, interpolating the whole ID3v2 tag (by C<%{ID3v2}>) will recalculate |
|
988
|
|
|
|
|
|
|
the tag even if its contents is not modified. |
|
989
|
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
=item parse_minmatch |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
may be 0, 1, or a list of C<%>-escapes (matching any string) which should |
|
993
|
|
|
|
|
|
|
matched non-greedily by parse() and friends. E.g., parsing |
|
994
|
|
|
|
|
|
|
C<'Adagio - Andante - Piano Sonata'> via C<'%t - %l'> gives different results |
|
995
|
|
|
|
|
|
|
for the settings 0 and 1; note that greediness of C<%l> does not matter, |
|
996
|
|
|
|
|
|
|
thus the value of 1 is equivalent for the value of C for this particular |
|
997
|
|
|
|
|
|
|
pattern. |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=item id3v23_unsync_size_w |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
Old experimental flag to test why ITunes refuses to handle unsyncronized tags |
|
1002
|
|
|
|
|
|
|
(does not help, see L). The idea was that |
|
1003
|
|
|
|
|
|
|
version 2.3 of the standard is not clear about frame size field, whether it |
|
1004
|
|
|
|
|
|
|
is the size of the frame after unsyncronization, or not. We assume |
|
1005
|
|
|
|
|
|
|
that this size is one before unsyncronization (as in v2.2). |
|
1006
|
|
|
|
|
|
|
Setting this value to 1 will assume another interpretation (as in v2.4) for |
|
1007
|
|
|
|
|
|
|
write. |
|
1008
|
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
=item id3v23_unsync |
|
1010
|
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
Some broken MP3 players (e.g., ITunes, at least up to v6) refuse to |
|
1012
|
|
|
|
|
|
|
handle unsyncronized (i.e., written as the standard requires it) tags; |
|
1013
|
|
|
|
|
|
|
they may need this to be set to FALSE. Default: TRUE. |
|
1014
|
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
(Some details: by definition, MP3 files should contain combinations of bytes |
|
1016
|
|
|
|
|
|
|
C or C only at the start of audio frames ("syncronization" points). |
|
1017
|
|
|
|
|
|
|
ID3v2 standards take this into account, and supports storing raw tag data |
|
1018
|
|
|
|
|
|
|
in a format which does not contain these combinations of bytes |
|
1019
|
|
|
|
|
|
|
[via "unsyncronization"]. Itunes etc do not only emit broken MP3 files |
|
1020
|
|
|
|
|
|
|
[which cause severe hiccups in players which do not know how to skip ID3v2 |
|
1021
|
|
|
|
|
|
|
tags, as most settop DVD players], they also refuse to read ID3v2 tags |
|
1022
|
|
|
|
|
|
|
written in a correct, unsyncronized, format.) |
|
1023
|
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
(Note also that the issue of syncronization is also applicable to ID3v1 |
|
1025
|
|
|
|
|
|
|
tags; however, since this data is near the end of the file, many players |
|
1026
|
|
|
|
|
|
|
are able to recognize that the syncronization points in ID3v1 tag cannot |
|
1027
|
|
|
|
|
|
|
start a valid frame, since there is not enough data to read; some other |
|
1028
|
|
|
|
|
|
|
players would hiccup anyway if ID3v1 contains these combinations of bytes...) |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=item encoded_v1_fits |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
If FALSE (default), data containing "high bit characters" is considered to |
|
1033
|
|
|
|
|
|
|
not fit ID3v1 tag if one of the following conditions hold: |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=over 4 |
|
1036
|
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
=item 1. |
|
1038
|
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
C is set (so the resulting ID3v1 tag is not |
|
1040
|
|
|
|
|
|
|
standard-complying, thus ambiguous without ID3v2), or |
|
1041
|
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=item 2. |
|
1043
|
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
C is not set, but C is set |
|
1045
|
|
|
|
|
|
|
(thus read+write operation is not idempotent for ID3v1 tag). |
|
1046
|
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=back |
|
1048
|
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
With the default setting, these problems are resolved as far as (re)encoding |
|
1050
|
|
|
|
|
|
|
of ID3v2 tag is non-ambiguous (which holds with the default settings for |
|
1051
|
|
|
|
|
|
|
ID3v2 encodeing). |
|
1052
|
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
=item decode_encoding_v1 |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=item encode_encoding_v1 |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=item decode_encoding_v2 |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
=item decode_encoding_filename |
|
1060
|
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
=item decode_encoding_inf |
|
1062
|
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
=item decode_encoding_cddb_file |
|
1064
|
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=item decode_encoding_cue |
|
1066
|
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
=item decode_encoding_files |
|
1068
|
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
=item encode_encoding_files |
|
1070
|
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
Encodings of C, non-Unicode frames of C, filenames, |
|
1072
|
|
|
|
|
|
|
external files, F<.inf> files, C files, F<.cue> files, |
|
1073
|
|
|
|
|
|
|
and user-specified files correspondingly. The value of 0 means "latin1". |
|
1074
|
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
The default values for C are set from the |
|
1076
|
|
|
|
|
|
|
corresponding C environment variable (here |
|
1077
|
|
|
|
|
|
|
C<*> stands for the uppercased last component of the name); if this |
|
1078
|
|
|
|
|
|
|
variable is not set, from C. Likewise, the |
|
1079
|
|
|
|
|
|
|
default value for C is set from |
|
1080
|
|
|
|
|
|
|
C or C; if not |
|
1081
|
|
|
|
|
|
|
present, from the value for C; similarly for |
|
1082
|
|
|
|
|
|
|
C. |
|
1083
|
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
Note that C has no "encode" pair; it may also be disabled |
|
1085
|
|
|
|
|
|
|
per tag via effects of C and the corresponding |
|
1086
|
|
|
|
|
|
|
frame C in the tag. One should also keep in |
|
1087
|
|
|
|
|
|
|
mind that the ID3v1 standard requires the encoding to be "latin1" (so |
|
1088
|
|
|
|
|
|
|
does not store the encoding anywhere); this does not make a lot of sense, |
|
1089
|
|
|
|
|
|
|
and a lot of effort of this module is spend to fix this unfortunate flaw. |
|
1090
|
|
|
|
|
|
|
See L<"Problems with ID3 format">. |
|
1091
|
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
=item ignore_trusted_encoding0_v2 |
|
1093
|
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
If FALSE (default), and the frame C is set to TRUE, |
|
1095
|
|
|
|
|
|
|
the setting of C is ignored. |
|
1096
|
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
=item id3v2_set_trusted_encoding0 |
|
1098
|
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
If TRUE (default), and frames are converted from the given C |
|
1100
|
|
|
|
|
|
|
to a standard-conforming encoding, a frame C with |
|
1101
|
|
|
|
|
|
|
a TRUE value is added. |
|
1102
|
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
[The purpose is to make multi-step update in presence of C |
|
1104
|
|
|
|
|
|
|
possible; with C TRUE, and |
|
1105
|
|
|
|
|
|
|
C FALSE (both are default values), editing of tags |
|
1106
|
|
|
|
|
|
|
can be idempotent.] |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=item id3v2_fix_encoding_on_write |
|
1109
|
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
If TRUE and C is defined, the ID3v2 frames are converted |
|
1111
|
|
|
|
|
|
|
to standard-conforming encodings on write. The default is FALSE. |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=item id3v2_fix_encoding_on_edit |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
If TRUE (default) and C is defined (and not disabled |
|
1116
|
|
|
|
|
|
|
via a frame C and the setting |
|
1117
|
|
|
|
|
|
|
C), a CYA action is performed when an |
|
1118
|
|
|
|
|
|
|
edit may result in a confusion. More precise, adding an ID3v2 frame which |
|
1119
|
|
|
|
|
|
|
is I affected by C would convert other |
|
1120
|
|
|
|
|
|
|
frames to a standard-conforming encoding (and would set |
|
1121
|
|
|
|
|
|
|
C if required by C). |
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
Recall that the added frames are always encoded in standard-conformant way; |
|
1124
|
|
|
|
|
|
|
the action above avoids mixing non-standard-conformant frames with |
|
1125
|
|
|
|
|
|
|
standard-conformant frames. Such a mix could not be cleared up by setting |
|
1126
|
|
|
|
|
|
|
C! One should also keep in mind that this does not affect |
|
1127
|
|
|
|
|
|
|
frames which contain characters above C<0x255>; such frames are always written |
|
1128
|
|
|
|
|
|
|
in Unicode, thus are not affected by C. |
|
1129
|
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
=item id3v2_frames_autofill |
|
1131
|
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
Hash of suggested ID3v2 frames to autogenerate basing on extra information |
|
1133
|
|
|
|
|
|
|
available; keys are frame descriptors (such as C), values |
|
1134
|
|
|
|
|
|
|
indicate whether ID3v2 tag should be created if it was not present. |
|
1135
|
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
This variable is inspected by the method C, |
|
1137
|
|
|
|
|
|
|
which is not called automatically when the tag is accessed, but may be called |
|
1138
|
|
|
|
|
|
|
by scripts using the module. |
|
1139
|
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
The default is to force creation of tag for C frame, and do not |
|
1141
|
|
|
|
|
|
|
force creation for C and C. |
|
1142
|
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
=item local_cfg_file |
|
1144
|
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
Name of configuration file read at startup by the method parse_cfg(); is |
|
1146
|
|
|
|
|
|
|
C<~>-substituted; defaults to F<~/.mp3tagprc>. |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=item prohibit_v24 |
|
1149
|
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
If FALSE (default), reading of ID3v2.4 is allowed (it is not fully supported, |
|
1151
|
|
|
|
|
|
|
but most things work acceptably). |
|
1152
|
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
=item write_v24 |
|
1154
|
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
If FALSE (default), writing of ID3v2.4 is prohibited (it is not fully |
|
1156
|
|
|
|
|
|
|
supported; allow on your own risk). |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=item name_for_field_normalization |
|
1159
|
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
interpolation of this string is used as a person name to normalize |
|
1161
|
|
|
|
|
|
|
title-like fields. Defaults to C<%{composer}>. |
|
1162
|
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
=item extra_config_keys |
|
1164
|
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
List of extra config keys (default is empty); setting these would not cause |
|
1166
|
|
|
|
|
|
|
warnings, and would not affect operation of C. Applications using |
|
1167
|
|
|
|
|
|
|
this module may add to this list to allow their configuration by the same |
|
1168
|
|
|
|
|
|
|
means as configuration of C. |
|
1169
|
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=item is_writable |
|
1171
|
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
Contains a boolean value, or a method name and argument list |
|
1173
|
|
|
|
|
|
|
to call whether the tag may be added to the file. Defaults to |
|
1174
|
|
|
|
|
|
|
writable_by_extension(). |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=item writable_extensions |
|
1177
|
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
Contains a list of extensions (case insensitive) for which the tag may be |
|
1179
|
|
|
|
|
|
|
added to the file. Current default is C
|
|
1180
|
|
|
|
|
|
|
mp4 aiff flac ape ram mpc> (extracted from L docs; may be tuned |
|
1181
|
|
|
|
|
|
|
later). |
|
1182
|
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
=item * |
|
1184
|
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
Later there will be probably more things to configure. |
|
1186
|
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
=back |
|
1188
|
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
=cut |
|
1190
|
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
my $conf_rex; |
|
1192
|
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
sub config { |
|
1194
|
24
|
|
|
24
|
|
80
|
my ($self, $item, @options) = @_; |
|
1195
|
24
|
|
|
|
|
36
|
$item = lc $item; |
|
1196
|
24
|
100
|
100
|
|
|
305
|
my $config = ref $self ? ($self->{config} ||= {%config}) : \%config; |
|
1197
|
24
|
|
|
|
|
180
|
my @known = qw(autoinfo title artist album year comment track genre |
|
1198
|
|
|
|
|
|
|
v2title cddb_files force_interpolate parse_data parse_split |
|
1199
|
|
|
|
|
|
|
composer performer default_language default_descr_c |
|
1200
|
|
|
|
|
|
|
update_length id3v2_fix_encoding_on_write |
|
1201
|
|
|
|
|
|
|
id3v2_fix_encoding_on_edit extra_config_keys |
|
1202
|
|
|
|
|
|
|
parse_join parse_filename_ignore_case encoded_v1_fits |
|
1203
|
|
|
|
|
|
|
parse_filename_merge_dots year_is_timestamp |
|
1204
|
|
|
|
|
|
|
comment_remove_date extension id3v2_missing_fatal |
|
1205
|
|
|
|
|
|
|
id3v2_frame_empty_ok id3v2_minpadding id3v2_sizemult |
|
1206
|
|
|
|
|
|
|
id3v2_shrink id3v2_mergepadding person_frames short_person |
|
1207
|
|
|
|
|
|
|
parse_minmatch id3v23_unsync id3v23_unsync_size_w |
|
1208
|
|
|
|
|
|
|
id3v2_recalculate ignore_trusted_encoding0_v2 |
|
1209
|
|
|
|
|
|
|
id3v2_set_trusted_encoding0 write_v24 prohibit_v24 |
|
1210
|
|
|
|
|
|
|
encode_encoding_files encode_encoding_v1 encode_encoding_cue |
|
1211
|
|
|
|
|
|
|
decode_encoding_v1 decode_encoding_v2 |
|
1212
|
|
|
|
|
|
|
decode_encoding_filename decode_encoding_files |
|
1213
|
|
|
|
|
|
|
decode_encoding_inf decode_encoding_cddb_file |
|
1214
|
|
|
|
|
|
|
name_for_field_normalization is_writable writable_extensions |
|
1215
|
|
|
|
|
|
|
id3v2_frames_autofill local_cfg_file ampersand_joiner); |
|
1216
|
24
|
|
|
|
|
217
|
my @tr = map "translate_$_", qw( title track artist album comment |
|
1217
|
|
|
|
|
|
|
year genre comment_collection |
|
1218
|
|
|
|
|
|
|
comment_track title_track |
|
1219
|
|
|
|
|
|
|
composer performer |
|
1220
|
|
|
|
|
|
|
artist_collection person ); |
|
1221
|
24
|
|
|
|
|
54
|
my $e_known = $self->get_config('extra_config_keys'); |
|
1222
|
24
|
|
|
|
|
37
|
$e_known = [map lc, @$e_known]; |
|
1223
|
24
|
100
|
|
|
|
72
|
$conf_rex = '^(' . join('|', @known, @$e_known, @tr) . ')$' unless $conf_rex; |
|
1224
|
|
|
|
|
|
|
|
|
1225
|
24
|
50
|
|
|
|
1402
|
if ($item =~ /^(force)$/) { |
|
|
|
50
|
|
|
|
|
|
|
1226
|
0
|
|
|
|
|
0
|
return $config->{$item} = {@options}; |
|
1227
|
|
|
|
|
|
|
} elsif ($item !~ $conf_rex) { |
|
1228
|
0
|
|
|
|
|
0
|
warn "MP3::Tag::config(): Unknown option '$item' found; known options: @known @$e_known @tr\n REX = <<<$conf_rex>>>\n"; |
|
1229
|
0
|
|
|
|
|
0
|
return; |
|
1230
|
|
|
|
|
|
|
} |
|
1231
|
24
|
50
|
|
|
|
78
|
undef $conf_rex if $item eq 'extra_config_keys'; |
|
1232
|
|
|
|
|
|
|
|
|
1233
|
24
|
|
|
|
|
133
|
$config->{$item} = \@options; |
|
1234
|
|
|
|
|
|
|
} |
|
1235
|
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
=item get_config |
|
1237
|
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
$opt_array = $mp3->get_config("item"); |
|
1239
|
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
When object options are first time set or get, the global options are |
|
1241
|
|
|
|
|
|
|
propagated into object options. (So if global options are changed later, these |
|
1242
|
|
|
|
|
|
|
changes are not inherited.) |
|
1243
|
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
=item get_config1 |
|
1245
|
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
$opt = $mp3->get_config1("item"); |
|
1247
|
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
Similar to get_config(), but returns UNDEF if no config array is present, or |
|
1249
|
|
|
|
|
|
|
the first entry of array otherwise. |
|
1250
|
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
=cut |
|
1252
|
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
sub get_config ($$) { |
|
1254
|
2622
|
|
|
2622
|
|
2320
|
my ($self, $item) = @_; |
|
1255
|
2622
|
100
|
100
|
|
|
6480
|
my $config = ref $self ? ($self->{config} ||= {%config}) : \%config; |
|
1256
|
2622
|
|
|
|
|
8260
|
$config->{lc $item}; |
|
1257
|
|
|
|
|
|
|
} |
|
1258
|
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
sub get_config1 { |
|
1260
|
683
|
|
|
683
|
|
525
|
my $self = shift; |
|
1261
|
683
|
|
|
|
|
790
|
my $c = $self->get_config(@_); |
|
1262
|
683
|
100
|
|
|
|
3072
|
$c and $c->[0]; |
|
1263
|
|
|
|
|
|
|
} |
|
1264
|
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
=item name_for_field_normalization |
|
1266
|
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
$name = $mp3->name_for_field_normalization; |
|
1268
|
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
Returns "person name" to use for normalization of title-like fields; |
|
1270
|
|
|
|
|
|
|
it is the result of interpolation of the configuration variable |
|
1271
|
|
|
|
|
|
|
C (defaults to C<%{composer}> - which, by |
|
1272
|
|
|
|
|
|
|
default, expands the same as C<%{TCOM|a}>). |
|
1273
|
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
=cut |
|
1275
|
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
sub name_for_field_normalization ($) { |
|
1277
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
1278
|
0
|
|
|
|
|
0
|
$self->interpolate( $self->get_config1("name_for_field_normalization") ); |
|
1279
|
|
|
|
|
|
|
} |
|
1280
|
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=item pure_filetags |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
$data = $mp3->pure_filetags()->autoinfo; |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
Configures $mp3 to not read anything except the pure ID3v2 or ID3v1 tags, and |
|
1286
|
|
|
|
|
|
|
do not postprocess them. Returns the object reference itself to simplify |
|
1287
|
|
|
|
|
|
|
chaining of method calls. |
|
1288
|
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
=cut |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
sub pure_filetags ($) { |
|
1292
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
1293
|
0
|
|
|
|
|
0
|
for my $c (qw(autoinfo title artist album year comment track genre)) { |
|
1294
|
0
|
|
|
|
|
0
|
$self->config($c,"ID3v2","ID3v1"); |
|
1295
|
|
|
|
|
|
|
} |
|
1296
|
0
|
|
|
|
|
0
|
$self->config('comment_remove_date', 0); |
|
1297
|
0
|
|
|
|
|
0
|
for my $k (%{$self->{config}}) { |
|
|
0
|
|
|
|
|
0
|
|
|
1298
|
0
|
0
|
|
|
|
0
|
delete $self->{config}->{$k} if $k =~ /^translate_/; |
|
1299
|
|
|
|
|
|
|
} |
|
1300
|
0
|
|
|
|
|
0
|
return $self; |
|
1301
|
|
|
|
|
|
|
} |
|
1302
|
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
=item get_user |
|
1304
|
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
$data = $mp3->get_user($n); # n-th piece of user scratch space |
|
1306
|
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
Queries an entry in a scratch array ($n=3 corresponds to C<%{U3}>). |
|
1308
|
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
=item set_user |
|
1310
|
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
$mp3->set_user($n, $data); # n-th piece of user scratch space |
|
1312
|
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
Sets an entry in a scratch array ($n=3 corresponds to C<%{U3}>). |
|
1314
|
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
=cut |
|
1316
|
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
sub get_user ($$) { |
|
1318
|
0
|
|
|
0
|
|
0
|
my ($self, $item) = @_; |
|
1319
|
0
|
0
|
|
|
|
0
|
unless ($self->{userdata}) { |
|
1320
|
0
|
0
|
0
|
|
|
0
|
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN}; |
|
1321
|
0
|
|
|
|
|
0
|
$self->{ParseData}->parse('track'); # Populate the hash if possible |
|
1322
|
0
|
|
0
|
|
|
0
|
$self->{userdata} ||= []; |
|
1323
|
|
|
|
|
|
|
} |
|
1324
|
0
|
0
|
|
|
|
0
|
return unless defined (my $d = $self->{userdata}[$item]); |
|
1325
|
0
|
|
|
|
|
0
|
$d; |
|
1326
|
|
|
|
|
|
|
} |
|
1327
|
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
sub set_user ($$$) { |
|
1329
|
0
|
|
|
0
|
|
0
|
my ($self, $item, $val) = @_; |
|
1330
|
0
|
|
0
|
|
|
0
|
$self->{userdata} ||= []; |
|
1331
|
0
|
|
|
|
|
0
|
$self->{userdata}[$item] = $val; |
|
1332
|
|
|
|
|
|
|
} |
|
1333
|
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
=item set_id3v2_frame |
|
1335
|
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
$mp3->set_id3v2_frame($name, @values); |
|
1337
|
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
When called with only $name as the argument, removes the specified |
|
1339
|
|
|
|
|
|
|
frame (if it existed). Otherwise sets the frame passing the specified |
|
1340
|
|
|
|
|
|
|
@values to the add_frame() function of MP3::Tag::ID3v2. (The old value is |
|
1341
|
|
|
|
|
|
|
removed.) |
|
1342
|
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
=cut |
|
1344
|
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
# With two elements, removes frame |
|
1346
|
|
|
|
|
|
|
sub set_id3v2_frame ($$;@) { |
|
1347
|
6
|
|
|
6
|
|
184
|
my ($self, $item) = (shift, shift); |
|
1348
|
6
|
|
|
|
|
13
|
$self->get_tags; |
|
1349
|
6
|
0
|
33
|
|
|
15
|
return if not @_ and not exists $self->{ID3v2}; |
|
1350
|
6
|
100
|
|
|
|
21
|
$self->new_tag("ID3v2") unless exists $self->{ID3v2}; |
|
1351
|
|
|
|
|
|
|
$self->{ID3v2}->remove_frame($item) |
|
1352
|
6
|
100
|
|
|
|
16
|
if defined $self->{ID3v2}->get_frame($item); |
|
1353
|
6
|
50
|
|
|
|
20
|
return unless @_; |
|
1354
|
6
|
|
|
|
|
18
|
return $self->{ID3v2}->add_frame($item, @_); |
|
1355
|
|
|
|
|
|
|
} |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=item get_id3v2_frames |
|
1358
|
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
($descr, @frames) = $mp3->get_id3v2_frames($fname); |
|
1360
|
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
Returns the specified frame(s); has the same API as |
|
1362
|
|
|
|
|
|
|
L, but also returns undef if no ID3v2 |
|
1363
|
|
|
|
|
|
|
tag is present. |
|
1364
|
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
=cut |
|
1366
|
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
sub get_id3v2_frames ($$;$) { |
|
1368
|
0
|
|
|
0
|
|
0
|
my ($self) = (shift); |
|
1369
|
0
|
|
|
|
|
0
|
$self->get_tags; |
|
1370
|
0
|
0
|
|
|
|
0
|
return if not exists $self->{ID3v2}; |
|
1371
|
0
|
|
|
|
|
0
|
$self->{ID3v2}->get_frames(@_); |
|
1372
|
|
|
|
|
|
|
} |
|
1373
|
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
=item delete_tag |
|
1375
|
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
$deleted = $mp3->delete_tag($tag); |
|
1377
|
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
$tag should be either C or C. Deletes the tag if it is present. |
|
1379
|
|
|
|
|
|
|
Returns FALSE if the tag is not present. |
|
1380
|
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
=cut |
|
1382
|
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
sub delete_tag ($$) { |
|
1384
|
0
|
|
|
0
|
|
0
|
my ($self, $tag) = (shift, shift); |
|
1385
|
0
|
|
|
|
|
0
|
$self->get_tags; |
|
1386
|
0
|
0
|
|
|
|
0
|
die "Unexpected tag type '$tag'" unless $tag =~ /^ID3v[12]$/; |
|
1387
|
0
|
0
|
|
|
|
0
|
return unless exists $self->{$tag}; |
|
1388
|
0
|
|
|
|
|
0
|
my $res = $self->{$tag}->remove_tag(); |
|
1389
|
0
|
0
|
|
|
|
0
|
$res = ($res >= 0) if $tag eq 'ID3v1'; # -1 on error |
|
1390
|
0
|
0
|
|
|
|
0
|
$res or die "Error deleting tag `$tag'"; |
|
1391
|
|
|
|
|
|
|
} |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=item is_id3v2_modified |
|
1394
|
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
$frame = $mp3->is_id3v2_modified(); |
|
1396
|
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
Returns TRUE if ID3v2 tag exists and was modified after creation. |
|
1398
|
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
=cut |
|
1400
|
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
sub is_id3v2_modified ($$;@) { |
|
1402
|
0
|
|
|
0
|
|
0
|
my ($self) = (shift); |
|
1403
|
0
|
0
|
|
|
|
0
|
return if not exists $self->{ID3v2}; |
|
1404
|
0
|
|
|
|
|
0
|
$self->{ID3v2}->is_modified(); |
|
1405
|
|
|
|
|
|
|
} |
|
1406
|
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
=item select_id3v2_frame |
|
1408
|
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
$frame = $mp3->select_id3v2_frame($fname, $descrs, $langs [, $VALUE]); |
|
1410
|
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
Returns the specified frame(s); has the same API as |
|
1412
|
|
|
|
|
|
|
L (args are the frame name, the list of |
|
1413
|
|
|
|
|
|
|
wanted Descriptors, list of wanted Languages, and possibly the new |
|
1414
|
|
|
|
|
|
|
contents - with C meaning deletion). For read-only access it |
|
1415
|
|
|
|
|
|
|
returns empty if no ID3v2 tag is present, or no frame is found. |
|
1416
|
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
If new contents is specified, B the existing frames matching the |
|
1418
|
|
|
|
|
|
|
specification are deleted. |
|
1419
|
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
=item have_id3v2_frame |
|
1421
|
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
$have_it = $mp3->have_id3v2_frame($fname, $descrs, $langs); |
|
1423
|
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
Returns TRUE the specified frame(s) exist; has the same API as |
|
1425
|
|
|
|
|
|
|
L (args are frame name, list of wanted |
|
1426
|
|
|
|
|
|
|
Descriptors, list of wanted Languages). |
|
1427
|
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=item get_id3v2_frame_ids |
|
1429
|
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
$h = $mp3->get_id3v2_frame_ids(); |
|
1431
|
|
|
|
|
|
|
print " $_ => $h{$_}" for keys %$h; |
|
1432
|
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
Returns a hash reference with the short names of ID3v2 frames present |
|
1434
|
|
|
|
|
|
|
in the tag as keys (and long description of the meaning as values), or |
|
1435
|
|
|
|
|
|
|
FALSE if no ID3v2 tag is present. See |
|
1436
|
|
|
|
|
|
|
L for details. |
|
1437
|
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
=item id3v2_frame_descriptors |
|
1439
|
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
Returns the list of human-readable "long names" of frames (such as |
|
1441
|
|
|
|
|
|
|
C), appropriate for interpolation, or |
|
1442
|
|
|
|
|
|
|
for select_id3v2_frame_by_descr(). |
|
1443
|
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
=item select_id3v2_frame_by_descr |
|
1445
|
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
=item have_id3v2_frame_by_descr |
|
1447
|
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
Similar to select_id3v2_frame(), have_id3v2_frame(), but instead of |
|
1449
|
|
|
|
|
|
|
arguments $fname, $descrs, $langs take one string of the form |
|
1450
|
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
NAME(langs)[descr] |
|
1452
|
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
Both C<(langs)> and C<[descr]> parts may be omitted; langs should |
|
1454
|
|
|
|
|
|
|
contain comma-separated list of needed languages. The semantic is |
|
1455
|
|
|
|
|
|
|
similar to |
|
1456
|
|
|
|
|
|
|
L. |
|
1457
|
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
It is allowed to have C of the form C; C-th frame |
|
1459
|
|
|
|
|
|
|
with name C is chosen (C<-1>-based: the first frame is C, |
|
1460
|
|
|
|
|
|
|
the second C, the third C etc; for more user-friendly |
|
1461
|
|
|
|
|
|
|
scheme, use C of the form C<#NNN>, with C 0-based; see |
|
1462
|
|
|
|
|
|
|
L). |
|
1463
|
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
$frame = $mp3->select_id3v2_frame_by_descr($descr [, $VALUE1, ...]); |
|
1465
|
|
|
|
|
|
|
$have_it = $mp3->have_id3v2_frame_by_descr($descr); |
|
1466
|
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
select_id3v2_frame_by_descr() will also apply the normalizer in config |
|
1468
|
|
|
|
|
|
|
setting C if the frame name matches one of the |
|
1469
|
|
|
|
|
|
|
elements of the configuration setting C. |
|
1470
|
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
$c = $mp3->select_id3v2_frame_by_descr("COMM(fre,fra,eng,#0)[]"); |
|
1472
|
|
|
|
|
|
|
$t = $mp3->select_id3v2_frame_by_descr("TIT2"); |
|
1473
|
|
|
|
|
|
|
$mp3->select_id3v2_frame_by_descr("TIT2", "MyT"); # Set/Change |
|
1474
|
|
|
|
|
|
|
$mp3->select_id3v2_frame_by_descr("RBUF", $n1, $n2, $n3); # Set/Change |
|
1475
|
|
|
|
|
|
|
$mp3->select_id3v2_frame_by_descr("RBUF", "$n1;$n2;$n3"); # Set/Change |
|
1476
|
|
|
|
|
|
|
$mp3->select_id3v2_frame_by_descr("TIT2", undef); # Remove |
|
1477
|
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
Remember that when select_id3v2_frame_by_descr() is used for |
|
1479
|
|
|
|
|
|
|
modification, B found frames are deleted before a new one is |
|
1480
|
|
|
|
|
|
|
added. For gory details, see L. |
|
1481
|
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
=item frame_translate |
|
1483
|
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
$mp3->frame_translate('TCOM'); # Normalize TCOM ID3v2 frame |
|
1485
|
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
assuming that the frame value denotes a person, normalizes the value |
|
1487
|
|
|
|
|
|
|
using personal name normalization logic (via C |
|
1488
|
|
|
|
|
|
|
configuration value). Frame is updated, but the tag is not written |
|
1489
|
|
|
|
|
|
|
back. The frame must be in the list of personal names frames |
|
1490
|
|
|
|
|
|
|
(C configuration value). |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
=item frames_translate |
|
1493
|
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
Similar to frame_translate(), but updates all the frames in |
|
1495
|
|
|
|
|
|
|
C configuration value. |
|
1496
|
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
=cut |
|
1498
|
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
sub select_id3v2_frame ($$;@) { |
|
1500
|
49
|
|
|
49
|
|
257
|
my ($self) = (shift); |
|
1501
|
49
|
|
|
|
|
70
|
$self->get_tags; |
|
1502
|
49
|
100
|
|
|
|
77
|
if (not exists $self->{ID3v2}) { |
|
1503
|
1
|
50
|
33
|
|
|
7
|
return if @_ <= 3 or not defined $_[3]; # Read access, or deletion |
|
1504
|
1
|
|
|
|
|
3
|
$self->new_tag("ID3v2"); |
|
1505
|
|
|
|
|
|
|
} |
|
1506
|
49
|
|
|
|
|
124
|
$self->{ID3v2}->frame_select(@_); |
|
1507
|
|
|
|
|
|
|
} |
|
1508
|
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
sub _select_id3v2_frame_by_descr ($$$;@) { |
|
1510
|
169
|
|
|
169
|
|
168
|
my ($self, $update) = (shift, shift); |
|
1511
|
169
|
|
|
|
|
213
|
$self->get_tags; |
|
1512
|
169
|
100
|
|
|
|
259
|
if (not exists $self->{ID3v2}) { |
|
1513
|
7
|
50
|
33
|
|
|
41
|
return if @_ <= 1 or @_ <= 2 and not defined $_[1]; # Read or delete |
|
|
|
|
33
|
|
|
|
|
|
1514
|
7
|
|
|
|
|
13
|
$self->new_tag("ID3v2"); |
|
1515
|
|
|
|
|
|
|
} |
|
1516
|
169
|
|
|
|
|
144
|
my $fname = $_[0]; |
|
1517
|
169
|
|
|
|
|
303
|
$fname =~ s/^(\w{4})\d+/$1/; # if FRAMnn, convert to FRAM |
|
1518
|
169
|
|
50
|
|
|
271
|
my $tr = ($self->get_config('translate_person') || [])->[0]; |
|
1519
|
169
|
50
|
|
|
|
268
|
if ($tr) { |
|
1520
|
0
|
|
|
|
|
0
|
my $translate = $self->get_config('person_frames'); |
|
1521
|
0
|
0
|
|
|
|
0
|
unless (ref $translate eq 'HASH') { # XXXX Store the hash somewhere??? |
|
1522
|
0
|
|
|
|
|
0
|
$translate = {map +($_, 1), @$translate}; |
|
1523
|
|
|
|
|
|
|
#$self->config('person_frames', @translate); |
|
1524
|
|
|
|
|
|
|
} |
|
1525
|
0
|
|
|
|
|
0
|
my $do = $translate->{$fname}; |
|
1526
|
0
|
0
|
0
|
|
|
0
|
$do = $translate->{$fname} # Remove language |
|
1527
|
|
|
|
|
|
|
if not $do and $fname =~ s/^(\w{4})(?:\(([^()]*(?:\([^()]+\)[^()]*)*)\))/$1/; |
|
1528
|
0
|
0
|
|
|
|
0
|
undef $tr unless $do; |
|
1529
|
|
|
|
|
|
|
} |
|
1530
|
169
|
50
|
33
|
|
|
267
|
return if $update and not $tr; |
|
1531
|
169
|
|
50
|
102
|
|
717
|
$tr ||= sub {$_[1]}; |
|
|
102
|
|
|
|
|
124
|
|
|
1532
|
169
|
100
|
100
|
|
|
564
|
return $self->{ID3v2}->frame_select_by_descr_simpler(@_) |
|
|
|
|
66
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
if @_ > 2 or @_ == 2 and not defined $_[1]; # Multi-arg write or delete |
|
1534
|
|
|
|
|
|
|
return $self->{ID3v2}->frame_select_by_descr_simpler( |
|
1535
|
153
|
100
|
|
|
|
235
|
$_[0], &$tr($self, $_[1]) |
|
1536
|
|
|
|
|
|
|
) if @_ == 2; # Write access with one arg |
|
1537
|
|
|
|
|
|
|
|
|
1538
|
135
|
|
|
|
|
348
|
my $val = $self->{ID3v2}->frame_select_by_descr_simpler(@_); |
|
1539
|
135
|
|
|
|
|
108
|
my $nval; |
|
1540
|
135
|
100
|
|
|
|
253
|
$nval = &$tr($self, $val) if defined $val; |
|
1541
|
135
|
50
|
|
|
|
532
|
return $nval unless $update; |
|
1542
|
|
|
|
|
|
|
# Update logic: |
|
1543
|
0
|
0
|
0
|
|
|
0
|
return if not defined $val or $val eq $nval; |
|
1544
|
0
|
|
|
|
|
0
|
$self->{ID3v2}->frame_select_by_descr_simpler($_[0], $nval); |
|
1545
|
|
|
|
|
|
|
} |
|
1546
|
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
sub select_id3v2_frame_by_descr ($$;@) { |
|
1548
|
169
|
|
|
169
|
|
911
|
my ($self) = (shift); |
|
1549
|
169
|
|
|
|
|
272
|
return $self->_select_id3v2_frame_by_descr(0, @_); |
|
1550
|
|
|
|
|
|
|
} |
|
1551
|
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
sub frame_translate ($@) { |
|
1553
|
0
|
|
|
0
|
|
0
|
my ($self) = (shift); |
|
1554
|
0
|
|
|
|
|
0
|
return $self->_select_id3v2_frame_by_descr(1, @_); |
|
1555
|
|
|
|
|
|
|
} |
|
1556
|
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
sub frames_translate ($) { |
|
1558
|
0
|
|
|
0
|
|
0
|
my ($self) = (shift); |
|
1559
|
0
|
0
|
|
|
|
0
|
for my $f (@{$self->get_config('person_frames') || []}) { |
|
|
0
|
|
|
|
|
0
|
|
|
1560
|
0
|
|
|
|
|
0
|
$self->frame_translate($f); |
|
1561
|
|
|
|
|
|
|
} |
|
1562
|
|
|
|
|
|
|
} |
|
1563
|
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
sub have_id3v2_frame ($$;@) { |
|
1565
|
0
|
|
|
0
|
|
0
|
my ($self) = (shift); |
|
1566
|
0
|
|
|
|
|
0
|
$self->get_tags; |
|
1567
|
0
|
0
|
|
|
|
0
|
return if not exists $self->{ID3v2}; |
|
1568
|
0
|
|
|
|
|
0
|
$self->{ID3v2}->frame_have(@_); |
|
1569
|
|
|
|
|
|
|
} |
|
1570
|
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
sub have_id3v2_frame_by_descr ($$) { |
|
1572
|
30
|
|
|
30
|
|
30
|
my ($self) = (shift); |
|
1573
|
30
|
|
|
|
|
37
|
$self->get_tags; |
|
1574
|
30
|
100
|
|
|
|
51
|
return if not exists $self->{ID3v2}; |
|
1575
|
27
|
|
|
|
|
70
|
$self->{ID3v2}->frame_have_by_descr(shift); |
|
1576
|
|
|
|
|
|
|
} |
|
1577
|
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
sub get_id3v2_frame_ids ($$) { |
|
1579
|
0
|
|
|
0
|
|
0
|
my ($self) = (shift); |
|
1580
|
0
|
|
|
|
|
0
|
$self->get_tags; |
|
1581
|
0
|
0
|
|
|
|
0
|
return if not exists $self->{ID3v2}; |
|
1582
|
0
|
|
|
|
|
0
|
$self->{ID3v2}->get_frame_ids(@_); |
|
1583
|
|
|
|
|
|
|
} |
|
1584
|
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
sub id3v2_frame_descriptors ($) { |
|
1586
|
7
|
|
|
7
|
|
10
|
my ($self) = (shift); |
|
1587
|
7
|
|
|
|
|
9
|
$self->get_tags; |
|
1588
|
7
|
50
|
|
|
|
14
|
return if not exists $self->{ID3v2}; |
|
1589
|
7
|
|
|
|
|
20
|
$self->{ID3v2}->get_frame_descriptors(@_); |
|
1590
|
|
|
|
|
|
|
} |
|
1591
|
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
=item copy_id3v2_frames($from, $to, $overwrite, [$keep_flags, $f_ids]) |
|
1593
|
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
Copies specified frames between C objects $from, $to. Unless |
|
1595
|
|
|
|
|
|
|
$keep_flags, the copied frames have their flags cleared. |
|
1596
|
|
|
|
|
|
|
If the array reference $f_ids is not specified, all the frames (but C |
|
1597
|
|
|
|
|
|
|
and C) are considered (subject to $overwrite), otherwise $f_ids should |
|
1598
|
|
|
|
|
|
|
contain short frame ids to consider. Group ID flag is always cleared. |
|
1599
|
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
If $overwrite is C<'delete'>, frames with the same descriptors (as |
|
1601
|
|
|
|
|
|
|
returned by get_frame_descr()) in $to are deleted first, then all the |
|
1602
|
|
|
|
|
|
|
specified frames are copied. If $overwrite is FALSE, only frames with |
|
1603
|
|
|
|
|
|
|
descriptors not present in $to are copied. (If one of these two |
|
1604
|
|
|
|
|
|
|
conditions is not met, the result may be not conformant to standards.) |
|
1605
|
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
Returns count of copied frames. |
|
1607
|
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
=cut |
|
1609
|
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
sub copy_id3v2_frames { |
|
1611
|
0
|
|
|
0
|
|
0
|
my ($from, $to, $overwrite, $keep_flags, $f_ids) = @_; |
|
1612
|
0
|
|
|
|
|
0
|
$from->get_tags; |
|
1613
|
0
|
0
|
|
|
|
0
|
return 0 unless $from = $from->{ID3v2}; # No need to create it... |
|
1614
|
0
|
|
0
|
|
|
0
|
$f_ids ||= [keys %{$from->get_frame_ids}]; |
|
|
0
|
|
|
|
|
0
|
|
|
1615
|
0
|
0
|
|
|
|
0
|
return 0 unless @$f_ids; |
|
1616
|
0
|
|
|
|
|
0
|
$to->get_tags; |
|
1617
|
0
|
0
|
|
|
|
0
|
$to->new_tag("ID3v2") if not exists $to->{ID3v2}; |
|
1618
|
0
|
|
|
|
|
0
|
$from->copy_frames($to->{ID3v2}, $overwrite, $keep_flags, $f_ids); |
|
1619
|
|
|
|
|
|
|
} |
|
1620
|
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
sub _Data_to_MIME ($$;$) { |
|
1622
|
0
|
|
|
0
|
|
0
|
goto &MP3::Tag::ID3v2::_Data_to_MIME |
|
1623
|
|
|
|
|
|
|
} |
|
1624
|
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
=item _Data_to_MIME |
|
1626
|
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
Internal method to extract MIME type from a string the image file content. |
|
1628
|
|
|
|
|
|
|
Returns C for unrecognized data |
|
1629
|
|
|
|
|
|
|
(unless extra TRUE argument is given). |
|
1630
|
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
$format = $id3->_Data_to_MIME($data); |
|
1632
|
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
Currently, only the first 4 bytes of the string are inspected. |
|
1634
|
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
=cut |
|
1636
|
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
=item shorten_person |
|
1639
|
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
$string = $mp3->shorten_person($person_name); |
|
1641
|
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
shorten $person_name as a personal name (according to C |
|
1643
|
|
|
|
|
|
|
configuration setting). |
|
1644
|
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
=cut |
|
1646
|
|
|
|
|
|
|
|
|
1647
|
|
|
|
|
|
|
sub shorten_person ($$) { |
|
1648
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
1649
|
0
|
|
0
|
|
|
0
|
my $tr = ($self->get_config('short_person') || [])->[0]; |
|
1650
|
0
|
0
|
|
|
|
0
|
return shift unless $tr; |
|
1651
|
0
|
|
|
|
|
0
|
return &$tr($self, shift); |
|
1652
|
|
|
|
|
|
|
} |
|
1653
|
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
=item normalize_person |
|
1655
|
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
$string = $mp3->normalize_person($person_name); |
|
1657
|
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
normalize $person_name as a personal name (according to C |
|
1659
|
|
|
|
|
|
|
configuration setting). |
|
1660
|
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
=cut |
|
1662
|
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
sub normalize_person ($$) { |
|
1664
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
1665
|
0
|
|
0
|
|
|
0
|
my $tr = ($self->get_config('translate_person') || [])->[0]; |
|
1666
|
0
|
0
|
|
|
|
0
|
return shift unless $tr; |
|
1667
|
0
|
|
|
|
|
0
|
return &$tr($self, shift); |
|
1668
|
|
|
|
|
|
|
} |
|
1669
|
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
=item id3v2_frames_autofill |
|
1672
|
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
$mp3->id3v2_frames_autofill($force); |
|
1674
|
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
Generates missing tags from the list specified in C |
|
1676
|
|
|
|
|
|
|
configuration variable. The tags should be from a short list this method |
|
1677
|
|
|
|
|
|
|
knows how to deal with: |
|
1678
|
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
TXXX[MCDI-fulltoc]: filled from file audio_cd.toc in directory of the |
|
1680
|
|
|
|
|
|
|
audio file. [Create this file with |
|
1681
|
|
|
|
|
|
|
readcd -fulltoc dev=0,1,0 -f=audio_cd >& nul |
|
1682
|
|
|
|
|
|
|
modifying the dev (and redirection per your shell). ] |
|
1683
|
|
|
|
|
|
|
TXXX[cddb_id] |
|
1684
|
|
|
|
|
|
|
TXXX[cdindex_id]: filled from the result of the corresponding method |
|
1685
|
|
|
|
|
|
|
(which may extract from .inf or cddb files). |
|
1686
|
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
Existing frames are not modified unless $force option is specified; when |
|
1688
|
|
|
|
|
|
|
$force is true, ID3v2 tag will be created even if it was not present. |
|
1689
|
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
=cut |
|
1691
|
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
sub id3v2_frames_autofill ($$) { |
|
1693
|
0
|
|
|
0
|
|
0
|
my ($self, $forceframe) = (shift, shift); |
|
1694
|
0
|
|
|
|
|
0
|
my %force = @{$self->get_config('id3v2_frames_autofill')}; |
|
|
0
|
|
|
|
|
0
|
|
|
1695
|
0
|
|
|
|
|
0
|
$self->get_tags; |
|
1696
|
0
|
0
|
0
|
|
|
0
|
unless ($self->{ID3v2} or $forceframe) { # first run: force ID3v2? |
|
1697
|
0
|
|
|
|
|
0
|
for my $tag (keys %force) { |
|
1698
|
0
|
0
|
|
|
|
0
|
next unless $force{$tag}; |
|
1699
|
0
|
|
|
|
|
0
|
my $v; |
|
1700
|
0
|
0
|
0
|
|
|
0
|
$v = $self->$1() or next if $tag =~ /^TXXX\[(cd(?:db|index)_id)\]$/; |
|
1701
|
0
|
0
|
|
|
|
0
|
if ($tag eq 'TXXX[MCDI-fulltoc]') { |
|
1702
|
0
|
|
|
|
|
0
|
my $file = $self->interpolate('%D/audio_cd.toc'); |
|
1703
|
0
|
|
|
|
|
0
|
$v = -e $file; |
|
1704
|
|
|
|
|
|
|
} |
|
1705
|
0
|
0
|
|
|
|
0
|
$forceframe = 1, last if $v |
|
1706
|
|
|
|
|
|
|
} |
|
1707
|
|
|
|
|
|
|
} |
|
1708
|
0
|
|
|
|
|
0
|
for my $tag (keys %force) { |
|
1709
|
0
|
0
|
0
|
|
|
0
|
next if $self->have_id3v2_frame_by_descr($tag) and not $forceframe; |
|
1710
|
0
|
0
|
0
|
|
|
0
|
next unless $force{$tag} or $self->{ID3v2} or $forceframe; |
|
|
|
|
0
|
|
|
|
|
|
1711
|
0
|
|
|
|
|
0
|
my $v; |
|
1712
|
0
|
0
|
0
|
|
|
0
|
$v = $self->$1() or next if $tag =~ /^TXXX\[(cd(?:db|index)_id)\]$/; |
|
1713
|
0
|
0
|
|
|
|
0
|
if ($tag eq 'TXXX[MCDI-fulltoc]') { |
|
1714
|
0
|
|
|
|
|
0
|
my $file = $self->interpolate('%D/audio_cd.toc'); |
|
1715
|
0
|
0
|
|
|
|
0
|
next unless -e $file; |
|
1716
|
0
|
0
|
|
|
|
0
|
warn(<track; |
|
1717
|
|
|
|
|
|
|
Could deduce MCDI info, but per id3v2.4 specs, must know the track number! |
|
1718
|
|
|
|
|
|
|
EOW |
|
1719
|
0
|
0
|
|
|
|
0
|
eval { |
|
1720
|
0
|
0
|
|
|
|
0
|
open F, "< $file" or die "Can't open `$file' for read: $!"; |
|
1721
|
0
|
0
|
|
|
|
0
|
binmode F or die "Can't binmode `$file' for read: $!"; |
|
1722
|
0
|
|
|
|
|
0
|
local $/; |
|
1723
|
0
|
|
|
|
|
0
|
$v = ; |
|
1724
|
0
|
0
|
|
|
|
0
|
CORE::close F or die "Can't close `$file' for read: $!"; |
|
1725
|
|
|
|
|
|
|
} or warn($@), next; |
|
1726
|
|
|
|
|
|
|
} |
|
1727
|
0
|
0
|
|
|
|
0
|
$self->select_id3v2_frame_by_descr($tag, $v), next if defined $v; |
|
1728
|
0
|
|
|
|
|
0
|
die "id3v2_frames_autofill(): do not know how to create frame `$tag'"; |
|
1729
|
|
|
|
|
|
|
} |
|
1730
|
|
|
|
|
|
|
} |
|
1731
|
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
=item interpolate |
|
1733
|
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
$string = $mp3->interpolate($pattern) |
|
1735
|
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
interpolates C<%>-escapes in $pattern using the information from $mp3 tags. |
|
1737
|
|
|
|
|
|
|
The syntax of escapes is similar to this of sprintf(): |
|
1738
|
|
|
|
|
|
|
|
|
1739
|
|
|
|
|
|
|
% [ [FLAGS] MINWIDTH] [.MAXWIDTH] ESCAPE |
|
1740
|
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
The only recognized FLAGS are C<-> (to denote left-alignment inside MINWIDTH- |
|
1742
|
|
|
|
|
|
|
wide field), C<' '> (SPACE), and C<0> (denoting the fill character to use), as |
|
1743
|
|
|
|
|
|
|
well as an arbitrary character in parentheses (which becomes the fill |
|
1744
|
|
|
|
|
|
|
character). MINWIDTH and MAXWIDTH should be numbers. |
|
1745
|
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
The short ESCAPEs are replaced by |
|
1747
|
|
|
|
|
|
|
|
|
1748
|
|
|
|
|
|
|
% => literal '%' |
|
1749
|
|
|
|
|
|
|
t => title |
|
1750
|
|
|
|
|
|
|
a => artist |
|
1751
|
|
|
|
|
|
|
l => album |
|
1752
|
|
|
|
|
|
|
y => year |
|
1753
|
|
|
|
|
|
|
g => genre |
|
1754
|
|
|
|
|
|
|
c => comment |
|
1755
|
|
|
|
|
|
|
n => track |
|
1756
|
|
|
|
|
|
|
f => filename without the directory path |
|
1757
|
|
|
|
|
|
|
F => filename with the directory path |
|
1758
|
|
|
|
|
|
|
D => the directory path of the filename |
|
1759
|
|
|
|
|
|
|
E => file extension |
|
1760
|
|
|
|
|
|
|
e => file extension without the leading dot |
|
1761
|
|
|
|
|
|
|
A => absolute filename without extension |
|
1762
|
|
|
|
|
|
|
B => filename without the directory part and extension |
|
1763
|
|
|
|
|
|
|
N => filename as originally given without extension |
|
1764
|
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
v mpeg_version |
|
1766
|
|
|
|
|
|
|
L mpeg_layer_roman |
|
1767
|
|
|
|
|
|
|
r bitrate_kbps |
|
1768
|
|
|
|
|
|
|
q frequency_kHz |
|
1769
|
|
|
|
|
|
|
Q frequency_Hz |
|
1770
|
|
|
|
|
|
|
S total_secs_int |
|
1771
|
|
|
|
|
|
|
M total_millisecs_int |
|
1772
|
|
|
|
|
|
|
m total_mins |
|
1773
|
|
|
|
|
|
|
mL leftover_mins |
|
1774
|
|
|
|
|
|
|
H total_hours |
|
1775
|
|
|
|
|
|
|
s leftover_secs |
|
1776
|
|
|
|
|
|
|
SL leftover_secs_trunc |
|
1777
|
|
|
|
|
|
|
ML leftover_msec |
|
1778
|
|
|
|
|
|
|
SML leftover_secs_float |
|
1779
|
|
|
|
|
|
|
C is_copyrighted_YN |
|
1780
|
|
|
|
|
|
|
p frames_padded_YN |
|
1781
|
|
|
|
|
|
|
o channel_mode |
|
1782
|
|
|
|
|
|
|
u frames |
|
1783
|
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
h height (these 3 for image files, Image::Size or Image::ExifData required) |
|
1785
|
|
|
|
|
|
|
w width |
|
1786
|
|
|
|
|
|
|
iT img_type |
|
1787
|
|
|
|
|
|
|
mT mime_type |
|
1788
|
|
|
|
|
|
|
mP mime_Pretype (the capitalized first part of mime_type) |
|
1789
|
|
|
|
|
|
|
aR aspect_ratio (width/height) |
|
1790
|
|
|
|
|
|
|
a3 aspect_ratio3 (3 decimal places after the dot) |
|
1791
|
|
|
|
|
|
|
aI aspect_ratio_inverted (height/width) |
|
1792
|
|
|
|
|
|
|
bD bit_depth |
|
1793
|
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
aC collection artist (from CDDB_File) |
|
1795
|
|
|
|
|
|
|
tT track title (from CDDB_File) |
|
1796
|
|
|
|
|
|
|
cC collection comment (from CDDB_File) |
|
1797
|
|
|
|
|
|
|
cT track comment (from CDDB_File) |
|
1798
|
|
|
|
|
|
|
iC CDDB id |
|
1799
|
|
|
|
|
|
|
iI CDIndex id |
|
1800
|
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
(Multi-char escapes must be inclosed in braces, as in C<%{SML}> or C<%.5{aR}>. |
|
1802
|
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
Additional multi-char escapes are interpretated is follows: |
|
1804
|
|
|
|
|
|
|
|
|
1805
|
|
|
|
|
|
|
=over 4 |
|
1806
|
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
=item * |
|
1808
|
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
Names of ID3v2 frames are replaced by their text values (empty for missing |
|
1810
|
|
|
|
|
|
|
frames). |
|
1811
|
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
=item * |
|
1813
|
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
Strings C and C are replaced by "pure track number" and |
|
1815
|
|
|
|
|
|
|
"max track number" (this allows for both formats C and C of "track", |
|
1816
|
|
|
|
|
|
|
the latter meaning track N1 of N2); use C to pad C with leading 0 |
|
1817
|
|
|
|
|
|
|
to the width of C (in absense of n2, to 2). Likewise for C, C |
|
1818
|
|
|
|
|
|
|
but with disk (media) number instead of track number; use C to encode |
|
1819
|
|
|
|
|
|
|
C as a letter (see L). |
|
1820
|
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
=item * |
|
1822
|
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
Strings C and C are replaced by the whole ID3v1/2 tag |
|
1824
|
|
|
|
|
|
|
(interpolation of C for an unmodified tag is subject to |
|
1825
|
|
|
|
|
|
|
C configuration variable). (These may work as |
|
1826
|
|
|
|
|
|
|
conditionals too, with C<:>.) |
|
1827
|
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
=item * |
|
1829
|
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
Strings of the form C are |
|
1831
|
|
|
|
|
|
|
replaced by the first FRAM frame with the descriptor "description" in |
|
1832
|
|
|
|
|
|
|
the specified comma-separated list of languages. Instead of a |
|
1833
|
|
|
|
|
|
|
language (ID3v2 uses lowercase 3-char ISO-639-2 language notations) one can use |
|
1834
|
|
|
|
|
|
|
a string of the form C<#Number>; e.g., C<#4> means 4th FRAM frame, or |
|
1835
|
|
|
|
|
|
|
FRAM04. Empty string for the language means any language.) Works as |
|
1836
|
|
|
|
|
|
|
a condition for conditional interpolation too. |
|
1837
|
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
Any one of the list of languages and the disription can be omitted; |
|
1839
|
|
|
|
|
|
|
this means that either the frame FRAM has no language or descriptor |
|
1840
|
|
|
|
|
|
|
associated, or no restriction should be applied. |
|
1841
|
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
Unknown language should be denoted as C (in uppercase!). The language |
|
1843
|
|
|
|
|
|
|
match is case-insensitive. |
|
1844
|
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
=item * |
|
1846
|
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
Several descriptors of the form |
|
1848
|
|
|
|
|
|
|
C discussed above may be |
|
1849
|
|
|
|
|
|
|
combined together with C<&>; the non-empty expansions are joined |
|
1850
|
|
|
|
|
|
|
together with the value of configuration variable C |
|
1851
|
|
|
|
|
|
|
(default C<"; ">). Example: |
|
1852
|
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
%{TXXX[pre-title]&TIT1&TIT2&TIT3&TXXX[post-title]} |
|
1854
|
|
|
|
|
|
|
|
|
1855
|
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
=item * |
|
1857
|
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
Strings of the form C are replaced |
|
1859
|
|
|
|
|
|
|
by the result of C (with the given arguments) in one of the specified |
|
1860
|
|
|
|
|
|
|
known subpackages (e.g., for C, C is used). Arbitrary number |
|
1861
|
|
|
|
|
|
|
of arguments is supported. Instead of a long name C one can use its |
|
1862
|
|
|
|
|
|
|
standard shortcut (e.g., C for C). For example, |
|
1863
|
|
|
|
|
|
|
|
|
1864
|
|
|
|
|
|
|
$mp3->interpolate('%{t(ID3v1,Cue)}') |
|
1865
|
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
returns the title from the ID3v1 tag, or (if not there) from a cue sheet. |
|
1867
|
|
|
|
|
|
|
One can use this in conditionals etc as well. |
|
1868
|
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
=item * |
|
1870
|
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
CI is replaced by I-th component of the directory name (with |
|
1872
|
|
|
|
|
|
|
0 corresponding to the last component). |
|
1873
|
|
|
|
|
|
|
|
|
1874
|
|
|
|
|
|
|
=item * |
|
1875
|
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
CI is replaced by the directory name with NUMBER components stripped. |
|
1877
|
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
=item * |
|
1879
|
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
CI is replaced by I-th component of the user scratch |
|
1881
|
|
|
|
|
|
|
array. |
|
1882
|
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
=item * |
|
1884
|
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
If string starts with C: if frame FNAME does not exists, the escape |
|
1886
|
|
|
|
|
|
|
is ignored; otherwise the rest of the string is reinterpreted. |
|
1887
|
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
=item * |
|
1889
|
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
String starting with C are treated similarly with inverted test. |
|
1891
|
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
=item * |
|
1893
|
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
If string starts with C: if frame FNAME exists, the part |
|
1895
|
|
|
|
|
|
|
after C<||> is ignored; otherwise the part before C<||> is ignored, |
|
1896
|
|
|
|
|
|
|
and the rest is reinterpreted. |
|
1897
|
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
=item * |
|
1899
|
|
|
|
|
|
|
|
|
1900
|
|
|
|
|
|
|
If string starts with C: if frame FNAME exists, the part |
|
1901
|
|
|
|
|
|
|
after C<|> is ignored; otherwise the part before C<|> is ignored, |
|
1902
|
|
|
|
|
|
|
and the rest is reinterpreted as if it started with C<%{>. |
|
1903
|
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
=item * |
|
1905
|
|
|
|
|
|
|
|
|
1906
|
|
|
|
|
|
|
String starting with IC<:> or CIC<:> are treated similarly |
|
1907
|
|
|
|
|
|
|
to ID3v2 conditionals, but the condition is that the corresponding escape |
|
1908
|
|
|
|
|
|
|
expands to non-empty string. Same applies to non-time related 2-char escapes |
|
1909
|
|
|
|
|
|
|
and user variables. |
|
1910
|
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
=item * |
|
1912
|
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
Likewise for string starting with IC<|> or IC<||>. |
|
1914
|
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
=item * |
|
1916
|
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
For strings of the form C or C, I is |
|
1918
|
|
|
|
|
|
|
interpolated, then normalized or shortened as a personal name |
|
1919
|
|
|
|
|
|
|
(according to C or C configuration |
|
1920
|
|
|
|
|
|
|
setting). |
|
1921
|
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
=item * |
|
1923
|
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
C or C is replaced by the result of calling the |
|
1925
|
|
|
|
|
|
|
corresponding method. |
|
1926
|
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
=item * |
|
1928
|
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
C is replaced by space-separated list of "long names" of ID3v2 |
|
1930
|
|
|
|
|
|
|
frames (see id3v2_frame_descriptors()). (To use a different separator, |
|
1931
|
|
|
|
|
|
|
put it after slash, as in C<%{frames/, }>, where separator is COMMA |
|
1932
|
|
|
|
|
|
|
SPACE). |
|
1933
|
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
=item * |
|
1935
|
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
C<_out_frames[QQPRE//QQPOST]> is replaced by a verbose listing of frames. |
|
1937
|
|
|
|
|
|
|
"simple" frames are output one-per-line (with the value surrounded by |
|
1938
|
|
|
|
|
|
|
C and C); fields of other frames are output one-per-line. |
|
1939
|
|
|
|
|
|
|
If one omits the leading C<_>, then C<__binary_DATA__> replaces the value |
|
1940
|
|
|
|
|
|
|
of binary fields. |
|
1941
|
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
=item * |
|
1943
|
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
C, C, and C are replaced by size of |
|
1945
|
|
|
|
|
|
|
ID3v2 tag in bytes, the amount of 0-padding at the end of the tag |
|
1946
|
|
|
|
|
|
|
(not counting one extra 0 byte at the end of tag which may be needed for |
|
1947
|
|
|
|
|
|
|
unsyncing if the last char is \xFF), and size without padding. Currently, |
|
1948
|
|
|
|
|
|
|
for modified ID3v2 tag, what is returned reflect the size on disk (i.e., |
|
1949
|
|
|
|
|
|
|
before modification). |
|
1950
|
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
=item * |
|
1952
|
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
C is replaced by C<'modified'> if ID3v2 is present and |
|
1954
|
|
|
|
|
|
|
is modified in memory; otherwise is replaced by an empty string. |
|
1955
|
|
|
|
|
|
|
|
|
1956
|
|
|
|
|
|
|
=item * |
|
1957
|
|
|
|
|
|
|
|
|
1958
|
|
|
|
|
|
|
For strings of the form C, I is interpolated |
|
1959
|
|
|
|
|
|
|
with flags in I (see L<"interpolate_with_flags">). If FLAGS |
|
1960
|
|
|
|
|
|
|
does not contain C, VALUE should have C<{}> and C<\> backwacked. |
|
1961
|
|
|
|
|
|
|
|
|
1962
|
|
|
|
|
|
|
=item * |
|
1963
|
|
|
|
|
|
|
|
|
1964
|
|
|
|
|
|
|
For strings of the form C, I is split on comma, and |
|
1965
|
|
|
|
|
|
|
the resulting list of formats is used to convert the duration of the |
|
1966
|
|
|
|
|
|
|
audio to a string using the method format_time(). (E.g., |
|
1967
|
|
|
|
|
|
|
C<%{T[=Em,?H:,{mL}]}> would print duration in (optional) hours and minutes |
|
1968
|
|
|
|
|
|
|
rounded to the closest minute.) |
|
1969
|
|
|
|
|
|
|
|
|
1970
|
|
|
|
|
|
|
=back |
|
1971
|
|
|
|
|
|
|
|
|
1972
|
|
|
|
|
|
|
The default for the fill character is SPACE. Fill character should preceed |
|
1973
|
|
|
|
|
|
|
C<-> if both are given. Example: |
|
1974
|
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
Title: %(/)-12.12t%{TIT3:; TIT3 is %\{TIT3\}}%{!TIT3:. No TIT3 is present} |
|
1976
|
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
will result in |
|
1978
|
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
Title: TITLE///////; TIT3 is Op. 16 |
|
1980
|
|
|
|
|
|
|
|
|
1981
|
|
|
|
|
|
|
if title is C, and TIT3 is C, and |
|
1982
|
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
Title: TITLE///////. No TIT3 is present |
|
1984
|
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
if title is C, but TIT3 is not present. |
|
1986
|
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
Fat content: %{COMM(eng,fra,fre,rus,)[FatContent]} |
|
1988
|
|
|
|
|
|
|
|
|
1989
|
|
|
|
|
|
|
will print the comment field with I C |
|
1990
|
|
|
|
|
|
|
prefering the description in English to one in French, Russian, or any |
|
1991
|
|
|
|
|
|
|
other language (in this order). (I do not know which one of |
|
1992
|
|
|
|
|
|
|
terminology/bibliography codes for French is used, so for safety |
|
1993
|
|
|
|
|
|
|
include both.) |
|
1994
|
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
Composer: %{TCOM|a} |
|
1996
|
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
will use the ID3v2 field C if present, otherwise uses C<%a> (this is |
|
1998
|
|
|
|
|
|
|
similar to |
|
1999
|
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
Composer: %{composer} |
|
2001
|
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
but the latter may be subject to (different) normalization, and/or |
|
2003
|
|
|
|
|
|
|
configuration variables). |
|
2004
|
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
Interpolation of ID3v2 frames uses the minimal possible non-ambiguous |
|
2006
|
|
|
|
|
|
|
backslashing rules: the only backslashes needed are to protect the |
|
2007
|
|
|
|
|
|
|
innermost closing delimiter (C<]> or C<}>) appearing as a literal |
|
2008
|
|
|
|
|
|
|
character, or to protect backslashes I preceding such |
|
2009
|
|
|
|
|
|
|
literal, or the closing delimiter. E.g., the pattern equal to |
|
2010
|
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
%{COMM(eng)[a\b\\c\}\]end\\\]\\\\]: comment `a\b\\c\\\}]end\]\\' present} |
|
2012
|
|
|
|
|
|
|
|
|
2013
|
|
|
|
|
|
|
checks for the presence of comment with the descriptor C. |
|
2014
|
|
|
|
|
|
|
Note that if you want to write this string as a Perl literal, a lot of |
|
2015
|
|
|
|
|
|
|
extra backslashes may be needed (unless you use CE'FOO'> |
|
2016
|
|
|
|
|
|
|
HERE-document). |
|
2017
|
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
%{T[?Hh,?{mL}m,{SML}s]} |
|
2019
|
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
for a file of duration 2345.62sec will result in C<39m05.62s>, while |
|
2021
|
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
%{T[?H:,?{mL}:,{SL},?{ML}]}sec |
|
2023
|
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
will result in C<39:05.620sec>. |
|
2025
|
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
=cut |
|
2027
|
|
|
|
|
|
|
|
|
2028
|
|
|
|
|
|
|
# ` |
|
2029
|
|
|
|
|
|
|
|
|
2030
|
|
|
|
|
|
|
my %trans = qw( t title |
|
2031
|
|
|
|
|
|
|
a artist |
|
2032
|
|
|
|
|
|
|
l album |
|
2033
|
|
|
|
|
|
|
y year |
|
2034
|
|
|
|
|
|
|
g genre |
|
2035
|
|
|
|
|
|
|
c comment |
|
2036
|
|
|
|
|
|
|
n track |
|
2037
|
|
|
|
|
|
|
|
|
2038
|
|
|
|
|
|
|
E filename_extension |
|
2039
|
|
|
|
|
|
|
e filename_extension_nodot |
|
2040
|
|
|
|
|
|
|
A abs_filename_noextension |
|
2041
|
|
|
|
|
|
|
B filename_nodir_noextension |
|
2042
|
|
|
|
|
|
|
N filename_noextension |
|
2043
|
|
|
|
|
|
|
f filename_nodir |
|
2044
|
|
|
|
|
|
|
D dirname |
|
2045
|
|
|
|
|
|
|
F abs_filename |
|
2046
|
|
|
|
|
|
|
|
|
2047
|
|
|
|
|
|
|
aC artist_collection |
|
2048
|
|
|
|
|
|
|
tT title_track |
|
2049
|
|
|
|
|
|
|
cC comment_collection |
|
2050
|
|
|
|
|
|
|
cT comment_track |
|
2051
|
|
|
|
|
|
|
iD cddb_id |
|
2052
|
|
|
|
|
|
|
iI cdindex_id |
|
2053
|
|
|
|
|
|
|
n1 track1 |
|
2054
|
|
|
|
|
|
|
n2 track2 |
|
2055
|
|
|
|
|
|
|
n0 track0 |
|
2056
|
|
|
|
|
|
|
mA disk_alphanum |
|
2057
|
|
|
|
|
|
|
m1 disk1 |
|
2058
|
|
|
|
|
|
|
m2 disk2 |
|
2059
|
|
|
|
|
|
|
|
|
2060
|
|
|
|
|
|
|
h height |
|
2061
|
|
|
|
|
|
|
w width |
|
2062
|
|
|
|
|
|
|
iT img_type |
|
2063
|
|
|
|
|
|
|
mT mime_type |
|
2064
|
|
|
|
|
|
|
mP mime_Pretype |
|
2065
|
|
|
|
|
|
|
aR aspect_ratio |
|
2066
|
|
|
|
|
|
|
a3 aspect_ratio3 |
|
2067
|
|
|
|
|
|
|
aI aspect_ratio_inverted |
|
2068
|
|
|
|
|
|
|
bD bit_depth |
|
2069
|
|
|
|
|
|
|
|
|
2070
|
|
|
|
|
|
|
v mpeg_version |
|
2071
|
|
|
|
|
|
|
L mpeg_layer_roman |
|
2072
|
|
|
|
|
|
|
? is_stereo |
|
2073
|
|
|
|
|
|
|
? is_vbr |
|
2074
|
|
|
|
|
|
|
r bitrate_kbps |
|
2075
|
|
|
|
|
|
|
q frequency_kHz |
|
2076
|
|
|
|
|
|
|
Q frequency_Hz |
|
2077
|
|
|
|
|
|
|
? size_bytes |
|
2078
|
|
|
|
|
|
|
S total_secs_int |
|
2079
|
|
|
|
|
|
|
M total_millisecs_int |
|
2080
|
|
|
|
|
|
|
m total_mins |
|
2081
|
|
|
|
|
|
|
mL leftover_mins |
|
2082
|
|
|
|
|
|
|
H total_hours |
|
2083
|
|
|
|
|
|
|
s leftover_secs |
|
2084
|
|
|
|
|
|
|
ML leftover_msec |
|
2085
|
|
|
|
|
|
|
SML leftover_secs_float |
|
2086
|
|
|
|
|
|
|
SL leftover_secs_trunc |
|
2087
|
|
|
|
|
|
|
? time_mm_ss |
|
2088
|
|
|
|
|
|
|
C is_copyrighted_YN |
|
2089
|
|
|
|
|
|
|
p frames_padded_YN |
|
2090
|
|
|
|
|
|
|
o channel_mode |
|
2091
|
|
|
|
|
|
|
u frames |
|
2092
|
|
|
|
|
|
|
? frame_len |
|
2093
|
|
|
|
|
|
|
? vbr_scale |
|
2094
|
|
|
|
|
|
|
); |
|
2095
|
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
# Different: %v is without trailing 0s, %q has fractional part, |
|
2097
|
|
|
|
|
|
|
# %e, %E are for the extension, |
|
2098
|
|
|
|
|
|
|
# %r is a number instead of 'Variable', %u is one less... |
|
2099
|
|
|
|
|
|
|
# Missing: |
|
2100
|
|
|
|
|
|
|
# %b Number of corrupt audio frames (integer) |
|
2101
|
|
|
|
|
|
|
# %e Emphasis (string) |
|
2102
|
|
|
|
|
|
|
# %E CRC Error protection (string) |
|
2103
|
|
|
|
|
|
|
# %O Original material flag (string) |
|
2104
|
|
|
|
|
|
|
# %G Musical genre (integer) |
|
2105
|
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
# Made as tags: ParseData ID3v2 ID3v1 ImageExifTool Inf CDDB_File Cue ImageSize LastResort |
|
2107
|
|
|
|
|
|
|
my %handlers = map {($_, 1)} qw( |
|
2108
|
|
|
|
|
|
|
CDDB_File File ID3v2 ImageExifTool Inf ParseData |
|
2109
|
|
|
|
|
|
|
Cue ID3v1 ImageSize LastResort |
|
2110
|
|
|
|
|
|
|
); # Inf/Cue are not in language list: https://www.loc.gov/standards/iso639-2/php/code_list.php |
|
2111
|
|
|
|
|
|
|
|
|
2112
|
|
|
|
|
|
|
#$handler_r = qr/$handler_r/; |
|
2113
|
|
|
|
|
|
|
# |
|
2114
|
|
|
|
|
|
|
#my $frame_bra = # FRAM | FRAM03 | FRAM(lang)[ |
|
2115
|
|
|
|
|
|
|
# qr{\w{4}(?:(?:\d\d)|(?:\([^()]*(?:\([^()]+\)[^()]*)*\))?(?:(\[)|(?=[\}:|&])))}s; # 1 group for begin-descr |
|
2116
|
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
my $at_end_frame_name = qr/(?=[\}:|&])/; |
|
2118
|
|
|
|
|
|
|
my $lang_or_handlers_rex = qr/\(([^()]*(?:\([^()]+\)[^()]*)*)\)/; |
|
2119
|
|
|
|
|
|
|
my $frame_bra = # FRAM | FRAM03 | FRAM(lang)[ | cmd(PACKAGES) | cmd(PACKAGES)[args] |
|
2120
|
|
|
|
|
|
|
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 |
|
2121
|
|
|
|
|
|
|
|
|
2122
|
|
|
|
|
|
|
# used with offset by 1: 2: fill, 3: same, 4: $left, 5..6 width, 7: key |
|
2123
|
|
|
|
|
|
|
my $pat_rx = qr/^%(?:(?:\((.)\)|([^-.1-9%a-zA-Z]))?(-)?(\d+))?(?:\.(\d+))?([talgcynfFeEABDNvLrqQSmsCpouMHwh{%])/s; |
|
2124
|
|
|
|
|
|
|
# XXXX Partially repeated below, search for `talgc'??? vLrqQSmsCpouMH miss??? |
|
2125
|
|
|
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
my $longer_f = qr(a[3CRI]|tT|c[TC]|i[DIT]|n[012]|m[A12TP]|bD); |
|
2127
|
|
|
|
|
|
|
# (a[CR]|tT|c[TC]|[mMS]L|SML|i[DIT]|n[012]|m[A12T]|bD) |
|
2128
|
|
|
|
|
|
|
# a[CR]|tT|c[TC]|i[DIT]|n[012]|m[A12T]|bD |
|
2129
|
|
|
|
|
|
|
|
|
2130
|
|
|
|
|
|
|
sub process_handlers ($$$$;$$) { # only 1 level of parens allowed in flags |
|
2131
|
2
|
|
|
2
|
|
5
|
my ($self, $h, $handlers, $args, $cond, $set) = (shift, shift, shift, shift, shift, shift); |
|
2132
|
|
|
|
|
|
|
# die "Conditionals with handlers not supported yet" if $cond; |
|
2133
|
2
|
50
|
|
|
|
4
|
die "Handlers with arguments not supported yet" if @$args; |
|
2134
|
2
|
50
|
|
|
|
9
|
my (@f) = ($h =~ /^(\w+)/) or die "Panic: `$h' as a handler"; |
|
2135
|
2
|
50
|
|
|
|
5
|
push @f, $trans{$f[0]} if exists $trans{$f[0]}; |
|
2136
|
2
|
|
33
|
|
|
7
|
$set and $_ .= '__set' for @f; |
|
2137
|
2
|
|
|
|
|
5
|
$self->_auto_field_from($cond, $handlers, \@f, undef, $args, $set); # if $set, calls a method in all packages where possible |
|
2138
|
|
|
|
|
|
|
} |
|
2139
|
|
|
|
|
|
|
|
|
2140
|
|
|
|
|
|
|
# $upto TRUE: parse the part including $upto char |
|
2141
|
|
|
|
|
|
|
# Very restricted backslashitis: only $upto and \ before $upto-or-end |
|
2142
|
|
|
|
|
|
|
# $upto defined but FALSE: interpolate only one %-escape. |
|
2143
|
|
|
|
|
|
|
# Anyway: $_[1] is modified to remove interpolated part. |
|
2144
|
|
|
|
|
|
|
sub _interpolate ($$;$$) { |
|
2145
|
|
|
|
|
|
|
# goto &interpolate_flags if @_ == 3; |
|
2146
|
324
|
|
|
324
|
|
358
|
my ($self, undef, $upto, $skip) = @_; # pattern is modified, so is $_[1] |
|
2147
|
324
|
|
|
|
|
389
|
$self->get_tags(); |
|
2148
|
324
|
|
|
|
|
282
|
my $res = ""; |
|
2149
|
324
|
|
|
|
|
211
|
my $ids; |
|
2150
|
324
|
50
|
100
|
|
|
796
|
die "upto=`$upto' not supported" if $upto and $upto ne ']' and $upto ne'}'; |
|
|
|
|
66
|
|
|
|
|
|
2151
|
324
|
50
|
66
|
|
|
674
|
die "upto=`$upto' not supported with skip" |
|
|
|
|
33
|
|
|
|
|
|
2152
|
|
|
|
|
|
|
if $upto and not defined $upto and $skip; # XXXX Unreachable??? |
|
2153
|
324
|
100
|
100
|
|
|
849
|
my $cnt = ($upto or not defined $upto) ? -1 : 1; # upto eq '': 1 escape |
|
2154
|
|
|
|
|
|
|
|
|
2155
|
324
|
100
|
66
|
|
|
3167
|
while ($cnt-- and ($upto # undef and '' use the same code |
|
|
|
100
|
|
|
|
|
|
|
2156
|
|
|
|
|
|
|
? ($upto eq ']' |
|
2157
|
|
|
|
|
|
|
? $_[1] =~ s/^((?:[^%\\\]]|(?:\\\\)*\\\]|\\+[^\\\]]|\\\\)+)|$pat_rx//so |
|
2158
|
|
|
|
|
|
|
: $_[1] =~ s/^((?:[^%\\\}]|(?:\\\\)*\\\}|\\+[^\\\}]|\\\\)+)|$pat_rx//so) |
|
2159
|
|
|
|
|
|
|
: $_[1] =~ s/^([^%]+)|$pat_rx//so)) { |
|
2160
|
527
|
100
|
|
|
|
922
|
if (defined $1) { |
|
2161
|
237
|
|
|
|
|
229
|
my $str = $1; |
|
2162
|
237
|
100
|
100
|
|
|
829
|
if ($upto and $upto eq ']') { |
|
|
|
100
|
66
|
|
|
|
|
|
2163
|
73
|
|
|
|
|
342
|
$str =~ s<((?:\\\\)*)(?:\\(?=\])|(?!.))>< '\\' x (length($1)/2) >ges; |
|
|
137
|
|
|
|
|
439
|
|
|
2164
|
|
|
|
|
|
|
} elsif ($upto and $upto eq '}') { |
|
2165
|
63
|
|
|
|
|
265
|
$str =~ s<((?:\\\\)*)(?:\\(?=\})|(?!.))>< '\\' x (length($1)/2) >ges; |
|
|
78
|
|
|
|
|
310
|
|
|
2166
|
|
|
|
|
|
|
} |
|
2167
|
237
|
|
|
|
|
1430
|
$res .= $str, next; |
|
2168
|
|
|
|
|
|
|
} |
|
2169
|
290
|
100
|
|
|
|
784
|
my ($fill, $left, $minwidth, $maxwidth, $what) |
|
2170
|
|
|
|
|
|
|
= ((defined $2 ? $2 : $3), $4, $5, $6, $7); |
|
2171
|
290
|
50
|
66
|
|
|
459
|
next if $skip and $what ne '{'; |
|
2172
|
290
|
|
|
|
|
203
|
my $str; |
|
2173
|
290
|
100
|
100
|
|
|
4041
|
if ($what eq '{' and $_[1] =~ s/^([dD])(\d+)}//) { # Directory |
|
|
|
50
|
66
|
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
2174
|
1
|
50
|
|
|
|
3
|
next if $skip; |
|
2175
|
1
|
50
|
|
|
|
4
|
if ($1 eq 'd') { |
|
2176
|
1
|
|
|
|
|
10
|
$str = $self->dir_component($2); |
|
2177
|
|
|
|
|
|
|
} else { |
|
2178
|
0
|
|
|
|
|
0
|
$str = $self->dirname($2); |
|
2179
|
|
|
|
|
|
|
} |
|
2180
|
|
|
|
|
|
|
} elsif ($what eq '{' and $_[1] =~ s/^U(\d+)}//) { # User data |
|
2181
|
0
|
0
|
|
|
|
0
|
next if $skip; |
|
2182
|
0
|
|
|
|
|
0
|
$str = $self->get_user($1); |
|
2183
|
|
|
|
|
|
|
} elsif ($what eq '{' and $_[1] =~ s/^($longer_f|[mMS]L|SML)}//o) { |
|
2184
|
|
|
|
|
|
|
# CDDB, IDs, or leftover times |
|
2185
|
60
|
50
|
|
|
|
73
|
next if $skip; |
|
2186
|
60
|
|
|
|
|
86
|
my $meth = $trans{$1}; |
|
2187
|
60
|
|
|
|
|
117
|
$str = $self->$meth(); |
|
2188
|
|
|
|
|
|
|
} elsif ($what eq '{' and # $frame_bra has 2 groups, No. 5, 6 |
|
2189
|
|
|
|
|
|
|
# 2-char fields as above, except for [mMS]L|SML (XXX: vLrqQSmsCpouMH ???) |
|
2190
|
|
|
|
|
|
|
$_[1] =~ s/^(!)?(([talgcynfFeEABDNvLrqQSmsCpouMHwh]|ID3v[12]|ID3v2-modified|$longer_f|U\d+)(:|\|\|?)|$frame_bra)//o) { |
|
2191
|
|
|
|
|
|
|
# Alternation with simple/complicated stuff |
|
2192
|
163
|
|
|
|
|
331
|
my ($neg, $id, $simple, $delim, $lang_or_packages, $have_bra) = ($1, $2, $3, $4, $5, $6); |
|
2193
|
|
|
|
|
|
|
|
|
2194
|
163
|
|
100
|
|
|
495
|
my(@_handlers, @args) = split /,/, ($lang_or_packages || ''); |
|
2195
|
163
|
|
|
|
|
228
|
my @handlers = grep $handlers{$_}, @_handlers; |
|
2196
|
163
|
50
|
100
|
|
|
607
|
$delim or $id =~ /^[A-Z]{3}[A-Z\d](\d\d)?\b/ or @handlers and @handlers == @_handlers |
|
|
|
|
33
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
or die "Cannot parse frame descriptor: <<<$id>>>"; |
|
2198
|
|
|
|
|
|
|
|
|
2199
|
163
|
100
|
|
|
|
187
|
if ($delim) { # Not a frame/cmd id... |
|
2200
|
35
|
|
|
|
|
39
|
$id = $simple; |
|
2201
|
|
|
|
|
|
|
} else { # Frame/cmd: maybe trailed by :, |, ||, maybe not |
|
2202
|
128
|
|
66
|
|
|
259
|
while (@handlers and $have_bra) { |
|
2203
|
0
|
|
|
|
|
0
|
push @args, $self->_interpolate($_[1], ']', $skip); |
|
2204
|
0
|
|
|
|
|
0
|
$have_bra = ($_[1] =~ s/^\[//); |
|
2205
|
|
|
|
|
|
|
} |
|
2206
|
128
|
100
|
|
|
|
323
|
$id .= ($self->_interpolate($_[1], ']', $skip) . ']') if $have_bra; # unreachable if handler present! |
|
2207
|
128
|
100
|
|
|
|
299
|
$_[1] =~ s/^(:|\|\|?)// and $delim = $1; |
|
2208
|
128
|
100
|
|
|
|
179
|
unless ($delim) { |
|
2209
|
98
|
50
|
|
|
|
125
|
die "Can't parse negated conditional: I see `$_[1]'" if $neg; |
|
2210
|
98
|
|
|
|
|
75
|
my $nonesuch = 0; |
|
2211
|
98
|
100
|
66
|
|
|
291
|
unless (@handlers or $self->{ID3v2} or $neg) { |
|
|
|
|
66
|
|
|
|
|
|
2212
|
2
|
50
|
|
|
|
8
|
die "No ID3v2 present" |
|
2213
|
|
|
|
|
|
|
if $self->get_config('id3v2_missing_fatal'); |
|
2214
|
2
|
|
|
|
|
2
|
$nonesuch = 1; |
|
2215
|
|
|
|
|
|
|
} |
|
2216
|
98
|
100
|
100
|
|
|
329
|
next if ($skip or $nonesuch) and $_[1] =~ s/^\}//; |
|
|
|
|
66
|
|
|
|
|
|
2217
|
96
|
50
|
|
|
|
175
|
if ($_[1] =~ /^[\}&]/) { # frame with optional (lang)/[descr], or a package-handled descriptor |
|
2218
|
96
|
100
|
|
|
|
117
|
if (@handlers) { |
|
2219
|
2
|
50
|
|
|
|
10
|
$str = $self->process_handlers($id, \@handlers, \@args) unless $skip; |
|
2220
|
|
|
|
|
|
|
# $str = '' if not defined $str and $1 eq '&'; |
|
2221
|
|
|
|
|
|
|
} else { |
|
2222
|
94
|
|
|
|
|
178
|
$str = $self->select_id3v2_frame_by_descr($id); |
|
2223
|
|
|
|
|
|
|
} |
|
2224
|
|
|
|
|
|
|
} else { |
|
2225
|
0
|
|
|
|
|
0
|
die "unknown frame terminator; I see `$_[1]'"; |
|
2226
|
|
|
|
|
|
|
} |
|
2227
|
96
|
100
|
|
|
|
188
|
if ($_[1] =~ s/^&/%\{/) { # join of frames with optional (language)/[descriptor], etc |
|
2228
|
6
|
|
|
|
|
16
|
my $rest = $self->_interpolate($_[1], '', $skip); |
|
2229
|
6
|
50
|
|
|
|
11
|
next if $skip; |
|
2230
|
6
|
|
|
|
|
18
|
my $joiner = $self->get_config1('ampersand_joiner'); # default '; ' |
|
2231
|
6
|
100
|
66
|
|
|
8
|
$str = join $joiner, map {(defined and length) ? $_ : ()} $str, $rest; |
|
|
12
|
|
|
|
|
42
|
|
|
2232
|
|
|
|
|
|
|
} else { |
|
2233
|
90
|
|
|
|
|
237
|
$_[1] =~ s/^\}//; |
|
2234
|
|
|
|
|
|
|
} |
|
2235
|
|
|
|
|
|
|
} |
|
2236
|
|
|
|
|
|
|
} |
|
2237
|
161
|
100
|
|
|
|
268
|
if ($delim) { # Conditional |
|
2238
|
|
|
|
|
|
|
# $self->_interpolate($_[1], $upto, $skip), next if $skip; |
|
2239
|
65
|
|
66
|
|
|
134
|
my $alt = ($delim ne ':') && $delim; # FALSE or $delim |
|
2240
|
65
|
50
|
66
|
|
|
137
|
die "Negation and alternation incompatible in interpolation" |
|
2241
|
|
|
|
|
|
|
if $alt and $neg; |
|
2242
|
65
|
|
|
|
|
42
|
my $have; |
|
2243
|
65
|
100
|
66
|
|
|
306
|
if ($simple and (2 >= length $simple or $simple =~ /^U/)) { |
|
|
|
50
|
66
|
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
2244
|
21
|
100
|
|
|
|
39
|
my $s = (1 == length $simple ? $simple : "{$simple}"); |
|
2245
|
21
|
|
|
|
|
51
|
$str = $self->interpolate("%$s"); |
|
2246
|
21
|
|
|
|
|
24
|
$have = length($str); |
|
2247
|
|
|
|
|
|
|
} elsif (($simple || '') eq 'ID3v2-modified') { # may be undef |
|
2248
|
0
|
|
0
|
|
|
0
|
$have = ${ $self->{ID3v2} || {} }{modified} || ''; |
|
2249
|
|
|
|
|
|
|
} elsif ($simple) { # ID3v2 or ID3v1 |
|
2250
|
14
|
50
|
|
|
|
23
|
die "ID3v2 or ID3v1 as conditionals incompatible with $alt" |
|
2251
|
|
|
|
|
|
|
if $alt; |
|
2252
|
14
|
|
|
|
|
23
|
$have = !! $self->{$simple}; # Make logical |
|
2253
|
|
|
|
|
|
|
} elsif (@handlers) { |
|
2254
|
|
|
|
|
|
|
# warn "\t!!! Handlers"; |
|
2255
|
0
|
|
|
|
|
0
|
$have = $self->process_handlers($id, \@handlers, \@args, 'cond'); |
|
2256
|
|
|
|
|
|
|
} else { |
|
2257
|
30
|
|
|
|
|
74
|
$have = $self->have_id3v2_frame_by_descr($id); |
|
2258
|
|
|
|
|
|
|
# warn "\t!!! Cond: <<$id>> <<$have>>"; |
|
2259
|
|
|
|
|
|
|
} |
|
2260
|
65
|
|
66
|
|
|
228
|
my $skipping = $skip || (not $alt and $neg ? $have : !$have); |
|
2261
|
65
|
|
|
|
|
58
|
my $s; |
|
2262
|
65
|
100
|
100
|
|
|
148
|
if ($alt and $alt ne '||') { # Need to prepend % |
|
2263
|
14
|
100
|
|
|
|
27
|
if ($_[1] =~ s/^([^\\])\}//) { # One-char escape |
|
2264
|
3
|
50
|
|
|
|
14
|
$s = $self->interpolate("%$1") unless $skipping; |
|
2265
|
|
|
|
|
|
|
} else { # Understood with {}; prepend %{ |
|
2266
|
11
|
50
|
|
|
|
37
|
$_[1] =~ s/^/%\{/ or die; |
|
2267
|
11
|
|
|
|
|
24
|
$s = $self->_interpolate($_[1], '', $skipping); |
|
2268
|
|
|
|
|
|
|
} |
|
2269
|
|
|
|
|
|
|
} else { |
|
2270
|
51
|
|
|
|
|
136
|
$s = $self->_interpolate($_[1], '}', $skipping); |
|
2271
|
|
|
|
|
|
|
} |
|
2272
|
65
|
100
|
|
|
|
153
|
next if $skipping; |
|
2273
|
50
|
100
|
100
|
|
|
151
|
if ($alt and $have and not $simple) { |
|
|
|
|
100
|
|
|
|
|
|
2274
|
7
|
50
|
|
|
|
12
|
if (@handlers) { |
|
2275
|
0
|
|
|
|
|
0
|
$str = $self->process_handlers($id, \@handlers, \@args); |
|
2276
|
|
|
|
|
|
|
} else { |
|
2277
|
7
|
|
|
|
|
12
|
$str = $self->select_id3v2_frame_by_descr($id); |
|
2278
|
|
|
|
|
|
|
} |
|
2279
|
|
|
|
|
|
|
} |
|
2280
|
50
|
100
|
100
|
|
|
131
|
$str = $s unless $have and $alt; |
|
2281
|
|
|
|
|
|
|
$str = $str->{_Data} |
|
2282
|
50
|
0
|
33
|
|
|
176
|
if $str and ref $str and exists $str->{_Data}; |
|
|
|
|
33
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
} |
|
2284
|
|
|
|
|
|
|
} elsif ($what eq '{' and $_[1] =~ s/^ID3v1}//) { |
|
2285
|
0
|
0
|
|
|
|
0
|
next if $skip; |
|
2286
|
0
|
0
|
|
|
|
0
|
$str = $self->{ID3v1}->as_bin if $self->{ID3v1}; |
|
2287
|
|
|
|
|
|
|
} elsif ($what eq '{' |
|
2288
|
|
|
|
|
|
|
and $_[1] =~ s/^(sh|nm)P\[//s) { |
|
2289
|
|
|
|
|
|
|
# (Short) personal name |
|
2290
|
0
|
|
|
|
|
0
|
$what = $1; |
|
2291
|
0
|
|
|
|
|
0
|
$str = $self->_interpolate($_[1], ']', $skip); |
|
2292
|
0
|
0
|
|
|
|
0
|
$_[1] =~ s/^\}// or die "Can't find end of ${what}P escape; I see `$_[1]'"; |
|
2293
|
0
|
0
|
|
|
|
0
|
next if $skip; |
|
2294
|
0
|
0
|
|
|
|
0
|
my $meth = ($what eq 'sh' ? 'shorten_person' : 'normalize_person'); |
|
2295
|
0
|
|
|
|
|
0
|
$str = $self->$meth($str); |
|
2296
|
|
|
|
|
|
|
} elsif ($what eq '{' and $_[1] =~ s/^I\((\w+)\)//s) { |
|
2297
|
|
|
|
|
|
|
# Interpolate |
|
2298
|
5
|
|
|
|
|
6
|
my $flags = $1; |
|
2299
|
5
|
100
|
|
|
|
11
|
if ($flags =~ s/i//) { |
|
2300
|
4
|
|
|
|
|
8
|
$str = $self->_interpolate($_[1], '}', $skip); |
|
2301
|
|
|
|
|
|
|
} else { |
|
2302
|
1
|
50
|
|
|
|
7
|
$_[1] =~ s/^((?:[^\\\}]|(?:\\\\)*\\\}|\\+[^\\\}]|\\\\)*)\}//s |
|
2303
|
|
|
|
|
|
|
# $_[1] =~ s/^((?:\\.|[^{}\\])*)}// |
|
2304
|
|
|
|
|
|
|
or die "Can't find non-interpolated argument in `$_[1]'"; |
|
2305
|
1
|
50
|
|
|
|
3
|
next if $skip; |
|
2306
|
|
|
|
|
|
|
# ($str = $1) =~ s/\\([\\{}])/$1/g; |
|
2307
|
1
|
|
|
|
|
6
|
($str = $1) =~ s<((?:\\\\)*)(?:\\(?=\})|(?!.))>< '\\' x (length($1)/2) >ges; |
|
|
1
|
|
|
|
|
5
|
|
|
2308
|
|
|
|
|
|
|
} |
|
2309
|
5
|
100
|
|
|
|
11
|
next if $skip; |
|
2310
|
4
|
|
|
|
|
12
|
($str) = $self->interpolate_with_flags($str, $flags); |
|
2311
|
|
|
|
|
|
|
} elsif ($what eq '{' and $_[1] =~ s/^T\[([^\[\]]*)\]\}//s) { # time |
|
2312
|
1
|
50
|
|
|
|
3
|
next if $skip; |
|
2313
|
1
|
|
|
|
|
5
|
$str = $self->format_time(undef, split /,/, $1); |
|
2314
|
|
|
|
|
|
|
} elsif ($what eq '{') { #id3v2=whole, composer/performer/frames |
|
2315
|
6
|
50
|
66
|
|
|
22
|
unless ($self->{ID3v2} or $skip) { |
|
2316
|
0
|
0
|
|
|
|
0
|
die "No ID3v2 present" |
|
2317
|
|
|
|
|
|
|
if $self->get_config('id3v2_missing_fatal'); |
|
2318
|
0
|
|
|
|
|
0
|
$_[1] =~ s/^[^\}]*}//; # XXXX No error checking here... |
|
2319
|
0
|
|
|
|
|
0
|
next; |
|
2320
|
|
|
|
|
|
|
} |
|
2321
|
6
|
50
|
|
|
|
42
|
if ($_[1] =~ s/ID3v2}//) { # Whole tag |
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
2322
|
0
|
0
|
0
|
|
|
0
|
if (not $skip and $self->{ID3v2}) { |
|
2323
|
0
|
0
|
|
|
|
0
|
if ($self->get_config('id3v2_recalculate')) { |
|
2324
|
0
|
|
|
|
|
0
|
$str = $self->{ID3v2}->as_bin; |
|
2325
|
|
|
|
|
|
|
} else { |
|
2326
|
0
|
|
|
|
|
0
|
$str = $self->{ID3v2}->as_bin_raw; |
|
2327
|
|
|
|
|
|
|
} |
|
2328
|
|
|
|
|
|
|
} |
|
2329
|
|
|
|
|
|
|
} elsif ($_[1] =~ s/^(composer|performer)}//) { |
|
2330
|
0
|
0
|
|
|
|
0
|
$str = $self->$1() unless $skip; |
|
2331
|
|
|
|
|
|
|
} elsif ($_[1] =~ s,^frames(?:/(.*?))?},,) { |
|
2332
|
6
|
100
|
|
|
|
14
|
my $sep = (defined $1 ? $1 : ' '); |
|
2333
|
6
|
100
|
|
|
|
28
|
$str = join $sep, $self->id3v2_frame_descriptors() unless $skip; |
|
2334
|
|
|
|
|
|
|
} elsif ($_[1] =~ s,^(_)?out_frames\[(.*?)//(.*?)\]},,) { |
|
2335
|
0
|
|
|
|
|
0
|
my($bin, $pre, $post) = ($1, $2, $3); |
|
2336
|
0
|
|
|
|
|
0
|
my $v2 = $self->{ID3v2}; |
|
2337
|
|
|
|
|
|
|
# $fr_sep, $fn_sep, $pre,$post,$fsep,$pre_mult,$val_sep # length "Picture Type" = 12 |
|
2338
|
0
|
0
|
|
|
|
0
|
$str = ($v2 ? $v2->__frames_as_printable("\n", "\t==>\n ", $pre, # Tune tabbing for length=5..12 (_Data) |
|
|
|
0
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
$post, "\n ", "", " \t=\t", $bin) : '') unless $skip; |
|
2340
|
|
|
|
|
|
|
} elsif ($_[1] =~ s,^ID3v2-size},,) { |
|
2341
|
0
|
|
|
|
|
0
|
my $v2 = $self->{ID3v2}; |
|
2342
|
0
|
0
|
|
|
|
0
|
$str = ($v2 ? 10 + $v2->{buggy_padding_size} + $v2->{tagsize} : 0) |
|
|
|
0
|
|
|
|
|
|
|
2343
|
|
|
|
|
|
|
unless $skip; |
|
2344
|
|
|
|
|
|
|
} elsif ($_[1] =~ s,^ID3v2-pad},,) { |
|
2345
|
0
|
|
|
|
|
0
|
my $v2 = $self->{ID3v2}; |
|
2346
|
0
|
0
|
0
|
|
|
0
|
$v2->get_frame_ids() if $v2 and not exists $v2->{frameIDs}; |
|
2347
|
0
|
0
|
|
|
|
0
|
$str = ($v2 ? $v2->{padding} : 0) unless $skip; |
|
|
|
0
|
|
|
|
|
|
|
2348
|
|
|
|
|
|
|
} elsif ($_[1] =~ s,^ID3v2-stripped},,) { |
|
2349
|
0
|
|
|
|
|
0
|
my $v2 = $self->{ID3v2}; |
|
2350
|
0
|
0
|
0
|
|
|
0
|
$v2->get_frame_ids() if $v2 and not exists $v2->{frameIDs}; |
|
2351
|
0
|
0
|
|
|
|
0
|
$str = ($v2 ? 10 + $v2->{buggy_padding_size} + $v2->{tagsize} - $v2->{padding} : 0) unless $skip; |
|
|
|
0
|
|
|
|
|
|
|
2352
|
|
|
|
|
|
|
} elsif ($_[1] =~ s,^ID3v2-modified},,) { |
|
2353
|
0
|
|
|
|
|
0
|
my $v2 = $self->{ID3v2}; |
|
2354
|
0
|
0
|
0
|
|
|
0
|
$str = ($v2 and $v2->{modified}) || '' unless $skip; |
|
2355
|
|
|
|
|
|
|
} else { |
|
2356
|
0
|
|
|
|
|
0
|
die "unknown escape; I see `$_[1]'"; |
|
2357
|
|
|
|
|
|
|
} |
|
2358
|
|
|
|
|
|
|
} elsif ($what eq '%') { |
|
2359
|
4
|
|
|
|
|
4
|
$str = '%'; |
|
2360
|
|
|
|
|
|
|
} else { |
|
2361
|
50
|
|
|
|
|
83
|
my $meth = $trans{$what}; |
|
2362
|
50
|
|
|
|
|
164
|
$str = $self->$meth(); |
|
2363
|
|
|
|
|
|
|
} |
|
2364
|
272
|
100
|
|
|
|
434
|
$str = '' unless defined $str; |
|
2365
|
272
|
50
|
66
|
|
|
439
|
if (defined $maxwidth and length $str > $maxwidth) { |
|
2366
|
0
|
0
|
|
|
|
0
|
if ($str =~ /^(?:\+|(\-))?(\d*)(\.\d*)?$/) { |
|
2367
|
0
|
0
|
0
|
|
|
0
|
if (length($1 || '') + length $2 <= $maxwidth) { |
|
2368
|
0
|
|
0
|
|
|
0
|
my $w = $maxwidth - length $2 - length($1 || ''); |
|
2369
|
0
|
0
|
|
|
|
0
|
$w-- if $w; # Take into account decimal point... |
|
2370
|
0
|
|
|
|
|
0
|
$str = sprintf '%.*f', $w, $str |
|
2371
|
|
|
|
|
|
|
} else { # Might be a long integer benefiting from %g |
|
2372
|
0
|
|
|
|
|
0
|
my($w, $s0) = ($maxwidth, $str); |
|
2373
|
0
|
|
|
|
|
0
|
while ($w >= 1) { |
|
2374
|
0
|
|
|
|
|
0
|
$str = sprintf '%.*g', $w, $s0; |
|
2375
|
0
|
|
|
|
|
0
|
$str =~ s/(^|(?<=[-+]))0+|(?<=e)\+//gi; # 1e+07 to 1e7 |
|
2376
|
0
|
0
|
|
|
|
0
|
last if length $str <= $maxwidth; |
|
2377
|
0
|
|
|
|
|
0
|
$w-- |
|
2378
|
|
|
|
|
|
|
} |
|
2379
|
0
|
0
|
|
|
|
0
|
$str = $s0 if length $str > length $s0; # 12 vs 1e1 |
|
2380
|
0
|
|
|
|
|
0
|
$str = substr $str, 0, $maxwidth; # 1e as a truncation of 1234 is better than 12... |
|
2381
|
|
|
|
|
|
|
} |
|
2382
|
|
|
|
|
|
|
} else { |
|
2383
|
0
|
|
|
|
|
0
|
$str = substr $str, 0, $maxwidth; |
|
2384
|
|
|
|
|
|
|
} |
|
2385
|
|
|
|
|
|
|
} |
|
2386
|
272
|
100
|
|
|
|
353
|
if (defined $minwidth) { |
|
2387
|
16
|
50
|
|
|
|
22
|
$fill = ' ' unless defined $fill; |
|
2388
|
16
|
100
|
|
|
|
21
|
if ($left) { |
|
2389
|
1
|
|
|
|
|
3
|
$str .= $fill x ($minwidth - length $str); |
|
2390
|
|
|
|
|
|
|
} else { |
|
2391
|
15
|
|
|
|
|
33
|
$str = $fill x ($minwidth - length $str) . $str; |
|
2392
|
|
|
|
|
|
|
} |
|
2393
|
|
|
|
|
|
|
} |
|
2394
|
272
|
|
|
|
|
1114
|
$res .= $str; |
|
2395
|
|
|
|
|
|
|
} |
|
2396
|
324
|
100
|
|
|
|
381
|
if (defined $upto) { |
|
2397
|
145
|
100
|
66
|
|
|
574
|
not $upto or |
|
|
|
50
|
|
|
|
|
|
|
2398
|
|
|
|
|
|
|
($upto eq ']' ? $_[1] =~ s/^\]// : $_[1] =~ s/^\}//) |
|
2399
|
|
|
|
|
|
|
or die "Can't find final delimiter `$upto': I see `$_[1]'"; |
|
2400
|
|
|
|
|
|
|
} else { |
|
2401
|
179
|
50
|
|
|
|
277
|
die "Can't parse `$_[1]' during interpolation" if length $_[1]; |
|
2402
|
|
|
|
|
|
|
} |
|
2403
|
324
|
|
|
|
|
904
|
return $res; |
|
2404
|
|
|
|
|
|
|
} |
|
2405
|
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
sub interpolate ($$) { |
|
2407
|
179
|
|
|
179
|
|
1537
|
my ($self, $pattern) = @_; # local copy; $pattern is modified |
|
2408
|
179
|
|
|
|
|
322
|
$self->_interpolate($pattern); |
|
2409
|
|
|
|
|
|
|
} |
|
2410
|
|
|
|
|
|
|
|
|
2411
|
|
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
|
=item interpolate_with_flags |
|
2413
|
|
|
|
|
|
|
|
|
2414
|
|
|
|
|
|
|
@results = $mp3->interpolate_with_flags($text, $flags); |
|
2415
|
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
Processes $text according to directives in the string $flags; $flags is |
|
2417
|
|
|
|
|
|
|
split into separate flag characters; the meanings (and order of application) of |
|
2418
|
|
|
|
|
|
|
flags are |
|
2419
|
|
|
|
|
|
|
|
|
2420
|
|
|
|
|
|
|
i interpolate via $mp3->interpolate |
|
2421
|
|
|
|
|
|
|
f interpret (the result) as filename, read from file |
|
2422
|
|
|
|
|
|
|
F if file does not exist, it is not an error |
|
2423
|
|
|
|
|
|
|
B read is performed in binary mode (otherwise |
|
2424
|
|
|
|
|
|
|
in text mode, modified per |
|
2425
|
|
|
|
|
|
|
'decode_encoding_files' configuration variable) |
|
2426
|
|
|
|
|
|
|
l split result per 'parse_split' configuration variable |
|
2427
|
|
|
|
|
|
|
n as l, using the track-number-th element (1-based) |
|
2428
|
|
|
|
|
|
|
in the result |
|
2429
|
|
|
|
|
|
|
I interpolate (again) via $mp3->interpolate |
|
2430
|
|
|
|
|
|
|
b unless present, remove leading and trailing whitespace |
|
2431
|
|
|
|
|
|
|
|
|
2432
|
|
|
|
|
|
|
With C, may produce multiple results. May be accessed via |
|
2433
|
|
|
|
|
|
|
interpolation of C<%{I(flags)text}>. |
|
2434
|
|
|
|
|
|
|
|
|
2435
|
|
|
|
|
|
|
=cut |
|
2436
|
|
|
|
|
|
|
|
|
2437
|
|
|
|
|
|
|
sub interpolate_with_flags ($$$) { |
|
2438
|
35
|
|
|
35
|
|
41
|
my ($self, $data, $flags) = @_; |
|
2439
|
|
|
|
|
|
|
|
|
2440
|
35
|
100
|
|
|
|
97
|
$data = $self->interpolate($data) if $flags =~ /i/; |
|
2441
|
35
|
100
|
|
|
|
60
|
if ($flags =~ /f/) { |
|
2442
|
4
|
|
|
|
|
7
|
local *F; |
|
2443
|
4
|
|
|
|
|
3
|
my $e; |
|
2444
|
4
|
50
|
|
|
|
89
|
unless (open F, "< $data") { |
|
2445
|
0
|
0
|
|
|
|
0
|
return if $flags =~ /F/; |
|
2446
|
0
|
|
|
|
|
0
|
die "Can't open file `$data' for parsing: $!"; |
|
2447
|
|
|
|
|
|
|
} |
|
2448
|
4
|
50
|
|
|
|
9
|
if ($flags =~ /B/) { |
|
2449
|
0
|
|
|
|
|
0
|
binmode F; |
|
2450
|
|
|
|
|
|
|
} else { |
|
2451
|
4
|
|
|
|
|
3
|
my $e; |
|
2452
|
4
|
0
|
33
|
|
|
6
|
if ($e = $self->get_config('decode_encoding_files') and $e->[0]) { |
|
2453
|
0
|
|
|
|
|
0
|
eval "binmode F, ':encoding($e->[0])'"; # old binmode won't compile... |
|
2454
|
|
|
|
|
|
|
} |
|
2455
|
|
|
|
|
|
|
} |
|
2456
|
|
|
|
|
|
|
|
|
2457
|
4
|
|
|
|
|
8
|
local $/; |
|
2458
|
4
|
|
|
|
|
54
|
my $d = ; |
|
2459
|
4
|
50
|
|
|
|
22
|
CORE::close F or die "Can't close file `$data' for parsing: $!"; |
|
2460
|
4
|
|
|
|
|
12
|
$data = $d; |
|
2461
|
|
|
|
|
|
|
} |
|
2462
|
35
|
|
|
|
|
44
|
my @data = $data; |
|
2463
|
35
|
50
|
|
|
|
73
|
if ($flags =~ /[ln]/) { |
|
2464
|
0
|
|
|
|
|
0
|
my $p = $self->get_config('parse_split')->[0]; |
|
2465
|
0
|
|
|
|
|
0
|
@data = split $p, $data, -1; |
|
2466
|
|
|
|
|
|
|
} |
|
2467
|
35
|
50
|
|
|
|
54
|
if ($flags =~ /n/) { |
|
2468
|
0
|
0
|
|
|
|
0
|
my $track = $self->track1 or return; |
|
2469
|
0
|
|
|
|
|
0
|
@data = $data[$track - 1]; |
|
2470
|
|
|
|
|
|
|
} |
|
2471
|
35
|
|
|
|
|
41
|
for my $d (@data) { |
|
2472
|
35
|
50
|
|
|
|
60
|
$d = $self->interpolate($d) if $flags =~ /I/; |
|
2473
|
35
|
100
|
|
|
|
54
|
unless ($flags =~ /b/) { |
|
2474
|
34
|
|
|
|
|
41
|
$d =~ s/^\s+//; |
|
2475
|
34
|
|
|
|
|
60
|
$d =~ s/\s+$//; |
|
2476
|
|
|
|
|
|
|
} |
|
2477
|
|
|
|
|
|
|
} |
|
2478
|
35
|
|
|
|
|
94
|
@data; |
|
2479
|
|
|
|
|
|
|
} |
|
2480
|
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
=item parse_rex($pattern, $string) |
|
2482
|
|
|
|
|
|
|
|
|
2483
|
|
|
|
|
|
|
Parse $string according to the regular expression $pattern with |
|
2484
|
|
|
|
|
|
|
C<%>-escapes C<%%, %a, %t, %l, %y, %g, %c, %n, %e, %E> etc. The meaning |
|
2485
|
|
|
|
|
|
|
of escapes is the same as for method L<"interpolate">(); but (with |
|
2486
|
|
|
|
|
|
|
the exception of C<%%>) they are |
|
2487
|
|
|
|
|
|
|
used not for I, but for I a part of $string |
|
2488
|
|
|
|
|
|
|
suitable to be a value for these fields. Returns false on failure, a |
|
2489
|
|
|
|
|
|
|
hash reference with parsed fields otherwise (with C<%a> setting the |
|
2490
|
|
|
|
|
|
|
field C, etc). |
|
2491
|
|
|
|
|
|
|
|
|
2492
|
|
|
|
|
|
|
Some more escapes are supported: C<%=a, %=t, %=l, %=y, %=g, %=c, %=n, %=e, |
|
2493
|
|
|
|
|
|
|
%=E, %=A, %=B, %=D, %=f, %=F, %=N, %={WHATEVER}> I |
|
2494
|
|
|
|
|
|
|
substrings which are I values of artist/title/etc (C<%=n> also |
|
2495
|
|
|
|
|
|
|
matches leading 0s; actual file-name matches ignore the difference |
|
2496
|
|
|
|
|
|
|
between C> and C<\>, between one and multiple consequent dots (if |
|
2497
|
|
|
|
|
|
|
configuration variable C is true (default)) |
|
2498
|
|
|
|
|
|
|
and are case-insensitive if configuration variable |
|
2499
|
|
|
|
|
|
|
C is true (default); moreover, C<%n>, |
|
2500
|
|
|
|
|
|
|
C<%y>, C<%=n>, C<%=y> will not match if the string-to-match is |
|
2501
|
|
|
|
|
|
|
adjacent to a digit). Double C<=> if you want to match to fail when |
|
2502
|
|
|
|
|
|
|
the corresponding conditional C<%>-escape would fail (a missing field, |
|
2503
|
|
|
|
|
|
|
or a zero-length field for required fields). |
|
2504
|
|
|
|
|
|
|
|
|
2505
|
|
|
|
|
|
|
The escapes C<%{UEnumberE}> and escapes of the forms |
|
2506
|
|
|
|
|
|
|
C<%{ABCD}> match any string; the |
|
2507
|
|
|
|
|
|
|
corresponding hash key in the result hash is what is inside braces; |
|
2508
|
|
|
|
|
|
|
here C is a 4-letter word possibly followed by 2-digit number |
|
2509
|
|
|
|
|
|
|
(as in names of ID3v2 tags), or what can be put in |
|
2510
|
|
|
|
|
|
|
C<'%{FRAM(lang,list)[description]}'>. |
|
2511
|
|
|
|
|
|
|
|
|
2512
|
|
|
|
|
|
|
$res = $mp3->parse_rex( qr<^%a - %t\.\w{1,4}$>, |
|
2513
|
|
|
|
|
|
|
$mp3->filename_nodir ) or die; |
|
2514
|
|
|
|
|
|
|
$author = $res->{author}; |
|
2515
|
|
|
|
|
|
|
|
|
2516
|
|
|
|
|
|
|
2-digit numbers, or I with number1,2 up to 999 are |
|
2517
|
|
|
|
|
|
|
allowed for the track number (the leading 0 is stripped); 4-digit |
|
2518
|
|
|
|
|
|
|
years in the range 1000..2999 are allowed for year. Alternatively, if |
|
2519
|
|
|
|
|
|
|
option year_is_timestamp is TRUE (default), year may be a range of |
|
2520
|
|
|
|
|
|
|
timestamps in the format understood by ID3v2 method year() (see |
|
2521
|
|
|
|
|
|
|
L). |
|
2522
|
|
|
|
|
|
|
|
|
2523
|
|
|
|
|
|
|
The escape C<%E> matches the REx in the configuration variable C; |
|
2524
|
|
|
|
|
|
|
the escape C<%e> matches the part of %E after the leading dot. |
|
2525
|
|
|
|
|
|
|
|
|
2526
|
|
|
|
|
|
|
In list context, also returns an array reference with %{handler} groups |
|
2527
|
|
|
|
|
|
|
parsed (if present). Such groups can match everything, and a successful match gives an |
|
2528
|
|
|
|
|
|
|
array element with C<[$method, $packages, $args, $matched]>. |
|
2529
|
|
|
|
|
|
|
|
|
2530
|
|
|
|
|
|
|
Currently the regular expressions with capturing parens are not supported. |
|
2531
|
|
|
|
|
|
|
|
|
2532
|
|
|
|
|
|
|
=item parse_rex_prepare($pattern) |
|
2533
|
|
|
|
|
|
|
|
|
2534
|
|
|
|
|
|
|
Returns a data structure which later can be used by parse_rex_match(). |
|
2535
|
|
|
|
|
|
|
These two are equivalent: |
|
2536
|
|
|
|
|
|
|
|
|
2537
|
|
|
|
|
|
|
$mp3->parse_rex($pattern, $data); |
|
2538
|
|
|
|
|
|
|
$mp3->parse_rex_match($mp3->parse_rex_prepare($pattern), $data); |
|
2539
|
|
|
|
|
|
|
|
|
2540
|
|
|
|
|
|
|
This call constitutes the "slow part" of the parse_rex() call; it makes sense to |
|
2541
|
|
|
|
|
|
|
factor out this step if the parse_rex() with the same $pattern is called |
|
2542
|
|
|
|
|
|
|
against multiple $data. |
|
2543
|
|
|
|
|
|
|
|
|
2544
|
|
|
|
|
|
|
=item parse_rex_match($prepared, $data) |
|
2545
|
|
|
|
|
|
|
|
|
2546
|
|
|
|
|
|
|
Matches $data against a data structure returned by parse_rex_prepare(). |
|
2547
|
|
|
|
|
|
|
These two are equivalent: |
|
2548
|
|
|
|
|
|
|
|
|
2549
|
|
|
|
|
|
|
$mp3->parse_rex($pattern, $data); |
|
2550
|
|
|
|
|
|
|
$mp3->parse_rex_match($mp3->parse_rex_prepare($pattern), $data); |
|
2551
|
|
|
|
|
|
|
|
|
2552
|
|
|
|
|
|
|
=cut |
|
2553
|
|
|
|
|
|
|
|
|
2554
|
|
|
|
|
|
|
sub _rex_protect_filename { |
|
2555
|
0
|
|
|
0
|
|
0
|
my ($self, $filename, $what) = (shift, quotemeta shift, shift); |
|
2556
|
0
|
|
|
|
|
0
|
$filename =~ s,\\[\\/],[\\\\/],g; # \ and / are interchangeable + backslashitis |
|
2557
|
0
|
0
|
|
|
|
0
|
if ($self->get_config('parse_filename_merge_dots')->[0]) { |
|
2558
|
|
|
|
|
|
|
# HPFS doesn't distinguish x..y and x.y |
|
2559
|
0
|
|
|
|
|
0
|
$filename =~ s(\\\.+)(\\.+)g; |
|
2560
|
0
|
0
|
|
|
|
0
|
$filename =~ s($)(\\.*) if $what =~ /[ABN]/; |
|
2561
|
|
|
|
|
|
|
} |
|
2562
|
0
|
|
|
|
|
0
|
my $case = $self->get_config('parse_filename_ignore_case')->[0]; |
|
2563
|
0
|
0
|
|
|
|
0
|
return $filename unless $case; |
|
2564
|
0
|
|
|
|
|
0
|
return "(?i:$filename)"; |
|
2565
|
|
|
|
|
|
|
} |
|
2566
|
|
|
|
|
|
|
|
|
2567
|
|
|
|
|
|
|
sub _parse_rex_anything ($$) { |
|
2568
|
42
|
|
|
42
|
|
57
|
my $c = shift->get_config('parse_minmatch'); |
|
2569
|
42
|
|
|
|
|
43
|
my $min = $c->[0]; |
|
2570
|
42
|
50
|
66
|
|
|
72
|
if ($min and $min ne '1') { |
|
2571
|
0
|
|
|
|
|
0
|
my $field = shift; |
|
2572
|
0
|
|
|
|
|
0
|
$min = grep $_ eq $field, @$c; |
|
2573
|
|
|
|
|
|
|
} |
|
2574
|
42
|
100
|
|
|
|
151
|
return $min ? '(.*?)' : '(.*)'; |
|
2575
|
|
|
|
|
|
|
} |
|
2576
|
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
sub __pure_track_rex ($) { |
|
2578
|
0
|
|
|
0
|
|
0
|
my $t = shift()->track; |
|
2579
|
0
|
|
|
|
|
0
|
$t =~ s/^0+//; |
|
2580
|
0
|
|
|
|
|
0
|
$t =~ s,^(.*?)(/.*),\Q$1\E(?:\Q$2\E)?,; |
|
2581
|
0
|
|
|
|
|
0
|
$t |
|
2582
|
|
|
|
|
|
|
} |
|
2583
|
|
|
|
|
|
|
|
|
2584
|
|
|
|
|
|
|
sub _parse_rex_microinterpolate ($$$;$) { # $self->idem($code, $groups, $have_non_trivial__not_group) |
|
2585
|
47
|
|
|
47
|
|
61
|
my ($self, $code, $groups) = (shift, shift, shift); |
|
2586
|
47
|
50
|
|
|
|
66
|
if ($_[1]) { # handler |
|
2587
|
0
|
0
|
|
|
|
0
|
my ($check, $fail, $id) = ($code =~ /^(=(=)?)?(\w+)/) or die "Panic: <<$code>>"; |
|
2588
|
|
|
|
|
|
|
# die "Setting via handler not suppored, handler=<<<$id>>>" unless $check; |
|
2589
|
0
|
0
|
|
|
|
0
|
(push @$groups, [$id, $_[1], $_[2]]), return $self->_parse_rex_anything($code) unless $check; |
|
2590
|
0
|
0
|
0
|
|
|
0
|
return '(?!)' if $fail and not (my($o) = $self->process_handlers($id, $_[1], $_[2])); |
|
2591
|
0
|
0
|
|
|
|
0
|
$o = '' unless defined $o; |
|
2592
|
0
|
|
|
|
|
0
|
$_[0]++, return quotemeta $o; |
|
2593
|
|
|
|
|
|
|
} |
|
2594
|
47
|
50
|
|
|
|
66
|
$_[0]++, return '%' if $code eq '%'; |
|
2595
|
|
|
|
|
|
|
# In these two, allow setting to '', and to 123/789 too... |
|
2596
|
47
|
100
|
|
|
|
71
|
push(@$groups, $code), return '((?
|
|
2597
|
46
|
0
|
33
|
|
|
61
|
(push @$groups, $code), return '((?
|
|
2598
|
|
|
|
|
|
|
if $code eq 'y' and ($self->get_config('year_is_timestamp'))->[0]; |
|
2599
|
46
|
50
|
|
|
|
64
|
(push @$groups, $code), return '((?
|
|
2600
|
|
|
|
|
|
|
if $code eq 'y'; |
|
2601
|
|
|
|
|
|
|
# Filename parts ABDfFN and vLrqQSmsCpouMH not settable... |
|
2602
|
46
|
100
|
|
|
|
110
|
(push @$groups, $code), return $self->_parse_rex_anything($code) |
|
2603
|
|
|
|
|
|
|
if $code =~ /^[talgc]$/; |
|
2604
|
28
|
50
|
|
|
|
49
|
$_[0]++, return $self->_rex_protect_filename($self->interpolate("%$1"), $1) |
|
2605
|
|
|
|
|
|
|
if $code =~ /^=([ABDfFN]|\{d\d+\})$/; |
|
2606
|
28
|
100
|
|
|
|
50
|
$_[0]++, return quotemeta($self->interpolate("%$1")) |
|
2607
|
|
|
|
|
|
|
if $code =~ /^=([talgceEwhvLrqQSmsCpouMH]|\{.*\})$/; |
|
2608
|
26
|
0
|
|
|
|
44
|
$_[0]++, return $self->interpolate("%{$+:1}") ? quotemeta($self->interpolate("%$1")) : '(?!)' |
|
|
|
50
|
|
|
|
|
|
|
2609
|
|
|
|
|
|
|
if $code =~ /^==(([talgcynfFeEABDNvLrqQSmsCpouMHwh])|\{(.*)\})$/; |
|
2610
|
26
|
50
|
|
|
|
33
|
$_[0]++, return '(?__pure_track_rex . '(?!\d)' |
|
2611
|
|
|
|
|
|
|
if $code eq '=n'; |
|
2612
|
26
|
50
|
|
|
|
38
|
$_[0]++, return '(?year) . '(?!\d)' |
|
2613
|
|
|
|
|
|
|
if $code eq '=y'; |
|
2614
|
26
|
100
|
|
|
|
144
|
(push @$groups, $1), return $self->_parse_rex_anything() |
|
2615
|
|
|
|
|
|
|
if $code =~ /^\{(U\d+|\w{4}(\d\d+|(?:\([^\)]*\))?(?:\[.*\])?)?)\}$/s; |
|
2616
|
|
|
|
|
|
|
# What remains is extension |
|
2617
|
2
|
|
|
|
|
5
|
my $e = $self->get_config('extension')->[0]; |
|
2618
|
2
|
100
|
|
|
|
11
|
(push @$groups, $code), return "($e)" if $code eq 'E'; |
|
2619
|
1
|
50
|
|
|
|
7
|
(push @$groups, $code), return "(?<=(?=(?:$e)\$)\\.)(.*)" if $code eq 'e'; |
|
2620
|
|
|
|
|
|
|
# Check whether '=' was omitted, as in %f |
|
2621
|
|
|
|
|
|
|
$code =~ /^=/ or |
|
2622
|
0
|
0
|
0
|
|
|
0
|
eval {my ($a, $b); $self->_parse_rex_microinterpolate("=$code", $a, $b)} |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
2623
|
|
|
|
|
|
|
and die "escape `%$code' can't be parsed; did you forget to put `='?"; |
|
2624
|
0
|
|
|
|
|
0
|
die "unknown escape `%$code'"; |
|
2625
|
|
|
|
|
|
|
} |
|
2626
|
|
|
|
|
|
|
|
|
2627
|
|
|
|
|
|
|
sub _parse_rex_prepare ($$$) { |
|
2628
|
35
|
|
|
35
|
|
41
|
my ($self, $is_rex, $pattern) = @_; |
|
2629
|
35
|
100
|
|
|
|
70
|
my ($codes, $exact, $p) = ([], 0, ($is_rex ? '' : '^')); |
|
2630
|
35
|
|
|
|
|
32
|
my $o = $pattern; |
|
2631
|
|
|
|
|
|
|
# (=? is correct! Groups 4(descr), 5(have_bra) are inside $frame_bra |
|
2632
|
35
|
|
|
|
|
436
|
while ($pattern =~ s< ^ ( [^%]+ ) # 1: no %-escapes |
|
2633
|
|
|
|
|
|
|
| % ( ={0,2} \{ # 2: %-group (beg-of-{FRAME}, or full {non-frame}), or single-letter |
|
2634
|
|
|
|
|
|
|
(?: ($frame_bra) # 3: beg-FRAME (up to leading [, if present) |
|
2635
|
|
|
|
|
|
|
| [^}]+ \} # or full non-frame |
|
2636
|
|
|
|
|
|
|
) |
|
2637
|
|
|
|
|
|
|
| =? . # or single letter |
|
2638
|
|
|
|
|
|
|
) |
|
2639
|
|
|
|
|
|
|
><>sox) { |
|
2640
|
58
|
100
|
|
|
|
110
|
if (defined $1) { |
|
2641
|
11
|
100
|
|
|
|
41
|
$p .= ($is_rex ? $1 : quotemeta $1); |
|
2642
|
|
|
|
|
|
|
} else { |
|
2643
|
47
|
|
|
|
|
58
|
my $group = $2; |
|
2644
|
47
|
100
|
|
|
|
81
|
if ($3) { |
|
2645
|
23
|
|
|
|
|
41
|
my ($id, $langs_or_packs, $have_bra) = ($3, $4, $5); |
|
2646
|
23
|
|
100
|
|
|
90
|
my(@_handlers, @args) = split /,/, ($4 || ''); |
|
2647
|
23
|
|
|
|
|
31
|
my @handlers = grep $handlers{$_}, @_handlers; |
|
2648
|
23
|
0
|
0
|
|
|
67
|
$id =~ /^[A-Z]{3}[A-Z\d](\d\d)?\b/ or @handlers and @handlers == @_handlers |
|
|
|
|
33
|
|
|
|
|
|
2649
|
|
|
|
|
|
|
or die "Cannot parse frame descriptor: <<<$id>>>"; |
|
2650
|
23
|
50
|
|
|
|
61
|
my ($meth) = ($id =~ /^(\w+)/) or die "Panic: meth"; |
|
2651
|
|
|
|
|
|
|
|
|
2652
|
23
|
|
33
|
|
|
55
|
while (@handlers and $have_bra) { # process []-arguments of a handler ($group is not terminated!) |
|
2653
|
0
|
|
|
|
|
0
|
push @args, $self->_interpolate($_[1], ']', !'skip'); |
|
2654
|
0
|
|
|
|
|
0
|
$have_bra = ($_[1] =~ s/^\[//); |
|
2655
|
|
|
|
|
|
|
} # append []-arguments of a frame: |
|
2656
|
23
|
100
|
|
|
|
60
|
$group .= ($self->_interpolate($pattern, ']') . ']') if $have_bra; |
|
2657
|
23
|
50
|
|
|
|
55
|
$pattern =~ s/^}// or die "Can't find end of frame name, I see `$p'"; |
|
2658
|
23
|
50
|
|
|
|
36
|
$p .= $self->_parse_rex_microinterpolate($group, $codes, $exact, \@handlers, \@args), next if @handlers; |
|
2659
|
23
|
|
|
|
|
30
|
$group .= '}'; |
|
2660
|
|
|
|
|
|
|
} |
|
2661
|
47
|
|
|
|
|
92
|
$p .= $self->_parse_rex_microinterpolate($group, $codes, $exact); |
|
2662
|
|
|
|
|
|
|
} |
|
2663
|
|
|
|
|
|
|
} |
|
2664
|
35
|
100
|
|
|
|
50
|
$p .= '$' unless $is_rex; |
|
2665
|
35
|
50
|
|
|
|
60
|
die "Can't parse pattern, I see `$pattern'" if length $pattern; |
|
2666
|
|
|
|
|
|
|
#$pattern =~ s<%(=?{(?:[^\\{}]|\\[\\{}])*}|{U\d+}|=?.)> # (=? is correct! |
|
2667
|
|
|
|
|
|
|
# ( $self->_parse_rex_microinterpolate($1, $codes, $exact) )seg; |
|
2668
|
35
|
100
|
66
|
|
|
42
|
my @tags = map { (not ref and length == 1) ? $trans{$_} : $_ } @$codes; |
|
|
45
|
|
|
|
|
210
|
|
|
2669
|
35
|
|
|
|
|
163
|
return [$o, $p, \@tags, $exact]; |
|
2670
|
|
|
|
|
|
|
} |
|
2671
|
|
|
|
|
|
|
|
|
2672
|
|
|
|
|
|
|
sub parse_rex_prepare ($$) { |
|
2673
|
2
|
|
|
2
|
|
3
|
my ($self) = shift; |
|
2674
|
2
|
|
|
|
|
5
|
$self->_parse_rex_prepare('REx', @_) |
|
2675
|
|
|
|
|
|
|
} |
|
2676
|
|
|
|
|
|
|
|
|
2677
|
|
|
|
|
|
|
sub parse_prepare ($$) { |
|
2678
|
33
|
|
|
33
|
|
34
|
my ($self) = shift; |
|
2679
|
33
|
|
|
|
|
67
|
$self->_parse_rex_prepare(!'REx', @_) |
|
2680
|
|
|
|
|
|
|
} |
|
2681
|
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
sub parse_rex_match { # pattern = [Original, Interpolated, Fields, NumExact] |
|
2683
|
35
|
|
|
35
|
|
36
|
my ($self, $pattern, $data) = @_; |
|
2684
|
35
|
0
|
33
|
|
|
31
|
return unless @{$pattern->[2]} or $pattern->[3]; |
|
|
35
|
|
|
|
|
64
|
|
|
2685
|
35
|
50
|
|
|
|
412
|
my @vals = ($data =~ /$pattern->[1]()/s) or return; # At least 1 group |
|
2686
|
35
|
|
|
|
|
50
|
my $cv = @vals - 1; |
|
2687
|
|
|
|
|
|
|
die "Unsupported %-regular expression `$pattern->[0]' (catching parens? Got $cv vals) (converted to `$pattern->[1]')" |
|
2688
|
35
|
50
|
|
|
|
32
|
unless $cv == @{$pattern->[2]}; |
|
|
35
|
|
|
|
|
60
|
|
|
2689
|
35
|
|
|
|
|
59
|
my ($c, %h, @a) = 0; |
|
2690
|
35
|
|
|
|
|
24
|
for my $k ( @{$pattern->[2]} ) { |
|
|
35
|
|
|
|
|
55
|
|
|
2691
|
45
|
50
|
|
|
|
76
|
next unless defined (my $v = $vals[$c++]); |
|
2692
|
45
|
50
|
|
|
|
56
|
push(@a, [@$k, $v]), next if ref $k; |
|
2693
|
45
|
|
100
|
|
|
157
|
$h{$k} ||= []; |
|
2694
|
45
|
|
|
|
|
31
|
push @{ $h{$k} }, $v; # Support multiple occurences |
|
|
45
|
|
|
|
|
89
|
|
|
2695
|
|
|
|
|
|
|
} |
|
2696
|
35
|
|
|
|
|
63
|
my $j = $self->get_config('parse_join')->[0]; |
|
2697
|
35
|
|
|
|
|
72
|
for $c (keys %h) { |
|
2698
|
42
|
|
|
|
|
25
|
$h{$c} = join $j, grep length, @{ $h{$c} }; |
|
|
42
|
|
|
|
|
142
|
|
|
2699
|
|
|
|
|
|
|
} |
|
2700
|
35
|
100
|
|
|
|
64
|
$h{track} =~ s/^0+(?=\d)// if exists $h{track}; |
|
2701
|
35
|
50
|
33
|
|
|
75
|
return \%h, \@a if wantarray and @a; |
|
2702
|
35
|
|
|
|
|
134
|
return \%h; |
|
2703
|
|
|
|
|
|
|
} |
|
2704
|
|
|
|
|
|
|
|
|
2705
|
|
|
|
|
|
|
sub parse_rex { |
|
2706
|
0
|
|
|
0
|
|
0
|
my ($self, $pattern, $data) = @_; |
|
2707
|
0
|
|
|
|
|
0
|
$self->parse_rex_match($self->parse_rex_prepare($pattern), $data); |
|
2708
|
|
|
|
|
|
|
} |
|
2709
|
|
|
|
|
|
|
|
|
2710
|
|
|
|
|
|
|
=item parse($pattern, $string) |
|
2711
|
|
|
|
|
|
|
|
|
2712
|
|
|
|
|
|
|
Parse $string according to the string $pattern with C<%>-escapes C<%%, |
|
2713
|
|
|
|
|
|
|
%a, %t, %l, %y, %g, %c, %n, %e, %E>. The meaning of escapes is the |
|
2714
|
|
|
|
|
|
|
same as for L<"interpolate">. See L<"parse_rex($pattern, $string)"> |
|
2715
|
|
|
|
|
|
|
for more details. Returns false on failure, a hash reference with |
|
2716
|
|
|
|
|
|
|
parsed fields otherwise. |
|
2717
|
|
|
|
|
|
|
|
|
2718
|
|
|
|
|
|
|
$res = $mp3->parse("%a - %t.mp3", $mp3->filename_nodir) or die; |
|
2719
|
|
|
|
|
|
|
$author = $res->{author}; |
|
2720
|
|
|
|
|
|
|
|
|
2721
|
|
|
|
|
|
|
2-digit numbers are allowed for the track number; 4-digit years in the range |
|
2722
|
|
|
|
|
|
|
1000..2999 are allowed for year. |
|
2723
|
|
|
|
|
|
|
|
|
2724
|
|
|
|
|
|
|
=item parse_prepare($pattern) |
|
2725
|
|
|
|
|
|
|
|
|
2726
|
|
|
|
|
|
|
Returns a data structure which later can be used by parse_rex_match(). |
|
2727
|
|
|
|
|
|
|
This is a counterpart of parse_rex_prepare() used with non-regular-expression |
|
2728
|
|
|
|
|
|
|
patterns. These two are equivalent: |
|
2729
|
|
|
|
|
|
|
|
|
2730
|
|
|
|
|
|
|
$mp3->parse($pattern, $data); |
|
2731
|
|
|
|
|
|
|
$mp3->parse_rex_match($mp3->parse_prepare($pattern), $data); |
|
2732
|
|
|
|
|
|
|
|
|
2733
|
|
|
|
|
|
|
This call constitutes the "slow part" of the parse() call; it makes sense to |
|
2734
|
|
|
|
|
|
|
factor out this step if the parse() with the same $pattern is called |
|
2735
|
|
|
|
|
|
|
against multiple $data. |
|
2736
|
|
|
|
|
|
|
|
|
2737
|
|
|
|
|
|
|
=cut |
|
2738
|
|
|
|
|
|
|
|
|
2739
|
|
|
|
|
|
|
#my %unquote = ('\\%' => '%', '\\%\\=' => '%='); |
|
2740
|
0
|
|
|
0
|
|
0
|
sub __unquote ($) { (my $k = shift) =~ s/\\(\W)/$1/g; $k } |
|
|
0
|
|
|
|
|
0
|
|
|
2741
|
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
sub __parse_prepare { # obsolete parse_prepare |
|
2743
|
0
|
|
|
0
|
|
0
|
my ($self, $pattern) = @_; |
|
2744
|
0
|
|
|
|
|
0
|
$pattern = "^\Q$pattern\E\$"; |
|
2745
|
|
|
|
|
|
|
# unquote %. and %=. and %={WHATEVER} and %{WHATEVER}; look for quoted \w or [^\w\\{}] or \[\\{}] |
|
2746
|
0
|
|
|
|
|
0
|
$pattern =~ s<(\\%(?:\\=){0,2}(\w|\\\{(?:\w|\\[^\w\\{}]|\\\\\\[\\{}])*\\\}|\\[^\w=\{]))> |
|
2747
|
0
|
|
|
|
|
0
|
( __unquote($1) )ge; |
|
2748
|
|
|
|
|
|
|
# $pattern =~ s/(\\%(?:\\=)?)(\w|\\(\W))/$unquote{$1}$+/g; |
|
2749
|
0
|
|
|
|
|
0
|
return $self->parse_rex_prepare($pattern); |
|
2750
|
|
|
|
|
|
|
} |
|
2751
|
|
|
|
|
|
|
|
|
2752
|
|
|
|
|
|
|
sub parse { |
|
2753
|
5
|
|
|
5
|
|
14
|
my ($self, $pattern, $data) = @_; |
|
2754
|
5
|
|
|
|
|
19
|
$self->parse_rex_match($self->parse_prepare($pattern), $data); |
|
2755
|
|
|
|
|
|
|
} |
|
2756
|
|
|
|
|
|
|
|
|
2757
|
|
|
|
|
|
|
=item filename() |
|
2758
|
|
|
|
|
|
|
|
|
2759
|
|
|
|
|
|
|
=item abs_filename() |
|
2760
|
|
|
|
|
|
|
|
|
2761
|
|
|
|
|
|
|
=item filename_nodir() |
|
2762
|
|
|
|
|
|
|
|
|
2763
|
|
|
|
|
|
|
=item filename_noextension() |
|
2764
|
|
|
|
|
|
|
|
|
2765
|
|
|
|
|
|
|
=item filename_nodir_noextension() |
|
2766
|
|
|
|
|
|
|
|
|
2767
|
|
|
|
|
|
|
=item abs_filename_noextension() |
|
2768
|
|
|
|
|
|
|
|
|
2769
|
|
|
|
|
|
|
=item dirname([$strip_levels]) |
|
2770
|
|
|
|
|
|
|
|
|
2771
|
|
|
|
|
|
|
=item filename_extension() |
|
2772
|
|
|
|
|
|
|
|
|
2773
|
|
|
|
|
|
|
=item filename_extension_nodot() |
|
2774
|
|
|
|
|
|
|
|
|
2775
|
|
|
|
|
|
|
=item dir_component([$level]) |
|
2776
|
|
|
|
|
|
|
|
|
2777
|
|
|
|
|
|
|
$filename = $mp3->filename(); |
|
2778
|
|
|
|
|
|
|
$abs_filename = $mp3->abs_filename(); |
|
2779
|
|
|
|
|
|
|
$filename_nodir = $mp3->filename_nodir(); |
|
2780
|
|
|
|
|
|
|
$abs_dirname = $mp3->dirname(); |
|
2781
|
|
|
|
|
|
|
$abs_dirname = $mp3->dirname(0); |
|
2782
|
|
|
|
|
|
|
$abs_parentdir = $mp3->dirname(1); |
|
2783
|
|
|
|
|
|
|
$last_dir_component = $mp3->dir_component(0); |
|
2784
|
|
|
|
|
|
|
|
|
2785
|
|
|
|
|
|
|
Return the name of the audio file: either as given to the new() method, or |
|
2786
|
|
|
|
|
|
|
absolute, or directory-less, or originally given without extension, or |
|
2787
|
|
|
|
|
|
|
directory-less without extension, or |
|
2788
|
|
|
|
|
|
|
absolute without extension, or the directory part of the fullname only, or |
|
2789
|
|
|
|
|
|
|
filename extension (with dot included, or not). |
|
2790
|
|
|
|
|
|
|
|
|
2791
|
|
|
|
|
|
|
The extension is calculated using the config() value C. |
|
2792
|
|
|
|
|
|
|
|
|
2793
|
|
|
|
|
|
|
The dirname() method takes an optional argument: the number of directory |
|
2794
|
|
|
|
|
|
|
components to strip; the C method returns one |
|
2795
|
|
|
|
|
|
|
component of the directory (to get the last use 0 as $level; this is the |
|
2796
|
|
|
|
|
|
|
default if no $level is specified). |
|
2797
|
|
|
|
|
|
|
|
|
2798
|
|
|
|
|
|
|
The configuration option C can be used to |
|
2799
|
|
|
|
|
|
|
specify the encoding of the filename; all these functions would use |
|
2800
|
|
|
|
|
|
|
filename decoded from this encoding. |
|
2801
|
|
|
|
|
|
|
|
|
2802
|
|
|
|
|
|
|
=cut |
|
2803
|
|
|
|
|
|
|
|
|
2804
|
|
|
|
|
|
|
sub from_filesystem ($$) { |
|
2805
|
41
|
|
|
41
|
|
48
|
my ($self, $f) = @_; |
|
2806
|
41
|
|
|
|
|
70
|
my $e = $self->get_config('decode_encoding_filename'); |
|
2807
|
41
|
50
|
33
|
|
|
780
|
return $f unless $e and $e->[0]; |
|
2808
|
0
|
|
|
|
|
0
|
require Encode; |
|
2809
|
0
|
|
|
|
|
0
|
Encode::decode($e->[0], $f); |
|
2810
|
|
|
|
|
|
|
} |
|
2811
|
|
|
|
|
|
|
|
|
2812
|
|
|
|
|
|
|
sub filename { |
|
2813
|
36
|
|
|
36
|
|
34
|
my $self = shift; |
|
2814
|
36
|
|
|
|
|
79
|
$self->from_filesystem($self->{ofilename}); |
|
2815
|
|
|
|
|
|
|
} |
|
2816
|
|
|
|
|
|
|
|
|
2817
|
|
|
|
|
|
|
sub abs_filename { |
|
2818
|
5
|
|
|
5
|
|
6
|
my $self = shift; |
|
2819
|
5
|
|
|
|
|
8
|
$self->from_filesystem($self->{abs_filename}); |
|
2820
|
|
|
|
|
|
|
} |
|
2821
|
|
|
|
|
|
|
|
|
2822
|
|
|
|
|
|
|
sub filename_noextension { |
|
2823
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
2824
|
0
|
|
|
|
|
0
|
my $f = $self->filename; |
|
2825
|
0
|
|
|
|
|
0
|
my $ext_re = $self->get_config('extension')->[0]; |
|
2826
|
0
|
|
|
|
|
0
|
$f =~ s/$ext_re//; |
|
2827
|
0
|
|
|
|
|
0
|
return $f; |
|
2828
|
|
|
|
|
|
|
} |
|
2829
|
|
|
|
|
|
|
|
|
2830
|
|
|
|
|
|
|
sub filename_nodir { |
|
2831
|
36
|
|
|
36
|
|
297
|
require File::Basename; |
|
2832
|
36
|
|
|
|
|
84
|
return scalar File::Basename::fileparse(shift->filename, ""); |
|
2833
|
|
|
|
|
|
|
} |
|
2834
|
|
|
|
|
|
|
|
|
2835
|
|
|
|
|
|
|
sub dirname { |
|
2836
|
1
|
|
|
1
|
|
3
|
require File::Basename; |
|
2837
|
1
|
|
|
|
|
2
|
my ($self, $l) = (shift, shift); |
|
2838
|
1
|
50
|
|
|
|
3
|
my $p = $l ? $self->dirname($l - 1) : $self->abs_filename; |
|
2839
|
1
|
|
|
|
|
41
|
return File::Basename::dirname($p); |
|
2840
|
|
|
|
|
|
|
} |
|
2841
|
|
|
|
|
|
|
|
|
2842
|
|
|
|
|
|
|
sub dir_component { |
|
2843
|
1
|
|
|
1
|
|
4
|
require File::Basename; |
|
2844
|
1
|
|
|
|
|
3
|
my ($self, $l) = (shift, shift); |
|
2845
|
1
|
|
|
|
|
4
|
return scalar File::Basename::fileparse($self->dirname($l), ""); |
|
2846
|
|
|
|
|
|
|
} |
|
2847
|
|
|
|
|
|
|
|
|
2848
|
|
|
|
|
|
|
sub filename_extension { |
|
2849
|
16
|
|
|
16
|
|
15
|
my $self = shift; |
|
2850
|
16
|
|
|
|
|
27
|
my $f = $self->filename_nodir; |
|
2851
|
16
|
|
|
|
|
35
|
my $ext_re = $self->get_config('extension')->[0]; |
|
2852
|
16
|
50
|
|
|
|
128
|
$f =~ /($ext_re)/ or return ''; |
|
2853
|
16
|
|
|
|
|
36
|
return $1; |
|
2854
|
|
|
|
|
|
|
} |
|
2855
|
|
|
|
|
|
|
|
|
2856
|
|
|
|
|
|
|
sub filename_nodir_noextension { |
|
2857
|
4
|
|
|
4
|
|
6
|
my $self = shift; |
|
2858
|
4
|
|
|
|
|
10
|
my $f = $self->filename_nodir; |
|
2859
|
4
|
|
|
|
|
13
|
my $ext_re = $self->get_config('extension')->[0]; |
|
2860
|
4
|
|
|
|
|
33
|
$f =~ s/$ext_re//; |
|
2861
|
4
|
|
|
|
|
10
|
return $f; |
|
2862
|
|
|
|
|
|
|
} |
|
2863
|
|
|
|
|
|
|
|
|
2864
|
|
|
|
|
|
|
sub abs_filename_noextension { |
|
2865
|
1
|
|
|
1
|
|
2
|
my $self = shift; |
|
2866
|
1
|
|
|
|
|
3
|
my $f = $self->abs_filename; |
|
2867
|
1
|
|
|
|
|
2
|
my $ext_re = $self->get_config('extension')->[0]; |
|
2868
|
1
|
|
|
|
|
20
|
$f =~ s/$ext_re//; |
|
2869
|
1
|
|
|
|
|
2
|
return $f; |
|
2870
|
|
|
|
|
|
|
} |
|
2871
|
|
|
|
|
|
|
|
|
2872
|
|
|
|
|
|
|
sub filename_extension_nodot { |
|
2873
|
15
|
|
|
15
|
|
11
|
my $self = shift; |
|
2874
|
15
|
|
|
|
|
39
|
my $e = $self->filename_extension; |
|
2875
|
15
|
|
|
|
|
38
|
$e =~ s/^\.//; |
|
2876
|
15
|
|
|
|
|
23
|
return $e; |
|
2877
|
|
|
|
|
|
|
} |
|
2878
|
|
|
|
|
|
|
|
|
2879
|
|
|
|
|
|
|
=item mpeg_version() |
|
2880
|
|
|
|
|
|
|
|
|
2881
|
|
|
|
|
|
|
=item mpeg_layer() |
|
2882
|
|
|
|
|
|
|
|
|
2883
|
|
|
|
|
|
|
=item mpeg_layer_roman() |
|
2884
|
|
|
|
|
|
|
|
|
2885
|
|
|
|
|
|
|
=item is_stereo() |
|
2886
|
|
|
|
|
|
|
|
|
2887
|
|
|
|
|
|
|
=item is_vbr() |
|
2888
|
|
|
|
|
|
|
|
|
2889
|
|
|
|
|
|
|
=item bitrate_kbps() |
|
2890
|
|
|
|
|
|
|
|
|
2891
|
|
|
|
|
|
|
=item frequency_Hz() |
|
2892
|
|
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
=item frequency_kHz() |
|
2894
|
|
|
|
|
|
|
|
|
2895
|
|
|
|
|
|
|
=item size_bytes() |
|
2896
|
|
|
|
|
|
|
|
|
2897
|
|
|
|
|
|
|
=item total_secs() |
|
2898
|
|
|
|
|
|
|
|
|
2899
|
|
|
|
|
|
|
=item total_secs_int() |
|
2900
|
|
|
|
|
|
|
|
|
2901
|
|
|
|
|
|
|
=item total_secs_trunc() |
|
2902
|
|
|
|
|
|
|
|
|
2903
|
|
|
|
|
|
|
=item total_millisecs_int() |
|
2904
|
|
|
|
|
|
|
|
|
2905
|
|
|
|
|
|
|
=item total_mins() |
|
2906
|
|
|
|
|
|
|
|
|
2907
|
|
|
|
|
|
|
=item leftover_mins() |
|
2908
|
|
|
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
=item leftover_secs() |
|
2910
|
|
|
|
|
|
|
|
|
2911
|
|
|
|
|
|
|
=item leftover_secs_float() |
|
2912
|
|
|
|
|
|
|
|
|
2913
|
|
|
|
|
|
|
=item leftover_secs_trunc() |
|
2914
|
|
|
|
|
|
|
|
|
2915
|
|
|
|
|
|
|
=item leftover_msec() |
|
2916
|
|
|
|
|
|
|
|
|
2917
|
|
|
|
|
|
|
=item time_mm_ss() |
|
2918
|
|
|
|
|
|
|
|
|
2919
|
|
|
|
|
|
|
=item is_copyrighted() |
|
2920
|
|
|
|
|
|
|
|
|
2921
|
|
|
|
|
|
|
=item is_copyrighted_YN() |
|
2922
|
|
|
|
|
|
|
|
|
2923
|
|
|
|
|
|
|
=item frames_padded() |
|
2924
|
|
|
|
|
|
|
|
|
2925
|
|
|
|
|
|
|
=item frames_padded_YN() |
|
2926
|
|
|
|
|
|
|
|
|
2927
|
|
|
|
|
|
|
=item channel_mode_int() |
|
2928
|
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
=item frames() |
|
2930
|
|
|
|
|
|
|
|
|
2931
|
|
|
|
|
|
|
=item frame_len() |
|
2932
|
|
|
|
|
|
|
|
|
2933
|
|
|
|
|
|
|
=item vbr_scale() |
|
2934
|
|
|
|
|
|
|
|
|
2935
|
|
|
|
|
|
|
These methods return the information about the contents of the MP3 |
|
2936
|
|
|
|
|
|
|
file. If this information is not cached in ID3v2 tags (not |
|
2937
|
|
|
|
|
|
|
implemented yet), using these methods requires that the module |
|
2938
|
|
|
|
|
|
|
L is installed. Since these calls are |
|
2939
|
|
|
|
|
|
|
redirectoed to the module L, the returned info is |
|
2940
|
|
|
|
|
|
|
subject to the same restrictions as the method get_mp3info() of this |
|
2941
|
|
|
|
|
|
|
module; in particular, the information about the frame number and |
|
2942
|
|
|
|
|
|
|
frame length is only approximate. |
|
2943
|
|
|
|
|
|
|
|
|
2944
|
|
|
|
|
|
|
vbr_scale() is from the VBR header; total_secs() is not necessarily an |
|
2945
|
|
|
|
|
|
|
integer, but total_secs_int() and total_secs_trunc() are (first is |
|
2946
|
|
|
|
|
|
|
rounded, second truncated); time_mm_ss() has format C; the |
|
2947
|
|
|
|
|
|
|
C<*_YN> flavors return the value as a string Yes or No; |
|
2948
|
|
|
|
|
|
|
mpeg_layer_roman() returns the value as a roman numeral; |
|
2949
|
|
|
|
|
|
|
channel_mode() takes values in C<'stereo', 'joint stereo', 'dual |
|
2950
|
|
|
|
|
|
|
channel', 'mono'>. |
|
2951
|
|
|
|
|
|
|
|
|
2952
|
|
|
|
|
|
|
=cut |
|
2953
|
|
|
|
|
|
|
|
|
2954
|
|
|
|
|
|
|
my %mp3info = qw( |
|
2955
|
|
|
|
|
|
|
mpeg_version VERSION |
|
2956
|
|
|
|
|
|
|
mpeg_layer LAYER |
|
2957
|
|
|
|
|
|
|
is_stereo STEREO |
|
2958
|
|
|
|
|
|
|
is_vbr VBR |
|
2959
|
|
|
|
|
|
|
bitrate_kbps BITRATE |
|
2960
|
|
|
|
|
|
|
frequency_kHz FREQUENCY |
|
2961
|
|
|
|
|
|
|
size_bytes SIZE |
|
2962
|
|
|
|
|
|
|
is_copyrighted COPYRIGHT |
|
2963
|
|
|
|
|
|
|
frames_padded PADDING |
|
2964
|
|
|
|
|
|
|
channel_mode_int MODE |
|
2965
|
|
|
|
|
|
|
frames FRAMES |
|
2966
|
|
|
|
|
|
|
frame_len FRAME_LENGTH |
|
2967
|
|
|
|
|
|
|
vbr_scale VBR_SCALE |
|
2968
|
|
|
|
|
|
|
total_secs_fetch SECS |
|
2969
|
|
|
|
|
|
|
); |
|
2970
|
|
|
|
|
|
|
|
|
2971
|
|
|
|
|
|
|
# Obsoleted: |
|
2972
|
|
|
|
|
|
|
# total_mins MM |
|
2973
|
|
|
|
|
|
|
# time_mm_ss TIME |
|
2974
|
|
|
|
|
|
|
# leftover_secs SS |
|
2975
|
|
|
|
|
|
|
# leftover_msec MS |
|
2976
|
|
|
|
|
|
|
|
|
2977
|
|
|
|
|
|
|
for my $elt (keys %mp3info) { |
|
2978
|
6
|
|
|
6
|
|
35
|
no strict 'refs'; |
|
|
6
|
|
|
|
|
6
|
|
|
|
6
|
|
|
|
|
14220
|
|
|
2979
|
|
|
|
|
|
|
my $k = $mp3info{$elt}; |
|
2980
|
|
|
|
|
|
|
*$elt = sub (;$) { |
|
2981
|
|
|
|
|
|
|
# $MP3::Info::try_harder = 1; # Bug: loops infinitely if no frames |
|
2982
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
2983
|
0
|
|
|
|
|
0
|
my $info = $self->{mp3info}; |
|
2984
|
0
|
0
|
|
|
|
0
|
unless ($info) { |
|
2985
|
0
|
|
|
|
|
0
|
require MP3::Info; |
|
2986
|
0
|
|
|
|
|
0
|
$info = MP3::Info::get_mp3info($self->abs_filename); |
|
2987
|
0
|
0
|
|
|
|
0
|
die "Didn't get valid data from MP3::Info for `".($self->abs_filename)."': $@" |
|
2988
|
|
|
|
|
|
|
unless defined $info; |
|
2989
|
|
|
|
|
|
|
} |
|
2990
|
0
|
|
|
|
|
0
|
$info->{$k} |
|
2991
|
|
|
|
|
|
|
} |
|
2992
|
|
|
|
|
|
|
} |
|
2993
|
|
|
|
|
|
|
|
|
2994
|
|
|
|
|
|
|
sub frequency_Hz ($) { |
|
2995
|
0
|
|
|
0
|
|
0
|
1000 * (shift->frequency_kHz); |
|
2996
|
|
|
|
|
|
|
} |
|
2997
|
|
|
|
|
|
|
|
|
2998
|
0
|
0
|
|
0
|
|
0
|
sub mpeg_layer_roman { eval { 'I' x (shift->mpeg_layer) } || '' } |
|
|
0
|
|
|
|
|
0
|
|
|
2999
|
0
|
|
|
0
|
|
0
|
sub total_millisecs_int_fetch { int (0.5 + 1000 * shift->duration_secs) } |
|
3000
|
0
|
0
|
|
0
|
|
0
|
sub frames_padded_YN { eval {shift->frames_padded() ? 'Yes' : 'No' } || '' } |
|
|
0
|
0
|
|
|
|
0
|
|
|
3001
|
0
|
0
|
|
0
|
|
0
|
sub is_copyrighted_YN { eval {shift->is_copyrighted() ? 'Yes' : 'No' } || '' } |
|
|
0
|
0
|
|
|
|
0
|
|
|
3002
|
|
|
|
|
|
|
|
|
3003
|
|
|
|
|
|
|
sub total_millisecs_int { |
|
3004
|
32
|
|
|
32
|
|
20
|
my $self = shift; |
|
3005
|
32
|
|
|
|
|
27
|
my $ms = $self->{ms}; |
|
3006
|
32
|
50
|
|
|
|
89
|
return $ms if defined $ms; |
|
3007
|
0
|
|
|
|
|
0
|
(undef, $ms) = $self->get_id3v2_frames('TLEN'); |
|
3008
|
0
|
0
|
|
|
|
0
|
$ms = $self->total_millisecs_int_fetch() unless defined $ms; |
|
3009
|
0
|
|
|
|
|
0
|
$self->{ms} = $ms; |
|
3010
|
0
|
|
|
|
|
0
|
return $ms; |
|
3011
|
|
|
|
|
|
|
} |
|
3012
|
0
|
|
|
0
|
|
0
|
sub total_secs_int { int (0.5 + 0.001 * shift->total_millisecs_int) } |
|
3013
|
1
|
|
|
1
|
|
8
|
sub total_secs { 0.001 * shift->total_millisecs_int } |
|
3014
|
6
|
|
|
6
|
|
7
|
sub total_secs_trunc { int (0.001 * (0.5 + shift->total_millisecs_int)) } |
|
3015
|
9
|
|
|
9
|
|
12
|
sub total_mins { int (0.001/60 * (0.5 + shift->total_millisecs_int)) } |
|
3016
|
9
|
|
|
9
|
|
12
|
sub leftover_mins { shift->total_mins() % 60 } |
|
3017
|
4
|
|
|
4
|
|
8
|
sub total_hours { int (0.001/60/60 * (0.5 + shift->total_millisecs_int)) } |
|
3018
|
0
|
|
|
0
|
|
0
|
sub leftover_secs { shift->total_secs_int() % 60 } |
|
3019
|
6
|
|
|
6
|
|
9
|
sub leftover_secs_trunc { shift->total_secs_trunc() % 60 } |
|
3020
|
3
|
|
|
3
|
|
27
|
sub leftover_msec { shift->total_millisecs_int % 1000 } |
|
3021
|
9
|
|
|
9
|
|
11
|
sub leftover_secs_float { shift->total_millisecs_int % 60000 / 1000 } |
|
3022
|
|
|
|
|
|
|
sub time_mm_ss { # Borrowed from MP3::Info |
|
3023
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
3024
|
0
|
|
|
|
|
0
|
sprintf "%.2d:%.2d", $self->total_mins, $self->leftover_secs; |
|
3025
|
|
|
|
|
|
|
} |
|
3026
|
|
|
|
|
|
|
|
|
3027
|
|
|
|
|
|
|
sub duration_secs { # Tricky: in which order to query MP3::Info and ExifTool? |
|
3028
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
3029
|
0
|
|
|
|
|
0
|
my $d = $self->{duration}; |
|
3030
|
0
|
0
|
|
|
|
0
|
return $d if defined $d; # Cached value |
|
3031
|
|
|
|
|
|
|
return $self->{duration} = $self->total_secs_fetch # Have MP3::Info or a chance to work |
|
3032
|
0
|
0
|
0
|
|
|
0
|
if $self->{mp3info} or $self->{filename} =~ /\.mp[23]$/i; |
|
3033
|
0
|
|
|
|
|
0
|
my $r = $self->_duration; # Next: try ExifTool |
|
3034
|
0
|
0
|
|
|
|
0
|
$r = $self->total_secs_fetch unless $r; # Try MP3::Info anyway |
|
3035
|
0
|
|
|
|
|
0
|
return $r; |
|
3036
|
|
|
|
|
|
|
} |
|
3037
|
|
|
|
|
|
|
|
|
3038
|
|
|
|
|
|
|
=item format_time |
|
3039
|
|
|
|
|
|
|
|
|
3040
|
|
|
|
|
|
|
$output = $mp3->format_time(67456.123, @format); |
|
3041
|
|
|
|
|
|
|
|
|
3042
|
|
|
|
|
|
|
formats time according to @format, which should be a list of format |
|
3043
|
|
|
|
|
|
|
descriptors. Each format descriptor is either a simple letter, or a |
|
3044
|
|
|
|
|
|
|
string in braces appropriate to be put after C<%> in an interpolated |
|
3045
|
|
|
|
|
|
|
string. A format descriptor can be followed by a literal string to be |
|
3046
|
|
|
|
|
|
|
put as a suffix, and can be preceded by a question mark, which says |
|
3047
|
|
|
|
|
|
|
that this part of format should be printed only if needed. |
|
3048
|
|
|
|
|
|
|
|
|
3049
|
|
|
|
|
|
|
Leftover minutes, seconds are formated 0-padded to width 2 if they are |
|
3050
|
|
|
|
|
|
|
preceded by more coarse units. Similarly, leftover milliseconds are |
|
3051
|
|
|
|
|
|
|
printed with leading dot, and 0-padded to width 3. |
|
3052
|
|
|
|
|
|
|
|
|
3053
|
|
|
|
|
|
|
Two examples of useful C<@format>s are |
|
3054
|
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
qw(?H: ?{mL}: {SML}) |
|
3056
|
|
|
|
|
|
|
qw(?Hh ?{mL}m {SL} ?{ML}) |
|
3057
|
|
|
|
|
|
|
|
|
3058
|
|
|
|
|
|
|
Both will print hours, minutes, and milliseconds only if needed. The |
|
3059
|
|
|
|
|
|
|
second one will use 3 digit-format after a point, the first one will |
|
3060
|
|
|
|
|
|
|
not print the trailing 0s of milliseconds. The first one uses C<:> as |
|
3061
|
|
|
|
|
|
|
separator of hours and minutes, the second one will use C. |
|
3062
|
|
|
|
|
|
|
|
|
3063
|
|
|
|
|
|
|
Optionally, the first element of the array may be of the form |
|
3064
|
|
|
|
|
|
|
C<=EU>, here C is one of C. In this case, duration is |
|
3065
|
|
|
|
|
|
|
rounded to closest hours, min or second before processing. (E.g., |
|
3066
|
|
|
|
|
|
|
1.7sec would print as C<1> with C<@format>s above, but would print as |
|
3067
|
|
|
|
|
|
|
C<2> if rounded to seconds.) |
|
3068
|
|
|
|
|
|
|
|
|
3069
|
|
|
|
|
|
|
=cut |
|
3070
|
|
|
|
|
|
|
|
|
3071
|
|
|
|
|
|
|
my %Unit = qw( h 3600 m 60 s 1 ); |
|
3072
|
|
|
|
|
|
|
|
|
3073
|
|
|
|
|
|
|
sub format_time { |
|
3074
|
15
|
|
|
15
|
|
349
|
my ($self, $time) = (shift, shift); |
|
3075
|
15
|
100
|
|
|
|
28
|
$self = $self->new_fake() unless ref $self; |
|
3076
|
15
|
|
|
|
|
24
|
local $self->{ms} = $self->{ms}; # Make modifiable |
|
3077
|
15
|
100
|
|
|
|
41
|
local $self->{ms} = int($time * 1000 + 0.5) if defined $time; |
|
3078
|
15
|
|
|
|
|
16
|
my ($out, %have, $c) = ''; |
|
3079
|
15
|
|
|
|
|
19
|
for my $f (@_) { |
|
3080
|
51
|
50
|
|
|
|
155
|
$have{$+}++ if $f =~ /^\??({([^{}]+)}|.)/; |
|
3081
|
|
|
|
|
|
|
} |
|
3082
|
15
|
|
|
|
|
17
|
for my $f (@_) { |
|
3083
|
51
|
50
|
66
|
|
|
106
|
if (!$c++ and $f =~ /^=>(\w)$/) { |
|
3084
|
0
|
0
|
|
|
|
0
|
my $u = $Unit{$1} or die "Unexpected unit of time for rounding: `$1'"; |
|
3085
|
0
|
0
|
|
|
|
0
|
$time = $self->total_secs unless defined $time; |
|
3086
|
0
|
|
|
|
|
0
|
$time = $u * int($time/$u + 0.5); |
|
3087
|
0
|
|
|
|
|
0
|
$self->{ms} = 1000 * $time; |
|
3088
|
0
|
|
|
|
|
0
|
next; |
|
3089
|
|
|
|
|
|
|
} |
|
3090
|
51
|
|
|
|
|
33
|
my $ff = $f; # Modifiable |
|
3091
|
51
|
|
|
|
|
79
|
my $opt = ($ff =~ s/^\?//); |
|
3092
|
51
|
50
|
|
|
|
116
|
$ff =~ s/^({[^{}]+}|\w)// or die "unexpected time format: <<$f>>"; |
|
3093
|
51
|
|
|
|
|
60
|
my ($what, $format) = ($1, ''); |
|
3094
|
51
|
100
|
|
|
|
58
|
if ($opt) { |
|
3095
|
36
|
100
|
66
|
|
|
87
|
if ($what eq 'H') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
3096
|
15
|
100
|
|
|
|
25
|
$time = $self->total_secs unless defined $time; |
|
3097
|
15
|
|
66
|
|
|
58
|
$opt = int($time / 3600) || !(grep $have{$_}, qw(m mL s S SL SML)); |
|
3098
|
|
|
|
|
|
|
} elsif ($what eq 'm' or $what eq '{mL}') { |
|
3099
|
15
|
50
|
|
|
|
18
|
$time = $self->total_secs unless defined $time; |
|
3100
|
15
|
|
66
|
|
|
32
|
$opt = int($time / 60) || !(grep $have{$_}, qw(s S SL SML)); |
|
3101
|
|
|
|
|
|
|
} elsif ($what eq '{ML}') { |
|
3102
|
6
|
|
|
|
|
7
|
$opt = ($time != int $time); |
|
3103
|
|
|
|
|
|
|
} else { |
|
3104
|
0
|
|
|
|
|
0
|
$opt = 1; |
|
3105
|
|
|
|
|
|
|
#die "Do not know how to treat optional `$what'"; |
|
3106
|
|
|
|
|
|
|
} |
|
3107
|
36
|
50
|
|
|
|
72
|
$what =~ /^(?:{(.*)}|(.))/ or die; |
|
3108
|
36
|
100
|
|
|
|
76
|
(delete $have{$+}), next unless $opt; |
|
3109
|
|
|
|
|
|
|
} |
|
3110
|
|
|
|
|
|
|
$format = '02' |
|
3111
|
|
|
|
|
|
|
if (($what eq 's' or $what eq '{SL}') and (grep $have{$_}, qw(H m mL))) |
|
3112
|
31
|
100
|
66
|
|
|
154
|
or $what eq '{mL}' and $have{H}; |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
3113
|
31
|
|
|
|
|
33
|
$what = "%$format$what"; |
|
3114
|
|
|
|
|
|
|
$what = ".%03{ML}" |
|
3115
|
31
|
100
|
66
|
|
|
58
|
if $what eq '%{ML}' and grep $have{$_}, qw(H m mL s S SL); |
|
3116
|
31
|
100
|
100
|
|
|
64
|
if ($what eq '%{SML}' and grep $have{$_}, qw(H m mL)) { # manual padding |
|
3117
|
5
|
|
|
|
|
6
|
my $res = $self->interpolate($what); |
|
3118
|
5
|
50
|
|
|
|
13
|
$res = "0$res" unless $res =~ /^\d\d/; |
|
3119
|
5
|
|
|
|
|
8
|
$out .= "$res$ff"; |
|
3120
|
|
|
|
|
|
|
} else { |
|
3121
|
26
|
|
|
|
|
35
|
$out .= $self->interpolate($what) . $ff; |
|
3122
|
|
|
|
|
|
|
} |
|
3123
|
|
|
|
|
|
|
} |
|
3124
|
15
|
|
|
|
|
48
|
$out; |
|
3125
|
|
|
|
|
|
|
} |
|
3126
|
|
|
|
|
|
|
|
|
3127
|
|
|
|
|
|
|
my @channel_modes = ('stereo', 'joint stereo', 'dual channel', 'mono'); |
|
3128
|
0
|
|
|
0
|
|
0
|
sub channel_mode { $channel_modes[shift->channel_mode_int] } |
|
3129
|
|
|
|
|
|
|
|
|
3130
|
|
|
|
|
|
|
=item can_write() |
|
3131
|
|
|
|
|
|
|
|
|
3132
|
|
|
|
|
|
|
checks permission to write per the configuration variable C. |
|
3133
|
|
|
|
|
|
|
|
|
3134
|
|
|
|
|
|
|
=item can_write_or_die($mess) |
|
3135
|
|
|
|
|
|
|
|
|
3136
|
|
|
|
|
|
|
as can_write(), but die()s on non-writable files with meaningful error message |
|
3137
|
|
|
|
|
|
|
($mess is prepended to the message). |
|
3138
|
|
|
|
|
|
|
|
|
3139
|
|
|
|
|
|
|
=item die_cant_write($mess) |
|
3140
|
|
|
|
|
|
|
|
|
3141
|
|
|
|
|
|
|
die() with the same message as can_write_or_die(). |
|
3142
|
|
|
|
|
|
|
|
|
3143
|
|
|
|
|
|
|
=item writable_by_extension() |
|
3144
|
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
Checks that extension is (case-insensitively) in the list given by |
|
3146
|
|
|
|
|
|
|
configuration variable C. |
|
3147
|
|
|
|
|
|
|
|
|
3148
|
|
|
|
|
|
|
=cut |
|
3149
|
|
|
|
|
|
|
|
|
3150
|
|
|
|
|
|
|
sub can_write ($) { |
|
3151
|
14
|
|
|
14
|
|
17
|
my $self = shift; |
|
3152
|
14
|
|
|
|
|
12
|
my @wr = @{ $self->get_config('is_writable') }; # Make copy |
|
|
14
|
|
|
|
|
22
|
|
|
3153
|
14
|
50
|
33
|
|
|
96
|
return $wr[0] if @wr == 1 and not $wr[0] =~ /\D/; |
|
3154
|
14
|
|
|
|
|
17
|
my $meth = shift @wr; |
|
3155
|
14
|
|
|
|
|
38
|
$self->$meth(@wr); |
|
3156
|
|
|
|
|
|
|
} |
|
3157
|
|
|
|
|
|
|
|
|
3158
|
|
|
|
|
|
|
sub writable_by_extension ($) { |
|
3159
|
14
|
|
|
14
|
|
12
|
my $self = shift; |
|
3160
|
14
|
|
|
|
|
24
|
my $wr = $self->get_config('writable_extensions'); # Make copy |
|
3161
|
14
|
|
|
|
|
36
|
$self->extension_is(@$wr); |
|
3162
|
|
|
|
|
|
|
} |
|
3163
|
|
|
|
|
|
|
|
|
3164
|
|
|
|
|
|
|
sub die_cant_write ($$) { |
|
3165
|
1
|
|
|
1
|
|
2
|
my($self, $what) = (shift, shift); |
|
3166
|
|
|
|
|
|
|
die $what, $self->interpolate("File %F is not writable per `is_writable' confuration variable, current value is `"), |
|
3167
|
1
|
|
|
|
|
5
|
join(', ', @{$self->get_config('is_writable')}), "'"; |
|
|
1
|
|
|
|
|
3
|
|
|
3168
|
|
|
|
|
|
|
} |
|
3169
|
|
|
|
|
|
|
|
|
3170
|
|
|
|
|
|
|
sub can_write_or_die ($$) { |
|
3171
|
14
|
|
|
14
|
|
20
|
my($self, $what) = (shift, shift); |
|
3172
|
14
|
|
|
|
|
34
|
my $wr = $self->can_write; |
|
3173
|
14
|
100
|
|
|
|
30
|
return $wr if $wr; |
|
3174
|
1
|
|
|
|
|
7
|
$self->die_cant_write($what); |
|
3175
|
|
|
|
|
|
|
} |
|
3176
|
|
|
|
|
|
|
|
|
3177
|
|
|
|
|
|
|
=item update_tags( [ $data, [ $force2 ]] ) |
|
3178
|
|
|
|
|
|
|
|
|
3179
|
|
|
|
|
|
|
$mp3 = MP3::Tag->new($filename); |
|
3180
|
|
|
|
|
|
|
$mp3->update_tags(); # Fetches the info, and updates tags |
|
3181
|
|
|
|
|
|
|
|
|
3182
|
|
|
|
|
|
|
$mp3->update_tags({}); # Updates tags if needed/changed |
|
3183
|
|
|
|
|
|
|
|
|
3184
|
|
|
|
|
|
|
$mp3->update_tags({title => 'This is not a song'}); # Updates tags |
|
3185
|
|
|
|
|
|
|
|
|
3186
|
|
|
|
|
|
|
This method updates ID3v1 and ID3v2 tags (the latter only if in-memory copy |
|
3187
|
|
|
|
|
|
|
contains any data, or $data does not fit ID3v1 restrictions, or $force2 |
|
3188
|
|
|
|
|
|
|
argument is given) |
|
3189
|
|
|
|
|
|
|
with the the information about title, artist, album, year, comment, track, |
|
3190
|
|
|
|
|
|
|
genre from the hash reference $data. The format of $data is the same as |
|
3191
|
|
|
|
|
|
|
one returned from autoinfo() (with or without the optional argument 'from'). |
|
3192
|
|
|
|
|
|
|
The fields which are marked as coming from ID3v1 or ID3v2 tags are not updated |
|
3193
|
|
|
|
|
|
|
when written to the same tag. |
|
3194
|
|
|
|
|
|
|
|
|
3195
|
|
|
|
|
|
|
If $data is not defined or missing, C is called to obtain |
|
3196
|
|
|
|
|
|
|
the data. Returns the object reference itself to simplify chaining of method |
|
3197
|
|
|
|
|
|
|
calls. |
|
3198
|
|
|
|
|
|
|
|
|
3199
|
|
|
|
|
|
|
This is probably the simplest way to set data in the tags: populate |
|
3200
|
|
|
|
|
|
|
$data and call this method - no further tinkering with subtags is |
|
3201
|
|
|
|
|
|
|
needed. |
|
3202
|
|
|
|
|
|
|
|
|
3203
|
|
|
|
|
|
|
=cut |
|
3204
|
|
|
|
|
|
|
|
|
3205
|
|
|
|
|
|
|
sub update_tags { |
|
3206
|
32
|
|
|
32
|
|
527
|
my ($mp3, $data, $force2, $wr2) = (shift, shift, shift); |
|
3207
|
|
|
|
|
|
|
|
|
3208
|
32
|
|
|
|
|
52
|
$mp3->get_tags; |
|
3209
|
32
|
100
|
|
|
|
81
|
$data = $mp3->autoinfo('from') unless defined $data; |
|
3210
|
|
|
|
|
|
|
|
|
3211
|
|
|
|
|
|
|
# $mp3->new_tag("ID3v1") unless $wr1 = exists $mp3->{ID3v1}; |
|
3212
|
32
|
100
|
|
|
|
61
|
unless (exists $mp3->{ID3v1}) { |
|
3213
|
13
|
|
|
|
|
48
|
$mp3->can_write_or_die('update_tags() doing ID3v1: '); |
|
3214
|
12
|
|
|
|
|
13
|
$wr2 = 1; |
|
3215
|
12
|
|
|
|
|
26
|
$mp3->new_tag("ID3v1"); |
|
3216
|
|
|
|
|
|
|
} |
|
3217
|
31
|
|
|
|
|
23
|
my $elt; |
|
3218
|
31
|
|
|
|
|
45
|
for $elt (qw/title artist album year comment track genre/) { |
|
3219
|
217
|
|
|
|
|
173
|
my $d = $data->{$elt}; |
|
3220
|
217
|
100
|
|
|
|
296
|
next unless defined $d; |
|
3221
|
74
|
100
|
|
|
|
115
|
$d = [$d, ''] unless ref $d; |
|
3222
|
74
|
50
|
|
|
|
324
|
$mp3->{ID3v1}->$elt( $d->[0] ) if $d->[1] ne 'ID3v1'; |
|
3223
|
|
|
|
|
|
|
} # Skip what is already there... |
|
3224
|
31
|
|
|
|
|
79
|
$mp3->{ID3v1}->write_tag; |
|
3225
|
|
|
|
|
|
|
|
|
3226
|
|
|
|
|
|
|
my $do_length |
|
3227
|
31
|
50
|
|
|
|
58
|
= (defined $mp3->{ms}) ? ($mp3->get_config('update_length'))->[0] : 0; |
|
3228
|
|
|
|
|
|
|
|
|
3229
|
|
|
|
|
|
|
return $mp3 |
|
3230
|
|
|
|
|
|
|
if not $force2 and $mp3->{ID3v1}->fits_tag($data) |
|
3231
|
31
|
100
|
66
|
|
|
106
|
and not exists $mp3->{ID3v2} and $do_length < 2; |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
3232
|
|
|
|
|
|
|
|
|
3233
|
|
|
|
|
|
|
# $mp3->new_tag("ID3v2") unless exists $mp3->{ID3v2}; |
|
3234
|
26
|
100
|
|
|
|
46
|
unless (exists $mp3->{ID3v2}) { |
|
3235
|
3
|
100
|
|
|
|
8
|
if (defined $wr2) { |
|
3236
|
2
|
50
|
|
|
|
3
|
$mp3->die_cant_write('update_tags() doing ID3v2: ') unless $wr2; |
|
3237
|
|
|
|
|
|
|
} else { |
|
3238
|
1
|
|
|
|
|
3
|
$mp3->can_write_or_die('update_tags() doing ID3v2: '); |
|
3239
|
|
|
|
|
|
|
} |
|
3240
|
3
|
|
|
|
|
7
|
$mp3->new_tag("ID3v2"); |
|
3241
|
|
|
|
|
|
|
} |
|
3242
|
26
|
|
|
|
|
42
|
for $elt (qw/title artist album year comment track genre/) { |
|
3243
|
182
|
|
|
|
|
164
|
my $d = $data->{$elt}; |
|
3244
|
182
|
100
|
|
|
|
219
|
next unless defined $d; |
|
3245
|
69
|
100
|
|
|
|
109
|
$d = [$d, ''] unless ref $d; |
|
3246
|
69
|
100
|
|
|
|
214
|
$mp3->{ID3v2}->$elt( $d->[0] ) if $d->[1] ne 'ID3v2'; |
|
3247
|
|
|
|
|
|
|
} # Skip what is already there... |
|
3248
|
|
|
|
|
|
|
# $mp3->{ID3v2}->comment($data->{comment}->[0]); |
|
3249
|
|
|
|
|
|
|
|
|
3250
|
|
|
|
|
|
|
$mp3->set_id3v2_frame('TLEN', $mp3->{ms}) |
|
3251
|
26
|
50
|
33
|
|
|
63
|
if $do_length and not $mp3->have_id3v2_frame('TLEN'); |
|
3252
|
26
|
|
|
|
|
63
|
$mp3->{ID3v2}->write_tag; |
|
3253
|
26
|
|
|
|
|
118
|
return $mp3; |
|
3254
|
|
|
|
|
|
|
} |
|
3255
|
|
|
|
|
|
|
|
|
3256
|
|
|
|
|
|
|
sub _massage_genres ($;$) { # Thanks to neil verplank for the prototype |
|
3257
|
71
|
|
|
71
|
|
254
|
require MP3::Tag::ID3v1; |
|
3258
|
71
|
|
|
|
|
79
|
my($data, $how) = (shift, shift); |
|
3259
|
71
|
|
100
|
|
|
181
|
my $firstnum = (($how || 0) eq 'num'); |
|
3260
|
71
|
|
100
|
|
|
131
|
my $prefer_num = (($how || 0) eq 'prefer_num'); |
|
3261
|
71
|
|
|
|
|
37
|
my (%seen, @genres); # find all genres in incoming data |
|
3262
|
71
|
50
|
|
|
|
90
|
$data = $data->[0] if ref $data; |
|
3263
|
|
|
|
|
|
|
# clean and split line on both null and parentheses |
|
3264
|
71
|
|
|
|
|
132
|
$data =~ s/\s+/ /g; |
|
3265
|
71
|
|
|
|
|
71
|
$data =~ s/\s*\0[\0\s]*/\0/g; |
|
3266
|
71
|
|
|
|
|
89
|
$data =~ s/^[\s\0]+//; |
|
3267
|
71
|
|
|
|
|
78
|
$data =~ s/[\s\0]+$//; |
|
3268
|
71
|
|
|
|
|
232
|
my @data = split m<\0|\s+/\s+>, $data; |
|
3269
|
71
|
100
|
|
|
|
231
|
@data = split /\( ( \d+ | rx | cr ) \)/xi, $data[0] if @data == 1; |
|
3270
|
|
|
|
|
|
|
|
|
3271
|
|
|
|
|
|
|
# review array, produce a clean, ordered list of unique genres for output |
|
3272
|
71
|
|
|
|
|
94
|
foreach my $genre (@data) { |
|
3273
|
138
|
100
|
|
|
|
196
|
next if $genre eq ""; # (12)(13) ==> in front, and between |
|
3274
|
|
|
|
|
|
|
|
|
3275
|
|
|
|
|
|
|
# convert text to number to eliminate collisions, and produce consistent output |
|
3276
|
89
|
100
|
|
|
|
163
|
if ($genre =~ /\D/) {{ # Not a pure number |
|
3277
|
|
|
|
|
|
|
# return id number |
|
3278
|
14
|
|
|
|
|
11
|
my $genre_num = MP3::Tag::ID3v1::genres($genre); |
|
|
14
|
|
|
|
|
26
|
|
|
3279
|
|
|
|
|
|
|
# 255 is "non-standard text" in ID3v1; pass the rest through |
|
3280
|
14
|
100
|
66
|
|
|
45
|
last if $genre_num eq '255' or $genre_num eq ''; |
|
3281
|
2
|
100
|
|
|
|
6
|
return $genre_num if $firstnum; |
|
3282
|
1
|
50
|
|
|
|
3
|
$genre = $genre_num, last if $prefer_num; |
|
3283
|
0
|
|
|
|
|
0
|
$genre_num = MP3::Tag::ID3v1::genres($genre_num); |
|
3284
|
0
|
0
|
|
|
|
0
|
last unless defined $genre_num; |
|
3285
|
0
|
|
|
|
|
0
|
$genre = $genre_num; |
|
3286
|
|
|
|
|
|
|
}} # Now converted to a number - if possible |
|
3287
|
88
|
100
|
100
|
|
|
276
|
unless ($prefer_num or $genre =~ /\D/) {{ # Here $genre is a number |
|
3288
|
61
|
100
|
|
|
|
38
|
my $genre_str = MP3::Tag::ID3v1::genres($genre) or last; |
|
|
61
|
|
|
|
|
113
|
|
|
3289
|
39
|
100
|
|
|
|
87
|
return $genre if $firstnum; |
|
3290
|
24
|
|
|
|
|
28
|
$genre = $genre_str; |
|
3291
|
|
|
|
|
|
|
}} |
|
3292
|
|
|
|
|
|
|
# 2.4 defines these conversions |
|
3293
|
73
|
50
|
|
|
|
110
|
$genre = "Remix" if lc $genre eq "rx"; |
|
3294
|
73
|
50
|
|
|
|
103
|
$genre = "Cover" if lc $genre eq "cr"; |
|
3295
|
73
|
100
|
66
|
|
|
285
|
$genre = "($genre)" if length $genre and not $genre =~ /\D/; # Only digits |
|
3296
|
73
|
100
|
|
|
|
227
|
push @genres, $genre unless $seen{$genre}++; |
|
3297
|
|
|
|
|
|
|
} |
|
3298
|
55
|
100
|
|
|
|
76
|
return if $firstnum; |
|
3299
|
48
|
|
|
|
|
180
|
@genres; |
|
3300
|
|
|
|
|
|
|
} |
|
3301
|
|
|
|
|
|
|
|
|
3302
|
|
|
|
|
|
|
=item extension_is |
|
3303
|
|
|
|
|
|
|
|
|
3304
|
|
|
|
|
|
|
$mp3->extension_is(@EXT_LIST) |
|
3305
|
|
|
|
|
|
|
|
|
3306
|
|
|
|
|
|
|
returns TRUE if the extension of the filename coincides (case-insensitive) |
|
3307
|
|
|
|
|
|
|
with one of the elements of the list. |
|
3308
|
|
|
|
|
|
|
|
|
3309
|
|
|
|
|
|
|
=cut |
|
3310
|
|
|
|
|
|
|
|
|
3311
|
|
|
|
|
|
|
sub extension_is ($@) { |
|
3312
|
14
|
|
|
14
|
|
31
|
my ($self) = (shift); |
|
3313
|
14
|
|
|
|
|
38
|
my $ext = lc($self->filename_extension_nodot()); |
|
3314
|
14
|
100
|
|
|
|
82
|
return 1 if grep $ext eq lc, @_; |
|
3315
|
1
|
|
|
|
|
2
|
return; |
|
3316
|
|
|
|
|
|
|
} |
|
3317
|
|
|
|
|
|
|
|
|
3318
|
|
|
|
|
|
|
sub DESTROY { |
|
3319
|
84
|
|
|
84
|
|
266
|
my $self=shift; |
|
3320
|
84
|
100
|
66
|
|
|
367
|
if (exists $self->{filename} and defined $self->{filename}) { |
|
3321
|
82
|
|
|
|
|
194
|
$self->{filename}->close; |
|
3322
|
|
|
|
|
|
|
} |
|
3323
|
|
|
|
|
|
|
} |
|
3324
|
|
|
|
|
|
|
|
|
3325
|
|
|
|
|
|
|
sub parse_cfg_line ($$$) { |
|
3326
|
0
|
|
|
0
|
|
|
my ($self, $line, $data) = (shift,shift,shift); |
|
3327
|
0
|
0
|
|
|
|
|
return if $line =~ /^\s*(#|$)/; |
|
3328
|
0
|
0
|
|
|
|
|
die "Unrecognized configuration file line: <<<$line>>>" |
|
3329
|
|
|
|
|
|
|
unless $line =~ /^\s*(\w+)\s*=\s*(.*?)\s*$/; |
|
3330
|
0
|
|
|
|
|
|
push @{$data->{$1}}, $2; |
|
|
0
|
|
|
|
|
|
|
|
3331
|
|
|
|
|
|
|
} |
|
3332
|
|
|
|
|
|
|
|
|
3333
|
|
|
|
|
|
|
=item C |
|
3334
|
|
|
|
|
|
|
|
|
3335
|
|
|
|
|
|
|
Reads configuration information from the specified file (defaults to |
|
3336
|
|
|
|
|
|
|
the value of configuration variable C, which is |
|
3337
|
|
|
|
|
|
|
C<~>-substituted). Empty lines and lines starting with C<#> are ignored. |
|
3338
|
|
|
|
|
|
|
The remaining lines should have format C; leading |
|
3339
|
|
|
|
|
|
|
and trailing whitespace is stripped; there may be several lines with the same |
|
3340
|
|
|
|
|
|
|
C; this sets list-valued variables. |
|
3341
|
|
|
|
|
|
|
|
|
3342
|
|
|
|
|
|
|
=back |
|
3343
|
|
|
|
|
|
|
|
|
3344
|
|
|
|
|
|
|
=cut |
|
3345
|
|
|
|
|
|
|
|
|
3346
|
|
|
|
|
|
|
sub parse_cfg ($;$) { |
|
3347
|
0
|
|
|
0
|
|
|
my ($self, $file) = (shift,shift); |
|
3348
|
0
|
0
|
|
|
|
|
$file = ($self->get_config('local_cfg_file'))->[0] unless defined $file; |
|
3349
|
0
|
0
|
|
|
|
|
return unless defined $file; |
|
3350
|
0
|
0
|
|
|
|
|
$file =~ s,^~(?=[/\\]),$ENV{HOME}, if $ENV{HOME}; |
|
3351
|
0
|
0
|
|
|
|
|
return unless -e $file; |
|
3352
|
0
|
0
|
|
|
|
|
open F, "< $file" or die "Can't open `$file' for read: $!"; |
|
3353
|
0
|
|
|
|
|
|
my $data = {}; |
|
3354
|
0
|
|
|
|
|
|
while (defined (my $l = )) { |
|
3355
|
0
|
|
|
|
|
|
$self->parse_cfg_line($l, $data); |
|
3356
|
|
|
|
|
|
|
} |
|
3357
|
0
|
0
|
|
|
|
|
CORE::close F or die "Can't close `$file' for read: $!"; |
|
3358
|
0
|
|
|
|
|
|
for my $k (keys %$data) { |
|
3359
|
0
|
|
|
|
|
|
$self->config($k, @{$data->{$k}}); |
|
|
0
|
|
|
|
|
|
|
|
3360
|
|
|
|
|
|
|
} |
|
3361
|
|
|
|
|
|
|
} |
|
3362
|
|
|
|
|
|
|
|
|
3363
|
|
|
|
|
|
|
my @parents = qw(User Site Vendor); |
|
3364
|
|
|
|
|
|
|
|
|
3365
|
|
|
|
|
|
|
@MP3::Tag::User::ISA = qw( MP3::Tag::Site MP3::Tag::Vendor |
|
3366
|
|
|
|
|
|
|
MP3::Tag::Implemenation ); # Make overridable |
|
3367
|
|
|
|
|
|
|
@MP3::Tag::Site::ISA = qw( MP3::Tag::Vendor MP3::Tag::Implemenation ); |
|
3368
|
|
|
|
|
|
|
@MP3::Tag::Vendor::ISA = qw( MP3::Tag::Implemenation ); |
|
3369
|
|
|
|
|
|
|
|
|
3370
|
|
|
|
|
|
|
sub load_parents { |
|
3371
|
0
|
|
|
0
|
|
|
my $par; |
|
3372
|
0
|
|
|
|
|
|
while ($par = shift @parents) { |
|
3373
|
0
|
0
|
|
|
|
|
return 1 if eval "require MP3::Tag::$par; 1" |
|
3374
|
|
|
|
|
|
|
} |
|
3375
|
0
|
|
|
|
|
|
return; |
|
3376
|
|
|
|
|
|
|
} |
|
3377
|
|
|
|
|
|
|
load_parents() unless $ENV{MP3TAG_SKIP_LOCAL}; |
|
3378
|
|
|
|
|
|
|
MP3::Tag->parse_cfg() unless $ENV{MP3TAG_SKIP_LOCAL}; |
|
3379
|
|
|
|
|
|
|
|
|
3380
|
|
|
|
|
|
|
1; |
|
3381
|
|
|
|
|
|
|
|
|
3382
|
|
|
|
|
|
|
=pod |
|
3383
|
|
|
|
|
|
|
|
|
3384
|
|
|
|
|
|
|
=head1 ENVIRONMENT |
|
3385
|
|
|
|
|
|
|
|
|
3386
|
|
|
|
|
|
|
Some defaults for the operation of this module (and/or scripts distributed |
|
3387
|
|
|
|
|
|
|
with this module) are set from |
|
3388
|
|
|
|
|
|
|
environment. Assumed encodings (0 or encoding name): for read access: |
|
3389
|
|
|
|
|
|
|
|
|
3390
|
|
|
|
|
|
|
MP3TAG_DECODE_V1_DEFAULT MP3TAG_DECODE_V2_DEFAULT |
|
3391
|
|
|
|
|
|
|
MP3TAG_DECODE_FILENAME_DEFAULT MP3TAG_DECODE_FILES_DEFAULT |
|
3392
|
|
|
|
|
|
|
MP3TAG_DECODE_INF_DEFAULT MP3TAG_DECODE_CDDB_FILE_DEFAULT |
|
3393
|
|
|
|
|
|
|
MP3TAG_DECODE_CUE_DEFAULT |
|
3394
|
|
|
|
|
|
|
|
|
3395
|
|
|
|
|
|
|
for write access: |
|
3396
|
|
|
|
|
|
|
|
|
3397
|
|
|
|
|
|
|
MP3TAG_ENCODE_V1_DEFAULT MP3TAG_ENCODE_FILES_DEFAULT |
|
3398
|
|
|
|
|
|
|
|
|
3399
|
|
|
|
|
|
|
(if not set, default to corresponding C options). |
|
3400
|
|
|
|
|
|
|
|
|
3401
|
|
|
|
|
|
|
Defaults for the above: |
|
3402
|
|
|
|
|
|
|
|
|
3403
|
|
|
|
|
|
|
MP3TAG_DECODE_DEFAULT MP3TAG_ENCODE_DEFAULT |
|
3404
|
|
|
|
|
|
|
|
|
3405
|
|
|
|
|
|
|
(if the second one is not set, the value of the first one is used). |
|
3406
|
|
|
|
|
|
|
Value 0 for more specific variable will cancel the effect of the less |
|
3407
|
|
|
|
|
|
|
specific variables. |
|
3408
|
|
|
|
|
|
|
|
|
3409
|
|
|
|
|
|
|
These variables set default configuration settings for C; |
|
3410
|
|
|
|
|
|
|
the values are read during the load time of the module. After load, |
|
3411
|
|
|
|
|
|
|
one can use config()/get_config() methods to change/access these |
|
3412
|
|
|
|
|
|
|
settings. See C and C in |
|
3413
|
|
|
|
|
|
|
documentation of L method. (Note that C variant |
|
3414
|
|
|
|
|
|
|
govern file read/written in non-binary mode by L module, |
|
3415
|
|
|
|
|
|
|
as well as reading of control files of some scripts using this module, such as |
|
3416
|
|
|
|
|
|
|
L.) |
|
3417
|
|
|
|
|
|
|
|
|
3418
|
|
|
|
|
|
|
=over |
|
3419
|
|
|
|
|
|
|
|
|
3420
|
|
|
|
|
|
|
=item B |
|
3421
|
|
|
|
|
|
|
|
|
3422
|
|
|
|
|
|
|
Assume that locally present CDDB files and F<.inf> files |
|
3423
|
|
|
|
|
|
|
are in encoding C (this is not supported by "standard", but since |
|
3424
|
|
|
|
|
|
|
the standard supports only a handful of languages, this is widely used anyway), |
|
3425
|
|
|
|
|
|
|
and that one wants C fields to be in the same encoding, but C |
|
3426
|
|
|
|
|
|
|
have an honest (Unicode, if needed) encoding. Then set |
|
3427
|
|
|
|
|
|
|
|
|
3428
|
|
|
|
|
|
|
MP3TAG_DECODE_INF_DEFAULT=cp1251 |
|
3429
|
|
|
|
|
|
|
MP3TAG_DECODE_CDDB_FILE_DEFAULT=cp1251 |
|
3430
|
|
|
|
|
|
|
MP3TAG_DECODE_V1_DEFAULT=cp1251 |
|
3431
|
|
|
|
|
|
|
|
|
3432
|
|
|
|
|
|
|
Since C implies C, |
|
3433
|
|
|
|
|
|
|
you will get the desired effect both for read and write of MP3 tags. |
|
3434
|
|
|
|
|
|
|
|
|
3435
|
|
|
|
|
|
|
=back |
|
3436
|
|
|
|
|
|
|
|
|
3437
|
|
|
|
|
|
|
Additionally, the following (unsupported) variables are currently |
|
3438
|
|
|
|
|
|
|
recognized by ID3v2 code: |
|
3439
|
|
|
|
|
|
|
|
|
3440
|
|
|
|
|
|
|
MP3TAG_DECODE_UNICODE MP3TAG_DECODE_UTF8 |
|
3441
|
|
|
|
|
|
|
|
|
3442
|
|
|
|
|
|
|
MP3TAG_DECODE_UNICODE (default 1) enables decoding; the target of |
|
3443
|
|
|
|
|
|
|
decoding is determined by MP3TAG_DECODE_UTF8: if 0, decoded values are |
|
3444
|
|
|
|
|
|
|
byte-encoded UTF-8 (every Perl character contains a byte of UTF-8 |
|
3445
|
|
|
|
|
|
|
encoded string); otherwise (default) it is a native Perl Unicode |
|
3446
|
|
|
|
|
|
|
string. |
|
3447
|
|
|
|
|
|
|
|
|
3448
|
|
|
|
|
|
|
If C is true, local customization files are not loaded. |
|
3449
|
|
|
|
|
|
|
|
|
3450
|
|
|
|
|
|
|
=head1 CUSTOMIZATION |
|
3451
|
|
|
|
|
|
|
|
|
3452
|
|
|
|
|
|
|
Many aspects of operation of this module are subject to certain subtle |
|
3453
|
|
|
|
|
|
|
choices. A lot of effort went into making these choices customizable, |
|
3454
|
|
|
|
|
|
|
by setting global or per-object configuration variables. |
|
3455
|
|
|
|
|
|
|
|
|
3456
|
|
|
|
|
|
|
A certain degree of customization of global configuration variables is |
|
3457
|
|
|
|
|
|
|
available via the environment variables. Moreover, at startup the local |
|
3458
|
|
|
|
|
|
|
customization file F<~/.mp3tagprc> is read, and defaults are set accordingly. |
|
3459
|
|
|
|
|
|
|
|
|
3460
|
|
|
|
|
|
|
In addition, to make customization as flexible as possible, I aspects |
|
3461
|
|
|
|
|
|
|
of operation of C are subject to local override. Three customization |
|
3462
|
|
|
|
|
|
|
modules |
|
3463
|
|
|
|
|
|
|
|
|
3464
|
|
|
|
|
|
|
MP3::Tag::User MP3::Tag::Site MP3::Tag::Vendor |
|
3465
|
|
|
|
|
|
|
|
|
3466
|
|
|
|
|
|
|
are attempted to be loaded if present. Only the first module (of |
|
3467
|
|
|
|
|
|
|
those present) is loaded directly; if sequential load is desirable, |
|
3468
|
|
|
|
|
|
|
the first thing a customization module should do is to call |
|
3469
|
|
|
|
|
|
|
|
|
3470
|
|
|
|
|
|
|
MP3::Tag->load_parents() |
|
3471
|
|
|
|
|
|
|
|
|
3472
|
|
|
|
|
|
|
method. |
|
3473
|
|
|
|
|
|
|
|
|
3474
|
|
|
|
|
|
|
The customization modules have an opportunity to change global |
|
3475
|
|
|
|
|
|
|
configuration variables on load. To allow more flexibility, they may |
|
3476
|
|
|
|
|
|
|
override any method defined in C; as usual, the overriden |
|
3477
|
|
|
|
|
|
|
method may be called using C modifier (see L
|
|
3478
|
|
|
|
|
|
|
invocation">). |
|
3479
|
|
|
|
|
|
|
|
|
3480
|
|
|
|
|
|
|
E.g., it is recommended to make a local customization file with |
|
3481
|
|
|
|
|
|
|
|
|
3482
|
|
|
|
|
|
|
eval 'require Normalize::Text::Music_Fields'; |
|
3483
|
|
|
|
|
|
|
for my $elt ( qw( title track artist album comment year genre |
|
3484
|
|
|
|
|
|
|
title_track artist_collection person ) ) { |
|
3485
|
|
|
|
|
|
|
no strict 'refs'; |
|
3486
|
|
|
|
|
|
|
MP3::Tag->config("translate_$elt", \&{"Normalize::Text::Music_Fields::normalize_$elt"}) |
|
3487
|
|
|
|
|
|
|
if defined &{"Normalize::Text::Music_Fields::normalize_$elt"}; |
|
3488
|
|
|
|
|
|
|
} |
|
3489
|
|
|
|
|
|
|
MP3::Tag->config("short_person", \&Normalize::Text::Music_Fields::short_person) |
|
3490
|
|
|
|
|
|
|
if defined &Normalize::Text::Music_Fields::short_person; |
|
3491
|
|
|
|
|
|
|
|
|
3492
|
|
|
|
|
|
|
and install the (supplied, in the F) module |
|
3493
|
|
|
|
|
|
|
L which enables normalization of person |
|
3494
|
|
|
|
|
|
|
names (to a long or a short form), and of music piece names to |
|
3495
|
|
|
|
|
|
|
canonical forms. |
|
3496
|
|
|
|
|
|
|
|
|
3497
|
|
|
|
|
|
|
To simplify debugging of local customization, it may be switched off |
|
3498
|
|
|
|
|
|
|
completely by setting MP3TAG_SKIP_LOCAL to TRUE (in environment). |
|
3499
|
|
|
|
|
|
|
|
|
3500
|
|
|
|
|
|
|
For example, putting |
|
3501
|
|
|
|
|
|
|
|
|
3502
|
|
|
|
|
|
|
id3v23_unsync = 0 |
|
3503
|
|
|
|
|
|
|
|
|
3504
|
|
|
|
|
|
|
into F<~/.mp3tagprc> will produce broken ID3v2 tags (but those required |
|
3505
|
|
|
|
|
|
|
by ITunes). |
|
3506
|
|
|
|
|
|
|
|
|
3507
|
|
|
|
|
|
|
=head1 EXAMPLE SCRIPTS |
|
3508
|
|
|
|
|
|
|
|
|
3509
|
|
|
|
|
|
|
Some example scripts come with this module (either installed, or in directory |
|
3510
|
|
|
|
|
|
|
F in the distribution); they either use this module, or |
|
3511
|
|
|
|
|
|
|
provide data understood by this module: |
|
3512
|
|
|
|
|
|
|
|
|
3513
|
|
|
|
|
|
|
=over |
|
3514
|
|
|
|
|
|
|
|
|
3515
|
|
|
|
|
|
|
=item mp3info2 |
|
3516
|
|
|
|
|
|
|
|
|
3517
|
|
|
|
|
|
|
perform command line manipulation of audio tags (and more!); |
|
3518
|
|
|
|
|
|
|
|
|
3519
|
|
|
|
|
|
|
=item audio_rename |
|
3520
|
|
|
|
|
|
|
|
|
3521
|
|
|
|
|
|
|
rename audio files according to associated tags (and more!); |
|
3522
|
|
|
|
|
|
|
|
|
3523
|
|
|
|
|
|
|
=item typeset_mp3_dir |
|
3524
|
|
|
|
|
|
|
|
|
3525
|
|
|
|
|
|
|
write LaTeX files suitable for CD covers and normal-size sheet |
|
3526
|
|
|
|
|
|
|
descriptions of hierarchy of audio files; |
|
3527
|
|
|
|
|
|
|
|
|
3528
|
|
|
|
|
|
|
=item mp3_total_time |
|
3529
|
|
|
|
|
|
|
|
|
3530
|
|
|
|
|
|
|
Calculate total duration of audio files; |
|
3531
|
|
|
|
|
|
|
|
|
3532
|
|
|
|
|
|
|
=item eat_wav_mp3_header |
|
3533
|
|
|
|
|
|
|
|
|
3534
|
|
|
|
|
|
|
remove WAV headers from MP3 files in WAV containers. |
|
3535
|
|
|
|
|
|
|
|
|
3536
|
|
|
|
|
|
|
=item fulltoc_2fake_cddb |
|
3537
|
|
|
|
|
|
|
|
|
3538
|
|
|
|
|
|
|
converts a CD's "full TOC" to a "fake" CDDB file (header only). Create |
|
3539
|
|
|
|
|
|
|
this file with something like |
|
3540
|
|
|
|
|
|
|
|
|
3541
|
|
|
|
|
|
|
readcd -fulltoc dev=0,1,0 -f=audio_cd >& nul |
|
3542
|
|
|
|
|
|
|
|
|
3543
|
|
|
|
|
|
|
run similar to |
|
3544
|
|
|
|
|
|
|
|
|
3545
|
|
|
|
|
|
|
fulltoc_2fake_cddb < audio_cd.toc | cddb2cddb > cddb.out |
|
3546
|
|
|
|
|
|
|
|
|
3547
|
|
|
|
|
|
|
=item dir_mp3_2fake_cddb |
|
3548
|
|
|
|
|
|
|
|
|
3549
|
|
|
|
|
|
|
tries to convert a directory of MP3 files to a "fake" CDDB file (header only); |
|
3550
|
|
|
|
|
|
|
assumes that files are a rip from a CD, and that alphabetical sort gives |
|
3551
|
|
|
|
|
|
|
the track order (works only heuristically, since quantization of duration |
|
3552
|
|
|
|
|
|
|
of MP3 files and of CD tracks is so different). |
|
3553
|
|
|
|
|
|
|
|
|
3554
|
|
|
|
|
|
|
Run similar to |
|
3555
|
|
|
|
|
|
|
|
|
3556
|
|
|
|
|
|
|
dir_mp3_2fake_cddb | cddb2cddb > cddb.out |
|
3557
|
|
|
|
|
|
|
|
|
3558
|
|
|
|
|
|
|
|
|
3559
|
|
|
|
|
|
|
=item inf_2fake_cddb |
|
3560
|
|
|
|
|
|
|
|
|
3561
|
|
|
|
|
|
|
tries to convert a directory of F<.inf> files to a "fake" CDDB file (header |
|
3562
|
|
|
|
|
|
|
only). (Still heuristic, since it can't guess the length of the leader.) |
|
3563
|
|
|
|
|
|
|
|
|
3564
|
|
|
|
|
|
|
Run similar to |
|
3565
|
|
|
|
|
|
|
|
|
3566
|
|
|
|
|
|
|
inf_2fake_cddb | cddb2cddb > cddb.out |
|
3567
|
|
|
|
|
|
|
|
|
3568
|
|
|
|
|
|
|
=item cddb2cddb |
|
3569
|
|
|
|
|
|
|
|
|
3570
|
|
|
|
|
|
|
Reads a (header of) CDDB file from STDIN, outputs (on STDOUT) the current |
|
3571
|
|
|
|
|
|
|
version of the database record. Can be used to update a file, and/or to |
|
3572
|
|
|
|
|
|
|
convert a fake CDDB file to a real one. |
|
3573
|
|
|
|
|
|
|
|
|
3574
|
|
|
|
|
|
|
=back |
|
3575
|
|
|
|
|
|
|
|
|
3576
|
|
|
|
|
|
|
(Last four do not use these modules!) |
|
3577
|
|
|
|
|
|
|
|
|
3578
|
|
|
|
|
|
|
Some more examples: |
|
3579
|
|
|
|
|
|
|
|
|
3580
|
|
|
|
|
|
|
# Convert from one (non-standard-conforming!) encoding to another |
|
3581
|
|
|
|
|
|
|
perl -MMP3::Tag -MEncode -wle ' |
|
3582
|
|
|
|
|
|
|
my @fields = qw(artist album title comment); |
|
3583
|
|
|
|
|
|
|
for my $f (@ARGV) { |
|
3584
|
|
|
|
|
|
|
print $f; |
|
3585
|
|
|
|
|
|
|
my $t = MP3::Tag->new($f) or die; |
|
3586
|
|
|
|
|
|
|
$t->update_tags( |
|
3587
|
|
|
|
|
|
|
{ map { $_ => encode "cp1251", decode "koi8-r", $t->$_() }, @fields } |
|
3588
|
|
|
|
|
|
|
); |
|
3589
|
|
|
|
|
|
|
}' list_of_audio_files |
|
3590
|
|
|
|
|
|
|
|
|
3591
|
|
|
|
|
|
|
=head1 Problems with ID3 format |
|
3592
|
|
|
|
|
|
|
|
|
3593
|
|
|
|
|
|
|
The largest problem with ID3 format is that the first versions of these |
|
3594
|
|
|
|
|
|
|
format were absolutely broken (underspecified). It I like the newer |
|
3595
|
|
|
|
|
|
|
versions of this format resolved most of these problems; however, in reality |
|
3596
|
|
|
|
|
|
|
they did not (due to unspecified backward compatibility, and |
|
3597
|
|
|
|
|
|
|
grandfathering considerations). |
|
3598
|
|
|
|
|
|
|
|
|
3599
|
|
|
|
|
|
|
What are the problems with C? First, one of the fields was C, |
|
3600
|
|
|
|
|
|
|
which does not make any sense. In particular, different people/publishers |
|
3601
|
|
|
|
|
|
|
would put there performer(s), composer, author of text/lyrics, or a combination |
|
3602
|
|
|
|
|
|
|
of these. The second problem is that the only allowed encoding was |
|
3603
|
|
|
|
|
|
|
C; since most of languages of the world can't be expressed |
|
3604
|
|
|
|
|
|
|
in this encoding, this restriction was completely ignored, thus the |
|
3605
|
|
|
|
|
|
|
encoding is essentially "unknown". |
|
3606
|
|
|
|
|
|
|
|
|
3607
|
|
|
|
|
|
|
Newer versions of C allow specification of encodings; however, |
|
3608
|
|
|
|
|
|
|
since there is no way to specify that the encoding is "unknown", when a |
|
3609
|
|
|
|
|
|
|
tag is automatically upgraded from C, it is most probably assumed to be |
|
3610
|
|
|
|
|
|
|
in the "standard" C encoding. Thus impossibility to |
|
3611
|
|
|
|
|
|
|
distinguish "unknown, assumed C" from "known to be C" |
|
3612
|
|
|
|
|
|
|
in C, essentially, makes any encoding specified in the tag "unknown" |
|
3613
|
|
|
|
|
|
|
(or, at least, "untrusted"). (Since the upgrade [or a chain of upgrades] |
|
3614
|
|
|
|
|
|
|
from the C tag to the C tag can result in any encoding of |
|
3615
|
|
|
|
|
|
|
the "supposedly C" tag, one cannot trust the content of |
|
3616
|
|
|
|
|
|
|
C tag even if it stored as Unicode strings.) |
|
3617
|
|
|
|
|
|
|
|
|
3618
|
|
|
|
|
|
|
This is why this module provides what some may consider only lukewarm support |
|
3619
|
|
|
|
|
|
|
for encoding field in ID3v2 tags: if done fully automatic, it can allow |
|
3620
|
|
|
|
|
|
|
instant propagation of wrong information; and this propagation is in a form |
|
3621
|
|
|
|
|
|
|
which is quite hard to undo (but still possible to do with suitable settings |
|
3622
|
|
|
|
|
|
|
to this module; see L). |
|
3623
|
|
|
|
|
|
|
|
|
3624
|
|
|
|
|
|
|
Likewise, the same happens with the C field in C. Since there |
|
3625
|
|
|
|
|
|
|
is no way to specify just "artist, type unknown" in C tags, when |
|
3626
|
|
|
|
|
|
|
C tag is automatically upgraded to C, the content would most |
|
3627
|
|
|
|
|
|
|
probably be put in the "main performer", C, tag. As a result, the |
|
3628
|
|
|
|
|
|
|
content of C tag is also "untrusted" - it may contain, e.g., the composer. |
|
3629
|
|
|
|
|
|
|
|
|
3630
|
|
|
|
|
|
|
In my opinion, a different field should be used for "known to be |
|
3631
|
|
|
|
|
|
|
principal performer"; for example, the method performer() (and the |
|
3632
|
|
|
|
|
|
|
script F shipped with this module) uses C<%{TXXX[TPE1]}> in |
|
3633
|
|
|
|
|
|
|
preference to C<%{TPE1}>. |
|
3634
|
|
|
|
|
|
|
|
|
3635
|
|
|
|
|
|
|
For example, interpolate C<%{TXXX[TPE1]|TPE1}> or C<%{TXXX[TPE1]|a}> - |
|
3636
|
|
|
|
|
|
|
this will use the frame C with identifier C if present, if not, |
|
3637
|
|
|
|
|
|
|
it will use the frame C (the first example), or will try to get I |
|
3638
|
|
|
|
|
|
|
by other means (including C frame) (the second example). |
|
3639
|
|
|
|
|
|
|
|
|
3640
|
|
|
|
|
|
|
=head1 FILES |
|
3641
|
|
|
|
|
|
|
|
|
3642
|
|
|
|
|
|
|
There are many files with special meaning to this module and its dependent |
|
3643
|
|
|
|
|
|
|
modules. |
|
3644
|
|
|
|
|
|
|
|
|
3645
|
|
|
|
|
|
|
=over 4 |
|
3646
|
|
|
|
|
|
|
|
|
3647
|
|
|
|
|
|
|
=item F<*.inf> |
|
3648
|
|
|
|
|
|
|
|
|
3649
|
|
|
|
|
|
|
Files with extension F<.inf> and the same basename as the audio file are |
|
3650
|
|
|
|
|
|
|
read by module C, and the extracted data is merged into the |
|
3651
|
|
|
|
|
|
|
information flow according to configuration variable C. |
|
3652
|
|
|
|
|
|
|
|
|
3653
|
|
|
|
|
|
|
It is assumed that these files are compatible in format to the files written |
|
3654
|
|
|
|
|
|
|
by the program F. |
|
3655
|
|
|
|
|
|
|
|
|
3656
|
|
|
|
|
|
|
=item F F F |
|
3657
|
|
|
|
|
|
|
|
|
3658
|
|
|
|
|
|
|
in the same directory as the audio file are read by module |
|
3659
|
|
|
|
|
|
|
C, and the extracted data is merged into the |
|
3660
|
|
|
|
|
|
|
information flow according to configuration variable C. |
|
3661
|
|
|
|
|
|
|
|
|
3662
|
|
|
|
|
|
|
(In fact, the list may be customized by configuration variable C.) |
|
3663
|
|
|
|
|
|
|
|
|
3664
|
|
|
|
|
|
|
=item F |
|
3665
|
|
|
|
|
|
|
|
|
3666
|
|
|
|
|
|
|
in the same directory as the audio file may be read by the method |
|
3667
|
|
|
|
|
|
|
id3v2_frames_autofill() (should be called explicitly) to fill the C |
|
3668
|
|
|
|
|
|
|
frame. Depends on contents of configuration variable C. |
|
3669
|
|
|
|
|
|
|
|
|
3670
|
|
|
|
|
|
|
=item F<~/.mp3tagprc> |
|
3671
|
|
|
|
|
|
|
|
|
3672
|
|
|
|
|
|
|
By default, this file is read on startup (may be customized by overriding |
|
3673
|
|
|
|
|
|
|
the method parse_cfg()). By default, the name of the file is in the |
|
3674
|
|
|
|
|
|
|
configuration variable C. |
|
3675
|
|
|
|
|
|
|
|
|
3676
|
|
|
|
|
|
|
=back |
|
3677
|
|
|
|
|
|
|
|
|
3678
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
3679
|
|
|
|
|
|
|
|
|
3680
|
|
|
|
|
|
|
L, L, L, |
|
3681
|
|
|
|
|
|
|
L, L, L, |
|
3682
|
|
|
|
|
|
|
L, L, L, |
|
3683
|
|
|
|
|
|
|
L, L, L. |
|
3684
|
|
|
|
|
|
|
|
|
3685
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
3686
|
|
|
|
|
|
|
|
|
3687
|
|
|
|
|
|
|
Copyright (c) 2000-2016 Thomas Geffert, Ilya Zakharevich. All rights reserved. |
|
3688
|
|
|
|
|
|
|
|
|
3689
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
|
3690
|
|
|
|
|
|
|
modify it under the terms of the Artistic License, distributed |
|
3691
|
|
|
|
|
|
|
with Perl. |
|
3692
|
|
|
|
|
|
|
|
|
3693
|
|
|
|
|
|
|
=cut |
|
3694
|
|
|
|
|
|
|
|