| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package MP3::Tag::ParseData; |
|
2
|
|
|
|
|
|
|
|
|
3
|
6
|
|
|
6
|
|
20
|
use strict; |
|
|
6
|
|
|
|
|
6
|
|
|
|
6
|
|
|
|
|
144
|
|
|
4
|
6
|
|
|
6
|
|
18
|
use vars qw /$VERSION @ISA/; |
|
|
6
|
|
|
|
|
4
|
|
|
|
6
|
|
|
|
|
5512
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
$VERSION="1.00"; |
|
7
|
|
|
|
|
|
|
@ISA = 'MP3::Tag::__hasparent'; |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=pod |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
MP3::Tag::ParseData - Module for parsing arbitrary data associated with music files. |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# parses the file name according to one of the patterns: |
|
18
|
|
|
|
|
|
|
$mp3->config('parse_data', ['i', '%f', '%t - %n - %a.%e', '%t - %y.%e']); |
|
19
|
|
|
|
|
|
|
$title = $mp3->title; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
see L |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
MP3::Tag::ParseData is designed to be called from the MP3::Tag module. |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Each option of configuration item C should be of the form |
|
28
|
|
|
|
|
|
|
C<[$flag, $string, $pattern1, ...]>. For each of the option, patterns of |
|
29
|
|
|
|
|
|
|
the option are matched agains the $string of the option, until one of them |
|
30
|
|
|
|
|
|
|
succeeds. The information obtained from later options takes precedence over |
|
31
|
|
|
|
|
|
|
the information obtained from earlier ones. |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
The meaning of the patterns is the same as for parse() or parse_rex() methods |
|
34
|
|
|
|
|
|
|
of C. Since the default for C is empty, by default this |
|
35
|
|
|
|
|
|
|
handler has no effect. |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
$flag is split into 1-character-long flags (unknown flags are ignored): |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=over |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=item C |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
the string-to-parse is interpolated first; |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=item C |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
the string-to-parse is interpreted as the name of the file to read; |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=item C |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
added to C, makes it non-fatal if the file does not exist; |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=item C |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
the file should be read in C mode; |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=item C |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
the string-to-parse is interpreted as collection of lines, one per track; |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=item C |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
the string-to-parse is interpreted as collection of lines, and the first |
|
64
|
|
|
|
|
|
|
matched is chosen; |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=item C |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
the resulting string is interpolated before parsing. |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item C |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Do not strip the leading and trailing blanks. (With output to file, |
|
73
|
|
|
|
|
|
|
the output is performed in binary mode too.) |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item C |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
the patterns are considered as regular expressions. |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item C |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
one of the patterns must match. |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item C, C, C |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
With C or C interpret the pattern as a name of file to output |
|
86
|
|
|
|
|
|
|
parse-data to. With C the name of output file is interpolated. |
|
87
|
|
|
|
|
|
|
When C is present, intermediate directories are created. |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item C |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Do not ignore a field even if the result is a 0-length string. |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=back |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Unless C option is given, the resulting values have starting and |
|
96
|
|
|
|
|
|
|
trailing whitespace trimmed. (Actually, split()ing into lines is done |
|
97
|
|
|
|
|
|
|
using the configuration item C; it defaults to C<"\n">.) |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
If the configuration item C has multiple options, the $strings |
|
100
|
|
|
|
|
|
|
which are interpolated will use information set by preceding options; |
|
101
|
|
|
|
|
|
|
similarly, any interolated option may use information obtained by other |
|
102
|
|
|
|
|
|
|
handlers - even if these handers are later in the pecking order than |
|
103
|
|
|
|
|
|
|
C (which by default is the first handler). For |
|
104
|
|
|
|
|
|
|
example, with |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
['i', '%t' => '%t (%y)'], ['i', '%t' => '%t - %c'] |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
and a local CDDB file which identifies title to C<'Merry old - another |
|
109
|
|
|
|
|
|
|
interpretation (1905)'>, the first field will interpolate C<'%t'> into this |
|
110
|
|
|
|
|
|
|
title, then will split it into the year and the rest. The second field will |
|
111
|
|
|
|
|
|
|
split the rest into a title-proper and comment. |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
Note that one can use fields of the form |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
['mz', 'This is a forced title' => '%t'] |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
to force particular values for parts of the MP3 tag. |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
The usual methods C, C, C, C, C, C |
|
120
|
|
|
|
|
|
|
C can be used to access the results of the parse. |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
It is possible to set individual id3v2 frames; use %{TIT1} or |
|
123
|
|
|
|
|
|
|
some such. Setting to an empty string deletes the frame if config |
|
124
|
|
|
|
|
|
|
parameter C is false (the default value). |
|
125
|
|
|
|
|
|
|
Setting ID3v2 frames uses the same translation rules as |
|
126
|
|
|
|
|
|
|
select_id3v2_frame_by_descr(). |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 SEE ALSO |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
The flags C are identical to flags of the method |
|
131
|
|
|
|
|
|
|
interpolate_with_flags() of MP3::Tag (see L). |
|
132
|
|
|
|
|
|
|
Essentially, the other flags (C) are applied to the result of |
|
133
|
|
|
|
|
|
|
calling the latter method. |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=cut |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# Constructor |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub new_with_parent { |
|
141
|
86
|
|
|
86
|
0
|
109
|
my ($class, $filename, $parent) = @_; |
|
142
|
86
|
100
|
|
|
|
270
|
$filename = $filename->filename if ref $filename; |
|
143
|
86
|
|
|
|
|
269
|
bless {filename => $filename, parent => $parent}, $class; |
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# Destructor |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
0
|
|
|
sub DESTROY {} |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub parse_one { |
|
151
|
31
|
|
|
31
|
0
|
31
|
my ($self, $in) = @_; |
|
152
|
|
|
|
|
|
|
|
|
153
|
31
|
|
|
|
|
48
|
my @patterns = @$in; # Apply shift to a copy, not original... |
|
154
|
31
|
|
|
|
|
30
|
my $flags = shift @patterns; |
|
155
|
31
|
|
|
|
|
29
|
my $data = shift @patterns; |
|
156
|
|
|
|
|
|
|
|
|
157
|
31
|
|
|
|
|
131
|
my @data = $self->{parent}->interpolate_with_flags($data, $flags); |
|
158
|
31
|
|
|
|
|
28
|
my $res; |
|
159
|
31
|
|
|
|
|
34
|
my @opatterns = @patterns; |
|
160
|
|
|
|
|
|
|
|
|
161
|
31
|
100
|
|
|
|
58
|
if ($flags =~ /[oO]/) { |
|
162
|
1
|
50
|
|
|
|
20
|
@patterns = map $self->{parent}->interpolate($_), @patterns |
|
163
|
|
|
|
|
|
|
if $flags =~ /O/; |
|
164
|
1
|
50
|
33
|
|
|
11
|
return unless length $data[0] or $flags =~ /z/; |
|
165
|
1
|
|
|
|
|
3
|
for my $file (@patterns) { |
|
166
|
1
|
50
|
33
|
|
|
14
|
if ($flags =~ /D/ and $file =~ m,(.*)[/\\],s) { |
|
167
|
1
|
|
|
|
|
6
|
require File::Path; |
|
168
|
1
|
|
|
|
|
110
|
File::Path::mkpath($1); |
|
169
|
|
|
|
|
|
|
} |
|
170
|
1
|
50
|
|
|
|
48
|
open OUT, "> $file" or die "open(`$file') for write: $!"; |
|
171
|
1
|
50
|
|
|
|
8
|
if ($flags =~ /b/) { |
|
172
|
1
|
|
|
|
|
2
|
binmode OUT; |
|
173
|
|
|
|
|
|
|
} else { |
|
174
|
0
|
|
|
|
|
0
|
my $e; |
|
175
|
0
|
0
|
0
|
|
|
0
|
if ($e = $self->get_config('encode_encoding_files') and $e->[0]) { |
|
176
|
0
|
|
|
|
|
0
|
eval "binmode OUT, ':encoding($e->[0])'"; # old binmode won't compile... |
|
177
|
|
|
|
|
|
|
} |
|
178
|
|
|
|
|
|
|
} |
|
179
|
1
|
|
|
|
|
5
|
local ($/, $,) = ('', ''); |
|
180
|
1
|
|
|
|
|
6
|
print OUT $data[0]; |
|
181
|
1
|
50
|
|
|
|
24
|
close OUT or die "close(`$file') for write: $!"; |
|
182
|
|
|
|
|
|
|
} |
|
183
|
1
|
|
|
|
|
3
|
return; |
|
184
|
|
|
|
|
|
|
} |
|
185
|
30
|
100
|
|
|
|
42
|
if ($flags =~ /R/) { |
|
186
|
2
|
|
|
|
|
15
|
@patterns = map $self->{parent}->parse_rex_prepare($_), @patterns; |
|
187
|
|
|
|
|
|
|
} else { |
|
188
|
28
|
|
|
|
|
111
|
@patterns = map $self->{parent}->parse_prepare($_), @patterns; |
|
189
|
|
|
|
|
|
|
} |
|
190
|
30
|
|
|
|
|
45
|
for $data (@data) { |
|
191
|
30
|
|
|
|
|
19
|
my $pattern; |
|
192
|
30
|
|
|
|
|
30
|
for $pattern (@patterns) { |
|
193
|
30
|
50
|
|
|
|
121
|
last if $res = $self->{parent}->parse_rex_match($pattern, $data); |
|
194
|
|
|
|
|
|
|
} |
|
195
|
30
|
50
|
|
|
|
52
|
last if $res; |
|
196
|
|
|
|
|
|
|
} |
|
197
|
30
|
|
|
|
|
23
|
{ local $" = "' `"; |
|
|
30
|
|
|
|
|
36
|
|
|
198
|
30
|
50
|
33
|
|
|
125
|
die "Pattern(s) `@opatterns' did not succeed vs `@data'" |
|
199
|
|
|
|
|
|
|
if $flags =~ /m/ and not $res; |
|
200
|
|
|
|
|
|
|
} |
|
201
|
30
|
|
|
|
|
20
|
my $k; |
|
202
|
30
|
|
|
|
|
39
|
for $k (keys %$res) { |
|
203
|
34
|
50
|
|
|
|
60
|
unless ($flags =~ /b/) { |
|
204
|
34
|
|
|
|
|
45
|
$res->{$k} =~ s/^\s+//; |
|
205
|
34
|
|
|
|
|
49
|
$res->{$k} =~ s/\s+$//; |
|
206
|
|
|
|
|
|
|
} |
|
207
|
34
|
50
|
66
|
|
|
125
|
delete $res->{$k} unless length $res->{$k} or $flags =~ /z/; |
|
208
|
|
|
|
|
|
|
} |
|
209
|
30
|
50
|
33
|
|
|
105
|
return unless $res and keys %$res; |
|
210
|
30
|
|
|
|
|
72
|
return $res; |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# XXX Two decisions: which entries can access results of which ones, |
|
214
|
|
|
|
|
|
|
# and which entries overwrite which ones; the user can reverse one of them |
|
215
|
|
|
|
|
|
|
# by sorting config('parse_data') in the opposite order; but not both. |
|
216
|
|
|
|
|
|
|
# Only practice can show whether our choice is correct... How to customize? |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub parse { # Later recipies can access results of earlier ones. |
|
219
|
282
|
|
|
282
|
0
|
254
|
my ($self,$what) = @_; |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
return $self->{parsed}->{$what} # Recalculate during recursive calls |
|
222
|
282
|
100
|
66
|
|
|
857
|
if not $self->{parsing} and exists $self->{parsed}; # Do not recalc after finish |
|
223
|
|
|
|
|
|
|
|
|
224
|
234
|
|
|
|
|
401
|
my $data = $self->get_config('parse_data'); |
|
225
|
234
|
100
|
66
|
|
|
1252
|
return unless $data and @$data; |
|
226
|
24
|
|
|
|
|
27
|
my $parsing = $self->{parsing}; |
|
227
|
24
|
|
|
|
|
40
|
local $self->{parsing}; |
|
228
|
|
|
|
|
|
|
|
|
229
|
24
|
|
|
|
|
20
|
my (%res, $d, $c); |
|
230
|
24
|
|
|
|
|
35
|
for $d (@$data) { |
|
231
|
37
|
|
|
|
|
35
|
$c++; |
|
232
|
37
|
|
|
|
|
37
|
$self->{parsing} = $c; |
|
233
|
|
|
|
|
|
|
# Protect against recursion: later $d can access results of earlier ones |
|
234
|
37
|
100
|
100
|
|
|
86
|
last if $parsing and $parsing <= $c; |
|
235
|
31
|
|
|
|
|
55
|
my $res = $self->parse_one($d); |
|
236
|
|
|
|
|
|
|
# warn "Failure: [@$d]\n" unless $res; |
|
237
|
|
|
|
|
|
|
# Set user-scratch space data immediately |
|
238
|
31
|
|
|
|
|
44
|
for my $k (keys %$res) { |
|
239
|
34
|
50
|
|
|
|
167
|
if ($k eq 'year') { # Do nothing |
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
} elsif ($k =~ /^U(\d{1,2})$/) { |
|
241
|
0
|
|
|
|
|
0
|
$self->{parent}->set_user($1, delete $res->{$k}) |
|
242
|
|
|
|
|
|
|
} elsif (0 and $k =~ /^\w{4}(\d{2,})?$/) { |
|
243
|
|
|
|
|
|
|
if (length $res->{$k} |
|
244
|
|
|
|
|
|
|
or $self->get_config('id3v2_frame_empty_ok')->[0]) { |
|
245
|
|
|
|
|
|
|
$self->{parent}->set_id3v2_frame($k, delete $res->{$k}) |
|
246
|
|
|
|
|
|
|
} else { |
|
247
|
|
|
|
|
|
|
delete $res->{$k}; |
|
248
|
|
|
|
|
|
|
$self->{parent}->set_id3v2_frame($k); # delete |
|
249
|
|
|
|
|
|
|
} |
|
250
|
|
|
|
|
|
|
} elsif ($k =~ /^\w{4}(\d{2,}|(?:\(([^()]*(?:\([^()]+\)[^()]*)*)\))?(?:\[(\\.|[^]\\]*)\])?)$/) { |
|
251
|
20
|
|
|
|
|
27
|
my $r = delete $res->{$k}; |
|
252
|
20
|
50
|
66
|
|
|
51
|
$r = undef unless length $r or $self->get_config('id3v2_frame_empty_ok')->[0]; |
|
253
|
20
|
50
|
66
|
|
|
63
|
if (defined $r or $self->{parent}->_get_tag('ID3v2')) { |
|
254
|
20
|
|
|
|
|
72
|
$self->{parent}->select_id3v2_frame_by_descr($k, $r); |
|
255
|
|
|
|
|
|
|
} |
|
256
|
|
|
|
|
|
|
} |
|
257
|
|
|
|
|
|
|
} |
|
258
|
|
|
|
|
|
|
# later ones overwrite earlier |
|
259
|
31
|
50
|
|
|
|
119
|
%res = (%res, %$res) if $res; |
|
260
|
|
|
|
|
|
|
} |
|
261
|
24
|
|
|
|
|
30
|
$self->{parsed} = \%res; |
|
262
|
|
|
|
|
|
|
# return unless keys %res; |
|
263
|
24
|
|
|
|
|
102
|
return $self->{parsed}->{$what}; |
|
264
|
|
|
|
|
|
|
} |
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
for my $elt ( qw( title track artist album comment year genre ) ) { |
|
267
|
6
|
|
|
6
|
|
27
|
no strict 'refs'; |
|
|
6
|
|
|
|
|
6
|
|
|
|
6
|
|
|
|
|
366
|
|
|
268
|
|
|
|
|
|
|
*$elt = sub (;$) { |
|
269
|
282
|
|
|
282
|
|
230
|
my $self = shift; |
|
270
|
282
|
|
|
|
|
477
|
$self->parse($elt, @_); |
|
271
|
|
|
|
|
|
|
} |
|
272
|
|
|
|
|
|
|
} |
|
273
|
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
1; |