#!/usr/bin/perl -w # Copyright © 2006-2008 Jamie Zawinski # # 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.23 $ }; $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 $html_head = ' traitor.jwz.org: directory listing
traitor.jwz.org: recently added

music   ·   recent   ·   videos   ·   upload

'; my $html_tail = "\n\n"; sub url_quote($) { my ($s) = @_; $s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge; return $s; } # 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); $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 ("bogus path: $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 = "$title"; $path =~ s@/[^/]*$@/@; $album = 'Unknown Album' unless $album; $album = "$album"; $path =~ s@/[^/]*/$@/@; $artist = '?' unless $artist; $composer = '?' unless $composer; $artist = 'Various Artists' if ($comp_p eq 'true' && $album_only_p); $artist = "$artist" 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 ("" . ($album_only_p ? '' : ("$title" . "$time  " . "$size  ")) . ($composer_p ? "$composer   " : '') . "$artist   " . "$album   " . "$year" . "\n"); } sub itunes_recent($$$) { my ($file, $days, $days2) = @_; # FIELDS my $lines = itunes_script ("recent", join ("\n", ('tell application "iTunes"', " set theDate to (current date) - $days * days", ' set TS to every file track of playlist "Library"' . ' whose date added > theDate', 'set output to ""', 'repeat with T in TS', ' set L to the location of T', ' 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" & ' . ' (the POSIX path of L) & "\n"', ' end repeat', 'end tell'))); print STDERR "$progname: formatting...\n" if ($verbose); my $output = $html_head; $output =~ s@(<(TITLE|B)>[^:]*:\s*)[^<>]*@$1 recently added@sig; 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; error ("bogus fullpath: $_") unless defined($fullpath); 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 = $_; # 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 .= ("\n" . "" . "" . "\n" . "" . "" . "" . "" . "\n" . "\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 .= ("" . "" . "\n" . "" . "" . "" . "" . "\n" . "\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 .= ("
" . "Albums added in the last $days2 days:

\n" . "
Artist   Album   Year  

" . "

" . "Albums added in the last $days days:

\n" . "
Artist   Album   Year  

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

" . "Singles added in the last $days days:" . "

" . "
Title   Time   Size   Artist   Album   Year  

" . "

\n" . "Videos added in the last $days2 days:" . "

\n" . "
Title   Time   Size   Artist   Album   Year  

" . "

" . "Videos added in the last $days days:

\n" . "
Title   Time   Size   Artist   Album   Year  

\n

\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) = @_; # FIELDS my $lines = itunes_script ("videos", join ("\n", ('tell application "iTunes"', ' set TS to every file track of playlist "Music Videos"', 'set output to ""', 'repeat with T in TS', ' set L to the location of T', ' 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" & ' . ' (the POSIX path of L) & "\n"', ' end repeat', 'end tell'))); print STDERR "$progname: formatting...\n" if ($verbose); my $output = $html_head; $output .= ("

" . "\n" . "" . "" . "" . "" . "" . "" . "" . "\n" . "\n"); $output =~ s@(<(TITLE|B)>[^:]*:\s*)[^<>]*@$1 music videos@sig; 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; error ("bogus fullpath: $_") unless defined($fullpath); 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) { $output .= fmt_line($_, 0, 0); } $output .= "
Title   Time   Size   Artist   Album   Year  

\n

\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) = @_; # FIELDS my $lines = itunes_script ("covers", join ("\n", ('tell application "iTunes"', ' set TS to every file track of playlist "Covers"', 'set output to ""', 'repeat with T in TS', ' set L to the location of T', ' 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" & ' . ' (the POSIX path of L) & "\n"', ' end repeat', 'end tell'))); print STDERR "$progname: formatting...\n" if ($verbose); my $output = $html_head; $output .= ("

" . "\n" . "" . "" . "" . "" . "" . "" . "" . "" . "\n" . "\n"); $output =~ s@(<(TITLE|B)>[^:]*:\s*)[^<>]*@$1 cover songs@sig; 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; error ("bogus fullpath: $_") unless defined($fullpath); 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) { $output .= fmt_line($_, 0, 1); } $output .= "
Title   Time   Size   Composer   Artist   Album   Year  

\n

\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); itunes_ping(); itunes_videos ($vfile) if ($vfile); itunes_covers ($cfile) if ($cfile); itunes_recent ($rfile, $days, $days2) unless ($rfile eq ''); } main(); exit 0;