#!/usr/bin/perl -w
# Copyright © 2001-2006 Jamie Zawinski <jwz@dnalounge.com>
#
# 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.
#
#
# Strip the silence out of any MP3 files in the archive that we haven't
# done that for yet.  Runs "silencer" to do the dirty work.
#
# Created: 17-Oct-2001

require 5;
use diagnostics;
use strict;
use Config;

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


my $target_user = (-d "/home/archive" ? "archive" : "icecast");
my $data_dir = (-d "/home" ? "/home/" : "/Users/") . $target_user . "/";
				   # directly under this directory should be a
				   # directory whose name is the 4 digit year
				   # of the mp3 files within.  (At the very
				   # beginning of january, there will
				   # presumably be two such directories.)

my $progname;
my $exec_dir;
$_ = $0;
($exec_dir, $progname) = m@^(.*?)([^/]+)$@;

if ($exec_dir =~ m@^./(.*)$@) {
  $_ = `pwd`;
  chomp($_);
  $exec_dir = "$_/$1";
}
$exec_dir =~ s@/+$@@;

my $verbose = 0;
my $debug = 0;
my $allow_big_shrink_p = 0;
my $do_pbm_p = 0;

my @signames = split(' ', $Config{sig_name});

my @silencer_cmd = "$exec_dir/silencer";
my $stripped_suffix = "stripped";
my $time_suffix = "time";
my $file_bytes_per_second = 16000;   # the magic number for 128k mp3 files...

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

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

  my $sfile = $file;
  $sfile =~ s/\.[^.]+$/.$stripped_suffix/;

  if (-f "$sfile") {
    print STDERR "$progname: skipping $file (already stripped)\n"
      if ($verbose);
    return;
  }

  $_ = (-s "$file");
  $_ = 0 if (!defined($_) || $_ eq '');
  if ($_ < 1024) {
    print STDERR "$progname: skipping $file ($_ bytes)\n"
      if ($verbose);
    return;
  }

  my $tfile = $file;
  $tfile =~ s/\.[^.]+$/.$time_suffix/;

  my $file_tmp = "$file.tmp";
  my @cmd = @silencer_cmd;

  if ($verbose > 2) {
    push @cmd, ("-" .("v" x ($verbose - 2)));
  }

  push @cmd, $file;
  push @cmd, "--strip";
  push @cmd, $file_tmp;

  if ($do_pbm_p) {
    my $pbm = $file;
    $pbm =~ s/\.[^.]+$/.pbm/;
    push @cmd, "--pbm";
    push @cmd, "$pbm";
  }

  my @st_old = stat($file);
  my @st_otf = stat($tfile);

  if ($debug == 1) {
    print STDERR "$progname: not executing \"" . join(" ", @cmd) . "\"\n";

  } else {
    print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
      if ($debug || $verbose > 1);

    if (system (@cmd) != 0) {
      my $status = $? >> 8;
      my $signal = $? & 127;
      my $core   = $? & 128;

      my $f = $file;
      $f =~ s@^.*/([^/]+)$@$1@;

      if ($core) {
        print STDERR "$progname: $f: $cmd[0] dumped core\n";
      } elsif ($signal) {
        $signal = "SIG" . $signames[$signal];
        print STDERR "$progname: $f: $cmd[0] died with signal $signal\n";
      } else {
        print STDERR "$progname: $f: $cmd[0] exited with status $status\n";
      }

      $status = -1 unless ($status != 0);

      unlink $file_tmp;
      exit ($status);
    }
  }

  my @st_new = stat($file_tmp);
  my @st_ntf = stat($tfile);

  my $old_size = $st_old[7];
  my $new_size = $st_new[7];

  $new_size = $old_size if ($debug == 1);

  if (!defined ($new_size)) {
    print STDERR "$progname: $file_tmp doesn't exist\n";
    exit 1;
  }

  if ($old_size == $new_size) {
    print STDERR "$progname: $file unchanged.\n" if ($verbose);
    unlink $file_tmp;
    mark_done ($file);

  } elsif ($old_size > $new_size) {
    my $b = $old_size - $new_size;
    my $size = fmt_bytes ($b);
    my $shrunk_secs = int ($b / $file_bytes_per_second);
    my $shrunk_str = bytes_to_time ($b);

    my $front_secs = $st_ntf[9] - $st_otf[9];
    my $front_str = sprintf ("%d:%02d:%02d",
                             $front_secs / (60 * 60),
                             ($front_secs / 60) % 60,
                             $front_secs % 60);

    print STDERR "$progname: $file shrunk by $size ($shrunk_str" .
                 ($front_secs > 0 ? ", $front_str front" : "") .
                 ").\n";

    if ($shrunk_secs >= (60 * 60 * 3) ||        # 3 hours lost
        $new_size <= ($old_size * 0.6666)) {    # or 1/3 of file lost
      if ($allow_big_shrink_p) {
        print STDERR "$progname: that's a lot!\n";
      } else {
        print STDERR "$progname: that's a lot!  That can't be right.\n";
        unlink $file_tmp;
        # put the previous write-date back on the .time file.
        utime (time, $st_otf[9], $tfile) || error "$tfile: utime: $!";
        exit 1;
      }
    }

    my $otime = $st_old[9];
    my $ntime = $otime - ($shrunk_secs - $front_secs);
    $shrunk_str = sprintf ("%d:%02d:%02d",
                           ($otime - $ntime) / (60 * 60),
                           (($otime - $ntime) / 60) % 60,
                           ($otime - $ntime) % 60);

    if ($debug) {
      print STDERR "$progname: would have renamed $file_tmp\n\t\tto $file\n";
      unlink $file_tmp;

    } else {
      rename ($file_tmp, $file) || error "mv $file_tmp $file: $!";
      print STDERR "$progname: mv $file_tmp $file\n" if ($verbose > 1);

      utime (time, $ntime, $file) || error "$file: utime: $!";
    }

    if ($verbose > 1 || $debug) {
      $otime = localtime($otime);
      $ntime = localtime($ntime);
      print STDERR "$progname: $file: " . ($debug ? "would have " : "") .
                   "set mod time to\n\t\t$ntime ($otime - $shrunk_str)\n";
    }

    mark_done ($file);

  } else {  # $old_size < $new_size
    my $size = fmt_bytes ($new_size - $old_size);
    print STDERR "$progname: ERROR: $file would have grown by $size?\n";
    unlink $file_tmp;
  }


  # If a PBM file exists, compress it.
  #
  my $pfile = $file;
  $pfile =~ s/\.[^.]+$/.pbm/;
  if (-f $pfile) {
    if (system ("gzip", "-v", $pfile) != 0) {
      exit (-1);
    }
  }
}


