#!/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;
use File::Basename;

##################################################
# Setup the variables
##################################################
$MAIN::PROGNAME = basename($0);

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..>
  Run a command every time a file/files change
  -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)
  -0        Watch the first argument in the commmand (no <file> needed)
  -a        Watch any args in the command that are current files
  -1        Run through the first time before any checks
  -which    Watch the `which` of the first argument (implies -0)
  -Y        Short for -which -1
  -delay    Delay between checks for changes
  -d        Set debug mode
  -e        Wait till file exists
  -exit     Exit after running

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


#### NOT USED ANYMORE
## 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 %opt = (
		first => 0,
		delay => 0.1,
		write_slack => 0,
		write_delay => 0.4,
	);
	my $opt = \%opt;
  my ($first, $delay, $write_slack, $write_delay) = (0,.1,0, .4);

  while ($#ARGV>=0) {
    $arg=shift(@ARGV);
    if ($arg =~ /^-h$/) { usage(); }
    if ($arg =~ /^-d$/) { $MAIN::DEBUG=1; next; }
    if ($arg =~ /^-1$/) { $opt->{first}=1; next; }
    if ($arg =~ /^-0$/) { $opt->{zero}=1; next; }
    if ($arg =~ /^-which$/) { $opt->{zero}=1; $opt->{which}=1; next; }
    if ($arg =~ /^-Y$/) { $opt->{first}=1; $opt->{zero}=1; $opt->{which}=1; next; }
    if ($arg =~ /^-a$/) { $opt->{all}=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$/) { $opt->{write_slack}=shift(@ARGV); next; }
    if ($arg =~ /^-delay$/) { $opt->{delay}=shift(@ARGV); next; }
    if ($arg =~ /^-write_delay$/) { $opt->{write_delay}=shift(@ARGV); next; }
    if ($arg =~ /^-e(xists)?$/) { $opt->{exists}=1; next; }
    if ($arg =~ /^-exit$/) { $opt->{exit}=1; next; }
    if ($arg =~ /^-/) { usage("Unknown option: $arg"); }
    if (!@files && !$opt->{zero} && !$opt->{all}) { push(@files,my_glob($arg)); next; }

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

	map { push(@files,$_) if -e $_ } @cmd if $opt->{all};
	unshift(@files,$cmd[0]) if $opt->{zero};

	if ($opt->{which}) {
		my $which = `which $files[0]`;
		die("Could not -which $files[0]?") if $?;
		chomp($which);
		$files[0] = $which;
	}

  usage("No file specified") unless @files;
	unless ($opt->{exists}) {
  	foreach ( @files ) { usage("File not found [$_]") if (!-M $_); }
	}

	#@cmd = -x $files[0] ? ($files[0]) : ('tail','-n',25,$files[0])
	@cmd = -x $files[0] ? ($files[0]) : ('cat',$files[0])
  	unless @cmd;

	$opt->{files} = \@files;
	$opt->{cmd} = \@cmd;
	($opt);
}

##################################################
# 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 ($opt, $file) = @_;
	
	print $file ? ("-- [$file] "."-"x(50-length($file))) : "-"x60;
	print "\n";
	
	# Replacements
	my ($D,$f) = ($file =~ m|(.*)/(.+)$|) ? ($1?$1:'/',$2) : ('.',$file);
	my @cmd = map {
		s/\%f/$f/g;
		s/\%F/$file/g;
		s/\%D/$D/g;
		$_;
	} @{$opt->{cmd}};
	
	system(@cmd);
	my $exit = $? >> 8;
	my $int  = $? & 127;
	my $core = $? & 128;
	print STDERR "-- [exit: $?] --";
	print STDERR " COREDUMP --" if $core;
}

sub main {
  my ($opt) = parse_args();

  my $file;
  my %mods;

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

  run($opt) if $opt->{first};

  while (1) {
    my $file;
    foreach $file ( @{$opt->{files}} ) {
			# Force NFS cache to refresh
			my $dir = dirname($file);
			opendir(my $dirh, $dir); closedir($dirh);

      if (-M $file < $mods{$file} - $opt->{write_slack}*$SECOND) {
        usleep $opt->{write_delay};	# Hack: Give it a moment to finish writing if necessary

        $mods{$file}=-M $file;

        run($opt,$file);
				return if $opt->{exit};
        last;
      }
    }
    usleep $opt->{delay};
  }
}
main();