]> diplodocus.org Git - flac-archive/blob - tags.pl
ceb590fc721a69691c9d2243d7d3d5c9a8dbad22
[flac-archive] / tags.pl
1 package epg::flac::archive::tags;
2
3 =head1 NAME tags.pl
4
5 subroutines for tag processing
6
7 =head1 DESCRIPTION
8
9 TODO
10
11 =cut
12
13 # POSIX.1-2017, Base Definitions, 3.282 Portable Filename Character Set says
14 # [A-Za-z0-9._-]
15 # https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap03.html#tag_03_282
16
17 # Flac tags (set with `flac -T fieldname=...`) are Vorbis comments.
18 # https://www.xiph.org/vorbis/doc/v-comment.html#fieldnames field names we care about:
19 # - TITLE - Track/Work name
20 # - VERSION - may be used to differentiate multiple versions of the same track title in a single collection. (e.g. remix info)
21 # - ALBUM - The collection name to which this track belongs
22 # - TRACKNUMBER - The track number of this piece
23 # - ARTIST - The artist generally considered responsible for the track
24 # - DATE - Date the track was recorded (XXX I use US release date)
25 # https://age.hobba.nl/audio/mirroredpages/ogg-tagging.html (supposedly mirrored from http://reactor-core.org/ogg-tagging.html )
26 # specifies more:
27 # - DISCNUMBER - if part of a multi-disc album, put the disc number here
28 # - VERSION - e.g. "live", "radio edit"
29 # - PARTNUMBER - part number if a work is divided across tracks
30 # - PART - part name e.g. "Oh sole mio"
31 # https://picard-docs.musicbrainz.org/en/appendices/tag_mapping.html
32 # - ALBUMARTIST - maps to ID3v2 TPE2
33
34 # Input is a directory containing:
35 # - trackNN.cdda.wav - WAV format files ripped from CD-DA audio tracks where NN is track number 01 - 99
36 # - tags - described below
37 # - cover.front.jpeg - optional JPEG format file containing the album front cover
38
39 # The tags file is composed of two blocks:
40 # 1. album tags
41 # 2. track tags
42 # Album tags may be:
43 # - ALBUM
44 # - ARTIST
45 # - DATE
46 # - DISCNUMBER (optional)
47
48 # Track tags may be any of the rest of the tags listed above, suffixed with
49 # [N] where N is the track number. ARTIST, and only ARTIST, may also appear
50 # in the track tags. In this case, it overrides the album artist. In order
51 # to add artists, the album artist must be listed again. For example, Reba
52 # McEntire's "The Heart Won't Lie" on the album "It's Your Call" features
53 # Vince Gill, and is specified as:
54 # ARTIST=Reba McEntire
55 # ALBUM=It's Your Call
56 # TITLE[5]=The Heart Won't Lie
57 # ARTIST[5]=Reba McEntire
58 # ARTIST[5]=Vince Gill
59
60 # TODO
61 # - sub filename in (fa-encode, fa-mp3cd, and flac2mp3) TESTED
62 # - use PART, PARTNUMBER, VERSION in those filenames
63 # - replace tags.pl with fa-tags which the others still import but which is a tool
64 # - perltidy
65 # - -bt=2 Strictest brace tightness
66 # - -pt=2 Strictest paren tightness
67 # - -nvc No vertical code alignment
68 # - -se errors to stderr... how is this not the default?
69
70 use v5.12;
71 use warnings;
72
73 use Exporter 'import';
74
75 our @EXPORT_OK = qw[
76 read_tags
77 read_tags_metaflac
78 disc_tags
79 track_tags
80 track_tags_from_disc
81
82 mangle_for_file_name
83 quote
84 two_digits
85 ];
86
87 sub two_digits {
88 my $n = shift;
89 my $s = sprintf('%02d', $n);
90 if (length($s) != 2) {
91 die("$n won't fit into two digits")
92 }
93 $s
94 }
95
96 sub read_tags {
97 my $fh = shift;
98 my %album;
99 my @tracks;
100 my $tracknum = 0;
101 my $name;
102 while (<$fh>) {
103 chomp;
104 if (!s/^([^=[\]]+)(\[(\d+)])?=//) {
105 if (defined($name) && $name eq 'DESCRIPTION') {
106 # Qobuz offers FLAC files like this.
107 warn("looks like DESCRIPTION had multiple lines; discarding and returning early: $_");
108 last
109 }
110 die("no field name in: $_");
111 }
112 $name = $1;
113 # TODO validate $name
114 # TODO album tags should be illegal after track tags
115 if (defined($3)) {
116 if ($3 == $tracknum + 2) {
117 $tracknum++;
118 } elsif ($3 != $tracknum + 1) {
119 $tracknum++; # increment from 0 to 1 for error message
120 die("illegal track number jump from $tracknum to $3")
121 }
122 push(@{$tracks[$tracknum]->{$name}}, $_);
123 } else {
124 push(@{$album{$name}}, $_);
125 }
126 }
127
128 \%album, \@tracks
129 }
130
131 sub read_tags_metaflac {
132 my $fn = shift;
133 open(my $fh, '-|', 'metaflac', '--no-utf8-convert', '--export-tags-to=-', $fn) || die("metaflac: $!");
134 my @result = read_tags($fh);
135 if (!close($fh)) {
136 if ($! == 0) {
137 die("metaflac exited $?")
138 }
139 die("close(metaflac): $!")
140 }
141 @result
142 }
143
144 sub one_or_undef {
145 my $name = shift;
146 my $tags = shift;
147 my $tag = $tags->{$name};
148 if (defined($tag) && @$tag > 0) {
149 return $tag->[0]
150 }
151 undef
152 }
153
154 sub one {
155 my $tag = one_or_undef(@_);
156 if (!defined($tag)) {
157 my $name = shift;
158 die("exactly one $name tag required")
159 }
160 $tag
161 }
162
163 =over
164
165 =item B<disc_tags>
166
167 Interpret the tags hash for a disc, returning:
168
169 =over
170
171 =item *
172 Artist tag (exactly one required in the hash).
173
174 =item *
175 Album tag (exactly one required).
176
177 =item *
178 Date tag (zero or one required).
179
180 =item *
181 Disc number (zero or one required) as a reference to an array of size 0 or 1.
182
183 =back
184 =cut
185 sub disc_tags {
186 my %tags = @_;
187
188 if (!defined($tags{ALBUM}) || @{$tags{ALBUM}} != 1) {
189 die('exactly one ALBUM tag required')
190 }
191 my $album_tag = $tags{ALBUM}->[0];
192
193 # TODO ALBUMARTIST
194 if (!defined($tags{ARTIST}) || @{$tags{ARTIST}} != 1) {
195 die('exactly one ARTIST tag required')
196 }
197 my $artist = $tags{ARTIST}->[0];
198
199 my $date;
200 if (defined($tags{DATE})) {
201 if (@{$tags{DATE}} != 1) {
202 die('one or zero DATE tags required')
203 }
204 $date = $tags{DATE}->[0];
205 }
206
207 my $version;
208 if (defined($tags{VERSION})) {
209 if (@{$tags{VERSION}} != 1) {
210 die('one or zero VERSION tags required')
211 }
212 $version = $tags{VERSION}->[0];
213 }
214
215 my @discnumber = ();
216 if (defined($tags{DISCNUMBER})) {
217 if (@{$tags{DISCNUMBER}} != 1) {
218 die('one or zero DISCNUMBER tags required')
219 }
220 my ($discnum) = @{$tags{DISCNUMBER}};
221 @discnumber = ($discnum);
222 # But check it against DISCTOTAL if present.
223 my $total = $tags{DISCTOTAL};
224 if (defined($total) && @$total > 0) {
225 my ($total) = @$total;
226 if ($total < $discnum) {
227 die("DISCNUMBER=$discnum > DISCTOTAL=$total")
228 }
229 if ($total == 1) {
230 # Qobuz offers FLAC files like this.
231 @discnumber = ();
232 }
233 }
234 }
235
236 $artist, $album_tag, $date, \@discnumber, $version
237 }
238
239 # TODO dedup with flac2mp3
240 sub track_tags {
241 my $tags = shift;
242 # TODO probably ought to return hash too. then track_tags would augment
243 my ($artist, $album, $date, $discnumber, $version) = disc_tags(%$tags);
244
245 # TODO resurrect whole-disc FLAC?
246 # Stupid hack: only a single-track file should have the
247 # TRACKNUMBER tag, so use it if set for the first pass through
248 # the loop. At the end of the loop, we'll set $track for the
249 # next run, so this continues to work for multi-track files.
250 # if track == None:
251 # track = 1
252 # else:
253 # track = int(track)
254
255 my $tracknumber = epg::flac::archive::tags::one(TRACKNUMBER => $tags);
256 my $title = epg::flac::archive::tags::one(TITLE => $tags);
257 # TODO restore PARTNUMBER and VERSION next time i need them
258
259 (
260 artist => $artist,
261 album => $album,
262 date => $date,
263 discnumber => $discnumber,
264 tracknumber => $tracknumber,
265 title => $title,
266 version => $version,
267 )
268 }
269
270 # TODO confusing relationship with track_tags which is wrong
271 sub track_tags_from_disc {
272 my ($album, $tracks, $tracknumber) = @_;
273 my $trackcount = @$tracks;
274 if ($trackcount < $tracknumber) {
275 die("requested track $tracknumber out of $trackcount tracks");
276 }
277 # Listing the track tags second makes them override the album tags.
278 %$album, %{$tracks->[$tracknumber - 1]}
279 }
280
281 sub mangle_for_file_name {
282 my $fn = shift;
283 $fn =~ s/[!,.?]//g; # discard these punctuation marks
284 $fn =~ s/\s+/_/g; # replace all whitespace with _
285 $fn =~ s/[^A-Za-z0-9_]/-/g; # everything else with -
286 $fn =~ s/_[_-]/_/g; # collapse repeated _ or - to _
287 $fn =~ s/-[_-]/_/g; # more
288 $fn =~ s/^[_-]+//; # discard any _ or - at beginning
289 $fn =~ s/[_-]+$//; # at end too
290 $fn =~ s/_[_-]/_/g; # XXX repeated collapse?! test and fix...
291 $fn
292 }
293
294 sub quote {
295 my $s = shift;
296 $s =~ s/'/'\\''/g;
297 "'$s'"
298 }
299
300 =back
301
302 =cut
303
304 1;