#!/usr/bin/perl -w
# Copyright © 2007-2012 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:
#
#   - Install a few Perl modules:
#
#       sudo cpan MP3::Tag MP3::Info MP4::Info
#
#   - In this file, edit $base_dir to be the full path name of where your
#     MP3 files live (e.g., your iTunes Media/Music/ directory).
#
#   - Also edit $header_file to point to the HTML file that you want to be
#     the header of each generate page (for title and 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:
#
#       Options +ExecCGI
#       <Files ~ "^MP3$">
#         SetHandler cgi-script
#       </Files>
#
#   - To make .htaccess files work, you might also need to edit the
#     global /etc/httpd/conf/httpd.conf file:
#
#       AllowOverride All
#
# 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.


require 5;
#use diagnostics;
use strict;
use POSIX qw(strftime);
use Encode;
use bytes;

use MP3::Tag;
use MP3::Info;
use MP4::Info;

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

my $verbose = 0;

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

my @zip_video_exclude = ('mov', 'mp4', 'm4v', 'mpg', 'mpeg');


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 { $s = decode('iso-8859-1', $ss, Encode::FB_WARN) };  # ignore errors
  if ($cvt_p) {
    eval { $ss = "$s"; $s = decode ('utf8', $ss, 
                                    Encode::FB_CROAK|Encode::FB_WARN); };
    eval { $ss = "$s"; $s = encode ('utf8', $ss, 
                                    Encode::FB_CROAK|Encode::FB_WARN); }
  }
  return $s;
}


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

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

    error (500, "SERVER_NAME undefined") unless $ENV{SERVER_NAME};
    error (500, "SERVER_PORT undefined") unless $ENV{SERVER_PORT};
    error (500, "REQUEST_URI undefined") unless $ENV{REQUEST_URI};

    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);
  my $o = $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

  $s = "0 $o" if ($s eq '');  # stupid Unicode Witch House bands...

  # 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|mpg|mpeg)$/si) {

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

      # It seems completely random which fields are readable by MP3::Tag,
      # and which are readable by mdls, so we try both and see what we
      # can see.

      # MP3::Tag works on MP3, and sometimes on MP4, M4V and MOV.
      # Does this work on anything that MP3::Info does not?
      #
      my $tags = MP3::Tag->new("$dir/$file");
      # error (500, "$file: unreadable tags?") unless ($mp3);
      if ($tags) {
        $tags->get_tags();
        $title  = $tags->title();
        $len    = $tags->time_mm_ss();
        $artist = $tags->artist();
        $album  = $tags->album();
        $track  = $tags->track();
        $year   = $tags->year();
        $comm   = $tags->comment();
      }

      # MP3::Info.  Does this work on anything that MP3::Tag does not?
      #
      $tags = get_mp3tag ("$dir/$file");
      # error (500, "$file: unreadable tags?") unless ($tags);
      if ($tags) {
        my $info = get_mp3info ("$dir/$file");
        $title  = $tags->{TITLE}    unless $title;
        $len    = $info->{TIME}     unless $len;
        $artist = $tags->{ARTIST}   unless $artist;
        $album  = $tags->{ALBUM}    unless $album;
        $track  = $tags->{TRACKNUM} unless $track;
        $year   = $tags->{YEAR}     unless $year;
        $comm   = $tags->{COMMENT}  unless $comm;

        # WTF. MP3::Info returns some iTunes bullshit as the comment,
        # but MP3::Tag does not.
        $comm = '' if ($comm =~ m/^iTunes_|^iTunNORM|^iTunSMPB/);
      }

      # MP4::Info works on MP4 and M4V, and sometimes on MOV.
      #
      $tags = get_mp4tag ("$dir/$file");
      if ($tags) {
        $title  = $tags->{NAM}	unless $title;
        $len    = $tags->{SECS}	unless $len;
        $artist = $tags->{ART}	unless $artist;
        $album  = $tags->{ALB}	unless $album;
	$track  = $tags->{TRKN}	unless $track;
        $year   = $tags->{DAY}	unless $year;
        $comm   = $tags->{CMT}	unless $comm;
      }

      $size = (stat("$dir/$file"))[7];

      # "mdls" works only on MP3s and MOVs.  However it sometimes works on
      # MOVs in cases where MP3::Tag and MP4::Info do not.
      #
      my $qfile = "$dir/$file";
      $qfile =~ s@([^-a-z\d._/])@\\$1@gsi;
      my $mdata = `mdls $qfile`;
      error (500, "$file: unreadable mdata? $qfile") unless ($mdata);
      $_ = $mdata;
      s/\\U(\d{4})/{chr(hex($1))}/gse;  # Unicrud: "\U0308"
      my $k = 'kMDItem';
      ($title)  = m/^${k}Title        \s+=\s+\" (.*)\"\s*$/xmi  unless $title;
      ($len)    = m/^${k}DurationSeconds\s+=\s+   (.*)\s*$/xmi;#unless $len;
      ($size)   = m/^${k}FSSize       \s+=\s+   (.*)\s*$/xmi    unless $size;
      ($width)  = m/^${k}PixelWidth   \s+=\s+   (.*)\s*$/xmi    unless $width;
      ($height) = m/^${k}PixelHeight  \s+=\s+   (.*)\s*$/xmi    unless $height;
      ($artist) = m/^${k}Authors      \s+=\s+\(?\s*\"?([^\"\n]*?)\"?\s*$/xmi
        unless $artist;
      ($album)  = m/^${k}Album        \s+=\s+  \"(.*)\"\s*$/xmi unless $album;
      ($track)  = m/^${k}FSName       \s+=\s+\"(\d\d+)\s.*$/xmi unless $track;
      ($comm)   = m/^${k}Comment      \s+=\s+\"(.*) \"\s*$/xmi  unless $comm;

      $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 (!$artist && $title =~ m/^(.*) -- (.*)$/s) {
          $artist = $1;
          $title = $2;
        }
      }

      # If title is "artist -- title", fix it.
      if ($title && $artist) {
        $title =~ s/^\Q$artist\E -- //si;
      }

      # If title is "title (year)", fix it.
      if ($title && $year) {
        $title =~ s/\s*\(\Q$year\E\)$//si;
      }

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

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

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

      $year =~ s/[.,\s]*$//si if $year;  # Sometimes has trailing commas??

      $track =~ s@/.*@@s if $track;	 # "3/15" => "3".

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

      $comm =~ s/^from (Tivo|VHS)\b/640x480/si; # Kludge

      $comm = '' if ($comm eq 'Created by Grip');  # stupid grip.
      $comm = '' if ($width && $height &&
                     $comm =~ m/^\s*\d+\s*x\s*\d+\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>$comm</I>" if ($comm);

      my $f2 = $title;
      $f2 = "<SPAN STYLE=\"color:#F00\">$f2</SPAN>"
        unless -f "$dir/$file";
      $title = "<A HREF=\"" . url_quote($file) . "\">$f2</A>";

      $mp3_output .=
        ("<TR>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT>$track &nbsp; </TD>" .
         "<TD VALIGN=TOP ALIGN=LEFT>$title</TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT> &nbsp; $len &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT>$size</TD>" .
         "<TD VALIGN=TOP ALIGN=LEFT>$artist &nbsp; </TD>" .
         "<TD VALIGN=TOP ALIGN=LEFT>$album &nbsp; </TD>" .
         "<TD NOWRAP VALIGN=TOP ALIGN=RIGHT>$year &nbsp; </TD>" .
         "<TD VALIGN=TOP ALIGN=LEFT>$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 $sk = dir_sortkey($file);
      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>");
#      $name .= "<TT> [$sk]</TT>";

      # 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";
      }

      $mod =~ s@^(... ... ..) (.*)$@<NOBR>$1</NOBR> <NOBR>$2</NOBR>@si;
      $file_output .=
        ("<TR>" .
         "<TD></TD>" .
         "<TD VALIGN=TOP ALIGN=LEFT>$name &nbsp; </TD>" .
         "<TD 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);

  local *IN;
  open (IN, "<$header_file") || error (500, "$header_file: $!");
  local $/ = undef;  # read entire file
  my $output = <IN>;
  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 $cmd  = "du -Lhs ";
    my $cmd2 = $cmd;
    foreach (@zip_video_exclude) { $cmd2 .= " -I \*.$_"; }
    my $size      = `$cmd  "$dir"`;
    my $novidsize = `$cmd2 "$dir"`;

    $size =~ s/^\s+//s;
    $size =~ s/\s.*$//s;
    $size =~ s/([GM])$/ $1B/s;

    $novidsize =~ s/^\s+//s;
    $novidsize =~ s/\s.*$//s;
    $novidsize =~ s/([GM])$/ $1B/s;

    $output .= "<P ALIGN=CENTER>\n";

    my $vids_p = ($novidsize ne '0B' && $novidsize ne $size);
    if ($vids_p) {
      $output .= ("Zip archive of this directory:<BR>" .
                  "<A HREF=\"$d.zip\">$size (with videos)</A><BR>" .
                  "<A HREF=\"$d.zip?novid=1\">$novidsize (without)</A>\n");
    } else {
      $output .= ("<A HREF=\"$d.zip\">" .
                  "Zip archive of this directory ($size)</A>");
    }
  }
  $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/\.m4[au]$/i) { $ct = 'audio/mpeg';      }
  elsif ($file =~ m/\.aiff?$/i)  { $ct = 'audio/aiff';      }
  elsif ($file =~ m/\.wav$/i)    { $ct = 'audio/wav';       }
  elsif ($file =~ m/\.amr$/i)    { $ct = 'audio/amr';       }
  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/\.m4v$/i)    { $ct = 'video/x-m4v';     }
  elsif ($file =~ m/\.mov$/i)    { $ct = 'video/quicktime'; }
  elsif ($file =~ m/\.mqv$/i)    { $ct = 'video/quicktime'; }
  elsif ($file =~ m/\.qt$/i)     { $ct = 'video/quicktime'; }
  elsif ($file =~ m/\.3gpp?$/i)  { $ct = 'audio/3gpp';      }
  elsif ($file =~ m/\.3gpp?2$/i) { $ct = 'audio/3gpp2';     }
  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;
  }

  my $range_start = undef;
  my $range_end   = undef;
  my $length      = $size;
  my $start_byte  = 0;
  my $end_byte    = $length;

  my $headers = "Content-Type: $ct\r\n";

  {
    my $http_range = $ENV{HTTP_RANGE};
    if ($http_range) {
      if ($http_range =~ m/^bytes=(\d*)-(\d*)$/) {
        $range_start = $1 || 0;
        $range_end   = $2 || $length;
        if ($range_end > $length) {
          error ("416 Requested Range Not Satisfiable",
                 "Range out of range: ($range_end > $length)");
        }
      } else {
        error ("400 Bad Request",
               "unparsable Range header: $http_range");
      }
    }
  }

  # This is confusing, but iPhone requires this.
  $range_end++ if defined($range_end);

  # The Content-Length header is always the length of the data actually sent.
  my $cl = (defined($range_start)
            ? $range_end - $range_start
            : $length);
  $headers .= "Content-Length: $cl\r\n";
  $headers .= "Accept-Ranges: bytes\r\n";

  if (defined ($range_start)) {
    my $re = $range_end - 1;
    # Need both 206 and Content-Range for WinAmp to do the right thing.
    $headers = "Status: 206 Partial Content\r\n" . $headers;
    $headers .= "Content-Range: bytes $range_start-$re/$length\r\n";
    $end_byte = $start_byte + $range_end;
    $start_byte += $range_start;
  }

  $headers .= "\r\n";

  print STDOUT $headers;

  local *IN;
  open (IN, "<$file")       || die "$progname: $file: open: $?\n";
  seek (IN, $start_byte, 0) || die "$progname: $file: seek: $?\n";
  my $remaining = $end_byte - $start_byte;
  my $buf = '';
  my $n;
  my $bufsiz = 102400;
  do {
    $bufsiz = $remaining if ($bufsiz > $remaining);
    $n = read (IN, $buf, $bufsiz);
    $remaining -= $n;
    print STDOUT $buf;
  } while ($n > 0 && $remaining > 0);
  close (IN);
}


