#!/usr/bin/perl
# Filename:	spigot
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License/
  my $VERSION=  '1.03';
# Description:	Like a faucet tap, turns the output of a text file on and off
use strict;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0; $PROGNAME =~ s|.*/||;
my ($BASENAME,$PROGNAME) = ($0 =~ m|(.*)/(.+)|) ? ($1?$1:'/',$2) : ('.',$0);


##################################################
# Usage
##################################################
sub fatal {
	foreach my $msg (@_) { print STDERR "[$PROGNAME] ERROR:  $msg\n"; }
	exit(-1);
}

sub usage {
	foreach my $msg (@_) { print STDERR "ERROR:  $msg\n"; }
	print STDERR <<USAGE;

Usage:\t$PROGNAME [-d] <files>
Like a faucet tap, turns the output of a text file on and off

  Controls:
  -show <num>    Show <num> lines (or 'all')
  -skip <num>    Skip <num> lines
  -line <num>    Move forward to exact line number <num> (if we haven't passed it)
  -off <regex>   Turn off display when <regex> is seen
  -on <regex>    Turn on display when <regex> is seen
  -ON            Just turn on (similar to '-on .')
  -OFF           Just turn off
  -do \"<cmd>\"    Execute a command
  -echo \"<str>\"  Print a line
 
  -d	Set debug mode

Examples:

# A very inefficient 'cat'
% $PROGNAME file

# Like 'head'
% $PROGNAME file -show 15 -OFF

# Show everything up until '^footer' is seen
% $PROGNAME file -off '^footer'

# Show everything up until and including '^footer'
# (The '-show 1' will show one line (the footer) but won't change on/off status)
% $PROGNAME file -off '^footer' -show 1

# Show everything after we find 'START'
% $PROGNAME file -OFF -on START

# Show everything after (but not including) 'START'
% $PROGNAME file -OFF -on START -skip 1

# Show the first two lines of 'log' then show everything from 'ERROR MSG'
# until the first blank line is found, then stop processing the file
% $PROGNAME log -OFF -show 2 -on "ERROR MSG" -off '^\$'

# Show lines 25-27
% $PROGNAME file -line 25 -show 3
% $PROGNAME file -skip 24 -show 3

# Any number can be a simple math expression:
% $PROGNAME file -line 24+1 -show '(10-1)/3'

# Use -echo and -do
% $PROGNAME file -echo "HEADER" -ON -off INCLUDE-HERE -do "cat include" -ON

# -echo at end of file
% $PROGNAME file -on START -show all -echo "FOOTER"

USAGE
	exit -1;
}

# Numbers in the parseArgs can be simple expressions
sub toNum {
	my ($for, $arg) = @_;
	return $arg unless $arg =~ /\D/;
	# Only handle mathematical expressions before calling eval
	# Is there any hack to this that can use these symbols for something other than math??
	# We can allow parens because there aren't any functions that only have numeric names.
	usage("Can't understand numeric arg: '-$for $arg'") unless $arg =~ /^[\d\+\*\/\(\)\- ]+$/;
	return eval($arg);
}

sub parse_args {
	my $opt = {};
	while (my $arg=shift(@ARGV)) {
		if ($arg =~ /^-h$/) { usage(); }
		if ($arg =~ /^-d$/) { $opt->{d}=1; next; }
		if ($arg =~ /^-(on|off|echo|do)$/) { push(@{$opt->{ctrl}}, [$1, shift @ARGV]); next; }
		if ($arg =~ /^-(show|line|skip)$/) { push(@{$opt->{ctrl}}, [$1, toNum($1, shift @ARGV)]); next; }
		if ($arg =~ /^-(ON|OFF)$/) { push(@{$opt->{ctrl}}, [$1]); next; }
		if ($arg =~ /^-./) { usage("Unknown option: $arg"); }
		push(@{$opt->{files}}, $arg);
	}
	usage("No file defined") unless $opt->{files};
	
	$opt;
}

sub debug {
	my ($opt,@msg) = @_;
  return unless $opt->{d};
  foreach my $msg (@msg) { print STDERR "[$PROGNAME] $msg\n"; }
}

##################################################
# Process a file
##################################################

sub moreCtrl {
	my ($opt) = @_;
	return 0 unless $opt->{ctrl};
	return 1 if @{$opt->{ctrl}};
}

# What is the current ctrl?
# Handle echo/do here
sub currCtrl {
	my ($opt) = @_;
	return 0 unless $opt->{ctrl};
	return 0 unless $opt->{ctrl}[0];
	my ($cmd,$arg,@args) = @{$opt->{ctrl}[0]};
	return ($cmd,$arg,@args) unless $cmd eq 'echo' || $cmd eq 'do';
	if ($cmd eq 'echo') {
		print "$arg\n";	# Should this have an automatic newline?
		return nextCtrl($opt);
	}
	if ($cmd eq 'do') {
		system($arg);
		return nextCtrl($opt);
	}
}

sub nextCtrl {
	my ($opt) = @_;
	return 0 unless $opt->{ctrl};
	shift @{$opt->{ctrl}};
	currCtrl($opt);
}

# Do we start with the spigot on or off?
sub start {
	my ($opt) = @_;

	return 1 unless moreCtrl($opt);	# Default case, act like "cat"
	my ($cmd) = currCtrl($opt);

	return 1 unless $cmd;
	return 0 if grep($cmd eq $_, qw(show on));
	1;
}

sub process {
	my ($opt, $file) = @_;

	my @backup = @{$opt->{ctrl}};

	open(FILE,"<$file") || usage("Couldn't open file: $file");
	
	# Process a file, turning the spigot on and off.
	my $on = start($opt);

	my $done_with_file = 0;
	while(<FILE>) {
		# Can we match any controls?
		my $match = 1;
		while ($match) {

			# We're done if we're 'off' and we have no more controls
			unless (moreCtrl($opt)) {
					if ($on) { print; map { print } <FILE>; }
					$on = 0;	# We're done
					$done_with_file = 1;
					last;
			}

			# Get the next control
			my ($cmd,$arg,@args) = currCtrl($opt);

			$match = 0;
			if ($cmd eq "ON") {
				($on,$match) = (1,1);
			} elsif ($cmd eq "OFF") {
				($on,$match) = (0,1);
			} elsif ($cmd eq "on") {
				($on,$match) = (1,1) if /$arg/;
			} elsif ($cmd eq "off") {
				($on,$match) = (0,1) if /$arg/;
			} elsif ($cmd eq "show") {
				$match = 1;
				print;	# Current line
				if ($arg eq 'all') {
					print <FILE>;
					$on = 0;
					undef $_;
				} else {
					map { print scalar <FILE>; } 2..$arg;
					$_ = scalar <FILE>;	# Next line
				}
			} elsif ($cmd eq "skip") {
				if ($arg > 0) {
					map { scalar <FILE>; } 2..$arg;
					$_ = scalar <FILE>;	# Next line
				}
				$match = 1;
			} elsif ($cmd eq "line") {
				my $skip = $arg - $.;
				if ($skip > 0) {
					map { scalar <FILE>; } 2..$skip;
					$_ = scalar <FILE>;	# Next line
				}
				$match = 1;
			} 

			nextCtrl($opt) if $match;
			print "$match -> cmd,on=[$cmd,$on] $_" if $opt->{d};
		}

		print if $on && !$opt->{d};

		last if $done_with_file;
	}
	close(FILE);

	@{$opt->{ctrl}} = @backup;
}

##################################################
# Main code
##################################################
sub main {
	my $opt = parse_args();

	map { process($opt, $_) } @{$opt->{files}};
}
main();