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
|
|
5647
|
use strict; |
|
6
|
|
|
|
|
41
|
|
|
6
|
|
|
|
|
994
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
{ |
19
|
|
|
|
|
|
|
package MP3::Tag::__hasparent; |
20
|
|
|
|
|
|
|
sub parent_ok { |
21
|
1814
|
|
|
1814
|
|
2420
|
my $self = shift; |
22
|
1814
|
100
|
|
|
|
6297
|
$self->{parent} and $self->{parent}->proxy_ok; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
sub get_config { |
25
|
1804
|
|
|
1804
|
|
2629
|
my $self = shift; |
26
|
1804
|
100
|
|
|
|
3618
|
return $MP3::Tag::config{shift()} unless $self->parent_ok; |
27
|
1394
|
|
|
|
|
6746
|
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
|
|
2947
|
use MP3::Tag::ID3v1; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
202
|
|
34
|
6
|
|
|
6
|
|
4788
|
use MP3::Tag::ID3v2; |
|
6
|
|
|
|
|
16
|
|
|
6
|
|
|
|
|
218
|
|
35
|
6
|
|
|
6
|
|
2974
|
use MP3::Tag::File; |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
196
|
|
36
|
6
|
|
|
6
|
|
2500
|
use MP3::Tag::Inf; |
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
182
|
|
37
|
6
|
|
|
6
|
|
2805
|
use MP3::Tag::CDDB_File; |
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
204
|
|
38
|
6
|
|
|
6
|
|
2553
|
use MP3::Tag::Cue; |
|
6
|
|
|
|
|
16
|
|
|
6
|
|
|
|
|
177
|
|
39
|
6
|
|
|
6
|
|
2659
|
use MP3::Tag::ParseData; |
|
6
|
|
|
|
|
52
|
|
|
6
|
|
|
|
|
183
|
|
40
|
6
|
|
|
6
|
|
2377
|
use MP3::Tag::ImageSize; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
187
|
|
41
|
6
|
|
|
6
|
|
2616
|
use MP3::Tag::ImageExifTool; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
239
|
|
42
|
6
|
|
|
6
|
|
2635
|
use MP3::Tag::LastResort; |
|
6
|
|
|
|
|
29
|
|
|
6
|
|
|
|
|
196
|
|
43
|
|
|
|
|
|
|
|
44
|
6
|
|
|
6
|
|
37
|
use vars qw/$VERSION @ISA/; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
587
|
|
45
|
|
|
|
|
|
|
$VERSION="1.15"; |
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
|
|
44
|
use vars qw/%config/; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
3072
|
|
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
|
|
295
|
shift; |
205
|
174
|
50
|
|
|
|
293
|
if (eval {require File::Spec; File::Spec->can('rel2abs')}) { |
|
174
|
|
|
|
|
896
|
|
|
174
|
|
|
|
|
1592
|
|
206
|
174
|
|
|
|
|
4835
|
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
|
|
3008
|
my $class = shift; |
216
|
87
|
|
|
|
|
170
|
my $filename = shift; |
217
|
87
|
|
|
|
|
139
|
my $mp3data; |
218
|
87
|
|
|
|
|
167
|
my $self = {}; |
219
|
87
|
|
|
|
|
190
|
bless $self, $class; |
220
|
87
|
|
|
|
|
440
|
my $proxy = MP3::Tag::__proxy->new($self); |
221
|
87
|
50
|
33
|
|
|
1505
|
if (-f $filename or -c $filename) { |
222
|
87
|
|
|
|
|
727
|
$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
|
|
|
|
283
|
if ($mp3data) { |
227
|
87
|
|
|
|
|
318
|
%$self = (filename => $mp3data, |
228
|
|
|
|
|
|
|
ofilename => $filename, |
229
|
|
|
|
|
|
|
abs_filename => $class->rel2abs($filename), |
230
|
|
|
|
|
|
|
__proxy => $proxy); |
231
|
87
|
|
|
|
|
552
|
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
|
|
47
|
use vars qw/$AUTOLOAD/; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
11751
|
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
my $skip_weaken = $ENV{MP3TAG_SKIP_WEAKEN}; |
242
|
|
|
|
|
|
|
sub new { |
243
|
88
|
|
|
88
|
|
211
|
my ($class, $handle) = (shift,shift); |
244
|
88
|
|
|
|
|
205
|
my $self = bless [$handle], $class; |
245
|
|
|
|
|
|
|
#warn("weaken() failed, falling back"), |
246
|
|
|
|
|
|
|
return bless [], $class if $skip_weaken or not |
247
|
88
|
50
|
33
|
|
|
301
|
eval {require Scalar::Util; Scalar::Util::weaken($self->[0]); 1}; |
|
88
|
|
|
|
|
564
|
|
|
88
|
|
|
|
|
434
|
|
|
88
|
|
|
|
|
334
|
|
248
|
88
|
|
|
|
|
192
|
$self; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
0
|
|
|
sub DESTROY {} |
251
|
1404
|
|
|
1404
|
|
4502
|
sub proxy_ok { shift->[0] } |
252
|
|
|
|
|
|
|
sub AUTOLOAD { |
253
|
1544
|
|
|
1544
|
|
2469
|
my $self = shift; |
254
|
1544
|
50
|
|
|
|
3051
|
die "local_proxy not initialized" unless $self->[0]; |
255
|
1544
|
|
|
|
|
7046
|
(my $meth = $AUTOLOAD) =~ s/.*:://; |
256
|
1544
|
|
|
|
|
4612
|
my $smeth = $self->[0]->can($meth); |
257
|
1544
|
50
|
|
|
|
3122
|
die "proxy can't find the method $meth" unless $smeth; |
258
|
1544
|
|
|
|
|
2727
|
unshift @_, $self->[0]; |
259
|
1544
|
|
|
|
|
4303
|
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
|
|
1346
|
my $self = shift; |
290
|
937
|
100
|
|
|
|
2048
|
return @{$self->{gottags}} if exists $self->{gottags}; |
|
852
|
|
|
|
|
1687
|
|
291
|
85
|
|
|
|
|
189
|
my (@IDs, $id); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# Will not create a reference loop |
294
|
85
|
0
|
33
|
|
|
231
|
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN}; |
295
|
85
|
|
|
|
|
209
|
for $id (qw(ParseData ID3v2 ID3v1 ImageExifTool Inf CDDB_File Cue ImageSize LastResort)) { |
296
|
765
|
|
|
|
|
5263
|
my $ref = "MP3::Tag::$id"->new_with_parent($self->{filename}, $self->{__proxy}); |
297
|
765
|
100
|
|
|
|
2153
|
next unless defined $ref; |
298
|
470
|
|
|
|
|
1061
|
$self->{$id} = $ref; |
299
|
470
|
|
|
|
|
1321
|
push @IDs, $id; |
300
|
|
|
|
|
|
|
} |
301
|
85
|
|
|
|
|
256
|
$self->{gottags} = [@IDs]; |
302
|
85
|
|
|
|
|
202
|
return @IDs; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub _get_tag { |
306
|
12
|
|
|
12
|
|
17
|
my $self = shift; |
307
|
12
|
|
|
|
|
65
|
$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
|
|
70
|
my ($class, $settable) = (shift, shift); |
326
|
3
|
|
|
|
|
12
|
my %h = (gottags => []); |
327
|
3
|
|
|
|
|
8
|
my $self = bless \%h, $class; |
328
|
3
|
100
|
|
|
|
12
|
if ($settable) { |
329
|
1
|
|
|
|
|
6
|
$h{__proxy} = MP3::Tag::__proxy->new($self); |
330
|
1
|
|
|
|
|
11
|
$h{ParseData} = MP3::Tag::ParseData->new_with_parent(undef, $h{__proxy}); |
331
|
|
|
|
|
|
|
} |
332
|
3
|
|
|
|
|
12
|
\%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
|
|
95
|
my $self = shift; |
354
|
32
|
|
|
|
|
67
|
my $whichTag = shift; |
355
|
32
|
100
|
|
|
|
169
|
if ($whichTag =~ /1/) { |
|
|
50
|
|
|
|
|
|
356
|
16
|
|
|
|
|
113
|
$self->{ID3v1}= MP3::Tag::ID3v1->new($self->{filename},1); |
357
|
16
|
|
|
|
|
42
|
return $self->{ID3v1}; |
358
|
|
|
|
|
|
|
} elsif ($whichTag =~ /2/) { |
359
|
16
|
|
|
|
|
108
|
$self->{ID3v2}= MP3::Tag::ID3v2->new($self->{filename},1); |
360
|
16
|
|
|
|
|
35
|
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
|
|
123
|
my ($self, $from) = (shift, shift); |
447
|
23
|
|
|
|
|
45
|
my (@out, %out); |
448
|
|
|
|
|
|
|
|
449
|
23
|
|
|
|
|
58
|
for my $elt ( qw( title track artist album comment year genre ) ) { |
450
|
161
|
|
|
|
|
605
|
my $out = $self->$elt($from); |
451
|
161
|
50
|
66
|
|
|
885
|
if (wantarray) { |
|
|
100
|
|
|
|
|
|
452
|
0
|
|
|
|
|
0
|
push @out, $out; |
453
|
|
|
|
|
|
|
} elsif (defined $out and length $out) { |
454
|
111
|
|
|
|
|
310
|
$out{$elt} = $out; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
} |
457
|
23
|
50
|
|
|
|
107
|
$out{song} = $out{title} if exists $out{title}; |
458
|
|
|
|
|
|
|
|
459
|
23
|
50
|
|
|
|
140
|
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
|
|
100
|
my $r = track(@_); |
547
|
19
|
|
|
|
|
67
|
$r =~ s(/.*)()s; |
548
|
19
|
|
|
|
|
68
|
$r; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub track2 ($) { |
552
|
5
|
|
|
5
|
|
12
|
my $r = track(@_); |
553
|
5
|
50
|
|
|
|
27
|
return '' unless $r =~ s(^.*?/)()s; |
554
|
5
|
|
|
|
|
18
|
$r; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
sub track0 ($) { |
558
|
5
|
|
|
5
|
|
11
|
my $self = shift; |
559
|
5
|
50
|
|
|
|
14
|
my $d = (@_ ? shift() : 2); |
560
|
5
|
|
|
|
|
12
|
my $r = $self->track(); |
561
|
5
|
50
|
|
|
|
14
|
return '' unless defined $r; |
562
|
5
|
|
|
|
|
22
|
(my $r1 = $r) =~ s(/.*)()s; |
563
|
5
|
50
|
|
|
|
25
|
$r = 'a' x $d unless $r =~ s(^.*?/)()s; |
564
|
5
|
|
|
|
|
11
|
my $l = length $r; |
565
|
5
|
|
|
|
|
36
|
sprintf "%0${l}d", $r1; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
sub disk1 ($) { |
569
|
11
|
|
|
11
|
|
17
|
my $self = shift; |
570
|
11
|
|
|
|
|
26
|
my $r = $self->select_id3v2_frame('TPOS'); |
571
|
11
|
100
|
|
|
|
34
|
return '' unless defined $r; |
572
|
5
|
|
|
|
|
22
|
$r =~ s(/.*)()s; |
573
|
5
|
|
|
|
|
25
|
$r; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub disk2 ($) { |
577
|
7
|
|
|
7
|
|
13
|
my $self = shift; |
578
|
7
|
|
|
|
|
20
|
my $r = $self->select_id3v2_frame('TPOS'); |
579
|
7
|
100
|
|
|
|
22
|
return '' unless defined $r; |
580
|
5
|
50
|
|
|
|
36
|
return '' unless $r =~ s(^.*?/)()s; |
581
|
5
|
|
|
|
|
23
|
$r; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
sub disk_alphanum ($) { |
585
|
7
|
|
|
7
|
|
13
|
my $self = shift; |
586
|
7
|
|
|
|
|
18
|
my $r = $self->select_id3v2_frame('TPOS'); |
587
|
7
|
100
|
|
|
|
23
|
return '' unless defined $r; |
588
|
5
|
|
|
|
|
23
|
(my $r1 = $r) =~ s(/.*)()s; |
589
|
5
|
50
|
|
|
|
22
|
$r = $r1 unless $r =~ s(^.*?/)()s; # max(disk2, disk1) |
590
|
5
|
100
|
|
|
|
29
|
return chr(ord('a') - 1 + $r1) if $r <= 26; |
591
|
2
|
|
|
|
|
4
|
my $l = length $r; |
592
|
2
|
|
|
|
|
15
|
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
|
|
1150
|
my ($self, $check_only, $packs, $rwhat, $ret_from, $args, $all) = (shift, shift, shift, shift, shift, shift || [], shift); |
599
|
284
|
100
|
|
|
|
767
|
my @what = ref $rwhat ? @$rwhat : $rwhat; |
600
|
284
|
|
|
|
|
379
|
my @out; |
601
|
284
|
0
|
33
|
|
|
706
|
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN}; |
602
|
|
|
|
|
|
|
|
603
|
284
|
|
|
|
|
706
|
$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
|
|
|
|
|
548
|
foreach my $pack (@$packs) { |
608
|
1697
|
100
|
|
|
|
3344
|
next unless exists $self->{$pack}; |
609
|
1064
|
|
|
|
|
1637
|
my $do_can = $pack ne 'ID3v1'; |
610
|
1064
|
|
|
|
|
1246
|
my $out; |
611
|
1064
|
|
|
|
|
1574
|
for my $what (@what) { |
612
|
1066
|
100
|
100
|
|
|
2192
|
next if $pack eq 'ID3v1' and not $MP3::Tag::ID3v1::ok_length{$what}; # dup of a warning in AUTOLOAD |
613
|
1065
|
100
|
100
|
|
|
5163
|
next if $do_can and not $self->{$pack}->can($what); |
614
|
1064
|
50
|
33
|
|
|
2194
|
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
|
|
|
|
4136
|
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
|
100
|
|
|
1033
|
undef $out, next if not length $out and $ignore_0length{$pack}; # These return '' |
621
|
|
|
|
|
|
|
} |
622
|
1064
|
100
|
|
|
|
2363
|
next unless defined $out; |
623
|
228
|
50
|
|
|
|
500
|
$out = 1 if $check_only; |
624
|
228
|
50
|
|
|
|
438
|
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
|
|
|
|
567
|
return [$out, $pack] if $ret_from; |
629
|
160
|
|
|
|
|
482
|
return $out; |
630
|
|
|
|
|
|
|
} |
631
|
56
|
50
|
|
|
|
115
|
return @out if $all; |
632
|
56
|
|
|
|
|
132
|
return; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
sub auto_field($;$$) { |
636
|
282
|
|
|
282
|
|
550
|
my ($self, $what, $ret_from) = (shift, shift, shift); |
637
|
282
|
|
33
|
|
|
567
|
my $packs = $self->get_config($what) || $self->get_config('autoinfo'); |
638
|
282
|
|
|
|
|
723
|
my $o = $self->_auto_field_from(!'check_only', $packs, $what, $ret_from); |
639
|
282
|
100
|
|
|
|
655
|
return '' unless defined $o; |
640
|
227
|
|
|
|
|
646
|
$o; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
for my $elt ( qw( title track artist album comment year genre ) ) { |
644
|
6
|
|
|
6
|
|
85
|
no strict 'refs'; |
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
1054
|
|
645
|
|
|
|
|
|
|
*$elt = sub (;$) { |
646
|
282
|
|
|
282
|
|
716
|
my $self = shift; |
647
|
282
|
|
50
|
282
|
|
1028
|
my $translate = ($self->get_config("translate_$elt") || [])->[0] || sub {$_[1]}; |
|
282
|
|
|
|
|
1363
|
|
648
|
282
|
|
|
|
|
906
|
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
|
|
45
|
no strict 'refs'; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
571
|
|
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
|
|
40
|
no strict 'refs'; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
1589
|
|
664
|
|
|
|
|
|
|
my ($tr) = ($elt =~ /^(\w+)_/); |
665
|
|
|
|
|
|
|
*$elt = sub (;$) { |
666
|
20
|
|
|
20
|
|
55
|
my $self = shift; |
667
|
20
|
0
|
33
|
|
|
66
|
local $self->{__proxy}[0] = $self unless $self->{__proxy}[0] or $ENV{MP3TAG_TEST_WEAKEN}; |
668
|
20
|
|
|
|
|
60
|
$self->get_tags; |
669
|
20
|
100
|
|
|
|
110
|
return unless exists $self->{CDDB_File}; |
670
|
6
|
|
|
|
|
21
|
my $v = $self->{CDDB_File}->parse($elt); |
671
|
6
|
100
|
|
|
|
19
|
return unless defined $v; |
672
|
5
|
|
50
|
5
|
|
21
|
my $translate = ($self->get_config("translate_$tr") || [])->[0] || sub {$_[1]}; |
|
5
|
|
|
|
|
31
|
|
673
|
5
|
|
|
|
|
14
|
return &$translate( $self, $v ); |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
for my $elt ( qw(title artist album year comment track genre) ) { |
678
|
6
|
|
|
6
|
|
46
|
no strict 'refs'; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
2831
|
|
679
|
|
|
|
|
|
|
*{"${elt}_set"} = sub ($$;$) { |
680
|
4
|
|
|
4
|
|
51
|
my ($mp3, $val, $force2) = (shift, shift, shift); |
681
|
|
|
|
|
|
|
|
682
|
4
|
|
|
|
|
15
|
$mp3->get_tags; |
683
|
4
|
100
|
|
|
|
37
|
$mp3->new_tag("ID3v1") unless exists $mp3->{ID3v1}; |
684
|
4
|
|
|
|
|
32
|
$mp3->{ID3v1}->$elt( $val ); |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
return 1 |
687
|
|
|
|
|
|
|
if not $force2 and $mp3->{ID3v1}->fits_tag({$elt => $val}) |
688
|
4
|
100
|
66
|
|
|
32
|
and not exists $mp3->{ID3v2}; |
|
|
|
66
|
|
|
|
|
689
|
|
|
|
|
|
|
|
690
|
2
|
50
|
|
|
|
17
|
$mp3->new_tag("ID3v2") unless exists $mp3->{ID3v2}; |
691
|
2
|
|
|
|
|
12
|
$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
|
|
46
|
no strict 'refs'; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
62166
|
|
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
|
|
285
|
my ($self, $item, @options) = @_; |
1195
|
24
|
|
|
|
|
61
|
$item = lc $item; |
1196
|
24
|
100
|
100
|
|
|
432
|
my $config = ref $self ? ($self->{config} ||= {%config}) : \%config; |
1197
|
24
|
|
|
|
|
262
|
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
|
|
|
|
|
267
|
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
|
|
|
|
|
82
|
my $e_known = $self->get_config('extra_config_keys'); |
1222
|
24
|
|
|
|
|
81
|
$e_known = [map lc, @$e_known]; |
1223
|
24
|
100
|
|
|
|
126
|
$conf_rex = '^(' . join('|', @known, @$e_known, @tr) . ')$' unless $conf_rex; |
1224
|
|
|
|
|
|
|
|
1225
|
24
|
50
|
|
|
|
2670
|
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
|
|
|
|
92
|
undef $conf_rex if $item eq 'extra_config_keys'; |
1232
|
|
|
|
|
|
|
|
1233
|
24
|
|
|
|
|
213
|
$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
|
|
4910
|
my ($self, $item) = @_; |
1255
|
2622
|
100
|
100
|
|
|
8745
|
my $config = ref $self ? ($self->{config} ||= {%config}) : \%config; |
1256
|
2622
|
|
|
|
|
10728
|
$config->{lc $item}; |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
sub get_config1 { |
1260
|
683
|
|
|
683
|
|
990
|
my $self = shift; |
1261
|
683
|
|
|
|
|
1286
|
my $c = $self->get_config(@_); |
1262
|
683
|
100
|
|
|
|
3443
|
$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
|
|
93
|
my ($self, $item) = (shift, shift); |
1348
|
6
|
|
|
|
|
26
|
$self->get_tags; |
1349
|
6
|
0
|
33
|
|
|
22
|
return if not @_ and not exists $self->{ID3v2}; |
1350
|
6
|
100
|
|
|
|
68
|
$self->new_tag("ID3v2") unless exists $self->{ID3v2}; |
1351
|
|
|
|
|
|
|
$self->{ID3v2}->remove_frame($item) |
1352
|
6
|
100
|
|
|
|
26
|
if defined $self->{ID3v2}->get_frame($item); |
1353
|
6
|
50
|
|
|
|
21
|
return unless @_; |
1354
|
6
|
|
|
|
|
25
|
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
|
|
250
|
my ($self) = (shift); |
1501
|
49
|
|
|
|
|
121
|
$self->get_tags; |
1502
|
49
|
100
|
|
|
|
121
|
if (not exists $self->{ID3v2}) { |
1503
|
1
|
50
|
33
|
|
|
9
|
return if @_ <= 3 or not defined $_[3]; # Read access, or deletion |
1504
|
1
|
|
|
|
|
4
|
$self->new_tag("ID3v2"); |
1505
|
|
|
|
|
|
|
} |
1506
|
49
|
|
|
|
|
173
|
$self->{ID3v2}->frame_select(@_); |
1507
|
|
|
|
|
|
|
} |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
sub _select_id3v2_frame_by_descr ($$$;@) { |
1510
|
169
|
|
|
169
|
|
327
|
my ($self, $update) = (shift, shift); |
1511
|
169
|
|
|
|
|
409
|
$self->get_tags; |
1512
|
169
|
100
|
|
|
|
373
|
if (not exists $self->{ID3v2}) { |
1513
|
7
|
50
|
33
|
|
|
70
|
return if @_ <= 1 or @_ <= 2 and not defined $_[1]; # Read or delete |
|
|
|
33
|
|
|
|
|
1514
|
7
|
|
|
|
|
19
|
$self->new_tag("ID3v2"); |
1515
|
|
|
|
|
|
|
} |
1516
|
169
|
|
|
|
|
311
|
my $fname = $_[0]; |
1517
|
169
|
|
|
|
|
528
|
$fname =~ s/^(\w{4})\d+/$1/; # if FRAMnn, convert to FRAM |
1518
|
169
|
|
50
|
|
|
403
|
my $tr = ($self->get_config('translate_person') || [])->[0]; |
1519
|
169
|
50
|
|
|
|
394
|
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
|
|
|
363
|
return if $update and not $tr; |
1531
|
169
|
|
50
|
102
|
|
1003
|
$tr ||= sub {$_[1]}; |
|
102
|
|
|
|
|
231
|
|
1532
|
169
|
100
|
100
|
|
|
787
|
return $self->{ID3v2}->frame_select_by_descr_simpler(@_) |
|
|
|
100
|
|
|
|
|
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
|
|
|
|
337
|
$_[0], &$tr($self, $_[1]) |
1536
|
|
|
|
|
|
|
) if @_ == 2; # Write access with one arg |
1537
|
|
|
|
|
|
|
|
1538
|
135
|
|
|
|
|
525
|
my $val = $self->{ID3v2}->frame_select_by_descr_simpler(@_); |
1539
|
135
|
|
|
|
|
219
|
my $nval; |
1540
|
135
|
100
|
|
|
|
340
|
$nval = &$tr($self, $val) if defined $val; |
1541
|
135
|
50
|
|
|
|
789
|
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
|
|
752
|
my ($self) = (shift); |
1549
|
169
|
|
|
|
|
405
|
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
|
|
61
|
my ($self) = (shift); |
1573
|
30
|
|
|
|
|
72
|
$self->get_tags; |
1574
|
30
|
100
|
|
|
|
87
|
return if not exists $self->{ID3v2}; |
1575
|
27
|
|
|
|
|
92
|
$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
|
|
18
|
my ($self) = (shift); |
1587
|
7
|
|
|
|
|
18
|
$self->get_tags; |
1588
|
7
|
50
|
|
|
|
20
|
return if not exists $self->{ID3v2}; |
1589
|
7
|
|
|
|
|
39
|
$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
|
|
7
|
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
|
|
|
|
5
|
die "Handlers with arguments not supported yet" if @$args; |
2134
|
2
|
50
|
|
|
|
11
|
my (@f) = ($h =~ /^(\w+)/) or die "Panic: `$h' as a handler"; |
2135
|
2
|
50
|
|
|
|
20
|
push @f, $trans{$f[0]} if exists $trans{$f[0]}; |
2136
|
2
|
|
33
|
|
|
10
|
$set and $_ .= '__set' for @f; |
2137
|
2
|
|
|
|
|
7
|
$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
|
|
720
|
my ($self, undef, $upto, $skip) = @_; # pattern is modified, so is $_[1] |
2147
|
324
|
|
|
|
|
774
|
$self->get_tags(); |
2148
|
324
|
|
|
|
|
502
|
my $res = ""; |
2149
|
324
|
|
|
|
|
395
|
my $ids; |
2150
|
324
|
50
|
100
|
|
|
983
|
die "upto=`$upto' not supported" if $upto and $upto ne ']' and $upto ne'}'; |
|
|
|
66
|
|
|
|
|
2151
|
324
|
50
|
66
|
|
|
826
|
die "upto=`$upto' not supported with skip" |
|
|
|
33
|
|
|
|
|
2152
|
|
|
|
|
|
|
if $upto and not defined $upto and $skip; # XXXX Unreachable??? |
2153
|
324
|
100
|
100
|
|
|
1076
|
my $cnt = ($upto or not defined $upto) ? -1 : 1; # upto eq '': 1 escape |
2154
|
|
|
|
|
|
|
|
2155
|
324
|
100
|
100
|
|
|
4073
|
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
|
|
|
|
1465
|
if (defined $1) { |
2161
|
237
|
|
|
|
|
432
|
my $str = $1; |
2162
|
237
|
100
|
100
|
|
|
890
|
if ($upto and $upto eq ']') { |
|
|
100
|
66
|
|
|
|
|
2163
|
73
|
|
|
|
|
480
|
$str =~ s<((?:\\\\)*)(?:\\(?=\])|(?!.))>< '\\' x (length($1)/2) >ges; |
|
137
|
|
|
|
|
606
|
|
2164
|
|
|
|
|
|
|
} elsif ($upto and $upto eq '}') { |
2165
|
63
|
|
|
|
|
361
|
$str =~ s<((?:\\\\)*)(?:\\(?=\})|(?!.))>< '\\' x (length($1)/2) >ges; |
|
78
|
|
|
|
|
375
|
|
2166
|
|
|
|
|
|
|
} |
2167
|
237
|
|
|
|
|
1924
|
$res .= $str, next; |
2168
|
|
|
|
|
|
|
} |
2169
|
290
|
100
|
|
|
|
1223
|
my ($fill, $left, $minwidth, $maxwidth, $what) |
2170
|
|
|
|
|
|
|
= ((defined $2 ? $2 : $3), $4, $5, $6, $7); |
2171
|
290
|
50
|
66
|
|
|
647
|
next if $skip and $what ne '{'; |
2172
|
290
|
|
|
|
|
355
|
my $str; |
2173
|
290
|
100
|
100
|
|
|
5059
|
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
|
|
|
|
6
|
next if $skip; |
2175
|
1
|
50
|
|
|
|
5
|
if ($1 eq 'd') { |
2176
|
1
|
|
|
|
|
13
|
$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
|
|
|
|
140
|
next if $skip; |
2186
|
60
|
|
|
|
|
133
|
my $meth = $trans{$1}; |
2187
|
60
|
|
|
|
|
307
|
$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
|
|
|
|
|
638
|
my ($neg, $id, $simple, $delim, $lang_or_packages, $have_bra) = ($1, $2, $3, $4, $5, $6); |
2193
|
|
|
|
|
|
|
|
2194
|
163
|
|
100
|
|
|
646
|
my(@_handlers, @args) = split /,/, ($lang_or_packages || ''); |
2195
|
163
|
|
|
|
|
375
|
my @handlers = grep $handlers{$_}, @_handlers; |
2196
|
163
|
50
|
100
|
|
|
763
|
$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
|
|
|
|
321
|
if ($delim) { # Not a frame/cmd id... |
2200
|
35
|
|
|
|
|
63
|
$id = $simple; |
2201
|
|
|
|
|
|
|
} else { # Frame/cmd: maybe trailed by :, |, ||, maybe not |
2202
|
128
|
|
66
|
|
|
322
|
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
|
|
|
|
490
|
$id .= ($self->_interpolate($_[1], ']', $skip) . ']') if $have_bra; # unreachable if handler present! |
2207
|
128
|
100
|
|
|
|
466
|
$_[1] =~ s/^(:|\|\|?)// and $delim = $1; |
2208
|
128
|
100
|
|
|
|
266
|
unless ($delim) { |
2209
|
98
|
50
|
|
|
|
190
|
die "Can't parse negated conditional: I see `$_[1]'" if $neg; |
2210
|
98
|
|
|
|
|
159
|
my $nonesuch = 0; |
2211
|
98
|
100
|
100
|
|
|
469
|
unless (@handlers or $self->{ID3v2} or $neg) { |
|
|
|
66
|
|
|
|
|
2212
|
2
|
50
|
|
|
|
6
|
die "No ID3v2 present" |
2213
|
|
|
|
|
|
|
if $self->get_config('id3v2_missing_fatal'); |
2214
|
2
|
|
|
|
|
9
|
$nonesuch = 1; |
2215
|
|
|
|
|
|
|
} |
2216
|
98
|
100
|
100
|
|
|
402
|
next if ($skip or $nonesuch) and $_[1] =~ s/^\}//; |
|
|
|
66
|
|
|
|
|
2217
|
96
|
50
|
|
|
|
257
|
if ($_[1] =~ /^[\}&]/) { # frame with optional (lang)/[descr], or a package-handled descriptor |
2218
|
96
|
100
|
|
|
|
170
|
if (@handlers) { |
2219
|
2
|
50
|
|
|
|
13
|
$str = $self->process_handlers($id, \@handlers, \@args) unless $skip; |
2220
|
|
|
|
|
|
|
# $str = '' if not defined $str and $1 eq '&'; |
2221
|
|
|
|
|
|
|
} else { |
2222
|
94
|
|
|
|
|
244
|
$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
|
|
|
|
294
|
if ($_[1] =~ s/^&/%\{/) { # join of frames with optional (language)/[descriptor], etc |
2228
|
6
|
|
|
|
|
29
|
my $rest = $self->_interpolate($_[1], '', $skip); |
2229
|
6
|
50
|
|
|
|
16
|
next if $skip; |
2230
|
6
|
|
|
|
|
38
|
my $joiner = $self->get_config1('ampersand_joiner'); # default '; ' |
2231
|
6
|
100
|
66
|
|
|
17
|
$str = join $joiner, map {(defined and length) ? $_ : ()} $str, $rest; |
|
12
|
|
|
|
|
55
|
|
2232
|
|
|
|
|
|
|
} else { |
2233
|
90
|
|
|
|
|
361
|
$_[1] =~ s/^\}//; |
2234
|
|
|
|
|
|
|
} |
2235
|
|
|
|
|
|
|
} |
2236
|
|
|
|
|
|
|
} |
2237
|
161
|
100
|
|
|
|
401
|
if ($delim) { # Conditional |
2238
|
|
|
|
|
|
|
# $self->_interpolate($_[1], $upto, $skip), next if $skip; |
2239
|
65
|
|
66
|
|
|
187
|
my $alt = ($delim ne ':') && $delim; # FALSE or $delim |
2240
|
65
|
50
|
66
|
|
|
198
|
die "Negation and alternation incompatible in interpolation" |
2241
|
|
|
|
|
|
|
if $alt and $neg; |
2242
|
65
|
|
|
|
|
93
|
my $have; |
2243
|
65
|
100
|
66
|
|
|
419
|
if ($simple and (2 >= length $simple or $simple =~ /^U/)) { |
|
|
50
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2244
|
21
|
100
|
|
|
|
62
|
my $s = (1 == length $simple ? $simple : "{$simple}"); |
2245
|
21
|
|
|
|
|
88
|
$str = $self->interpolate("%$s"); |
2246
|
21
|
|
|
|
|
44
|
$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
|
|
|
|
38
|
die "ID3v2 or ID3v1 as conditionals incompatible with $alt" |
2251
|
|
|
|
|
|
|
if $alt; |
2252
|
14
|
|
|
|
|
33
|
$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
|
|
|
|
|
116
|
$have = $self->have_id3v2_frame_by_descr($id); |
2258
|
|
|
|
|
|
|
# warn "\t!!! Cond: <<$id>> <<$have>>"; |
2259
|
|
|
|
|
|
|
} |
2260
|
65
|
|
100
|
|
|
298
|
my $skipping = $skip || (not $alt and $neg ? $have : !$have); |
2261
|
65
|
|
|
|
|
108
|
my $s; |
2262
|
65
|
100
|
100
|
|
|
193
|
if ($alt and $alt ne '||') { # Need to prepend % |
2263
|
14
|
100
|
|
|
|
55
|
if ($_[1] =~ s/^([^\\])\}//) { # One-char escape |
2264
|
3
|
50
|
|
|
|
21
|
$s = $self->interpolate("%$1") unless $skipping; |
2265
|
|
|
|
|
|
|
} else { # Understood with {}; prepend %{ |
2266
|
11
|
50
|
|
|
|
58
|
$_[1] =~ s/^/%\{/ or die; |
2267
|
11
|
|
|
|
|
33
|
$s = $self->_interpolate($_[1], '', $skipping); |
2268
|
|
|
|
|
|
|
} |
2269
|
|
|
|
|
|
|
} else { |
2270
|
51
|
|
|
|
|
197
|
$s = $self->_interpolate($_[1], '}', $skipping); |
2271
|
|
|
|
|
|
|
} |
2272
|
65
|
100
|
|
|
|
206
|
next if $skipping; |
2273
|
50
|
100
|
100
|
|
|
192
|
if ($alt and $have and not $simple) { |
|
|
|
100
|
|
|
|
|
2274
|
7
|
50
|
|
|
|
29
|
if (@handlers) { |
2275
|
0
|
|
|
|
|
0
|
$str = $self->process_handlers($id, \@handlers, \@args); |
2276
|
|
|
|
|
|
|
} else { |
2277
|
7
|
|
|
|
|
21
|
$str = $self->select_id3v2_frame_by_descr($id); |
2278
|
|
|
|
|
|
|
} |
2279
|
|
|
|
|
|
|
} |
2280
|
50
|
100
|
100
|
|
|
167
|
$str = $s unless $have and $alt; |
2281
|
|
|
|
|
|
|
$str = $str->{_Data} |
2282
|
50
|
0
|
33
|
|
|
210
|
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
|
|
|
|
|
14
|
my $flags = $1; |
2299
|
5
|
100
|
|
|
|
16
|
if ($flags =~ s/i//) { |
2300
|
4
|
|
|
|
|
12
|
$str = $self->_interpolate($_[1], '}', $skip); |
2301
|
|
|
|
|
|
|
} else { |
2302
|
1
|
50
|
|
|
|
11
|
$_[1] =~ s/^((?:[^\\\}]|(?:\\\\)*\\\}|\\+[^\\\}]|\\\\)*)\}//s |
2303
|
|
|
|
|
|
|
# $_[1] =~ s/^((?:\\.|[^{}\\])*)}// |
2304
|
|
|
|
|
|
|
or die "Can't find non-interpolated argument in `$_[1]'"; |
2305
|
1
|
50
|
|
|
|
4
|
next if $skip; |
2306
|
|
|
|
|
|
|
# ($str = $1) =~ s/\\([\\{}])/$1/g; |
2307
|
1
|
|
|
|
|
10
|
($str = $1) =~ s<((?:\\\\)*)(?:\\(?=\})|(?!.))>< '\\' x (length($1)/2) >ges; |
|
1
|
|
|
|
|
7
|
|
2308
|
|
|
|
|
|
|
} |
2309
|
5
|
100
|
|
|
|
29
|
next if $skip; |
2310
|
4
|
|
|
|
|
20
|
($str) = $self->interpolate_with_flags($str, $flags); |
2311
|
|
|
|
|
|
|
} elsif ($what eq '{' and $_[1] =~ s/^T\[([^\[\]]*)\]\}//s) { # time |
2312
|
1
|
50
|
|
|
|
5
|
next if $skip; |
2313
|
1
|
|
|
|
|
7
|
$str = $self->format_time(undef, split /,/, $1); |
2314
|
|
|
|
|
|
|
} elsif ($what eq '{') { #id3v2=whole, composer/performer/frames |
2315
|
6
|
50
|
66
|
|
|
30
|
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
|
|
|
|
57
|
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
|
|
|
|
22
|
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
|
|
|
|
|
7
|
$str = '%'; |
2360
|
|
|
|
|
|
|
} else { |
2361
|
50
|
|
|
|
|
145
|
my $meth = $trans{$what}; |
2362
|
50
|
|
|
|
|
260
|
$str = $self->$meth(); |
2363
|
|
|
|
|
|
|
} |
2364
|
272
|
100
|
|
|
|
623
|
$str = '' unless defined $str; |
2365
|
272
|
50
|
66
|
|
|
607
|
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
|
|
|
|
489
|
if (defined $minwidth) { |
2387
|
16
|
50
|
|
|
|
36
|
$fill = ' ' unless defined $fill; |
2388
|
16
|
100
|
|
|
|
29
|
if ($left) { |
2389
|
1
|
|
|
|
|
8
|
$str .= $fill x ($minwidth - length $str); |
2390
|
|
|
|
|
|
|
} else { |
2391
|
15
|
|
|
|
|
49
|
$str = $fill x ($minwidth - length $str) . $str; |
2392
|
|
|
|
|
|
|
} |
2393
|
|
|
|
|
|
|
} |
2394
|
272
|
|
|
|
|
1496
|
$res .= $str; |
2395
|
|
|
|
|
|
|
} |
2396
|
324
|
100
|
|
|
|
634
|
if (defined $upto) { |
2397
|
145
|
100
|
66
|
|
|
804
|
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
|
|
|
|
389
|
die "Can't parse `$_[1]' during interpolation" if length $_[1]; |
2402
|
|
|
|
|
|
|
} |
2403
|
324
|
|
|
|
|
1584
|
return $res; |
2404
|
|
|
|
|
|
|
} |
2405
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
sub interpolate ($$) { |
2407
|
179
|
|
|
179
|
|
1255
|
my ($self, $pattern) = @_; # local copy; $pattern is modified |
2408
|
179
|
|
|
|
|
513
|
$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
|
|
93
|
my ($self, $data, $flags) = @_; |
2439
|
|
|
|
|
|
|
|
2440
|
35
|
100
|
|
|
|
133
|
$data = $self->interpolate($data) if $flags =~ /i/; |
2441
|
35
|
100
|
|
|
|
89
|
if ($flags =~ /f/) { |
2442
|
4
|
|
|
|
|
13
|
local *F; |
2443
|
4
|
|
|
|
|
7
|
my $e; |
2444
|
4
|
50
|
|
|
|
218
|
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
|
|
|
|
28
|
if ($flags =~ /B/) { |
2449
|
0
|
|
|
|
|
0
|
binmode F; |
2450
|
|
|
|
|
|
|
} else { |
2451
|
4
|
|
|
|
|
7
|
my $e; |
2452
|
4
|
0
|
33
|
|
|
14
|
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
|
|
|
|
|
18
|
local $/; |
2458
|
4
|
|
|
|
|
111
|
my $d = ; |
2459
|
4
|
50
|
|
|
|
45
|
CORE::close F or die "Can't close file `$data' for parsing: $!"; |
2460
|
4
|
|
|
|
|
26
|
$data = $d; |
2461
|
|
|
|
|
|
|
} |
2462
|
35
|
|
|
|
|
85
|
my @data = $data; |
2463
|
35
|
50
|
|
|
|
106
|
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
|
|
|
|
88
|
if ($flags =~ /n/) { |
2468
|
0
|
0
|
|
|
|
0
|
my $track = $self->track1 or return; |
2469
|
0
|
|
|
|
|
0
|
@data = $data[$track - 1]; |
2470
|
|
|
|
|
|
|
} |
2471
|
35
|
|
|
|
|
68
|
for my $d (@data) { |
2472
|
35
|
50
|
|
|
|
81
|
$d = $self->interpolate($d) if $flags =~ /I/; |
2473
|
35
|
100
|
|
|
|
100
|
unless ($flags =~ /b/) { |
2474
|
34
|
|
|
|
|
68
|
$d =~ s/^\s+//; |
2475
|
34
|
|
|
|
|
85
|
$d =~ s/\s+$//; |
2476
|
|
|
|
|
|
|
} |
2477
|
|
|
|
|
|
|
} |
2478
|
35
|
|
|
|
|
118
|
@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
|
|
102
|
my $c = shift->get_config('parse_minmatch'); |
2569
|
42
|
|
|
|
|
91
|
my $min = $c->[0]; |
2570
|
42
|
50
|
66
|
|
|
119
|
if ($min and $min ne '1') { |
2571
|
0
|
|
|
|
|
0
|
my $field = shift; |
2572
|
0
|
|
|
|
|
0
|
$min = grep $_ eq $field, @$c; |
2573
|
|
|
|
|
|
|
} |
2574
|
42
|
100
|
|
|
|
214
|
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
|
|
119
|
my ($self, $code, $groups) = (shift, shift, shift); |
2586
|
47
|
50
|
|
|
|
98
|
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
|
|
|
|
174
|
$_[0]++, return '%' if $code eq '%'; |
2595
|
|
|
|
|
|
|
# In these two, allow setting to '', and to 123/789 too... |
2596
|
47
|
100
|
|
|
|
116
|
push(@$groups, $code), return '((?
|
2597
|
46
|
0
|
33
|
|
|
92
|
(push @$groups, $code), return '((?
|
2598
|
|
|
|
|
|
|
if $code eq 'y' and ($self->get_config('year_is_timestamp'))->[0]; |
2599
|
46
|
50
|
|
|
|
84
|
(push @$groups, $code), return '((?
|
2600
|
|
|
|
|
|
|
if $code eq 'y'; |
2601
|
|
|
|
|
|
|
# Filename parts ABDfFN and vLrqQSmsCpouMH not settable... |
2602
|
46
|
100
|
|
|
|
169
|
(push @$groups, $code), return $self->_parse_rex_anything($code) |
2603
|
|
|
|
|
|
|
if $code =~ /^[talgc]$/; |
2604
|
28
|
50
|
|
|
|
78
|
$_[0]++, return $self->_rex_protect_filename($self->interpolate("%$1"), $1) |
2605
|
|
|
|
|
|
|
if $code =~ /^=([ABDfFN]|\{d\d+\})$/; |
2606
|
28
|
100
|
|
|
|
83
|
$_[0]++, return quotemeta($self->interpolate("%$1")) |
2607
|
|
|
|
|
|
|
if $code =~ /^=([talgceEwhvLrqQSmsCpouMH]|\{.*\})$/; |
2608
|
26
|
0
|
|
|
|
64
|
$_[0]++, return $self->interpolate("%{$+:1}") ? quotemeta($self->interpolate("%$1")) : '(?!)' |
|
|
50
|
|
|
|
|
|
2609
|
|
|
|
|
|
|
if $code =~ /^==(([talgcynfFeEABDNvLrqQSmsCpouMHwh])|\{(.*)\})$/; |
2610
|
26
|
50
|
|
|
|
53
|
$_[0]++, return '(?__pure_track_rex . '(?!\d)' |
2611
|
|
|
|
|
|
|
if $code eq '=n'; |
2612
|
26
|
50
|
|
|
|
65
|
$_[0]++, return '(?year) . '(?!\d)' |
2613
|
|
|
|
|
|
|
if $code eq '=y'; |
2614
|
26
|
100
|
|
|
|
231
|
(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
|
|
|
|
12
|
(push @$groups, $code), return "($e)" if $code eq 'E'; |
2619
|
1
|
50
|
|
|
|
11
|
(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
|
|
111
|
my ($self, $is_rex, $pattern) = @_; |
2629
|
35
|
100
|
|
|
|
99
|
my ($codes, $exact, $p) = ([], 0, ($is_rex ? '' : '^')); |
2630
|
35
|
|
|
|
|
63
|
my $o = $pattern; |
2631
|
|
|
|
|
|
|
# (=? is correct! Groups 4(descr), 5(have_bra) are inside $frame_bra |
2632
|
35
|
|
|
|
|
534
|
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
|
|
|
|
171
|
if (defined $1) { |
2641
|
11
|
100
|
|
|
|
61
|
$p .= ($is_rex ? $1 : quotemeta $1); |
2642
|
|
|
|
|
|
|
} else { |
2643
|
47
|
|
|
|
|
102
|
my $group = $2; |
2644
|
47
|
100
|
|
|
|
113
|
if ($3) { |
2645
|
23
|
|
|
|
|
103
|
my ($id, $langs_or_packs, $have_bra) = ($3, $4, $5); |
2646
|
23
|
|
100
|
|
|
116
|
my(@_handlers, @args) = split /,/, ($4 || ''); |
2647
|
23
|
|
|
|
|
50
|
my @handlers = grep $handlers{$_}, @_handlers; |
2648
|
23
|
0
|
0
|
|
|
91
|
$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
|
|
|
|
93
|
my ($meth) = ($id =~ /^(\w+)/) or die "Panic: meth"; |
2651
|
|
|
|
|
|
|
|
2652
|
23
|
|
33
|
|
|
67
|
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
|
|
|
|
85
|
$group .= ($self->_interpolate($pattern, ']') . ']') if $have_bra; |
2657
|
23
|
50
|
|
|
|
84
|
$pattern =~ s/^}// or die "Can't find end of frame name, I see `$p'"; |
2658
|
23
|
50
|
|
|
|
73
|
$p .= $self->_parse_rex_microinterpolate($group, $codes, $exact, \@handlers, \@args), next if @handlers; |
2659
|
23
|
|
|
|
|
62
|
$group .= '}'; |
2660
|
|
|
|
|
|
|
} |
2661
|
47
|
|
|
|
|
138
|
$p .= $self->_parse_rex_microinterpolate($group, $codes, $exact); |
2662
|
|
|
|
|
|
|
} |
2663
|
|
|
|
|
|
|
} |
2664
|
35
|
100
|
|
|
|
120
|
$p .= '$' unless $is_rex; |
2665
|
35
|
50
|
|
|
|
75
|
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
|
|
|
68
|
my @tags = map { (not ref and length == 1) ? $trans{$_} : $_ } @$codes; |
|
45
|
|
|
|
|
265
|
|
2669
|
35
|
|
|
|
|
339
|
return [$o, $p, \@tags, $exact]; |
2670
|
|
|
|
|
|
|
} |
2671
|
|
|
|
|
|
|
|
2672
|
|
|
|
|
|
|
sub parse_rex_prepare ($$) { |
2673
|
2
|
|
|
2
|
|
5
|
my ($self) = shift; |
2674
|
2
|
|
|
|
|
6
|
$self->_parse_rex_prepare('REx', @_) |
2675
|
|
|
|
|
|
|
} |
2676
|
|
|
|
|
|
|
|
2677
|
|
|
|
|
|
|
sub parse_prepare ($$) { |
2678
|
33
|
|
|
33
|
|
61
|
my ($self) = shift; |
2679
|
33
|
|
|
|
|
113
|
$self->_parse_rex_prepare(!'REx', @_) |
2680
|
|
|
|
|
|
|
} |
2681
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
sub parse_rex_match { # pattern = [Original, Interpolated, Fields, NumExact] |
2683
|
35
|
|
|
35
|
|
88
|
my ($self, $pattern, $data) = @_; |
2684
|
35
|
0
|
33
|
|
|
47
|
return unless @{$pattern->[2]} or $pattern->[3]; |
|
35
|
|
|
|
|
100
|
|
2685
|
35
|
50
|
|
|
|
478
|
my @vals = ($data =~ /$pattern->[1]()/s) or return; # At least 1 group |
2686
|
35
|
|
|
|
|
85
|
my $cv = @vals - 1; |
2687
|
|
|
|
|
|
|
die "Unsupported %-regular expression `$pattern->[0]' (catching parens? Got $cv vals) (converted to `$pattern->[1]')" |
2688
|
35
|
50
|
|
|
|
55
|
unless $cv == @{$pattern->[2]}; |
|
35
|
|
|
|
|
99
|
|
2689
|
35
|
|
|
|
|
80
|
my ($c, %h, @a) = 0; |
2690
|
35
|
|
|
|
|
56
|
for my $k ( @{$pattern->[2]} ) { |
|
35
|
|
|
|
|
81
|
|
2691
|
45
|
50
|
|
|
|
124
|
next unless defined (my $v = $vals[$c++]); |
2692
|
45
|
50
|
|
|
|
96
|
push(@a, [@$k, $v]), next if ref $k; |
2693
|
45
|
|
100
|
|
|
216
|
$h{$k} ||= []; |
2694
|
45
|
|
|
|
|
63
|
push @{ $h{$k} }, $v; # Support multiple occurences |
|
45
|
|
|
|
|
132
|
|
2695
|
|
|
|
|
|
|
} |
2696
|
35
|
|
|
|
|
91
|
my $j = $self->get_config('parse_join')->[0]; |
2697
|
35
|
|
|
|
|
110
|
for $c (keys %h) { |
2698
|
42
|
|
|
|
|
69
|
$h{$c} = join $j, grep length, @{ $h{$c} }; |
|
42
|
|
|
|
|
192
|
|
2699
|
|
|
|
|
|
|
} |
2700
|
35
|
100
|
|
|
|
102
|
$h{track} =~ s/^0+(?=\d)// if exists $h{track}; |
2701
|
35
|
50
|
33
|
|
|
84
|
return \%h, \@a if wantarray and @a; |
2702
|
35
|
|
|
|
|
172
|
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=\{]))> |
|
0
|
|
|
|
|
0
|
|
2747
|
|
|
|
|
|
|
( __unquote($1) )ge; |
2748
|
0
|
|
|
|
|
0
|
# $pattern =~ s/(\\%(?:\\=)?)(\w|\\(\W))/$unquote{$1}$+/g; |
2749
|
|
|
|
|
|
|
return $self->parse_rex_prepare($pattern); |
2750
|
|
|
|
|
|
|
} |
2751
|
|
|
|
|
|
|
|
2752
|
5
|
|
|
5
|
|
132
|
sub parse { |
2753
|
5
|
|
|
|
|
30
|
my ($self, $pattern, $data) = @_; |
2754
|
|
|
|
|
|
|
$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
|
41
|
|
|
41
|
|
103
|
sub from_filesystem ($$) { |
2805
|
41
|
|
|
|
|
97
|
my ($self, $f) = @_; |
2806
|
41
|
50
|
33
|
|
|
1102
|
my $e = $self->get_config('decode_encoding_filename'); |
2807
|
0
|
|
|
|
|
0
|
return $f unless $e and $e->[0]; |
2808
|
0
|
|
|
|
|
0
|
require Encode; |
2809
|
|
|
|
|
|
|
Encode::decode($e->[0], $f); |
2810
|
|
|
|
|
|
|
} |
2811
|
|
|
|
|
|
|
|
2812
|
36
|
|
|
36
|
|
62
|
sub filename { |
2813
|
36
|
|
|
|
|
165
|
my $self = shift; |
2814
|
|
|
|
|
|
|
$self->from_filesystem($self->{ofilename}); |
2815
|
|
|
|
|
|
|
} |
2816
|
|
|
|
|
|
|
|
2817
|
5
|
|
|
5
|
|
11
|
sub abs_filename { |
2818
|
5
|
|
|
|
|
14
|
my $self = shift; |
2819
|
|
|
|
|
|
|
$self->from_filesystem($self->{abs_filename}); |
2820
|
|
|
|
|
|
|
} |
2821
|
|
|
|
|
|
|
|
2822
|
0
|
|
|
0
|
|
0
|
sub filename_noextension { |
2823
|
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
|
|
|
|
|
|
|
return $f; |
2828
|
|
|
|
|
|
|
} |
2829
|
|
|
|
|
|
|
|
2830
|
36
|
|
|
36
|
|
303
|
sub filename_nodir { |
2831
|
36
|
|
|
|
|
144
|
require File::Basename; |
2832
|
|
|
|
|
|
|
return scalar File::Basename::fileparse(shift->filename, ""); |
2833
|
|
|
|
|
|
|
} |
2834
|
|
|
|
|
|
|
|
2835
|
1
|
|
|
1
|
|
4
|
sub dirname { |
2836
|
1
|
|
|
|
|
3
|
require File::Basename; |
2837
|
1
|
50
|
|
|
|
5
|
my ($self, $l) = (shift, shift); |
2838
|
1
|
|
|
|
|
61
|
my $p = $l ? $self->dirname($l - 1) : $self->abs_filename; |
2839
|
|
|
|
|
|
|
return File::Basename::dirname($p); |
2840
|
|
|
|
|
|
|
} |
2841
|
|
|
|
|
|
|
|
2842
|
1
|
|
|
1
|
|
7
|
sub dir_component { |
2843
|
1
|
|
|
|
|
4
|
require File::Basename; |
2844
|
1
|
|
|
|
|
8
|
my ($self, $l) = (shift, shift); |
2845
|
|
|
|
|
|
|
return scalar File::Basename::fileparse($self->dirname($l), ""); |
2846
|
|
|
|
|
|
|
} |
2847
|
|
|
|
|
|
|
|
2848
|
16
|
|
|
16
|
|
27
|
sub filename_extension { |
2849
|
16
|
|
|
|
|
81
|
my $self = shift; |
2850
|
16
|
|
|
|
|
61
|
my $f = $self->filename_nodir; |
2851
|
16
|
50
|
|
|
|
190
|
my $ext_re = $self->get_config('extension')->[0]; |
2852
|
16
|
|
|
|
|
74
|
$f =~ /($ext_re)/ or return ''; |
2853
|
|
|
|
|
|
|
return $1; |
2854
|
|
|
|
|
|
|
} |
2855
|
|
|
|
|
|
|
|
2856
|
4
|
|
|
4
|
|
6
|
sub filename_nodir_noextension { |
2857
|
4
|
|
|
|
|
17
|
my $self = shift; |
2858
|
4
|
|
|
|
|
15
|
my $f = $self->filename_nodir; |
2859
|
4
|
|
|
|
|
41
|
my $ext_re = $self->get_config('extension')->[0]; |
2860
|
4
|
|
|
|
|
12
|
$f =~ s/$ext_re//; |
2861
|
|
|
|
|
|
|
return $f; |
2862
|
|
|
|
|
|
|
} |
2863
|
|
|
|
|
|
|
|
2864
|
1
|
|
|
1
|
|
2
|
sub abs_filename_noextension { |
2865
|
1
|
|
|
|
|
4
|
my $self = shift; |
2866
|
1
|
|
|
|
|
3
|
my $f = $self->abs_filename; |
2867
|
1
|
|
|
|
|
26
|
my $ext_re = $self->get_config('extension')->[0]; |
2868
|
1
|
|
|
|
|
5
|
$f =~ s/$ext_re//; |
2869
|
|
|
|
|
|
|
return $f; |
2870
|
|
|
|
|
|
|
} |
2871
|
|
|
|
|
|
|
|
2872
|
15
|
|
|
15
|
|
31
|
sub filename_extension_nodot { |
2873
|
15
|
|
|
|
|
59
|
my $self = shift; |
2874
|
15
|
|
|
|
|
107
|
my $e = $self->filename_extension; |
2875
|
15
|
|
|
|
|
55
|
$e =~ s/^\.//; |
2876
|
|
|
|
|
|
|
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
|
6
|
|
|
6
|
|
63
|
for my $elt (keys %mp3info) { |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
21378
|
|
2978
|
|
|
|
|
|
|
no strict 'refs'; |
2979
|
|
|
|
|
|
|
my $k = $mp3info{$elt}; |
2980
|
|
|
|
|
|
|
*$elt = sub (;$) { |
2981
|
0
|
|
|
0
|
|
0
|
# $MP3::Info::try_harder = 1; # Bug: loops infinitely if no frames |
2982
|
0
|
|
|
|
|
0
|
my $self = shift; |
2983
|
0
|
0
|
|
|
|
0
|
my $info = $self->{mp3info}; |
2984
|
0
|
|
|
|
|
0
|
unless ($info) { |
2985
|
0
|
|
|
|
|
0
|
require MP3::Info; |
2986
|
0
|
0
|
|
|
|
0
|
$info = MP3::Info::get_mp3info($self->abs_filename); |
2987
|
|
|
|
|
|
|
die "Didn't get valid data from MP3::Info for `".($self->abs_filename)."': $@" |
2988
|
|
|
|
|
|
|
unless defined $info; |
2989
|
0
|
|
|
|
|
0
|
} |
2990
|
|
|
|
|
|
|
$info->{$k} |
2991
|
|
|
|
|
|
|
} |
2992
|
|
|
|
|
|
|
} |
2993
|
|
|
|
|
|
|
|
2994
|
0
|
|
|
0
|
|
0
|
sub frequency_Hz ($) { |
2995
|
|
|
|
|
|
|
1000 * (shift->frequency_kHz); |
2996
|
|
|
|
|
|
|
} |
2997
|
0
|
0
|
|
0
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2998
|
0
|
|
|
0
|
|
0
|
sub mpeg_layer_roman { eval { 'I' x (shift->mpeg_layer) } || '' } |
2999
|
0
|
0
|
|
0
|
|
0
|
sub total_millisecs_int_fetch { int (0.5 + 1000 * shift->duration_secs) } |
|
0
|
0
|
|
|
|
0
|
|
3000
|
0
|
0
|
|
0
|
|
0
|
sub frames_padded_YN { eval {shift->frames_padded() ? 'Yes' : 'No' } || '' } |
|
0
|
0
|
|
|
|
0
|
|
3001
|
|
|
|
|
|
|
sub is_copyrighted_YN { eval {shift->is_copyrighted() ? 'Yes' : 'No' } || '' } |
3002
|
|
|
|
|
|
|
|
3003
|
32
|
|
|
32
|
|
40
|
sub total_millisecs_int { |
3004
|
32
|
|
|
|
|
44
|
my $self = shift; |
3005
|
32
|
50
|
|
|
|
129
|
my $ms = $self->{ms}; |
3006
|
0
|
|
|
|
|
0
|
return $ms if defined $ms; |
3007
|
0
|
0
|
|
|
|
0
|
(undef, $ms) = $self->get_id3v2_frames('TLEN'); |
3008
|
0
|
|
|
|
|
0
|
$ms = $self->total_millisecs_int_fetch() unless defined $ms; |
3009
|
0
|
|
|
|
|
0
|
$self->{ms} = $ms; |
3010
|
|
|
|
|
|
|
return $ms; |
3011
|
0
|
|
|
0
|
|
0
|
} |
3012
|
1
|
|
|
1
|
|
5
|
sub total_secs_int { int (0.5 + 0.001 * shift->total_millisecs_int) } |
3013
|
6
|
|
|
6
|
|
12
|
sub total_secs { 0.001 * shift->total_millisecs_int } |
3014
|
9
|
|
|
9
|
|
17
|
sub total_secs_trunc { int (0.001 * (0.5 + shift->total_millisecs_int)) } |
3015
|
9
|
|
|
9
|
|
22
|
sub total_mins { int (0.001/60 * (0.5 + shift->total_millisecs_int)) } |
3016
|
4
|
|
|
4
|
|
14
|
sub leftover_mins { shift->total_mins() % 60 } |
3017
|
0
|
|
|
0
|
|
0
|
sub total_hours { int (0.001/60/60 * (0.5 + shift->total_millisecs_int)) } |
3018
|
6
|
|
|
6
|
|
17
|
sub leftover_secs { shift->total_secs_int() % 60 } |
3019
|
3
|
|
|
3
|
|
7
|
sub leftover_secs_trunc { shift->total_secs_trunc() % 60 } |
3020
|
9
|
|
|
9
|
|
21
|
sub leftover_msec { shift->total_millisecs_int % 1000 } |
3021
|
|
|
|
|
|
|
sub leftover_secs_float { shift->total_millisecs_int % 60000 / 1000 } |
3022
|
0
|
|
|
0
|
|
0
|
sub time_mm_ss { # Borrowed from MP3::Info |
3023
|
0
|
|
|
|
|
0
|
my $self = shift; |
3024
|
|
|
|
|
|
|
sprintf "%.2d:%.2d", $self->total_mins, $self->leftover_secs; |
3025
|
|
|
|
|
|
|
} |
3026
|
|
|
|
|
|
|
|
3027
|
0
|
|
|
0
|
|
0
|
sub duration_secs { # Tricky: in which order to query MP3::Info and ExifTool? |
3028
|
0
|
|
|
|
|
0
|
my $self = shift; |
3029
|
0
|
0
|
|
|
|
0
|
my $d = $self->{duration}; |
3030
|
|
|
|
|
|
|
return $d if defined $d; # Cached value |
3031
|
0
|
0
|
0
|
|
|
0
|
return $self->{duration} = $self->total_secs_fetch # Have MP3::Info or a chance to work |
3032
|
0
|
|
|
|
|
0
|
if $self->{mp3info} or $self->{filename} =~ /\.mp[23]$/i; |
3033
|
0
|
0
|
|
|
|
0
|
my $r = $self->_duration; # Next: try ExifTool |
3034
|
0
|
|
|
|
|
0
|
$r = $self->total_secs_fetch unless $r; # Try MP3::Info anyway |
3035
|
|
|
|
|
|
|
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
|
15
|
|
|
15
|
|
848
|
sub format_time { |
3074
|
15
|
100
|
|
|
|
51
|
my ($self, $time) = (shift, shift); |
3075
|
15
|
|
|
|
|
41
|
$self = $self->new_fake() unless ref $self; |
3076
|
15
|
100
|
|
|
|
59
|
local $self->{ms} = $self->{ms}; # Make modifiable |
3077
|
15
|
|
|
|
|
31
|
local $self->{ms} = int($time * 1000 + 0.5) if defined $time; |
3078
|
15
|
|
|
|
|
31
|
my ($out, %have, $c) = ''; |
3079
|
51
|
50
|
|
|
|
283
|
for my $f (@_) { |
3080
|
|
|
|
|
|
|
$have{$+}++ if $f =~ /^\??(\{([^{}]+)\}|.)/; |
3081
|
15
|
|
|
|
|
31
|
} |
3082
|
51
|
50
|
66
|
|
|
142
|
for my $f (@_) { |
3083
|
0
|
0
|
|
|
|
0
|
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
|
$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
|
|
|
|
|
|
|
next; |
3089
|
51
|
|
|
|
|
71
|
} |
3090
|
51
|
|
|
|
|
142
|
my $ff = $f; # Modifiable |
3091
|
51
|
50
|
|
|
|
180
|
my $opt = ($ff =~ s/^\?//); |
3092
|
51
|
|
|
|
|
123
|
$ff =~ s/^(\{[^{}]+\}|\w)// or die "unexpected time format: <<$f>>"; |
3093
|
51
|
100
|
|
|
|
86
|
my ($what, $format) = ($1, ''); |
3094
|
36
|
100
|
66
|
|
|
112
|
if ($opt) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3095
|
15
|
100
|
|
|
|
47
|
if ($what eq 'H') { |
3096
|
15
|
|
66
|
|
|
77
|
$time = $self->total_secs unless defined $time; |
3097
|
|
|
|
|
|
|
$opt = int($time / 3600) || !(grep $have{$_}, qw(m mL s S SL SML)); |
3098
|
15
|
50
|
|
|
|
26
|
} elsif ($what eq 'm' or $what eq '{mL}') { |
3099
|
15
|
|
66
|
|
|
72
|
$time = $self->total_secs unless defined $time; |
3100
|
|
|
|
|
|
|
$opt = int($time / 60) || !(grep $have{$_}, qw(s S SL SML)); |
3101
|
6
|
|
|
|
|
14
|
} elsif ($what eq '{ML}') { |
3102
|
|
|
|
|
|
|
$opt = ($time != int $time); |
3103
|
0
|
|
|
|
|
0
|
} else { |
3104
|
|
|
|
|
|
|
$opt = 1; |
3105
|
|
|
|
|
|
|
#die "Do not know how to treat optional `$what'"; |
3106
|
36
|
50
|
|
|
|
109
|
} |
3107
|
36
|
100
|
|
|
|
106
|
$what =~ /^(?:{(.*)}|(.))/ or die; |
3108
|
|
|
|
|
|
|
(delete $have{$+}), next unless $opt; |
3109
|
|
|
|
|
|
|
} |
3110
|
|
|
|
|
|
|
$format = '02' |
3111
|
31
|
100
|
66
|
|
|
172
|
if (($what eq 's' or $what eq '{SL}') and (grep $have{$_}, qw(H m mL))) |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
3112
|
31
|
|
|
|
|
57
|
or $what eq '{mL}' and $have{H}; |
3113
|
|
|
|
|
|
|
$what = "%$format$what"; |
3114
|
31
|
100
|
66
|
|
|
73
|
$what = ".%03{ML}" |
3115
|
31
|
100
|
100
|
|
|
97
|
if $what eq '%{ML}' and grep $have{$_}, qw(H m mL s S SL); |
3116
|
5
|
|
|
|
|
12
|
if ($what eq '%{SML}' and grep $have{$_}, qw(H m mL)) { # manual padding |
3117
|
5
|
50
|
|
|
|
18
|
my $res = $self->interpolate($what); |
3118
|
5
|
|
|
|
|
16
|
$res = "0$res" unless $res =~ /^\d\d/; |
3119
|
|
|
|
|
|
|
$out .= "$res$ff"; |
3120
|
26
|
|
|
|
|
59
|
} else { |
3121
|
|
|
|
|
|
|
$out .= $self->interpolate($what) . $ff; |
3122
|
|
|
|
|
|
|
} |
3123
|
15
|
|
|
|
|
68
|
} |
3124
|
|
|
|
|
|
|
$out; |
3125
|
|
|
|
|
|
|
} |
3126
|
|
|
|
|
|
|
|
3127
|
0
|
|
|
0
|
|
0
|
my @channel_modes = ('stereo', 'joint stereo', 'dual channel', 'mono'); |
3128
|
|
|
|
|
|
|
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
|
14
|
|
|
14
|
|
30
|
sub can_write ($) { |
3151
|
14
|
|
|
|
|
33
|
my $self = shift; |
|
14
|
|
|
|
|
72
|
|
3152
|
14
|
50
|
33
|
|
|
129
|
my @wr = @{ $self->get_config('is_writable') }; # Make copy |
3153
|
14
|
|
|
|
|
37
|
return $wr[0] if @wr == 1 and not $wr[0] =~ /\D/; |
3154
|
14
|
|
|
|
|
62
|
my $meth = shift @wr; |
3155
|
|
|
|
|
|
|
$self->$meth(@wr); |
3156
|
|
|
|
|
|
|
} |
3157
|
|
|
|
|
|
|
|
3158
|
14
|
|
|
14
|
|
28
|
sub writable_by_extension ($) { |
3159
|
14
|
|
|
|
|
33
|
my $self = shift; |
3160
|
14
|
|
|
|
|
67
|
my $wr = $self->get_config('writable_extensions'); # Make copy |
3161
|
|
|
|
|
|
|
$self->extension_is(@$wr); |
3162
|
|
|
|
|
|
|
} |
3163
|
|
|
|
|
|
|
|
3164
|
1
|
|
|
1
|
|
4
|
sub die_cant_write ($$) { |
3165
|
|
|
|
|
|
|
my($self, $what) = (shift, shift); |
3166
|
1
|
|
|
|
|
7
|
die $what, $self->interpolate("File %F is not writable per `is_writable' confuration variable, current value is `"), |
|
1
|
|
|
|
|
3
|
|
3167
|
|
|
|
|
|
|
join(', ', @{$self->get_config('is_writable')}), "'"; |
3168
|
|
|
|
|
|
|
} |
3169
|
|
|
|
|
|
|
|
3170
|
14
|
|
|
14
|
|
43
|
sub can_write_or_die ($$) { |
3171
|
14
|
|
|
|
|
64
|
my($self, $what) = (shift, shift); |
3172
|
14
|
100
|
|
|
|
48
|
my $wr = $self->can_write; |
3173
|
1
|
|
|
|
|
16
|
return $wr if $wr; |
3174
|
|
|
|
|
|
|
$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
|
32
|
|
|
32
|
|
1115
|
sub update_tags { |
3206
|
|
|
|
|
|
|
my ($mp3, $data, $force2, $wr2) = (shift, shift, shift); |
3207
|
32
|
|
|
|
|
101
|
|
3208
|
32
|
100
|
|
|
|
132
|
$mp3->get_tags; |
3209
|
|
|
|
|
|
|
$data = $mp3->autoinfo('from') unless defined $data; |
3210
|
|
|
|
|
|
|
|
3211
|
32
|
100
|
|
|
|
96
|
# $mp3->new_tag("ID3v1") unless $wr1 = exists $mp3->{ID3v1}; |
3212
|
13
|
|
|
|
|
111
|
unless (exists $mp3->{ID3v1}) { |
3213
|
12
|
|
|
|
|
24
|
$mp3->can_write_or_die('update_tags() doing ID3v1: '); |
3214
|
12
|
|
|
|
|
46
|
$wr2 = 1; |
3215
|
|
|
|
|
|
|
$mp3->new_tag("ID3v1"); |
3216
|
31
|
|
|
|
|
49
|
} |
3217
|
31
|
|
|
|
|
70
|
my $elt; |
3218
|
217
|
|
|
|
|
331
|
for $elt (qw/title artist album year comment track genre/) { |
3219
|
217
|
100
|
|
|
|
409
|
my $d = $data->{$elt}; |
3220
|
74
|
100
|
|
|
|
182
|
next unless defined $d; |
3221
|
74
|
50
|
|
|
|
476
|
$d = [$d, ''] unless ref $d; |
3222
|
|
|
|
|
|
|
$mp3->{ID3v1}->$elt( $d->[0] ) if $d->[1] ne 'ID3v1'; |
3223
|
31
|
|
|
|
|
146
|
} # Skip what is already there... |
3224
|
|
|
|
|
|
|
$mp3->{ID3v1}->write_tag; |
3225
|
|
|
|
|
|
|
|
3226
|
31
|
50
|
|
|
|
103
|
my $do_length |
3227
|
|
|
|
|
|
|
= (defined $mp3->{ms}) ? ($mp3->get_config('update_length'))->[0] : 0; |
3228
|
|
|
|
|
|
|
|
3229
|
|
|
|
|
|
|
return $mp3 |
3230
|
31
|
100
|
66
|
|
|
176
|
if not $force2 and $mp3->{ID3v1}->fits_tag($data) |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3231
|
|
|
|
|
|
|
and not exists $mp3->{ID3v2} and $do_length < 2; |
3232
|
|
|
|
|
|
|
|
3233
|
26
|
100
|
|
|
|
74
|
# $mp3->new_tag("ID3v2") unless exists $mp3->{ID3v2}; |
3234
|
3
|
100
|
|
|
|
12
|
unless (exists $mp3->{ID3v2}) { |
3235
|
2
|
50
|
|
|
|
6
|
if (defined $wr2) { |
3236
|
|
|
|
|
|
|
$mp3->die_cant_write('update_tags() doing ID3v2: ') unless $wr2; |
3237
|
1
|
|
|
|
|
5
|
} else { |
3238
|
|
|
|
|
|
|
$mp3->can_write_or_die('update_tags() doing ID3v2: '); |
3239
|
3
|
|
|
|
|
36
|
} |
3240
|
|
|
|
|
|
|
$mp3->new_tag("ID3v2"); |
3241
|
26
|
|
|
|
|
66
|
} |
3242
|
182
|
|
|
|
|
272
|
for $elt (qw/title artist album year comment track genre/) { |
3243
|
182
|
100
|
|
|
|
345
|
my $d = $data->{$elt}; |
3244
|
69
|
100
|
|
|
|
154
|
next unless defined $d; |
3245
|
69
|
100
|
|
|
|
304
|
$d = [$d, ''] unless ref $d; |
3246
|
|
|
|
|
|
|
$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
|
26
|
50
|
33
|
|
|
92
|
$mp3->set_id3v2_frame('TLEN', $mp3->{ms}) |
3251
|
26
|
|
|
|
|
122
|
if $do_length and not $mp3->have_id3v2_frame('TLEN'); |
3252
|
26
|
|
|
|
|
279
|
$mp3->{ID3v2}->write_tag; |
3253
|
|
|
|
|
|
|
return $mp3; |
3254
|
|
|
|
|
|
|
} |
3255
|
|
|
|
|
|
|
|
3256
|
71
|
|
|
71
|
|
365
|
sub _massage_genres ($;$) { # Thanks to neil verplank for the prototype |
3257
|
71
|
|
|
|
|
165
|
require MP3::Tag::ID3v1; |
3258
|
71
|
|
100
|
|
|
230
|
my($data, $how) = (shift, shift); |
3259
|
71
|
|
100
|
|
|
182
|
my $firstnum = (($how || 0) eq 'num'); |
3260
|
71
|
|
|
|
|
104
|
my $prefer_num = (($how || 0) eq 'prefer_num'); |
3261
|
71
|
50
|
|
|
|
129
|
my (%seen, @genres); # find all genres in incoming data |
3262
|
|
|
|
|
|
|
$data = $data->[0] if ref $data; |
3263
|
71
|
|
|
|
|
176
|
# clean and split line on both null and parentheses |
3264
|
71
|
|
|
|
|
127
|
$data =~ s/\s+/ /g; |
3265
|
71
|
|
|
|
|
161
|
$data =~ s/\s*\0[\0\s]*/\0/g; |
3266
|
71
|
|
|
|
|
133
|
$data =~ s/^[\s\0]+//; |
3267
|
71
|
|
|
|
|
323
|
$data =~ s/[\s\0]+$//; |
3268
|
71
|
100
|
|
|
|
353
|
my @data = split m<\0|\s+/\s+>, $data; |
3269
|
|
|
|
|
|
|
@data = split /\( ( \d+ | rx | cr ) \)/xi, $data[0] if @data == 1; |
3270
|
|
|
|
|
|
|
|
3271
|
71
|
|
|
|
|
171
|
# review array, produce a clean, ordered list of unique genres for output |
3272
|
138
|
100
|
|
|
|
289
|
foreach my $genre (@data) { |
3273
|
|
|
|
|
|
|
next if $genre eq ""; # (12)(13) ==> in front, and between |
3274
|
|
|
|
|
|
|
|
3275
|
89
|
100
|
|
|
|
221
|
# convert text to number to eliminate collisions, and produce consistent output |
3276
|
|
|
|
|
|
|
if ($genre =~ /\D/) {{ # Not a pure number |
3277
|
14
|
|
|
|
|
29
|
# return id number |
|
14
|
|
|
|
|
39
|
|
3278
|
|
|
|
|
|
|
my $genre_num = MP3::Tag::ID3v1::genres($genre); |
3279
|
14
|
100
|
66
|
|
|
61
|
# 255 is "non-standard text" in ID3v1; pass the rest through |
3280
|
2
|
100
|
|
|
|
10
|
last if $genre_num eq '255' or $genre_num eq ''; |
3281
|
1
|
50
|
|
|
|
4
|
return $genre_num if $firstnum; |
3282
|
0
|
|
|
|
|
0
|
$genre = $genre_num, last if $prefer_num; |
3283
|
0
|
0
|
|
|
|
0
|
$genre_num = MP3::Tag::ID3v1::genres($genre_num); |
3284
|
0
|
|
|
|
|
0
|
last unless defined $genre_num; |
3285
|
|
|
|
|
|
|
$genre = $genre_num; |
3286
|
88
|
100
|
100
|
|
|
303
|
}} # Now converted to a number - if possible |
3287
|
61
|
100
|
|
|
|
89
|
unless ($prefer_num or $genre =~ /\D/) {{ # Here $genre is a number |
|
61
|
|
|
|
|
178
|
|
3288
|
39
|
100
|
|
|
|
126
|
my $genre_str = MP3::Tag::ID3v1::genres($genre) or last; |
3289
|
24
|
|
|
|
|
44
|
return $genre if $firstnum; |
3290
|
|
|
|
|
|
|
$genre = $genre_str; |
3291
|
|
|
|
|
|
|
}} |
3292
|
73
|
50
|
|
|
|
176
|
# 2.4 defines these conversions |
3293
|
73
|
50
|
|
|
|
139
|
$genre = "Remix" if lc $genre eq "rx"; |
3294
|
73
|
100
|
66
|
|
|
327
|
$genre = "Cover" if lc $genre eq "cr"; |
3295
|
73
|
100
|
|
|
|
287
|
$genre = "($genre)" if length $genre and not $genre =~ /\D/; # Only digits |
3296
|
|
|
|
|
|
|
push @genres, $genre unless $seen{$genre}++; |
3297
|
55
|
100
|
|
|
|
130
|
} |
3298
|
48
|
|
|
|
|
241
|
return if $firstnum; |
3299
|
|
|
|
|
|
|
@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
|
14
|
|
|
14
|
|
31
|
sub extension_is ($@) { |
3312
|
14
|
|
|
|
|
55
|
my ($self) = (shift); |
3313
|
14
|
100
|
|
|
|
123
|
my $ext = lc($self->filename_extension_nodot()); |
3314
|
1
|
|
|
|
|
5
|
return 1 if grep $ext eq lc, @_; |
3315
|
|
|
|
|
|
|
return; |
3316
|
|
|
|
|
|
|
} |
3317
|
|
|
|
|
|
|
|
3318
|
84
|
|
|
84
|
|
226
|
sub DESTROY { |
3319
|
84
|
100
|
66
|
|
|
468
|
my $self=shift; |
3320
|
82
|
|
|
|
|
323
|
if (exists $self->{filename} and defined $self->{filename}) { |
3321
|
|
|
|
|
|
|
$self->{filename}->close; |
3322
|
|
|
|
|
|
|
} |
3323
|
|
|
|
|
|
|
} |
3324
|
|
|
|
|
|
|
|
3325
|
0
|
|
|
0
|
|
|
sub parse_cfg_line ($$$) { |
3326
|
0
|
0
|
|
|
|
|
my ($self, $line, $data) = (shift,shift,shift); |
3327
|
0
|
0
|
|
|
|
|
return if $line =~ /^\s*(#|$)/; |
3328
|
|
|
|
|
|
|
die "Unrecognized configuration file line: <<<$line>>>" |
3329
|
0
|
|
|
|
|
|
unless $line =~ /^\s*(\w+)\s*=\s*(.*?)\s*$/; |
|
0
|
|
|
|
|
|
|
3330
|
|
|
|
|
|
|
push @{$data->{$1}}, $2; |
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
|
0
|
|
|
0
|
|
|
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
|
|
|
|
|
|
open F, "< $file" or die "Can't open `$file' for read: $!"; |
3353
|
0
|
|
|
|
|
|
my $data = {}; |
3354
|
0
|
|
|
|
|
|
while (defined (my $l = )) { |
3355
|
|
|
|
|
|
|
$self->parse_cfg_line($l, $data); |
3356
|
0
|
0
|
|
|
|
|
} |
3357
|
0
|
|
|
|
|
|
CORE::close F or die "Can't close `$file' for read: $!"; |
3358
|
0
|
|
|
|
|
|
for my $k (keys %$data) { |
|
0
|
|
|
|
|
|
|
3359
|
|
|
|
|
|
|
$self->config($k, @{$data->{$k}}); |
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
|
0
|
|
|
0
|
|
|
sub load_parents { |
3371
|
0
|
|
|
|
|
|
my $par; |
3372
|
0
|
0
|
|
|
|
|
while ($par = shift @parents) { |
3373
|
|
|
|
|
|
|
return 1 if eval "require MP3::Tag::$par; 1" |
3374
|
0
|
|
|
|
|
|
} |
3375
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|