diplodocus.org Git - flac-archive/blob - tags.pl

   1 package epg::flac::archive::tags;
   2
   3 use v5.12;
   4 use warnings;
   5
   6 use Exporter 'import';
   7
   8 our @EXPORT_OK = qw[
   9     disc_tags
  10     read_tags
  11     mangle_for_file_name
  12     quote
  13 ];
  14
  15 sub read_tags {
  16     my $fh = shift;
  17     my %album;
  18     my @tracks;
  19     my $tracknum = 0;
  20     while (<$fh>) {
  21         chomp;
  22         s/^([^=[\]]+)(\[(\d+)])?=// || die("no field name in $_");
  23         my $name = $1;
  24         # TODO validate $name
  25         # TODO album tags should be illegal after track tags
  26         if (defined($3)) {
  27             if ($3 == $tracknum + 2) {
  28                 $tracknum++;
  29             } elsif ($3 != $tracknum + 1) {
  30                 $tracknum++;    # increment from 0 to 1 for error message
  31                 die("illegal track number jump from $tracknum to $3")
  32             }
  33             push(@{$tracks[$tracknum]->{$name}}, $_);
  34         } else {
  35             push(@{$album{$name}}, $_);
  36         }
  37     }
  38
  39     \%album, \@tracks
  40 }
  41
  42 sub one_or_undef {
  43     my $name = shift;
  44     my $tags = shift;
  45     my $tag = $tags->{$name};
  46     if (defined($tag) && @$tag > 0) {
  47         return $tag->[0]
  48     }
  49     undef
  50 }
  51
  52 sub one {
  53     my $tag = one_or_undef(@_);
  54     if (!defined($tag)) {
  55         my $name = shift;
  56         die("exactly one $name tag required")
  57     }
  58     $tag
  59 }
  60
  61 sub disc_tags {
  62     my $album = shift;
  63
  64     if (!defined($album->{ALBUM}) || @{$album->{ALBUM}} != 1) {
  65         die('exactly one ALBUM tag required')
  66     }
  67     my $album_tag = $album->{ALBUM}->[0];
  68
  69     # TODO ALBUMARTIST
  70     if (!defined($album->{ARTIST}) || @{$album->{ARTIST}} != 1) {
  71         die('exactly one ARTIST tag required')
  72     }
  73     my $artist = $album->{ARTIST}->[0];
  74
  75     my $date;
  76     if (defined($album->{DATE})) {
  77         if (@{$album->{DATE}} != 1) {
  78             die('one or zero DATE tags required')
  79         }
  80         $date = $album->{DATE}->[0];
  81     }
  82
  83     my @discnumber = ();
  84     if (defined($album->{DISCNUMBER})) {
  85         if (@{$album->{DISCNUMBER}} != 1) {
  86             die('one or zero DISCNUMBER tags required')
  87         }
  88         @discnumber = ($album->{DISCNUMBER}->[0]);
  89     }
  90
  91     $album_tag, $artist, $date, \@discnumber
  92 }
  93
  94 sub mangle_for_file_name {
  95     my $fn = shift;
  96     $fn =~ s/[!,.?]//g;          # discard these punctuation marks
  97     $fn =~ s/\s+/_/g;            # replace all whitespace with _
  98     $fn =~ s/[^A-Za-z0-9_]/-/g;  # everything else with -
  99     $fn =~ s/_[_-]/_/g;          # collapse repeated _ or - to _
 100     $fn =~ s/-[_-]/_/g;          # more
 101     $fn =~ s/^[_-]+//;           # discard any _ or - at beginning
 102     $fn =~ s/[_-]+$//;           # at end too
 103     $fn
 104 }
 105
 106 sub quote {
 107     my $s = shift;
 108     $s =~ s/'/'\\''/g;
 109     "'$s'"
 110 }
 111
 112 1;