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