#!/usr/bin/perl -w
# Copyright © 2011-2013 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.
#
# Makes some executive decisions about what is and isn't allowed to remain
# in the 'ITunes DJ' playlist:
#
#  - No track in the queue more than once.
#
#  - If there are more than N songs in the queue, delete the later ones.
#
#  - If there are more than M songs by a given artist in the queue,
#    delete the later ones.
#
# This is useful because we allow the anonymous iPhone-Remote-using public
# to request tracks to be played on the video screens in DNA Pizza.  We
# don't want someone to queue up 4 hours of songs and then leave, so the
# default is to limit you to around 40 minutes.  If you're still here 40
# minutes later, feel free to queue up some more.
#
# Created: 14-Aug-2011.

require 5;
#use diagnostics;
use strict;

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

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

my $playlist = 'ITunes DJ';

# Remove from queue if there are more than N songs queued.
#
my $max_tracks = 10;

# Remove from queue if there are more than N songs by the same artist.
# This includes both upcoming and recently-played tracks that are still
# visible in the iTunes DJ playlist.  Adjust how many old tracks are
# checked by adjusting the number of old tracks displayed in that
# playlist.
#
my $max_tracks_per_artist = 3;


sub itunes_running_p() {
  `killall -s -0 iTunes 2>&1`;
  my $exit = $? >> 8;
  return ($exit == 0);
}


sub itunes_dj_nanny() {

  my $delay = 30;
  print STDERR "$progname: sleep $delay\n" if ($verbose > 1);
  sleep ($delay) unless $debug_p;

  if (!itunes_running_p()) {
    print STDERR "$progname: iTunes not running\n" if ($verbose);
    return;
  }

  my @script = ('tell application "iTunes"',
                ' set LF to "\n"',
                ' set TAB to "\t"',
                ' set OUTPUT to "" & {database ID of current track} & LF',
                ' repeat with T in every file track of playlist "' . 
                     $playlist . '"',
                '  set DBID to {database ID of T}',
                '  set T2 to first file track whose database ID is DBID',
                '  set OUTPUT to OUTPUT & ' .
                     'DBID & TAB & ' . 
                     '{artist  of T2} & TAB & ' .
                     '{name    of T2} & TAB & ' .
                     '{rating  of T2} & TAB & ' .
                     '{enabled of T2} & LF',
                ' end repeat',
                'end tell',
                'OUTPUT');

  my $cmd = "osascript -e '" . join ("' -e '", @script) . "'";

  print STDERR "$progname: getting \"$playlist\" playlist from iTunes...\n" 
    if ($verbose > 1);

  $cmd = "( $cmd) 2>&-";
  my @lines = ();
  my $np = undef;

  # Try to get the currently-playing song.
  # Bail if iTunes is stopped.  But try a few times first in case it is
  # just starting up.
  #
  my $tries = 3;
  for (my $i = 0; $i < $tries; $i++) {
    @lines = split(/\n/, `$cmd`);
    $np = shift @lines;
    last if $np;
    print STDERR "$progname: iTunes running but stopped, retrying...\n"
      if ($verbose > 1);
    sleep 5;
  }
  error ("iTunes running but stopped.") unless $np;

  my $fmt = '%2d: %s - %s';


  my @played;

  while (@lines) {
    my $L = $lines[0];
    my ($id, $artist, $name, $rating, $enabled) = split(/\t/, $L);
    $rating = (($enabled ne 'false') ? ('*' x ($rating / 20)) : '-');
    $name .= " $rating";
    my $desc = sprintf ($fmt, 0, $artist, $name, $id);
    print STDERR "$progname:         past: $desc\n" if ($verbose > 1);
    push @played, shift @lines;
    last if ($id eq $np);
  }
  my @queued = @lines;

  error ("no track queued") unless @queued;

  my %artists;
  my $count = 0;

  my @kill = ();
  my %seen;

  # Mark all the played tracks as having been seen.
  # This means that the "N songs per artist" limit is enforced so long
  # as tracks by that artist are visible in the "Now Playing" playlist
  # at all: even ones that have not yet fallen off the top.
  #
  foreach my $L (@played) {
    my ($id, $artist, $name) = split(/\t/, $L);
    my $acount = ($artists{$artist} || 0) + 1;
    $artists{$artist} = $acount;
    $seen{$id} = 1;
  }

  my $i = 1;
  foreach my $L (@queued) {
    my ($id, $artist, $name, $rating, $enabled) = split(/\t/, $L);

    my $acount = ($artists{$artist} || 0) + 1;
    $artists{$artist} = $acount;

    my $r2 = (($enabled ne 'false') ? ('*' x ($rating / 20)) : '-');
    $name .= " $r2";
    my $desc = sprintf ("%2d: %s - %s", $i, $artist, $name, $id);

    if ($seen{$id}) {
      print STDERR "$progname:    dup track: $desc\n" if ($verbose);
      push @kill, $id;
    } elsif ($acount > $max_tracks_per_artist) {
      print STDERR "$progname: artist limit: $desc\n" if ($verbose);
      push @kill, $id;
    } elsif ($count >= $max_tracks) {
      print STDERR "$progname:  queue limit: $desc\n" if ($verbose);
      push @kill, $id;
    } elsif ($enabled eq 'false') {
      print STDERR "$progname:     disabled! $desc\n" if ($verbose);
      push @kill, $id;
    } elsif ($rating <= 20) {
      print STDERR "$progname:     one star! $desc\n" if ($verbose);
      push @kill, $id;
    } else {
      print STDERR "$progname:         keep: $desc\n" if ($verbose > 1);
      $count++;
    }
    $seen{$id} = 1;
    $i++;
  }

  if (! @kill) {
    print STDERR "$progname: nothing to delete!\n" if ($verbose > 1);
    return;
  }

  @script = ('tell application "iTunes"',
             ' set LF to "\n"',
             ' set TAB to "\t"',
             ' set OUTPUT to ""',
             ' set PL to playlist "' . $playlist . '"',
             ' repeat with DEL in {' . join(', ', @kill) . '}',
             '  try',
             '   set P to (first file track of PL whose database ID is DEL)',
             '   set LL to ' .
                     '{database ID of P} & TAB & ' . 
                     '{artist of P} & TAB & ' .
                     '{name of P}',
                 ($debug_p ? '' : '   delete P'),
             '   set OUTPUT to OUTPUT & LL & LF',
             '  on error errmesg number errn',
             '   set OUTPUT to OUTPUT & "ERROR: " & errmesg & ": " & ' .
                  '(errn as text) & LF',
             '  end try',
             ' end repeat',
             'end tell',
             'OUTPUT');

  $cmd = "osascript -e '" . join ("' -e '", @script) . "'";

  print STDERR "$progname: deleting " . @kill . 
        " tracks from \"$playlist\"\n" 
    if ($verbose);
  @lines = split(/\n/, `$cmd`);

  print STDERR "$progname: talking to iTunes...\n" if ($verbose > 1);

  if ($verbose > 1) {
    foreach my $L (@lines) {
      my ($id, $artist, $name) = split(/\t/, $L);
      print STDERR "$progname: deleted: $id: $artist - $name\n";
    }
  }

}


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

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

sub main() {
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if (m/^--?verbose$/) { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^--?quiet$/) { $verbose--; }
    elsif (m/^--?debug$/) { $debug_p++; }
    elsif (m/^-./) { usage; }
    else { usage; }
  }

  itunes_dj_nanny ();
}

main();
exit 0;