my $tmpfile = undef;
END { unlink $tmpfile if defined ($tmpfile); }


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

  my $dir;
  ($dir, $file) = ($file =~ m@^(.*/)([^/]+)(/[^/]+)$@s);

  $tmpfile = sprintf ("%s/mp3dir-%08x.zip", ($ENV{TMPDIR} || "/tmp"),
                      rand(0xFFFFFFFF));
  unlink $tmpfile;

  my $zargs = '-ro0D';
  $zargs .= 'q' unless ($verbose);

  chdir ($dir);
  my @cmd = ('nice', 'zip', $zargs, $tmpfile, $file);

  if ($ENV{QUERY_STRING} =~ /(^|&)novid=[^0&]/s) {
    foreach (@zip_video_exclude) {
      push @cmd, ('-x', "*.$_");
    }
  }

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

  system @cmd;

  local *F;
  open (F, "<$tmpfile") || error (500, "$tmpfile: $!");
  binmode (F, ':raw');
  unlink $tmpfile;
  $tmpfile = undef;
  my @st = stat (F);
  my $L = $st[7];
  my $D = strftime ("%a, %d %b %Y %T GMT", gmtime($st[9]));
  print STDERR "$progname: got $L bytes\n" if ($verbose);
  print STDOUT ("Content-Length: $L\n" .
                "Content-Type: application/zip\n" .
                "Last-Modified: $D\n" .
                "\n");
  my $buf = '';
  while (sysread (F, $buf, 102400)) { print STDOUT $buf; }
  close F;
}


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;

  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;