line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MP3::Tag::ParseData; |
2
|
|
|
|
|
|
|
|
3
|
6
|
|
|
6
|
|
42
|
use strict; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
202
|
|
4
|
6
|
|
|
6
|
|
30
|
use vars qw /$VERSION @ISA/; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
8310
|
|
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
|
266
|
my ($class, $filename, $parent) = @_; |
142
|
86
|
100
|
|
|
|
381
|
$filename = $filename->filename if ref $filename; |
143
|
86
|
|
|
|
|
388
|
bless {filename => $filename, parent => $parent}, $class; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# Destructor |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
0
|
|
|
sub DESTROY {} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub parse_one { |
151
|
31
|
|
|
31
|
0
|
65
|
my ($self, $in) = @_; |
152
|
|
|
|
|
|
|
|
153
|
31
|
|
|
|
|
74
|
my @patterns = @$in; # Apply shift to a copy, not original... |
154
|
31
|
|
|
|
|
57
|
my $flags = shift @patterns; |
155
|
31
|
|
|
|
|
54
|
my $data = shift @patterns; |
156
|
|
|
|
|
|
|
|
157
|
31
|
|
|
|
|
208
|
my @data = $self->{parent}->interpolate_with_flags($data, $flags); |
158
|
31
|
|
|
|
|
58
|
my $res; |
159
|
31
|
|
|
|
|
60
|
my @opatterns = @patterns; |
160
|
|
|
|
|
|
|
|
161
|
31
|
100
|
|
|
|
92
|
if ($flags =~ /[oO]/) { |
162
|
1
|
50
|
|
|
|
27
|
@patterns = map $self->{parent}->interpolate($_), @patterns |
163
|
|
|
|
|
|
|
if $flags =~ /O/; |
164
|
1
|
50
|
33
|
|
|
6
|
return unless length $data[0] or $flags =~ /z/; |
165
|
1
|
|
|
|
|
2
|
for my $file (@patterns) { |
166
|
1
|
50
|
33
|
|
|
10
|
if ($flags =~ /D/ and $file =~ m,(.*)[/\\],s) { |
167
|
1
|
|
|
|
|
5
|
require File::Path; |
168
|
1
|
|
|
|
|
135
|
File::Path::mkpath($1); |
169
|
|
|
|
|
|
|
} |
170
|
1
|
50
|
|
|
|
68
|
open OUT, "> $file" or die "open(`$file') for write: $!"; |
171
|
1
|
50
|
|
|
|
15
|
if ($flags =~ /b/) { |
172
|
1
|
|
|
|
|
5
|
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
|
|
|
|
|
7
|
local ($/, $,) = ('', ''); |
180
|
1
|
|
|
|
|
14
|
print OUT $data[0]; |
181
|
1
|
50
|
|
|
|
34
|
close OUT or die "close(`$file') for write: $!"; |
182
|
|
|
|
|
|
|
} |
183
|
1
|
|
|
|
|
5
|
return; |
184
|
|
|
|
|
|
|
} |
185
|
30
|
100
|
|
|
|
76
|
if ($flags =~ /R/) { |
186
|
2
|
|
|
|
|
20
|
@patterns = map $self->{parent}->parse_rex_prepare($_), @patterns; |
187
|
|
|
|
|
|
|
} else { |
188
|
28
|
|
|
|
|
167
|
@patterns = map $self->{parent}->parse_prepare($_), @patterns; |
189
|
|
|
|
|
|
|
} |
190
|
30
|
|
|
|
|
78
|
for $data (@data) { |
191
|
30
|
|
|
|
|
52
|
my $pattern; |
192
|
30
|
|
|
|
|
57
|
for $pattern (@patterns) { |
193
|
30
|
50
|
|
|
|
161
|
last if $res = $self->{parent}->parse_rex_match($pattern, $data); |
194
|
|
|
|
|
|
|
} |
195
|
30
|
50
|
|
|
|
85
|
last if $res; |
196
|
|
|
|
|
|
|
} |
197
|
30
|
|
|
|
|
43
|
{ local $" = "' `"; |
|
30
|
|
|
|
|
63
|
|
198
|
30
|
50
|
33
|
|
|
169
|
die "Pattern(s) `@opatterns' did not succeed vs `@data'" |
199
|
|
|
|
|
|
|
if $flags =~ /m/ and not $res; |
200
|
|
|
|
|
|
|
} |
201
|
30
|
|
|
|
|
59
|
my $k; |
202
|
30
|
|
|
|
|
69
|
for $k (keys %$res) { |
203
|
34
|
50
|
|
|
|
94
|
unless ($flags =~ /b/) { |
204
|
34
|
|
|
|
|
79
|
$res->{$k} =~ s/^\s+//; |
205
|
34
|
|
|
|
|
85
|
$res->{$k} =~ s/\s+$//; |
206
|
|
|
|
|
|
|
} |
207
|
34
|
50
|
66
|
|
|
134
|
delete $res->{$k} unless length $res->{$k} or $flags =~ /z/; |
208
|
|
|
|
|
|
|
} |
209
|
30
|
50
|
33
|
|
|
131
|
return unless $res and keys %$res; |
210
|
30
|
|
|
|
|
167
|
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
|
641
|
my ($self,$what) = @_; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
return $self->{parsed}->{$what} # Recalculate during recursive calls |
222
|
282
|
100
|
100
|
|
|
1200
|
if not $self->{parsing} and exists $self->{parsed}; # Do not recalc after finish |
223
|
|
|
|
|
|
|
|
224
|
234
|
|
|
|
|
577
|
my $data = $self->get_config('parse_data'); |
225
|
234
|
100
|
66
|
|
|
1331
|
return unless $data and @$data; |
226
|
24
|
|
|
|
|
47
|
my $parsing = $self->{parsing}; |
227
|
24
|
|
|
|
|
70
|
local $self->{parsing}; |
228
|
|
|
|
|
|
|
|
229
|
24
|
|
|
|
|
55
|
my (%res, $d, $c); |
230
|
24
|
|
|
|
|
56
|
for $d (@$data) { |
231
|
37
|
|
|
|
|
69
|
$c++; |
232
|
37
|
|
|
|
|
59
|
$self->{parsing} = $c; |
233
|
|
|
|
|
|
|
# Protect against recursion: later $d can access results of earlier ones |
234
|
37
|
100
|
100
|
|
|
115
|
last if $parsing and $parsing <= $c; |
235
|
31
|
|
|
|
|
96
|
my $res = $self->parse_one($d); |
236
|
|
|
|
|
|
|
# warn "Failure: [@$d]\n" unless $res; |
237
|
|
|
|
|
|
|
# Set user-scratch space data immediately |
238
|
31
|
|
|
|
|
80
|
for my $k (keys %$res) { |
239
|
34
|
50
|
|
|
|
239
|
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
|
|
|
|
|
49
|
my $r = delete $res->{$k}; |
252
|
20
|
50
|
66
|
|
|
89
|
$r = undef unless length $r or $self->get_config('id3v2_frame_empty_ok')->[0]; |
253
|
20
|
50
|
66
|
|
|
126
|
if (defined $r or $self->{parent}->_get_tag('ID3v2')) { |
254
|
20
|
|
|
|
|
107
|
$self->{parent}->select_id3v2_frame_by_descr($k, $r); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
# later ones overwrite earlier |
259
|
31
|
50
|
|
|
|
168
|
%res = (%res, %$res) if $res; |
260
|
|
|
|
|
|
|
} |
261
|
24
|
|
|
|
|
62
|
$self->{parsed} = \%res; |
262
|
|
|
|
|
|
|
# return unless keys %res; |
263
|
24
|
|
|
|
|
129
|
return $self->{parsed}->{$what}; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
for my $elt ( qw( title track artist album comment year genre ) ) { |
267
|
6
|
|
|
6
|
|
52
|
no strict 'refs'; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
494
|
|
268
|
|
|
|
|
|
|
*$elt = sub (;$) { |
269
|
282
|
|
|
282
|
|
468
|
my $self = shift; |
270
|
282
|
|
|
|
|
722
|
$self->parse($elt, @_); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
1; |