#!/usr/bin/perl -w
# Copyright © 2006-2008 Jamie Zawinski <jwz@jwz.org>
#
# 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: 23-May-2006.

require 5;
use diagnostics;
use strict;

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

my $verbose = 0;
my $debug_p = 0;

my $mp3dir = "$ENV{HOME}/Music/iTunes/iTunes Music";

$ENV{PATH} .= ":/opt/local/bin";

my $header_file = '/Library/WebServer/Documents/header.html';
my $html_head;
my $html_tail = "</BODY>\n</HTML>\n";


sub url_quote($) {
  my ($s) = @_;
  $s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge;
  return $s;
}

sub load_header() {
  local *IN;
  open (IN, "<$header_file") || error (500, "$header_file: $!");
  $html_head = '';
  while (<IN>) { $html_head .= $_; }
  close IN;
}


# Whether the given directory appears to contain a complete album
# (as opposed to just a few scattered MP3s).
#
my %complete_album_p_cache;
sub complete_album_p($$) {
  my ($dir, $ntrks) = @_;
  return 0 if ($dir =~ m/Unknown Album/i);
  return 0 if ($dir =~ m@/_$@i); # album name " "
  
  $_ = $complete_album_p_cache{$dir};
  return $_ if (defined ($_));

  local *DIR;
  opendir (DIR, "$mp3dir/$dir") || error ("$mp3dir/$$dir: $!");
  my @files = readdir (DIR);
  closedir DIR;

  my $count = 0;
  foreach my $file (sort (@files)) {
    next unless ($file =~ m/\.mp3$/si);
    my ($trk) = ($file =~ m/^(\d\d+) /si);

    if (! $trk) {    # saw an un-numbered mp3
      $complete_album_p_cache{$dir} = 0;
      print STDERR "$progname: incomplete album: un-numbered:\n\t $dir/$file\n"
        if ($verbose);
      return 0;
    }
    $count++;
  }

  my $exact_p = ($count == $ntrks);
  my $close_p = ($count > 4);
  my $ok = ($exact_p || $close_p);

  print STDERR "$progname: close enough album: $count/$ntrks:\n\t $dir\n"
    if (!$ok && $close_p && $verbose);

  print STDERR "$progname: incomplete album: $count/$ntrks:\n\t $dir\n"
    if (!$ok && !$close_p && $verbose);

  $complete_album_p_cache{$dir} = $ok;
  return $ok;

}


sub itunes_script($$) {
  my ($desc, $script) = @_;

  # The default timeout is apparently 60 seconds, which isn't enough time
  # to do any "...of playlist Library whose date added..." searches.
  # Which doesn't make any sense to me, since smart playlists do that
  # instantaneously.
  #
  $script = ("with timeout of (60 * 60) seconds\n" .
             $script . "\n" .
             "end timeout\n");

  my $cmd = "osascript -e '$script'";
  $cmd = "( $cmd ) 2>/dev/null" unless ($debug_p);
  my $lines;
  my $retries = 10;
  my $sleep = 10;

  my $cache = "/tmp/ir-$desc.cache";

  if ($debug_p && -f $cache) {
    $lines = `cat '$cache'`;
    print STDERR "$progname: using $cache\n", if ($verbose);
  } else {

    for (my $i = 0; $i < $retries; $i++) {
      print STDERR "$progname: talking to iTunes ($desc)...\n" if ($verbose);
      print STDERR "$progname: command:\n$cmd\n" if ($verbose > 3);
      $lines = `$cmd`;
      last if ($lines !~ m/^\s*$/);
      print STDERR "$progname: arrgh, retrying! ($desc)\n" if ($verbose);
      sleep $sleep;
      $sleep *= 2;
    }
  }

  if ($lines =~ m/^\s*$/) {
    error ("itunes unresponsive ($desc) after $retries retries");
  }
  $lines =~ s|\n\n+$|\n|s;   # lose trailing blank line

  print STDERR "$progname: itunes $desc: $lines\n" if ($verbose > 1);

  if ($debug_p) {
    local *OUT;
    open (OUT, ">$cache") || error ("$cache: $!");
    print OUT $lines;
    close OUT;
    print STDERR "$progname: wrote $cache\n", if ($verbose);
  }

  return $lines;
}


sub itunes_ping() {
  itunes_script ("ping",
                 join ("\n",
                       ('tell application "iTunes"',
                        ' set output to time of playlist "Library"',
                        'end tell')));
}


