#!/usr/bin/perl
# by Jeff Haemer
#	and a tip o' the hat to Tom Schneider
#       who wrote the original version as a shell script

# version = 2.07 of atchange 1999 Dec 30

# 1999 Dec 18:  Added shell call to /bin/csh so that
# atchange works under Linux.

# 1999 Feb 5: By setting the PERLCSH variable, the new shell can tell
#             it has been called by atchange.
# The test inside the .cshrc is:
#if ( (! $?PERLCSH ) && $?prompt) then 
#   stty erase '^H'
#   set prompt = "`uname -n` \!% "
#endif
# This is necessary under Sun Solaris 2.6 because otherwise the
# call to stty gives an error message now.

# previous change: 1997 Jan 9
# delay time is 0.25 seconds

#  For current version and other information about this program, see:
#  http://www.lecb.ncifcrf.gov/~toms/atchange.html

#  Tom Schneider
#  National Cancer Institute
#  Laboratory of Mathematical Biology
#  Frederick, Maryland  21702-1201
#  toms@ncifcrf.gov
#  http://www.lecb.ncifcrf.gov/~toms/

# 1999 Dec 30:  James Haefner (jhaefner@biology.usu.edu)
# has found that some changes are needed to make atchange
# work under Linux.  See the web site for details.
# This code will be revised when a good solution is found.

$0 =~ s(.*/)();			# basename
$usage = "usage: $0 filename cmd | $0 command_file";
@ARGV || die $usage;		# check for proper invocation

# This allows the .cshrc to know that atchange has called it:
$ENV{'PERLCSH'} = "TRUE";

# Haefner Suggestion 1999 Dec 18:
##if default SHELL is sh or csh or tcsh use the following line
###$shell = $ENV{"SHELL"} ? $ENV{"SHELL"} : "/bin/sh";
##if default SHELL is bash (eg, Linux) use the following line
# 1999 Dec 28 - this is not a good idea - untestable by me
# $shell = "/bin/csh";

$shell = $ENV{"SHELL"} ? $ENV{"SHELL"} : "/bin/sh";
open(SHELL, "|$shell") || die "Can't pipe to $shell: $!";
select(SHELL); $| = 1;

if (@ARGV > 1) {		# it's a file and a command
	$file = shift;				# peel off the filename
	$cmd{$file} = join(" ", @ARGV) . "\n";	#	and the command
	$old{$file} = (stat($file))[9];	# mod time.
} else {			# it's a program
	open(PGM, shift) || die "Can't open $_: $!";
	$/ = "";			# paragraph mode
	while(<PGM>) {			# first read the program
		s/#.*\n/\n/g;
		($file, $cmd) = /(\S*)\s+([^\000]+)/;
		$cmd{$file} = $cmd;
		unless ($file) { print $cmd{$file}; next; }
		if ($file && ! $cmd{$file}) { warn "odd line"; next; };
		$old{$file} = (stat($file))[9];	# mod time.
	}
}

while(1) {
	# sleep 1;		# wait a second, then
	select(undef, undef, undef, 0.25); # wait a quarter second, then
	foreach (keys %cmd) {	#	rip through the whole list
		atchange($_);
	}
}
close(SHELL);

sub atchange {		# if $file has changed, do $cmd{$file}
	my($file) = @_;
	my($new);

	$new = (stat($file))[9];
	return 0 if ($old{$file} == $new);
	while (1) {			# wait until it stops changing
		$old{$file} = $new;
		sleep 1;
		$new = (stat($file))[9];
		if ($old{$file} == $new) {
			print $cmd{$file};
			return 1;
		}
	}
}