diplodocus.org Git - flac-archive/blob - 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     local $_;
  98     my $fh = shift;
  99     my %album;
 100     my @tracks;
 101     my $tracknum = 0;
 102     my $name;
 103     while (<$fh>) {
 104         chomp;
 105         s/^DATE\[US]=200/DATE=200/; # I have DATE[US]=2004 and DATE[US]=2007.  TODO fix them and remove hack.
 106         if (!s/^([^=[\]]+)(\[(\d+)])?=//) {
 107             if (defined($name) && $name eq 'DESCRIPTION') {
 108                 # Qobuz offers FLAC files like this.
 109                 warn("looks like DESCRIPTION had multiple lines; discarding and returning early: $_");
 110                 last
 111             }
 112             die("no field name in:  $_");
 113         }
 114         $name = uc($1);
 115         # TODO validate $name
 116         # TODO album tags should be illegal after track tags
 117         if (defined($3)) {
 118             if ($3 == $tracknum + 2) {
 119                 $tracknum++;
 120             } elsif ($3 != $tracknum + 1) {
 121                 $tracknum++;    # increment from 0 to 1 for error message
 122                 die("illegal track number jump from $tracknum to $3")
 123             }
 124             push(@{$tracks[$tracknum]->{$name}}, $_);
 125         } else {
 126             push(@{$album{$name}}, $_);
 127         }
 128     }
 129
 130     \%album, \@tracks
 131 }
 132
 133 sub read_tags_metaflac {
 134     local $@;
 135     my $fn = shift;
 136     open(my $fh, '-|', 'metaflac', '--no-utf8-convert', '--export-tags-to=-', $fn) || die("metaflac: $!");
 137     my @result = eval { read_tags($fh) };
 138     if ($@) {
 139         die("$@: $fn")
 140     }
 141     if (!close($fh)) {
 142         if ($! == 0) {
 143             die("metaflac exited $?")
 144         }
 145         die("close(metaflac): $!")
 146     }
 147     @result
 148 }
 149
 150 sub one_or_undef {
 151     my $name = shift;
 152     my $tags = shift;
 153     my $tag = $tags->{$name};
 154     if (defined($tag) && @$tag > 0) {
 155         return $tag->[0]
 156     }
 157     undef
 158 }
 159
 160 sub one {
 161     my $tag = one_or_undef(@_);
 162     if (!defined($tag)) {
 163         my $name = shift;
 164         die("exactly one $name tag required")
 165     }
 166     $tag
 167 }
 168
 169 =over
 170
 171 =item B<disc_tags>
 172
 173 Interpret the tags hash for a disc, returning:
 174
 175 =over
 176
 177 =item *
 178 Artist tag (exactly one required in the hash).
 179
 180 =item *
 181 Album tag (exactly one required).
 182
 183 =item *
 184 Date tag (zero or one required).
 185
 186 =item *
 187 Disc number (zero or one required) as a reference to an array of size 0 or 1.
 188
 189 =back
 190 =cut
 191 sub disc_tags {
 192     my %tags = @_;
 193
 194     if (!defined($tags{ALBUM}) || @{$tags{ALBUM}} == 0) {
 195         die('exactly one ALBUM tag required, found zero')
 196     }
 197     if (@{$tags{ALBUM}} != 1) {
 198         die('exactly one ALBUM tag required, found [', join("\n", @{$tags{ALBUM}}), ']')
 199     }
 200     my $album_tag = $tags{ALBUM}->[0];
 201
 202     # TODO ALBUMARTIST
 203     if (!defined($tags{ARTIST}) || @{$tags{ARTIST}} != 1) {
 204         die('exactly one ARTIST tag required')
 205     }
 206     my $artist = $tags{ARTIST}->[0];
 207
 208     my $date;
 209     if (defined($tags{DATE})) {
 210         if (@{$tags{DATE}} != 1) {
 211             die('one or zero DATE tags required')
 212         }
 213         $date = $tags{DATE}->[0];
 214     }
 215
 216     my $version;
 217     if (defined($tags{VERSION})) {
 218         if (@{$tags{VERSION}} != 1) {
 219             die('one or zero VERSION tags required')
 220         }
 221         $version = $tags{VERSION}->[0];
 222     }
 223
 224     my @discnumber = ();
 225     if (defined($tags{DISCNUMBER})) {
 226         if (@{$tags{DISCNUMBER}} != 1) {
 227             die('one or zero DISCNUMBER tags required')
 228         }
 229         my ($discnum) = @{$tags{DISCNUMBER}};
 230         @discnumber = ($discnum);
 231         # But check it against DISCTOTAL if present.
 232         my $total = $tags{DISCTOTAL};
 233         if (defined($total) && @$total > 0) {
 234             my ($total) = @$total;
 235             if ($total < $discnum) {
 236                 die("DISCNUMBER=$discnum > DISCTOTAL=$total")
 237             }
 238             if ($total == 1) {
 239                 # Qobuz offers FLAC files like this.
 240                 @discnumber = ();
 241             }
 242         }
 243     }
 244
 245     $artist, $album_tag, $date, \@discnumber, $version
 246 }
 247
 248 # TODO dedup with flac2mp3
 249 sub track_tags {
 250     my $tags = shift;
 251     # TODO probably ought to return hash too.  then track_tags would augment
 252     my ($artist, $album, $date, $discnumber, $version) = disc_tags(%$tags);
 253
 254         # TODO resurrect whole-disc FLAC?
 255         # Stupid hack: only a single-track file should have the
 256         # TRACKNUMBER tag, so use it if set for the first pass through
 257         # the loop.  At the end of the loop, we'll set $track for the
 258         # next run, so this continues to work for multi-track files.
 259                 # if track == None:
 260                 #     track = 1
 261                 # else:
 262                 #     track = int(track)
 263
 264     my $tracknumber = epg::flac::archive::tags::one(TRACKNUMBER => $tags);
 265     my $title = epg::flac::archive::tags::one(TITLE => $tags);
 266     # TODO restore PARTNUMBER and VERSION next time i need them
 267
 268     (
 269      artist => $artist,
 270      album => $album,
 271      date => $date,
 272      discnumber => $discnumber,
 273      tracknumber => $tracknumber,
 274      title => $title,
 275      version => $version,
 276     )
 277 }
 278
 279 # TODO confusing relationship with track_tags which is wrong
 280 sub track_tags_from_disc {
 281     my ($album, $tracks, $tracknumber) = @_;
 282     my $trackcount = @$tracks;
 283     if ($trackcount < $tracknumber) {
 284         die("requested track $tracknumber out of $trackcount tracks");
 285     }
 286     # Listing the track tags second makes them override the album tags.
 287     %$album, %{$tracks->[$tracknumber - 1]}
 288 }
 289
 290 sub mangle_for_file_name {
 291     my $fn = shift;
 292     $fn =~ s/[!,.?]//g;          # discard these punctuation marks
 293     $fn =~ s/\s+/_/g;            # replace all whitespace with _
 294     $fn =~ s/[^A-Za-z0-9_]/-/g;  # everything else with -
 295     $fn =~ s/_[_-]/_/g;          # collapse repeated _ or - to _
 296     $fn =~ s/-[_-]/_/g;          # more
 297     $fn =~ s/^[_-]+//;           # discard any _ or - at beginning
 298     $fn =~ s/[_-]+$//;           # at end too
 299     $fn =~ s/_[_-]/_/g;          # XXX repeated collapse?!  test and fix...
 300     $fn
 301 }
 302
 303 sub quote {
 304     my $s = shift;
 305     $s =~ s/'/'\\''/g;
 306     "'$s'"
 307 }
 308
 309 =back
 310
 311 =cut
 312
 313 1;