#!/usr/local/bin/perl
#
#	$Id: spliton,v 1.4 1999/02/01 10:05:12 dgregor Exp $
# 
# Copyright (c) 1998 Daniel J. Gregor, Jr., All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
# 	This product includes software developed by Daniel J. Gregor, Jr.
# 4. The name of Daniel J. Gregor, Jr. may not be used to endorse or promote
#    products derived from this software without specific prior written
#    permission.
# 
# THIS SOFTWARE IS PROVIDED BY DANIEL J. GREGOR, JR. ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL DANIEL J. GREGOR, JR. BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#

use FileHandle;
use Getopt::Std;

$progname = "spliton";
$usage = 
"	$progname [-a] [-v] [-n] <regexp> [<input files>]
	$progname -h";
$help =
"usage:
$usage

options:
	-a	Append to files instead of overwriting
	-v	Verbose; tell what files we are opening
	-n	Dry run; don't actually open files; useful with -v to show you
		what's happening.

arguments:
	<regexp>
		Match this regular expression on input lines.  A portion of
		the regular expression must be enclosed in parenthesis, and
		the string matched inside the parenthesis will be used for
		the output file name.";

$writemode = "w";

getopts("avnh", \%opts);

if ($opts{'h'}) {
	print "$help\n";
	exit(0);
}

die "$progname: usage:\n$usage\n" unless @ARGV > 0;

$writemode = "a" if defined($opts{'a'});

$regexp = shift(@ARGV);

$regexp =~ m/^[^()]*\([^()]*\)[^()]*$/ ||
	die "$progname: <regexp> must contain one and only one set of parenthesis\n";

$openfiles = {};
$filesarray = ();

while (<>) {
	chomp();

	m/$regexp/ || do {
		warn "Could not match regexp on line $.\n";
		next;
	};

	if (!exists($$openfiles{$1})) {
		if (@$filesarray > 10) {
			$closefile = shift(@$filesarray);

			if (defined($opts{'v'})) {
				if (defined($opts{'n'})) {
					print "Would close file \"$closefile\"\n";
				} else {
					print "Closing file \"$closefile\"\n";
				}
			}

			undef($$openfiles{$closefile});
		}

		if (defined($opts{'n'})) {
			print "Would open file \"$1\"\n" if defined($opts{'v'});
			$file = "/dev/null";
		} else {
			print "Opening file \"$1\"\n" if defined($opts{'v'});
			$file = $1;
		}

		defined($$openfiles{$1} = new FileHandle($file, $writemode)) ||
			die "$progname: open($file): $!\n";

		push(@$filesarray, $1);
	}

	$$openfiles{$1}->print($_, "\n");
}