#!/usr/bin/perl -w
# Copyright © 2007 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.
#
# This is a script that implements prettier directory listings of MP3 files
# on a web server.  Instead of just listing the file names, it displays the
# MP3 data.  It also includes a magic link that downloads the entire contents
# of a directory as a single ZIP file.
#
# To install:
#
#   - In this file, edit $base_dir to be the full path name of where your
#     MP3 files live (e.g., your iTunes Music directory).
#
#   - Also edit $header_file to point to the HTML file that you want to be
#     the header of each generate page (this file should set background
#     colors and so on.)
#
#   - Install this file in your web server document directory with the
#     name you want for the root of your MP3 tree, e.g.,
#       cp ..../mp3dir.pl /var/www/html/MP3
#     Don't give it a file extension.  If you call this file "MP3",
#     then the URL you will access it with will be "http://localhost/MP3/"
#
#   - in the .htaccess file in that directory, mark the file as a CGI:
#     <Files ~ "^MP3$">
#      SetHandler cgi-script
#     </Files>
#
# Created: 19-Jun-2007.


# TODO:
# - try to get album name out of first mp3 in a subdir.
# - maybe link directly to only album if only one album in subdir.
# - figure out how to get artist/album/etc out of .mov and .mp4 video files.


require 5;
use diagnostics;
use strict;
use Encode;

use MP3::Tag;
use MP4::Info;
#use Audio::M4P::QuickTime;

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

my $verbose = 0;

my $base_dir = '/Users/jwz/Music/iTunes/iTunes Music';
my $header_file = '/Library/WebServer/Documents/header.html';

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

sub url_unquote($) {
  my ($u) = @_;
#  $u =~ s/[+]/ /g;
  $u =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
  return $u;
}

sub html_quote($$) {
  my ($s, $cvt_p) = @_;
  return $s if (! $s);
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/>/&gt;/g;
  $s =~ s/\"/&quot;/g;
  my $ss = $s;
  eval { $ss = decode('iso-8859-1', $s) };  # ignore errors
  $s = encode_utf8 ($ss) if ($cvt_p);
  return $s;
}


sub handle_path($) {
  my ($file) = @_;
  $file = url_unquote($file);

  if ($file eq '') {		# Redirect "/foo/MP3" to "/foo/MP3/".

    my $url = "http://" . $ENV{SERVER_NAME};
    $url .= ":" . $ENV{SERVER_PORT} unless ($ENV{SERVER_PORT} eq '80');
    $url .= $ENV{REQUEST_URI};
    $url .= "/";
    print STDOUT ("Location: $url\r\n" . 
                  "Content-Type: text/plain\r\n\r\n" . 
                  $url . "\r\n");
    return;
  }

  $file = $base_dir . $file;
  if (-d $file) {
    list_dir ($file);
  } elsif ($file =~ m@/([^/]+)/\1\.zip$@si) {
    zip_dir ($file);
  } else {
    stream_file ($file);
  }
}


sub size_abbr($) {
  my ($s) = @_;
  if ($s < 1024) { return "$s "; }
  $s /= 1024;
  if ($s < 1024) { return sprintf("%d KB", $s); }
  $s /= 1024;
  if ($s < 1024) { return sprintf("%.1f MB", $s); }
  $s /= 1024;
  return sprintf("%.1f GB", $s);
}


