Cultured Perl: Fun with MP3 and Perl, Part 1

# {{{ contains_word_char: return 1 if the text contains a word character
sub contains_word_char
{
 my $text = shift @_;
 return $text && length $text && $text =~ m/\w/;
}
# }}}

# {{{ get_tag: get a ID3 V2 tag, using V1 if necessary
sub get_tag
{
 my $file    = shift @_;
 my $upgrade = shift @_;
 my $mp3 = MP3::Tag->new($file);

 return undef unless defined $mp3;

 $mp3->get_tags();

 my $tag = {};

 if (exists $mp3->{ID3v2})
 {
  my $id3v2 = $mp3->{ID3v2};
  my $frames = $id3v2->supported_frames();
  while (my ($fname, $longname) = each %$frames)
  {
   # only grab the frames we know
   next unless exists $supported_frames{$fname};

   $tag->{$fname} = $id3v2->get_frame($fname);
   delete $tag->{$fname} unless defined $tag->{$fname};
   $tag->{$fname} = $tag->{$fname}->{Text} if $fname eq 'COMM';
   $tag->{$fname} = $tag->{$fname}->{URL} if $fname eq 'WXXX';
   $tag->{$fname} = '' unless defined $tag->{$fname};
  }
 }
 elsif (exists $mp3->{ID3v1})
 {
  warn "No ID3 v2 TAG info in $file, using the v1 tag";
  my $id3v1 = $mp3->{ID3v1};
  $tag->{COMM} = $id3v1->comment();
  $tag->{TIT2} = $id3v1->song();
  $tag->{TPE1} = $id3v1->artist();
  $tag->{TALB} = $id3v1->album();
  $tag->{TYER} = $id3v1->year();
  $tag->{TRCK} = $id3v1->track();
  $tag->{TIT1} = $id3v1->genre();

  if ($upgrade && read_yes_no("Upgrade ID3v1 tag to ID3v2 for $file?", 1))
  {
   set_tag($file, $tag);
  }
 }
 else
 {
  warn "No ID3 TAG info in $file, creating it";
  $tag = {
      TIT2 => '',
      TPE1 => '',
      TALB => '',
      TYER => 9999,
      COMM => '',
      };
 }
 print "Got tag ", Dumper $tag
  if $config->DEBUG();
 return $tag;
}
# }}}

use constant SEARCH_ALL   => 'all';

my %freedb_searches = (
   artist  => { keywords => [], abbrev => 'I', tagequiv => 'TPE1' },
   title   => { keywords => [], abbrev => 'T', tagequiv => 'TALB' },
   track   => { keywords => [], abbrev => 'K', tagequiv => 'TIT2' },
   rest    => { keywords => [], abbrev => 'R', tagequiv => 'COMM' },
      );

# maps ID3 v2 tag info to WebService::FreeDB info
my %info2freedb = (
   TALB  => 'cdname',
   TPE1  => 'artist',
      );

my %supported_frames = (
   TIT1 => 1,
   TIT2 => 1,
   TRCK => 1,
   TALB => 1,
   TPE1 => 1,
   COMM => 1,
   WXXX => 1,
   TYER => 1,
      );

my @supported_frames = keys %supported_frames;

my $term = new Term::ReadLine 'Input> '; # global input

# {{{ set up AppConfig and process -help

my $config = AppConfig->new();

$config->define(
   DEBUG       =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 0, ALIAS => 'D' },

   CONFIG_FILE       =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 0, ALIAS => 'F' },

   HELP        =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'H' },

   DUMP        =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0 },

   ACCEPT_ALL  =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'C' },

   DRYRUN      =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'N' },

   GUESS_TRACK_NUMBERS_ONLY  =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'G' },

    STRIP_COMMENT_ONLY =>
    { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'SC' },

   MASS_TAG_ONLY =>
   { ARGCOUNT => ARGCOUNT_HASH, ALIAS => 'M' },

   RENAME_ONLY =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'RO' },

   RENAME_MAX_CHARS =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 30},

   RENAME_FORMAT =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => '%a-%t-%n-%c-%s.mp3'},

   RENAME_BADCHARS =>
   { ARGCOUNT => ARGCOUNT_LIST, ALIAS => 'RB' },

   RENAME_REPLACECHARS =>
   { ARGCOUNT => ARGCOUNT_LIST, ALIAS => 'RR' },

   RENAME_REPLACEMENT =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => '_' },

   FREEDB_HOST =>
   { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 'http://www.freedb.org', },

   OR =>
   { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => '0', },

   SEARCH_ALL()  =>
   { ARGCOUNT => ARGCOUNT_LIST, ALIAS => 'A' },
      );

