#!/usr/bin/perl -w
# Copyright © 2007-2013 Jamie Zawinski <jwz@dnalounge.com>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Created: 20-Oct-2007.

require 5;
use diagnostics;
use strict;

use MP3::Tag;

use open ":encoding(utf8)";

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.15 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 1;
my $debug_p = 0;
my $normalize_p = 1;

my $datadir1 = "$ENV{HOME}/Music/Mixtapes/128";
my $datadir2 = "$ENV{HOME}/Music/Mixtapes/full";

sub safe_system(@) {
  my (@cmd) = @_;

  print STDOUT "$progname: executing " . join(' ', @cmd) . "\n"
    if ($verbose > 3);

  system @cmd;
  my $exit_value  = $? >> 8;
  my $signal_num  = $? & 127;
  my $dumped_core = $? & 128;
  error ("$cmd[0]: core dumped!") if ($dumped_core);
  error ("$cmd[0]: signal $signal_num!") if ($signal_num);
  error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
}


sub playlist_contents($) {
  my ($name) = @_;
  my @script = ('tell application "iTunes"',
                ' set TS to every file track of playlist "' . $name . '"',
                ' set output to ""',
                ' repeat with T in TS',
                '  set L to the location of T',
                '  set output to output & ' .
                '   (the artist of T) & "\t" & ' .
                '   (the album of T) & "\t" & ' .
                '   (the year of T) & "\t" & ' .
                '   (the name of T) & "\t" & ' .
                '   (the time of T) & "\t" & ' .
                '   (the POSIX path of L) & "\n"',
                ' end repeat',
                'end tell');
  my $cmd = "osascript -e '" . join ("' -e '", @script) . "'";
  print STDERR "$progname: talking to iTunes...\n" if ($verbose);
  my $lines = `$cmd`;
  error ("playlist \"$name\" is empty") unless ($lines =~ m/^.{40}/);
  return split (/\n/, $lines);
}