sub fmt_line($$$) {
  my ($line, $album_only_p, $composer_p) = @_;
  # FIELDS
  my ($skey, $title, $time, $size, $artist, $composer, $album, 
      $comp_p, $tnum, $ntrks, $year, $age, $path) = split (/\t/, $line);
  error ("unparsable fields: $line") unless defined($path);

  print STDERR "... $artist - " . ($album_only_p ? $album : $title) . "\n"
    if ($verbose > 2);

  return '' if ($title =~ m/^(Intro|Credits)$/);

  my $n = ($album_only_p ? 25 : 15);
  $title    =~ s/^(.{$n})....+(.{$n})$/$1...$2/s;   # mid-truncate to N chars
  $artist   =~ s/^(.{$n})....+(.{$n})$/$1...$2/s;
  $composer =~ s/^(.{$n})....+(.{$n})$/$1...$2/s;
  $album    =~ s/^(.{$n})....+(.{$n})$/$1...$2/s;

  $path = url_quote($path);
  $title = "<A HREF=\"$path\">$title</A>";

  $path =~ s@/[^/]*$@/@;
  $album = 'Unknown Album' unless $album;
  $album = "<A HREF=\"$path\">$album</A>";

  $path =~ s@/[^/]*/$@/@;
  $artist   = '?' unless $artist;
  $composer = '?' unless $composer;
  $artist = 'Various Artists' if ($comp_p eq 'true' && $album_only_p);
  $artist = "<A HREF=\"$path\">$artist</A>"
    if ($album_only_p || $comp_p ne 'true');

  if ($size > 2*1024*1024*1024) {
    $size = sprintf("%.1f GB", $size / (1024*1024*1024));
  } elsif ($size > 1024*1024) {
    $size = sprintf("%d MB", $size / (1024*1024));
  } elsif ($size > 1024) {
    $size = sprintf("%d KB",   $size / 1024);
  }

  return ("<TR>" .
          ($album_only_p
           ? ''
           : ("<TD VALIGN=TOP NOWRAP>$title</TD>" .
              "<TD VALIGN=TOP NOWRAP ALIGN=RIGHT>$time &nbsp;</TD>" .
              "<TD VALIGN=TOP NOWRAP ALIGN=RIGHT>$size &nbsp;</TD>")) .
          ($composer_p
           ? "<TD VALIGN=TOP NOWRAP>$composer &nbsp; </TD>"
           : '') .
          "<TD VALIGN=TOP NOWRAP>$artist &nbsp; </TD>" .
          "<TD VALIGN=TOP NOWRAP>$album  &nbsp; </TD>" .
          "<TD VALIGN=TOP NOWRAP>$year</TD>" .
          "</TR>\n");
}


sub itunes_list_tracks($$$) {
  my ($desc, $days, $list_expr) = @_;

  # FIELDS
  my $lines = itunes_script ($desc,
     join ("\n",
           ('tell application "iTunes"',
            ' set output to ""',
            ' set track_count to 0',
            " set theDate to (current date) - $days * days",
            ' set TS to ' . $list_expr,
            ' repeat with T in TS',
            '  set L to the location of T',
            '  if L is not missing value then',
            '    set L to the POSIX path of L',
            '  else',
            '    set L to ""',
            '  end if',
            '  set track_count to track_count + 1',
            '  set output to output & ' .
            '   (the name of T) & "\t" & ' .
            '   (the time of T) & "\t" & ' .
            '   (the size of T) & "\t" & ' .
            '   (the artist of T) & "\t" & ' .
            '   (the composer of T) & "\t" & ' .
            '   (the album of T) & "\t" & ' .
            '   (the compilation of T) & "\t" & ' .
            '   (the track number of T) & "\t" & ' .
            '   (the track count of T) & "\t" & ' .
            '   (the year of T) & "\t" & ' .
            '   (current date - the date added of T) & "\t" & ' .
            '   L & "\n"',
            ' end repeat',
            'end tell',
            'if track_count = 0 then',
            ' "zero tracks"',
            'else',
            ' output',
            'end if'
           )));

  if ($lines eq "zero tracks\n") {
    print STDERR "$progname: WARNING: no $desc tracks!\n";
    return "";
  }
  return $lines;
}