foreach my $search (keys %freedb_searches)
{
 $config->define($search => {
      ARGCOUNT => ARGCOUNT_LIST,
      ALIAS => $freedb_searches{$search}->{abbrev},
      });
}
$config->args();

$config->file($config->CONFIG_FILE())
 if $config->CONFIG_FILE();

unless (scalar @{$config->RENAME_BADCHARS()})
{
 push @{$config->RENAME_BADCHARS()}, split(//, "\"`!'?&[]()/;\n\t");
}

unless (scalar @{$config->RENAME_REPLACECHARS()})
{
 push @{$config->RENAME_REPLACECHARS()}, split(//, " ");
}

if ($config->HELP())
{
 print <<EOHIPPUS;
$0 [options] File1.mp3 File2.mp3 ...

Options:
 -help (-h)          : print this help
 -config_file (-f) N : use this config file, see AppConfig module docs for format
 -debug (-d) N       : print debugging information (level N, 0 is lowest)
 -dump               : just dump the list of albums and tracks within them
 -dryrun (-n)        : do everything but modify the MP3 files
 -freedb_host H      : set the FreeDB host, default "www.freedb.org"
 -or                 : search for keyword A or keyword B, not A and B as usual

 -accept_all (c)     : accept all search results for consideration for each file,
                       also accept all renames without asking

 -rename_badchars (-rb) A -rb B     : characters A and B to remove when renaming

 -rename_replacechars (-rr) A -rr B : characters A and B to replace
                                      when renaming

 -rename_maxchars N : use at most this many characters from a tag
                      element when renaming, default: ${\$config->RENAME_MAX_CHARS()}

 -rename_replacement X : character to use when replacing,
                      default: [${\$config->RENAME_REPLACEMENT()}]

 -rename_format (-f) F : format for renaming; default "${\$config->RENAME_FORMAT()}"
                         %a -> Artist
                         %t -> Track number
                         %n -> Album name
                         %c -> Comment
                         %s -> Song title

 -guess_track_numbers_only (-g) : guess track numbers using the file
                     name, then exit

 -rename_only (-ro)  : rename tracks using the given format (see
                       -rename_format), then exit

 -mass_tag_only (-m) A=X -m B=Y : mass-tag files (tag element A is X,
                                  B is Y), then exit (tag elements
                                  available: @supported_frames)

 -strip_comment_only (-sc) : strip comments and URLs, then exit

Repeatable options (you can specify them more than once, K is the keyword):

 -all (-a)    K : search everywhere
 -artist (-i) K : search for these artists
 -title (-t)  K : search for these titles
 -track (-k)  K : search for these tracks
 -rest (-r)   K : search for these keywords everywhere else

Note that the repeatable options are cumulative, so artist A and title
B will produce matches for A and B, not A or B. In the same way,
artist A and artist B will produce matches for A and B, not A or B.
If you want to match A or B terms, use -or, for instance:

$0 -or -artist "pink floyd" -artist "fred flintstone"

EOHIPPUS

 exit;
}

# }}}

# {{{ get_tag: get a ID3 V2 tag, using V1 if necessary
sub get_tag
{
 my $file    = shift @_;
 my $upgrade = shift @_;
 my $mp3 = MP3::Tag->new($file);

 return undef unless defined $mp3;

 $mp3->get_tags();

 my $tag = {};

 if (exists $mp3->{ID3v2})
 {
  my $id3v2 = $mp3->{ID3v2};
  my $frames = $id3v2->supported_frames();
  while (my ($fname, $longname) = each %$frames)
  {
   # only grab the frames we know
   next unless exists $supported_frames{$fname};

   $tag->{$fname} = $id3v2->get_frame($fname);
   delete $tag->{$fname} unless defined $tag->{$fname};
   $tag->{$fname} = $tag->{$fname}->{Text} if $fname eq 'COMM';
   $tag->{$fname} = $tag->{$fname}->{URL} if $fname eq 'WXXX';
   $tag->{$fname} = '' unless defined $tag->{$fname};
  }
 }
 elsif (exists $mp3->{ID3v1})
 {
  warn "No ID3 v2 TAG info in $file, using the v1 tag";
  my $id3v1 = $mp3->{ID3v1};
  $tag->{COMM} = $id3v1->comment();
  $tag->{TIT2} = $id3v1->song();
  $tag->{TPE1} = $id3v1->artist();
  $tag->{TALB} = $id3v1->album();
  $tag->{TYER} = $id3v1->year();
  $tag->{TRCK} = $id3v1->track();
  $tag->{TIT1} = $id3v1->genre();

  if ($upgrade && read_yes_no("Upgrade ID3v1 tag to ID3v2 for $file?", 1))
  {
   set_tag($file, $tag);
  }
 }
 else
 {
  warn "No ID3 TAG info in $file, creating it";
  $tag = {
      TIT2 => '',
      TPE1 => '',
      TALB => '',
      TYER => 9999,
      COMM => '',
      };
 }
 print "Got tag ", Dumper $tag
  if $config->DEBUG();
 return $tag;
}
# }}}

# {{{ set_tag: set a ID3 V2 tag on a file
sub set_tag
{
 my $file = shift @_;
 my $tag  = shift @_;
 my $mp3 = MP3::Tag->new($file);
 print Dumper $tag;
 my $tags = $mp3->get_tags();
 my $id3v2;

 if (ref $tags eq 'HASH' && exists $tags->{ID3v2})
 {
  $id3v2 = $tags->{ID3v2};
 }
 else
 {
  $id3v2 = $mp3->new_tag("ID3v2");
 }

 my %old_frames = %{$id3v2->get_frame_ids()};

 foreach my $fname (keys %$tag)
 {
  $id3v2->remove_frame($fname)
   if exists $old_frames{$fname};

  if ($fname eq 'WXXX')
  {
   $id3v2->add_frame('WXXX', 'ENG', 'FreeDB URL', $tag->{WXXX}) ;
  }
  elsif ($fname eq 'COMM')
  {
   $id3v2->add_frame('COMM', 'ENG', 'Comment', $tag->{COMM}) ;
  }
  else
  {
   $id3v2->add_frame($fname, $tag->{$fname});
  }
 }

 $id3v2->write_tag();
 return 0;
}
# }}}

# {{{ print_tag_info: print the tag info

sub print_tag_info
{
 my $filename = shift @_;
 my $tag      = shift @_;
 my $extra    = shift @_ || 'Track info';

 # argument checking
 return unless ref $tag eq 'HASH';

 print "$extra for '$filename':\n";

 foreach (keys %$tag)
 {
  printf "%10s : %s\n", $_, $tag->{$_};
 }
}

# }}}

# {{{ guess_track_number: guess track number from ID3 tag and file name
sub guess_track_number
{
 my $filename = shift @_;
 my $tag      = shift @_ || return undef;

 $filename = basename($filename);   # directories can contain confusing data

 # first try to guess the track number from the old tag
 if (exists $tag->{TRCK} && contains_word_char($tag->{TRCK}))
 {
  my $n = $tag->{TRCK} + 0;    # fix tracks like 1/10
  return $n;
 }
 elsif ($filename =~ m/([012]?\d).*\.[^.]+$/)
                     # now look for numbers in the filename (0 through 29)
 {
  print "Guessed track number $1 from filename '$filename'\n"
   if $config->DEBUG();
  return $1;
 }

 return undef; # if all else fails, return undef
}
# }}}

# {{{ guess_artist_and_track: guess artist and track from file name
sub guess_artist_and_track
{
 my $filename = shift @_;
 my $artist;
 my $track;

 $filename = basename($filename);   # directories can contain confusing data

 if ($filename =~ m/([^-_]{3,})\s*-\s*(.{3,})\s*\.[^.]+$/)
 {
  print "Guessed artist $1 from filename '$filename'\n"
   if $config->DEBUG();
  $artist = $1;
  $track = $2;
 }

 return ($artist, $track);
}
# }}}

# {{{ make_tag_from_freedb: make the ID3 tag info from a FreeDB entry
sub make_tag_from_freedb
{
 my $disc  = shift @_;
 my $track = shift @_;

 # argument checking
 return undef unless $track =~ m/^\d+$/;

 # note that the user inputs track "1" but WebService::FreeDB gives us that
 # track at position 0, so we decrement $track
 $track--;

 return undef unless exists $disc->{trackinfo};

 return undef unless exists $disc->{trackinfo}->[$track];

 my $track_data = $disc->{trackinfo}->[$track];

 return {
      TIT1 => $disc->{genre},
      TIT2 => $track_data->[0],
      TRCK => $track+1,
      TPE1 => $disc->{artist},
      TALB => $disc->{cdname},
      TYER => $disc->{year},
      WXXX => $disc->{url},
      COMM => $disc->{rest}||'',
   };

}
# }}}

# {{{ handle the one-shot options
if ($config->GUESS_TRACK_NUMBERS_ONLY() ||
    $config->STRIP_COMMENT_ONLY() ||
    scalar keys %{$config->MASS_TAG_ONLY()})
{
 foreach my $file (@ARGV)
 {
  my $tag = get_tag($file, 1);
  unless (defined $tag)
  {
   warn "No ID3 TAG info in '$file', skipping";
   next;
  }

  next if $config->DRYRUN();

  # delegate stripping comments to the mass tagging function
  if ($config->STRIP_COMMENT_ONLY())
  {
   $config->MASS_TAG_ONLY()->{COMM} = '';
   $config->MASS_TAG_ONLY()->{WXXX} = '';
  }

  if (scalar keys %{$config->MASS_TAG_ONLY()})
  {
   foreach (keys %{$config->MASS_TAG_ONLY()})
   {
    unless (exists $supported_frames{$_})
    {
     warn "Unsupported tag element $_ requested for mass tagging, skipping";
     next;
    }
    $tag->{$_} = $config->MASS_TAG_ONLY()->{$_};
   }
   set_tag($file, $tag);
  }
  else
  {
   my $track_number_guess = guess_track_number($file, $tag);

   next if $config->DRYRUN();

   if (defined $track_number_guess &&
              read_yes_no("Is track number $track_number_guess OK for '$file'?", 1))
   {
    $tag->{TRCK} = $track_number_guess;
    set_tag ($file, $tag);
   }
   else
   {
    warn "Could not guess a track number for file $file, sorry";
   }
  }
 }

 exit 0;
}
# }}}

# {{{ handle the -rename_only option
if ($config->RENAME_ONLY())
{
 foreach my $file (@ARGV)
 {
  my $tag = get_tag($file, 1);
                 # the extra parameter will ask us about upgrading V1 to V2
  unless (defined $tag)
  {
   warn "No ID3 TAG info in '$file', skipping";
   next;
  }

  my %map = (
     '%c' => 'COMM',
     '%s' => 'TIT2',
     '%a' => 'TPE1',
     '%t' => 'TALB',
     '%n' => 'TRCK',
    );

  my $name = $config->RENAME_FORMAT();

  foreach my $key (keys %map)
  {
   my $tagkey = $map{$key};
   my $replacement = '';
   if (exists $tag->{$tagkey})
   {
    $replacement = substr $tag->{$tagkey}, 0, $config->RENAME_MAX_CHARS();
                    # limit to N characters
    if ($tagkey eq 'TRCK' && $replacement =~ m/^\d$/)
    {
     $replacement = "0$replacement";
    }
   }

   $replacement =~ s/%/{{{%}}}/g;
                    # this is how we preserve %a in the fields, for example

   $name =~ s/$key/$replacement/;
  }

  $name =~ s/{{{%}}}/%/g;   # turn the {{{%}}} back into % in the fields

  print "The name after % expansion is $name\n" if $config->DEBUG();

  foreach my $char (map { quotemeta } @{$config->RENAME_BADCHARS()})
  {
   $name =~ s/$char//g;
  }

  print "The name after character removals is $name\n" if $config->DEBUG();

  my $newchar = quotemeta $config->RENAME_REPLACEMENT();

  foreach my $char (map { quotemeta } @{$config->RENAME_REPLACECHARS()})
  {
   $name =~ s/$char/$newchar/eg;
  }

  print "The name after character replacements is $name\n" if $config->DEBUG();


  if ($name eq $file)
  {
   # do nothing
   print "Renaming $file is unnecessary, it already answers to our high standards\n"
    if $config->DEBUG();
  }
  elsif (-e $name)
  {
   warn "Could not use name $name, it's already taken by an existing
                        file or directory $file";
  }
  elsif ($config->ACCEPT_ALL() || read_yes_no("Is name $name OK for '$file'?", 1))
  {
   next if $config->DRYRUN();
   print "Renaming $file -> $name\n";
   rename($file, $name);
  }
  else
  {
   # do nothing
  }
 }

 exit 0;
}
# }}}