#!/usr/bin/perl
# Filename:     every_change
# Author:       David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Description:  Does something every time a file changes
use strict;

##################################################
# Setup the variables
##################################################
($MAIN::PROGNAME = $0) =~ s|.*/||;

my $SECOND = .0000115740;	# 1 second = ? days

##################################################
# Usage
##################################################
sub usage {
  my $msg;
  foreach $msg (@_) { print "ERROR:  $msg\n"; }

  print STDERR <<USAGE;
Usage:\t$MAIN::PROGNAME [-d] [-delay <num>] <file> <what..>
	Does something every time a file changes
	-f        Specify more files to watch (globs in quotes are expanded)
	--files   Specify files until '--' or end or arg list
	-except   Exclude files to watch (Useful with --files)
	-1        Run through the first time before any checks
	-delay    Delay between checks for changes
	-d        Set debug mode

Commands can include replacements:
  %f        The changed file
  %F        The changed file full path
  %D        Directory of changed file

USAGE
  exit -1;
}

# Kinda kludgy:
# Glob files with '*' pattern, makes it easier to specify files to watch
sub my_glob {
  my ($file) = @_;
  $file =~ /\*/ ? glob $file : $file;
}

# Kludgy, but mostly works
# Quote everything except the main shell characters:
#   &, |, ;
# (I probably should have done it the other way around, quoting
#  what I needed, but I'm not sure I'd get the quotes right..)
# (I'm not sure \Q would work the way I want, but I found out about that after this)
sub make_cmd {
  my (@cmd) = @_;
  @cmd = map(quotemeta($_),@cmd);
  # "\&" -> "&", except "\\\\&" -> "\&" (since that means they previously quoted)
  @cmd = map { s/((\\)\\)?\\(\&|;|\|)/$2$3/g; $_; } @cmd;
  join(" ",@cmd);
}

sub parse_args {
  my (@files,@cmd,$arg);
  my ($first, $delay, $write_slack) = (0,0,0);

  while ($#ARGV>=0) {
    $arg=shift(@ARGV);
    if ($arg =~ /^-h$/) { usage(); }
    if ($arg =~ /^-d$/) { $MAIN::DEBUG=1; next; }
    if ($arg =~ /^-1$/) { $first=1; next; }
    if ($arg =~ /^-f$/) { push(@files,my_glob(shift(@ARGV))); next; }
    if ($arg =~ /^--f(iles)?$/) {
      # Add until -- or end of args
      while (($arg=shift(@ARGV)) && $arg ne "--") {
        push(@files,my_glob($arg));
      }
      next;
    }
    if ($arg =~ /^-exclude$/) { my $e = shift(@ARGV); @files = grep($_ ne $e, @files); next; }
    if ($arg =~ /^-write_slack$/) { $write_slack=shift(@ARGV); next; }
    if ($arg =~ /^-delay$/) { $delay=shift(@ARGV); next; }
    if ($arg =~ /^-/) { usage("Unknown option: $arg"); }
    if (!defined(@files)) { push(@files,my_glob($arg)); next; }

    @cmd=($arg,@ARGV);
    last;
  }

  usage("No file specified") if (!defined(@files));
  foreach ( @files ) { usage("File not found [$_]") if (!-M $_); }
  @cmd=($files[0]) unless @cmd;

  my $cmd = make_cmd(@cmd);

  ($delay,$first,$write_slack,$cmd,@files);
}

##################################################
# Interrupts
##################################################
#sub done {
#  foreach (@_) { print "\n[$MAIN::PROGNAME] ERROR:  $_\n"; }
#  unlink($touchfile);
#  exit;
#}
#$SIG{'INT'}='done';     # Ctrl-C?
#$SIG{'TERM'}='done';   # Terminate process (kill)
#$SIG{'HUP'}='done';     # Ctrl-C?
#$SIG{'QUIT'}='done';    # Bye?

##################################################
# Main code
##################################################

sub usleep($) { select(undef,undef,undef,shift); }

sub run {
  my ($cmd, $file) = @_;

  print $file ? ("-- [$file] "."-"x(54-length($file))) : "-"x60;
  print "\n";

  # Replacements
  if ($cmd =~ /%[D|F]/) {
    my ($D,$f) = ($file =~ m|(.*)/(.+)$|) ? ($1?$1:'/',$2) : ('.',$file);
    $cmd =~ s/\\%f/$f/g;
    $cmd =~ s/\\%F/$file/g;
    $cmd =~ s/\\%D/$D/g;
  }

  system($cmd);
  print STDERR "-- [exit: $?] --";
}

sub main {
  my ($delay,$first,$write_slack,$cmd,@files) = parse_args();

  my $file;
  my %mods;

  # Init the %mods hash
  map($mods{$_}=-M $_, @files);

  run($cmd) if $first;

  while (1) {
    my $file;
    usleep .3;	# Hack: Give it a moment to finish writing if necessary
    foreach $file ( @files ) {
      if (-M $file < $mods{$file} - $write_slack*$SECOND) {
        $mods{$file}=-M $file;

        run($cmd,$file);
        last;
      }
    }
    usleep $delay;
  }
}
main();