sub itunes_recent($$$) {
  my ($file, $days, $days2) = @_;
  
  my $lines = itunes_list_tracks ("recent", $days,
                                  'every file track of playlist "Library"' .
                                  '   whose date added > theDate');
  print STDERR "$progname: formatting...\n" if ($verbose);

  my $output = $html_head;
  $output =~ s@(<TITLE>[^:<>]*):?\s*[^<>]*@$1: recently added@si;
  $output =~ s@(<B>[^:<>]*):?\s*[^:<>]*@$1: recently added@si;

  my @all = split(/\n/, $lines);

  foreach (@all) {
    my @fields = split (/\t/, $_);
    # FIELDS
    my ($title, $time, $size, $artist, $composer, $album, 
        $comp_p, $tnum, $ntrks, $year, $age, $fullpath) = @fields;
    if (! $fullpath) {
      #error ("missing file for: $_");
      print STDERR "$progname: file missing: $artist - $album - $title\n";
      $_ = '';
      next;
    }

    my ($path) = ($fullpath =~ m@/([^/]+/[^/]+/[^/]+)$@);
    error ("bogus path: $_") unless defined($path);
    $fields[$#fields] = $path;

    $artist =~ s/^The //si;
    $artist = 'Various Artists' if ($comp_p eq 'true');
    my $sortkey = lc(sprintf("%s/%s/%02d/%s", $artist, $album, $tnum, $title));
    unshift @fields, $sortkey;

    $_ = join("\t", @fields);

    next if ($album =~ m@/^Podcasts$/@si);
    my ($dir) = ($path =~ m@^(.*)/[^/]*$@si);
    error ("bogus dir: $_") unless defined($dir);
  }

  @all = sort (@all);

  my @albums1 = ();
  my @albums2 = ();
  my @singles = ();
  my @videos1 = ();
  my @videos2 = ();

  foreach (@all) {
    my $line = $_;
    next unless ($line);
    # FIELDS
    my ($skey, $title, $time, $size, $artist, $composer, $album, 
        $comp_p, $tnum, $ntrks, $year, $age, $path) = split (/\t/, $_);
    error ("bogus path: $_") unless defined($path);

    next if ($album =~ m@/^Podcasts$/@);

    my $dir = $path;
    $dir =~ s@/[^/]*$@@;
    my ($ext) = ($path =~ m@\.([^./]+)$@);

    if ($ext =~ m/^(mov|mp4|mpg|mpeg|m4v)$/) {
      if ($age < ($days2 * 24 * 60 * 60)) {
        push @videos1, $line;
      } else {
        push @videos2, $line;
      }
    } elsif (! complete_album_p ($dir, $ntrks)) {
      push @singles, $line;
    } else {
      if ($age < ($days2 * 24 * 60 * 60)) {
        push @albums1, $line;
      } else {
        push @albums2, $line;
      }
    }
  }

  $output .= ("<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>\n" .
              "<TR>" .
               "<TD VALIGN=TOP COLSPAN=3>" .
                "<B>Albums added in the last $days2 days:</B><BR><BR>\n" .
               "</TD>" .
               "</TR>\n" .
               "<TR>" .
                "<TD NOWRAP><B>Artist &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Album &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Year &nbsp; </B></TD>" .
               "</TR>\n" .
               "<TR><TD COLSPAN=3><HR></TD></TR>\n");

  print STDERR "Albums 1:\n\n" if ($verbose > 2);
  my %albums;
  foreach my $line (@albums1) {
    # FIELDS
    my ($skey, $title, $time, $size, $artist, $composer, $album,
        $comp_p, $tnum, $ntrks, $year, $age, $path) = split (/\t/, $line);
    next if ($albums{$album});
    $albums{$album} = 1;
    $output .= fmt_line($line, 1, 0);
  }

  $output .= ("<TR>" .
               "<TD VALIGN=TOP COLSPAN=3>" .
                "<BR><HR>" .
                "<B>Albums added in the last $days days:</B><BR><BR>\n" .
               "</TD>" .
               "</TR>\n" .
               "<TR>" .
                "<TD NOWRAP><B>Artist &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Album &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Year &nbsp; </B></TD>" .
               "</TR>\n" .
               "<TR><TD COLSPAN=3><HR></TD></TR>\n");

  print STDERR "Albums 2:\n\n" if ($verbose > 2);
  foreach my $line (@albums2) {
    # FIELDS
    my ($skey, $title, $time, $size, $artist, $composer, $album,
        $comp_p, $tnum, $ntrks, $year, $age, $path) = split (/\t/, $line);
    next if ($albums{$album});
    $albums{$album} = 1;
    $output .= fmt_line($line, 1, 0);
  }

  $output .= ("</TABLE>\n" .
              "<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>\n" .
              "<TR>" .
                "<TD VALIGN=TOP COLSPAN=8>" .
                "<BR><HR>" .
                 "<B>Singles added in the last $days days:</B>" .
                 "<BR><BR>" .
                "</TD>" .
               "</TR>" .
               "<TR>" .
                "<TD NOWRAP><B>Title &nbsp; </B></TD>" .
                "<TD NOWRAP ALIGN=RIGHT><B>Time &nbsp; </B></TD>" .
                "<TD NOWRAP ALIGN=RIGHT><B>Size &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Artist &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Album &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Year &nbsp; </B></TD>" .
               "</TR>\n" .
               "<TR><TD COLSPAN=8><HR></TD></TR>\n");

  print STDERR "\nSingles:\n\n" if ($verbose > 2);
  foreach (@singles) {
    $output .= fmt_line($_, 0, 0);
  }
  print STDERR "\n\n" if ($verbose > 2);

  $output .= ("<TR>" .
              "<TD VALIGN=TOP COLSPAN=8>" .
               "<BR><HR>\n" .
               "<B>Videos added in the last $days2 days:</B>" .
               "<BR><BR>\n" .
               "</TD>" .
              "</TR>\n" .
              "<TR>" .
               "<TD NOWRAP><B>Title &nbsp; </B></TD>" .
               "<TD NOWRAP ALIGN=RIGHT><B>Time &nbsp; </B></TD>" .
               "<TD NOWRAP ALIGN=RIGHT><B>Size &nbsp; </B></TD>" .
               "<TD NOWRAP><B>Artist &nbsp; </B></TD>" .
               "<TD NOWRAP><B>Album &nbsp; </B></TD>" .
               "<TD NOWRAP><B>Year &nbsp; </B></TD>" .
              "</TR>\n" .
              "<TR><TD COLSPAN=8><HR></TD></TR>\n");

  print STDERR "\nVideos 1:\n\n" if ($verbose > 2);

  foreach (@videos1) {
    $output .= fmt_line($_, 0, 0);
  }

  $output .= ("<TR>" .
               "<TD VALIGN=TOP COLSPAN=8>" .
                "<BR><HR>" .
                "<B>Videos added in the last $days days:</B><BR><BR>\n" .
               "</TD>" .
              "</TR>\n" .
              "<TR>" .
               "<TD NOWRAP><B>Title &nbsp; </B></TD>" .
               "<TD NOWRAP ALIGN=RIGHT><B>Time &nbsp; </B></TD>" .
               "<TD NOWRAP ALIGN=RIGHT><B>Size &nbsp; </B></TD>" .
               "<TD NOWRAP><B>Artist &nbsp; </B></TD>" .
               "<TD NOWRAP><B>Album &nbsp; </B></TD>" .
               "<TD NOWRAP><B>Year &nbsp; </B></TD>" .
              "</TR>\n" .
              "<TR><TD COLSPAN=8><HR></TD></TR>\n");

  print STDERR "\nVideos 2:\n\n" if ($verbose > 2);

  foreach (@videos2) {
    $output .= fmt_line($_, 0, 0);
  }

  $output .= "</TABLE>\n<P>\n";
  $output .= $html_tail;

  local *OUT;
  open (OUT, ">$file") || error ("$file: $!");
  print OUT $output;
  close OUT;

  print STDERR "$progname: wrote $file\n", if ($verbose);
}


sub itunes_videos($) {
  my ($file) = @_;

  my $lines = itunes_list_tracks ('videos', 0,
                                'every file track of playlist "Music Videos"');
  print STDERR "$progname: formatting...\n" if ($verbose);

  my $output = $html_head;
  $output .= ("<P>" .
              "<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>\n" .
               "<TR>" .
                "<TD NOWRAP><B>Title &nbsp; </B></TD>" .
                "<TD NOWRAP ALIGN=RIGHT><B>Time &nbsp; </B></TD>" .
                "<TD NOWRAP ALIGN=RIGHT><B>Size &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Artist &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Album &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Year &nbsp; </B></TD>" .
               "</TR>\n" .
               "<TR><TD COLSPAN=8><HR></TD></TR>\n");

  $output =~ s@(<TITLE>[^:<>]*):?\s*[^<>]*@$1: music videos@si;
  $output =~ s@(<B>[^:<>]*):?\s*[^:<>]*@$1: music videos@si;
  print STDERR "\nVideos:\n\n" if ($verbose > 2);

  my @all = split(/\n/, $lines);
  foreach (@all) {
    # FIELDS
    my @fields = split (/\t/, $_);
    my ($title, $time, $size, $artist, $composer, $album, 
        $comp_p, $tnum, $ntrks, $year, $age, $fullpath) = @fields;
    if (! $fullpath) {
      #error ("missing file for: $_");
      print STDERR "$progname: file missing: $artist - $album - $title\n";
      $_ = '';
      next;
    }

    my ($path) = ($fullpath =~ m@/([^/]+/[^/]+/[^/]+)$@);
    error ("bogus path: $_") unless defined($path);
    $fields[$#fields] = $path;

    $artist =~ s/^The //si;
    my $sortkey = lc(sprintf("%s/%s/%02d/%s", $artist, $album, $tnum, $title));
    unshift @fields, $sortkey;

    $_ = join("\t", @fields);
  }

  @all = sort (@all);
  foreach (@all) {
    next unless ($_);
    $output .= fmt_line($_, 0, 0);
  }

  $output .= "</TABLE>\n<P>\n";
  $output .= $html_tail;

  local *OUT;
  open (OUT, ">$file") || error ("$file: $!");
  print OUT $output;
  close OUT;

  print STDERR "$progname: wrote $file\n", if ($verbose);
}


sub itunes_covers($) {
  my ($file) = @_;

  my $lines = itunes_list_tracks ("covers", 0,
                                  'every file track of playlist "Covers"');
  print STDERR "$progname: formatting...\n" if ($verbose);

  my $output = $html_head;
  $output .= ("<P>" .
              "<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>\n" .
               "<TR>" .
                "<TD NOWRAP><B>Title &nbsp; </B></TD>" .
                "<TD NOWRAP ALIGN=RIGHT><B>Time &nbsp; </B></TD>" .
                "<TD NOWRAP ALIGN=RIGHT><B>Size &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Composer &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Artist &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Album &nbsp; </B></TD>" .
                "<TD NOWRAP><B>Year &nbsp; </B></TD>" .
               "</TR>\n" .
               "<TR><TD COLSPAN=8><HR></TD></TR>\n");

  $output =~ s@(<TITLE>[^:<>]*):?\s*[^<>]*@$1: cover songs@si;
  $output =~ s@(<B>[^:<>]*):?\s*[^:<>]*@$1: cover songs@si;
  print STDERR "\nCovers:\n\n" if ($verbose > 2);

  my @all = split(/\n/, $lines);
  foreach (@all) {
    # FIELDS
    my @fields = split (/\t/, $_);
    my ($title, $time, $size, $artist, $composer, $album, 
        $comp_p, $tnum, $ntrks, $year, $age, $fullpath) = @fields;
    if (! $fullpath) {
      #error ("missing file for: $_");
      print STDERR "$progname: file missing: $artist - $album - $title\n";
      $_ = '';
      next;
    }

    my ($path) = ($fullpath =~ m@/([^/]+/[^/]+/[^/]+)$@);
    error ("bogus path: $_") unless defined($path);
    $fields[$#fields] = $path;

    $artist   =~ s/^The //si;
    $composer =~ s/^The //si;
    my $sortkey = lc(sprintf("%s/%s/%02d/%s", $composer, $album, $tnum, $title));
    unshift @fields, $sortkey;

    $_ = join("\t", @fields);
  }

  @all = sort (@all);
  foreach (@all) {
    next unless ($_);
    $output .= fmt_line($_, 0, 1);
  }

  $output .= "</TABLE>\n<P>\n";
  $output .= $html_tail;

  local *OUT;
  open (OUT, ">$file") || error ("$file: $!");
  print OUT $output;
  close OUT;

  print STDERR "$progname: wrote $file\n", if ($verbose);
}



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

sub usage() {
  print STDERR "usage: $progname [--verbose] [--debug] [--days 90]" .
    " recent.html videos.html covers.html\n";
  exit 1;
}

sub main() {
  my $rfile = undef;
  my $vfile = undef;
  my $cfile = undef;
  my $days  = 90;
  my $days2 = 14;
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    elsif ($_ eq "--debug") { $debug_p++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^--?days$/) { $days = 0 + shift @ARGV; }
    elsif (m/^-./) { usage; }
    elsif (!defined($rfile)) { $rfile = $_; }
    elsif (!defined($vfile)) { $vfile = $_; }
    elsif (!defined($cfile)) { $cfile = $_; }
    else { usage; }
  }
  usage unless defined ($rfile);

  load_header();
  itunes_ping();
  itunes_videos ($vfile) if ($vfile);
  itunes_covers ($cfile) if ($cfile);
  itunes_recent ($rfile, $days, $days2) unless ($rfile eq '');
}

main();
exit 0;