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     read_tags
  10     mangle_for_file_name
  11     quote
  12 ];
  13
  14 sub read_tags {
  15     my $fh = shift;
  16     my %album;
  17     my @tracks;
  18     my $tracknum = 0;
  19     while (<$fh>) {
  20         chomp;
  21         s/^([^=[\]]+)(\[(\d+)])?=// || die("no field name in $_");
  22         my $name = $1;
  23         # TODO validate $name
  24         # TODO album tags should be illegal after track tags
  25         if (defined($3)) {
  26             if ($3 == $tracknum + 2) {
  27                 $tracknum++;
  28             } elsif ($3 != $tracknum + 1) {
  29                 $tracknum++;    # increment from 0 to 1 for error message
  30                 die("illegal track number jump from $tracknum to $3")
  31             }
  32             push(@{$tracks[$tracknum]->{$name}}, $_);
  33         } else {
  34             push(@{$album{$name}}, $_);
  35         }
  36     }
  37
  38     \%album, \@tracks
  39 }
  40
  41 sub mangle_for_file_name {
  42     my $fn = shift;
  43     $fn =~ s/[!,.?]//g;          # discard these punctuation marks
  44     $fn =~ s/\s+/_/g;            # replace all whitespace with _
  45     $fn =~ s/[^A-Za-z0-9_]/-/g;  # everything else with -
  46     $fn =~ s/_[_-]/_/g;          # collapse repeated _ or - to _
  47     $fn =~ s/-[_-]/_/g;          # more
  48     $fn =~ s/^[_-]+//;           # discard any _ or - at beginning
  49     $fn =~ s/[_-]+$//;           # at end too
  50     $fn
  51 }
  52
  53 sub quote {
  54     my $s = shift;
  55     $s =~ s/'/'\\''/g;
  56     "'$s'"
  57 }
  58
  59 1;