sub mixtape_install($$$) {
  my ($playlist_name, $twop, $video_id) = @_;

  $video_id =~ s/^PL//s;  # WTF. Nice.

  my $dir_name0 = $playlist_name;
  $dir_name0 =~ s/ .*$//s
;
  $dir_name0 =~ s/^mixtape\s*//si;
  $dir_name0 =~ s/\s+/_/gsi;
  $dir_name0 = lc($dir_name0);
  my $dir_name1 = "$datadir1/$dir_name0";
  my $dir_name2 = "$datadir2/$dir_name0";

  error ("$datadir1/ does not exist") unless (-d $datadir1 || !$twop);
  error ("$datadir2/ does not exist") unless (-d $datadir2);
  error ("$dir_name1/ already exists") if (-e $dir_name1   && !$twop);
  error ("$dir_name2/ already exists") if (-e $dir_name2 && !$debug_p);

  my @src_files = playlist_contents ($playlist_name);

  if (! -d $dir_name1 && !$twop) {
    mkdir $dir_name1 || error ("mkdir $dir_name1: $!") unless $debug_p;
    print STDERR "$progname: creating $dir_name1/...\n" if ($verbose);
  }
  if (! -d $dir_name2) {
    mkdir $dir_name2 || error ("mkdir $dir_name2: $!") unless $debug_p;
    print STDERR "$progname: creating $dir_name2/...\n" if ($verbose);
  }

  my @dest_files1 = ();
  my @dest_files2 = ();
  my $i = 1;

  my @artist;
  my @name;
  my @year;
  foreach (@src_files) {
    my ($artist, $album, $year, $name, $time, $from) = split (/\t/, $_);
    $artist[$i] = $artist;
    $name[$i] = $name;
    $year[$i] = $year;
    my ($suffix) = ($from =~ m@(\.[a-z\d]+)$@s);

    error ("$playlist_name contains videos, but no video id specified")
      if ($suffix ne '.mp3' && !$video_id);

    # mid-truncate artist and name to N*2 characters

    my $n = 20;
    my ($artist2, $name2) = ($artist, $name);
    $artist2 =~ s/^(.{$n}).{4}.*(.{$n})$/$1...$2/s;
    $name2 =~ s/^(.{$n}).{4}.*(.{$n})$/$1...$2/s;

    my $to = sprintf ("%02d %s -- %s (%s)", $i, $artist2, $name2, $year);

    $to =~ s@/@|@gsi;   # characters that can't appear in file names
    $to =~ s@:@;@gsi;
    $to =~ s@\000@@gsi;

    $to .= $suffix;

    my $dest1 = "$dir_name1/$to";
    my $dest2 = "$dir_name2/$to";
    push @dest_files1, $dest1 if (! $twop);
    push @dest_files2, $dest2;

    if ($twop) {
    } elsif (-f $dest1) {
      print STDERR "$progname: $dest1 exists";
    } elsif ($video_id) {
    } elsif ($debug_p) {
      print STDERR "$progname: DEBUG: cp -p $from $dest1\n";
    } else {
      safe_system ("cp", "-p", $from, $dest1);
    }

    if (-f $dest2) {
      print STDERR "$progname: $dest2 exists";
    } elsif ($debug_p) {
      if ($video_id) {
        print STDERR "$progname: DEBUG: ln -s $from $dest2\n";
      } else {
        print STDERR "$progname: DEBUG: cp -p $from $dest2\n";
      }
    } else {
      if ($video_id) {
        safe_system ("ln", "-sf", $from, $dest2);
      } else {
        safe_system ("cp", "-p", $from, $dest2);
      }
    }
    $i++;
  }


  if ($video_id) {
    my $names = '';
    foreach (@dest_files2) {
      s@^.*/@@s;
      s@\.[a-z\d]+$@@s;
      $names .= "$_\n";
    }

    my $ofile = "$dir_name1/$video_id.txt";
    if ($debug_p) {
      print STDERR "$ofile: DEBUG: not writing $ofile\n";
    } else {
      open (my $out, '>', $ofile) || error ("$ofile: $!");
      print $out $names;
      close $out;
    }

    return;				##############
  }


  if ($twop) {

  } elsif ($normalize_p) {   # Cvt MP3s to WAVs, run "normalize" on those.
    #
    # Create all the WAVs..
    #
    my @wavs = ();
    foreach my $file (@dest_files1) {
      my $wav = $file;
      $wav =~ s/\.mp3$/.wav/si;
      unlink $wav;

      push @wavs, $wav;
      my @cmd = ("lame", "--quiet", "--decode", 
                 $file, $wav);
      if ($verbose) {
        my $s = $file;
        $s =~ s@^.*/@@;
        print STDERR "$progname: converting \"$s\"...\n";
      }
      $ENV{TERM} = 'dumb';  # LAME being lame
      if ($debug_p) {
        print STDERR "$progname: DEBUG: " . join (" ", @cmd) . "\n";
      } else {
        safe_system (@cmd);
        error ("lame failed") unless (-f $file);
      }
    }

    # Normalize the WAV files...
    #
    my @cmd = ("normalize", "--no-progress", "--mix", @wavs);
    print STDERR "$progname: normalizing...\n" if ($verbose);
    if ($debug_p) {
      print STDERR "$progname: DEBUG: " . join (" ", @cmd) . "\n";
    } else {
      safe_system (@cmd);
    }

    # Convert the normalized WAVs back to MP3s...
    #
    foreach my $file (@dest_files1) {
      my $wav = $file;
      $wav =~ s/\.mp3$/.wav/si;

      my @cmd = ("lame", "--quiet",
                 "--noreplaygain", "-t",
                 "--preset", "cbr", "128",
                 "--resample", "44.1",       # no-op unless src was <= 64kbps
                 $wav, $file);

      if ($verbose) {
        my $s = $file;
        $s =~ s@^.*/@@;
        print STDERR "$progname: encoding \"$s\"...\n";
      }
      $ENV{TERM} = 'dumb';  # LAME being lame
      if ($debug_p) {
        print STDERR "$progname: DEBUG: " . join (" ", @cmd) . "\n";
      } else {
        unlink $file;
        safe_system (@cmd);
        unlink $wav;
        error ("lame failed") unless (-f $file);
      }
    }

  } else {    # ! $normalize_p
    #
    # Create the 128kbps files in a single pass
    #
    foreach my $file (@dest_files1) {
      my $tmp = "$dir_name1/.tmp-" . sprintf ("%08x", rand(0xFFFFFFFF));
      unlink $tmp;
      my @cmd = ("lame", "--quiet", "--mp3input",
                 "--noreplaygain", "-t",
                 "--preset", "cbr", "128",
                 $file, $tmp);
      if ($verbose) {
        my $s = $file;
        $s =~ s@^.*/@@;
        print STDERR "$progname: converting \"$s\"...\n";
      }
      $ENV{TERM} = 'dumb';  # LAME being lame
      if ($debug_p) {
        print STDERR "$progname: DEBUG: " . join (" ", @cmd) . "\n";
      } else {
        safe_system (@cmd);
        error ("lame failed") unless (-f $tmp);
        unlink $file;
        safe_system ("mv", $tmp, $file);
        unlink $tmp;
      }
    }
  }

  # Create the high bitrate, fully tagged files
  #
  my $total = $i-1;
  $i = 1;

  my $png_file = "$ENV{HOME}/dna/webcast/mixtape.png";

  my $png_data = `cat $png_file`;

  my $alb = $playlist_name;
  $alb =~ s/ .*$//s;
  $alb = "jwz mixtape $alb";

  foreach my $file (@dest_files2) {

    my $mp3 = MP3::Tag->new($file);
    next if ($debug_p && !$mp3);
    $mp3->get_tags();
    my $id3v1 = $mp3->{ID3v1} if exists $mp3->{ID3v1};
    my $id3v2 = $mp3->{ID3v2} if exists $mp3->{ID3v2};

    $id3v1->remove_tag() if $id3v1;

    # Delete the existing frames that we don't (explicitly) want.
    #
    my %allowed_frames = (
      'RVAD' => 1, # Relative volume adjustment
      'TBPM' => 1, # Beats per minute
      'TCOM' => 1, # Composer
      'TIT2' => 1, # Title/songname/content description ("Name" in iTunes)
      'TKEY' => 1, # Initial key
      'TLEN' => 1, # Length (milliseconds)
      'TPE1' => 1, # Lead performers/Soloists ("Artist" in iTunes)
      'TSRC' => 1, # ISRC (international standard recording code)
      'TYER' => 1, # Year
      'USLT' => 1, # Unsychronized lyric/text transcription
      );

    foreach my $frame (keys %{$id3v2->get_frame_ids()}) {
      my $frame2 = $frame;
      $frame2 =~ s/^(.+)\d\d$/$1/s;
      if ($allowed_frames{$frame2}) {
        print STDERR "$progname: $file: keeping $frame\n" if ($verbose > 2);
      } else {
        print STDERR "$progname: $file: deleting $frame\n" if ($verbose > 1);
        $id3v2->remove_frame($frame);
      }
    }

    $id3v2->add_frame("TALB", $alb) ||
      error ("$file: add frame TALB failed");

    $id3v2->add_frame("TCMP", 1) || 
      error ("$file: add frame TCMP failed");

    $id3v2->add_frame("TRCK", "$i/$total") ||
      error ("$file: add frame TRCK failed");

    $id3v2->add_frame("APIC", 0, "image/png", "\000", "", $png_data) ||
      error ("$file: add frame APIC failed");

    if ($debug_p) {
      print STDERR "$file: DEBUG: not writing tag\n";
    } else {
      $id3v2->write_tag() || error ("$file: error writing tag");
    }

    $i++;
  }

}


sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage() {
  print STDERR "usage: $progname [--verbose] [--debug] [-2] [--video ID] mixtape-name\n";
  exit 1;
}

sub main() {
  my $name;
  my $twop = 0;
  my $video_id = undef;
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif ($_ eq "--debug") { $debug_p++; }
    elsif ($_ eq '-2') { $twop++; }
    elsif ($_ eq "--video") { $video_id = shift(@ARGV);
                              usage unless $video_id; }
    elsif (m/^-./) { usage; }
    elsif (!defined($name)) { $name = $_; }
    else { usage; }
  }

  usage unless defined($name);
  mixtape_install ($name, $twop, $video_id);
}

main();
exit 0;