sub fmt_bytes {
  my ($bytes) = @_;
  if ($bytes == 1) { return "1 byte"; }
  elsif ($bytes < 1024) { return "$bytes bytes"; }
  elsif ($bytes < 1024*1024) { return "" . int($bytes/1024) . "K"; }
  else { return sprintf("%.1fM", ($bytes/(1024*1024.0))); }
}

sub bytes_to_time {
  my ($bytes) = @_;
  my $secs = int ($bytes / $file_bytes_per_second);
  return sprintf ("%d:%02d:%02d",
                  $secs / (60 * 60),
                  ($secs / 60) % 60,
                  $secs % 60);
}


sub mark_done {
  my ($file) = @_;
  my $sfile = $file;
  $sfile =~ s/\.[^.]+$/.$stripped_suffix/;

  if ($debug) {
    print STDERR "$progname: not touching $sfile\n";
    return;
  }

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

  print STDERR "$progname: touched $sfile\n" if ($verbose > 1);
}


sub clean_mp3s {
  local *DIR;
  $data_dir =~ s@/+$@@;
  my @files = ();
  opendir (DIR, "$data_dir") || error ("$data_dir: $!");
  foreach my $d (readdir (DIR)) {
    local *YDIR;
    next unless ($d =~ m/^\d{4}$/);
    opendir (YDIR, "$data_dir/$d") || error ("$data_dir/$d: $!");
    foreach my $f (readdir (YDIR)) {
      next if ($f =~ m/^\./);
      next unless ($f =~ m/\.mp3$/);
      push @files, "$data_dir/$d/$f";
    }
    closedir (YDIR);
  }
  closedir (DIR);
  @files = sort (@files);

  foreach (@files) {
    clean_mp3 ($_);
  }
}


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

sub main {

  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif ($_ eq "--debug") { $debug++; }
    elsif ($_ eq "--shrink") { $allow_big_shrink_p++; }
    elsif ($_ eq "--pbm") { $do_pbm_p++; }
    elsif (m/^-d+$/) { $debug += length($_)-1; }
    elsif (m/^-./) { usage; }
    else { usage; }
  }
  clean_mp3s();
}

main;
exit 0;