sub dir_sortkey($) {
  my ($s) = @_;
  $s = lc($s);
  $s =~ s/^[^[[:alpha:]\d ]+//s;             # ignore leading non-alphanumeric
  $s = "!! $s" if ($s eq 'compilations');    # sort comps at the top
  $s =~ s/^(the|a|an) //s;		     # ignore leading small words

  # sort leading numbers ordinally, at the bottom
  $s = sprintf("\277\277 %08d %s", $1, $2) if ($s =~ m/^(\d+)(.*)$/s);

  return $s;
}


sub list_dir($) {
  my ($dir) = @_;
  local *DIR;
  opendir (DIR, $dir) || error (500, "$dir: $!");
  my @files = sort { dir_sortkey($a) cmp dir_sortkey($b) } readdir (DIR);
  closedir DIR;

  my $mp3_output  = '';
  my $file_output = '';

  my $mp3_headline =
    ("<TR>" .
      "<TD></TD>" .
      "<TD><B>Title</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>" .
      "<TD></TD>" .
     "</TR>\n" .
     "<TR><TD COLSPAN=8><HR></TD></TR>\n"
    );

  my $file_headline =
    ("<TR>" .
      "<TD></TD>" .
      "<TD><B>Name</B></TD>" .
      "<TD ALIGN=CENTER><B>Last Modified</B></TD>" .
      "<TD NOWRAP ALIGN=RIGHT><B>Size</B></TD>" .
      "<TD></TD>" .
     "</TR>\n" .
     "<TR><TD COLSPAN=8><HR></TD></TR>\n"
    );

  my $i = 1;
  my $prev_file = '';
  foreach my $file (@files) {
    next if ($file =~ m/^\./);
    next if ($file eq "Icon\r");
    $file = encode_utf8 (decode_utf8 ($file));

    if ($file =~ m/\.(mp3|mov|mp4|m4a|m4p|m4v)$/si) {

      my ($title, $len, $size, $width, $height, $artist, $album, $track,
          $year, $comm);

      if ($file =~ m/\.(mp3|m4a|m4p)$/si) {	# MPEG audio files

        my $mp3 = MP3::Tag->new("$dir/$file");
        error (500, "$file: unreadable tags?") unless ($mp3);
        $mp3->get_tags();

        $title  = $mp3->title();
        $len    = $mp3->time_mm_ss();
        $size   = (stat("$dir/$file"))[7];
        $artist = $mp3->artist();
        $album  = $mp3->album();
        $track  = $mp3->track();
        $year   = $mp3->year();
        $comm   = $mp3->comment();

      } elsif ($file =~ m/\.mov$/si) {		# Quicktime only
        my $mdata = `mdls "$dir/$file"`;
        error (500, "$file: unreadable mdata?") unless ($mdata);
        $_ = $mdata;
        ($title)  = m/^ kMDItemTitle           \s+=\s+\" (.*) \"\s*$/xmi;
        ($len)    = m/^ kMDItemDurationSeconds \s+=\s+   (.*) \s*$/xmi;
        ($size)   = m/^ kMDItemFSSize          \s+=\s+   (.*) \s*$/xmi;
        ($width)  = m/^ kMDItemPixelWidth      \s+=\s+   (.*) \s*$/xmi;
        ($height) = m/^ kMDItemPixelHeight     \s+=\s+   (.*) \s*$/xmi;
        ($artist) = m/^ kMDItemAuthors         \s+=\s+\(?\"([^\"]*)\".*$/xmi;
        ($album)  = m/^ kMDItemAlbum           \s+=\s+   \"(.*) \"\s*$/xmi;
        ($track)  = m/^ kMDItemFSName          \s+=\s+\" (\d\d+) \s.*$/xmi;
        $year     = '';
        ($comm)   = m/^ kMDItemComment         \s+=\s+\" (.*) \"\s*$/xmi;

      } else {					# MPEG video files (mp4, m4v)

        # We have to do this crap as well because 'mdls' doesn't know about
        # enough of the metadata of MP4 files.
        #
        my $mp3 = MP3::Tag->new("$dir/$file");
        error (500, "$file: unreadable tags?") unless ($mp3);
        $mp3->get_tags();

        # This works on MP4 files
        my $tags = get_mp4tag ("$dir/$file");

        $title  = $tags->{NAM} || $file;
        $len    = $tags->{SECS};
        $size   = (stat("$dir/$file"))[7];
        $artist = $tags->{ART};
        $album  = $tags->{ALB};
#       $track  = $tags->{TRKN};
        $year   = $tags->{DAY};
        $comm   = $tags->{CMT};
      }

      $len    = '' unless $len;
      $size   = 0  unless $size;
      $track  = '' unless $track;
      $year   = '' unless $year;
      $comm   = '' unless $comm;

      if (! $title) {
        $title  = $file;
        $title =~ s/^\d+ //s;
        $title =~ s/\.[a-z\d]+$//s;
      }

      if (! $album) {
        ($album) = ($dir =~ m@/([^/]+)/?$@s);
      }

      if (! $artist) {
        ($artist) = ($dir =~ m@/([^/]+)/[^/]+/?$@s);
      }

      if ($len =~ m/^[\d.]+$/) {
        $len = int($len);
        $len = sprintf("%d:%02d", $len/60, $len%60);
      } else {
        $len =~ s/^(0)(\d:)/$2/s;
      }

      $album = 'Uknown Album' unless ($album);

      $comm = '' if ($comm eq 'Created by Grip');  # stupid grip.
      $comm = '' if ($width && $height &&
                     $comm =~ m/^\s*$width\s*x\s*$height\s*$/s);

      if (! $width) {
        ($width, $height) = ($comm =~ m/^\s*(\d+)\s*x\s*(\d+)\s*$/s);
        $comm = '' if $width;
      }

      $size = size_abbr ($size);

      $title  = html_quote ($title, 1);
      $len    = html_quote ($len, 1);
      $size   = html_quote ($size, 1);
      $artist = html_quote ($artist, 1);
      $album  = html_quote ($album, 1);
      $track  = html_quote ($track, 1);
      $year   = html_quote ($year, 1);
      $comm   = html_quote ($comm, 1);

      $size = "&nbsp; $size &nbsp";
      $size = ("<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=\"100%\">" .
               "<TR><TD NOWRAP>$width&times;$height</TD>" .
               "<TD NOWRAP ALIGN=RIGHT>$size</TD></TR></TABLE>")
        if ($width);

      $track =~ s@/@ of @;
      $track =~ s@/.*$@@s;

      # Instead of using the track number in the file, number the files
      # from the top of the directory:
      $track = $i++;

      # But if the file name itself begins with a number, believe that.
      $track = ($1+0) if ($file =~ m/^(\d\d) /s);

      $comm = "<I> &nbsp; $comm</I>" if ($comm);

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

      $mp3_output .=
        ("<TR>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT>$track &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP>$title</TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT> &nbsp; $len &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT>$size</TD>" .
         "<TD NOWRAP VALIGN=TOP>$artist &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP>$album &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT>$year &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP>$comm</TD>" .
         "</TR>\n");


    } else {					# unknown extension

      my @st = stat("$dir/$file");
      my $size = html_quote (size_abbr ($st[7]), 1);
      my $mod  = html_quote (localtime ($st[9]), 1);

      my $name = $file;
      if (-d "$dir/$file") {
        $name .= '/' unless $name =~ m@/$@s;
        $file .= '/' unless $file =~ m@/$@s;
        $size = '-';
      }
      $name = ("<A HREF=\"" . url_quote($file) . "\">" . 
               html_quote($name, 0) . "</A>");

      # If some file names begin with a space (to make them sort at the top)
      # insert an HR between the "space" files and the "regular" files.
      #
      if ($file =~ m/^[^ ]/s && $prev_file =~ m/^ /s) {
        $file_output .= "<TR><TD COLSPAN=4><HR></TD></TR>\n";
      }

      $file_output .=
        ("<TR>" .
         "<TD></TD>" .
         "<TD NOWRAP VALIGN=TOP>$name &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT>$mod</TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT> &nbsp; $size</TD>" .
         "</TR>\n");
      $i++;
    }
    $prev_file = $file;
  }

  $mp3_output  = $mp3_headline  . $mp3_output  if ($mp3_output);
  $file_output = $file_headline . $file_output if ($file_output);

  my $output = '';

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

  # Wrap both tables inside another table, to center them,
  # but have them be flush-left relative to each other.
  #
  $output .= ("<P><DIV ALIGN=CENTER>\n" .
              "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>\n" .
              "<TR><TD>\n")
    if ($mp3_output || $file_output);

  $output .= ("<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>\n" .
              $mp3_output . "</TABLE>\n")
    if ($mp3_output);

  $output .= "<P>\n" if ($mp3_output && $file_output);

  $output .= ("<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>\n" .
              $file_output . "</TABLE>\n")
    if ($file_output);

  # close outer table
  $output .= ("</TD></TR></TABLE>\n</DIV><P>\n")
    if ($mp3_output || $file_output);


  if ($i > 2 && $i < 100) {

    my $d = $dir;
    $d =~ s@/$@@s;
    $d =~ s@^.*/@@s;
    $d = url_quote($d);

    my $size = `du -hs "$dir"`;
    $size =~ s/^\s+//s;
    $size =~ s/\s.*$//s;
    $size =~ s/([GM])$/ $1B/s;

    $output .= ("<P ALIGN=CENTER>\n" .
                "<A HREF=\"$d.zip\">" .
                "Zip archive of this directory ($size)" .
                "</A>\n");
  }
  $output .= "\n<P>\n";
  $output .= "</BODY>\n</HTML>\n";

  $dir = html_quote (($ENV{REQUEST_URI}
                      ? url_unquote($ENV{REQUEST_URI})
                      : $dir),
                     0);
  $dir =~ s@(^/|/$)@@gs;
  $dir =~ s@/@ &middot; @gs;

  $output =~ s@(<TITLE>.*?)(</TITLE>)@$1: $dir$2@si;
  $output =~ s@(<B>.*?)(</B>)@$1<BR>$dir$2@si;

  print STDOUT ("Content-Type: text/html; charset=UTF-8\n" .
                "Content-Length: " . length ($output) . "\n" .
                "\n" .
                $output);
}


sub stream_file($) {
  my ($file) = @_;
  
  my $ct = 'application/octet-stream';
  if    ($file =~ m/\.html?$/i) { $ct = 'text/html';    }
  elsif ($file =~ m/\.mp3$/i)   { $ct = 'audio/mpeg';    }
  elsif ($file =~ m/\.m3u$/i)   { $ct = 'audio/mpegurl'; }
  elsif ($file =~ m/\.pls$/i)   { $ct = 'audio/x-scpls'; }
  elsif ($file =~ m/\.ra?m$/i)  { $ct = 'audio/x-pn-realaudio'; }
  elsif ($file =~ m/\.mp4$/i)   { $ct = 'video/mp4'; }
  elsif ($file =~ m/\.mov$/i)   { $ct = 'video/quicktime'; }
  elsif ($file =~ m/\.3gp$/i)   { $ct = 'video/3gp'; }
  elsif ($file =~ m/\.3g2$/i)   { $ct = 'video/3g2'; }
  elsif ($file =~ m/\.flv$/i)   { $ct = 'video/x-flv'; }
  elsif ($file =~ m/\.wmv$/i)   { $ct = 'video/x-ms-wmv'; }

  my $size = (stat($file))[7];

  if (! defined($size)) {
    print STDOUT ("Status: 404\n" .
                  "Content-Type: text/html\n" .
                  "\n" .
                  "<H1>404</H1>\n");
    return;
  }

  print STDOUT ("Content-Type: $ct\n" .
                "Content-Length: $size\n" .
                "\n");
  close STDIN;
  close STDERR;
  exec ("cat", $file);
}


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

  $file =~ s@/[^/]*$@@s;
  my $data = `zip -qrj0 - \"$file\"`;
  print STDOUT ("Content-Length: " . length($data) . "\n" .
                "Content-Type: application/zip\n" .
                "\n");
  print STDOUT $data;
}


sub error {
  my ($http_status, $err) = @_;

  if (defined($ENV{REQUEST_URI})) {
    print "Status: $http_status\n";
    print "Content-Type: text/html\n";
    print "\n<TITLE>Error</TITLE>\n";
    print "<BODY BGCOLOR=\"#000000\" TEXT=\"#00FF00\">\n";
    print "<H1>$http_status</H1><P>\n";
    $err =~ s/&/&amp;/g;
    $err =~ s/</&lt;/g;
    $err =~ s/>/&gt;/g;
    print "$err\n<P>\n";

    if (0) {
      print "<P><TT>\n";
      foreach (sort keys(%ENV)) {
        $_ = "$_ = "  . $ENV{$_};
        s/&/&amp;/g;
        s/</&lt;/g;
        s/>/&gt;/g;
        print "$_<BR>\n";
      }
      print "</TT><P>\n";
    }

    exit (0);

  } else {
    print STDERR "$progname: $err\n";
    exit 1;
  }
}


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

sub main {
  $|=1;

  # Only parse argv if we're not running as a CGI.
  #
  if (!defined ($ENV{REQUEST_URI})) {
    while ($_ = $ARGV[0]) {
      shift @ARGV;
      if ($_ eq "--verbose") { $verbose++; }
      elsif (m/^-v+$/) { $verbose += length($_)-1; }
      elsif (m/^-./) { usage; }
      else { usage; }
    }
  }

  handle_path ($ENV{PATH_INFO} || '');
}


main();
exit 0;