#! /usr/bin/perl

##############################################################################
##############################################################################
{
# Copyright (c) 2005 Joseph Walton
# All rights reserved
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package FileCache::Handle;

# A FileCache, using IO::Handle instances

use strict;

our $VERSION = '0.002';

use IO::Handle;
our @ISA = ('IO::Handle');

use Symbol;
use IO::File;
use Errno;

# The maximum number of files to keep open
our $MAX = 1024;

# The current instances with a live file open
my @real;

# Show details of the files that are really open
sub showReal()
{
	print '[', join(',', map { $_ || '' } @real),"]\n";
}

sub new($)
{
	my $class = shift;
	my $self = $class->SUPER::new();

	tie *$self, $self;

	my $path = shift;

	*$self->{'path'} = $path;
	*$self->{'real'} = undef;
	*$self->{'initial'} = 1;

	$self->open() or die;

	if ($self->_allocate()) {
		return $self;
	} else {
		return undef;
	}
}

sub TIEHANDLE
{
	return $_[0] if ref($_[0]);

	my $class = shift;

	my $self = bless Symbol::gensym(), $class;

	return $self;
}

sub open
{
	my $self = shift;
	$self;
}

use overload (
	'""' => \&_stringify
);

sub _release()
{
	my $self = shift;

	my $count = 0;

	while (@real >= $MAX) {
		my $d = shift(@real);
		my $f = *$d->{'real'};
		*$d->{'real'} = undef;
		*$d->{'initial'} = 0;
		if ($f) {
			$f->close() or return undef;
		}
		$count++;
	}

	return $count;
}

sub _allocate()
{
	my $self = shift;

	if (!defined(*$self->{'real'})) {
		defined(_release()) or return undef;

		my $f;
		do {
			if (*$self->{'initial'}) {
				$f = new IO::File(*$self->{'path'}, '>');
			} else {
				$f = new IO::File(*$self->{'path'}, '>>');
			}

			# If opening failed because of EMFILE, correct $MAX
			if (!$f) {
				if ($!{EMFILE}) {
					if (@real < $MAX) {
						$MAX = @real;
					} else {
						die "$!: ".scalar(@real)." open, MAX is $MAX";
					}
				} else {
					return undef;
					die "Unable to open file: $!";
				}
			}
		} while (!$f && _release());

		if (*$self->{'binmode'}) {
			binmode($f, *$self->{'binmode'}) or return undef;;
		}

		*$self->{'real'} = $f;
		push @real, $self;
	} else {
		# XXX Should move $self to the head of @real, for LRU behaviour
	}

	return *$self->{'real'};
}

sub print
{
	return shift->PRINT(@_);
}

sub PRINT
{
	my $self = shift;

	my $f = $self->_allocate();
	
	if ($f) {
		return $f->print(@_);
	} else {
		return undef;
	}
}

sub BINMODE
{
	my $self = shift;
	my $bm = shift;

	*$self->{'binmode'} = $bm;

	if (*$self->{'real'}) {
		return binmode(*$self->{'real'}, $bm);
	} else {
		return 1;
	}
}

sub CLOSE
{
	my $self = shift;
	if (*$self->{'real'}) {
		my $f = *$self->{'real'};
		*$self->{'real'} = undef;
		# XXX Should remove $self from @real
		return $f->close();
	} else {
		return 1;
	}
}

sub _stringify()
{
	my $self = shift;
	return ref($self) . '@' . *$self->{'path'};
}

#:: 1;
#:: __END__
#:: 
#:: =head1 NAME
#:: 
#:: FileCache::Handle - A FileCache using IO::Handle instances
#:: 
#:: =head1 SYNOPSIS
#:: 
#::   use FileCache::Handle;
#:: 
#::   $FileCache::Handle::MAX = 16;
#:: 
#::   my @a;
#::   for (my $i = 0 ; $i < 100 ; $i++) {
#::     my $o = new FileCache::Handle("/tmp/$i");
#:: 
#::     binmode($o, ':utf8');
#::     push @a, $o;
#::   }
#:: 
#::   for (my $i = 0 ; $i < 3 ; $i++) {
#::     foreach my $o (@a) {
#::       print $o "Output ",$o," $i\n";
#::     }
#::   }
#:: 
#:: =head1 DESCRIPTION
#:: 
#:: FileCache::Handle, like FileCache, avoids OS-imposed limits on the number
#:: of simultaneously open files. Instances behave like file handles and,
#:: behind the scenes, real files are opened and closed as necessary.
#:: FileCache::Handle uses instances of IO::Handle, and so works well with
#:: 'use strict'.
#:: 
#:: =head1 NOTES
#:: 
#:: The only operations supported are 'print' and 'binmode'. To add more,
#:: create a glue method that delegates the call to the handle returned by
#:: '_allocate()'.
#:: 
#:: Unless MAX is set, this class will open as many files as possible before
#:: closing any. As such, it will monopolise available files, so you
#:: should open any other files beforehand.
#:: 
#:: =head1 AUTHOR
#:: 
#:: Joseph Walton <joe@kafsemo.org>
#:: 
#:: =head1 COPYRIGHT
#:: 
#:: Copyright (c) 2005 Joseph Walton
#:: 
}
##############################################################################
##############################################################################
{
package MiniSEED;

use 5.008008;
use strict;
use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use MiniSEED ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

our $VERSION = '0.01';


# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

our($SEED_BIG_ENDIAN) = 1;
our($SEED_LITTLE_ENDIAN) = 0;

sub new {
    my $class = shift;
    my %options = @_;

    my $self = {
   	mshdr  => 	undef,
	msrecord =>	undef,
	filehandle =>	undef,
	inbuf =>	undef,
	inbuflen =>	undef,
	inbufoffset =>	undef,
	%options,
    };
    bless($self, $class);
    return($self);    
}


sub set_filehandle {
    my $self = shift;
    my($fh)= @_;
    $self->{filehandle} = $fh;
    $self->{inbuflen} = undef;
    return 1;
}

sub set_inbuf {
    my $self = shift;
    my($inbuf)= @_;
    $self->{inbuf} = $inbuf;
    $self->{inbuflen} = length($inbuf);
    $self->{inbufoffset} = 0;
    $self->{filehandle} = undef;
    return 1;
}

# Functions to return component values.

sub seqno {
    my $self = shift;
    return $self->{mshdr}{seqno};
}

sub msqual {
    my $self = shift;
    return $self->{mshdr}{msqual};
}

sub station {
    my $self = shift;
    return $self->{mshdr}{station};
}

sub location {
    my $self = shift;
    return $self->{mshdr}{location};
}
    
sub channel {
    my $self = shift;
    return $self->{mshdr}{channel};
}
    
sub network {
    my $self = shift;
    return $self->{mshdr}{network};
}
    
sub hdrtime {
    my $self = shift;
    return $self->{mshdr}{hdrtime};
}
    
sub numsamples {
    my $self = shift;
    return $self->{mshdr}{numsamples};
}

sub rate {
    my $self = shift;
    return $self->{mshdr}{rate};
}
    
sub ratemult {
    my $self = shift;
    return $self->{mshdr}{ratemult};
}
    
sub aflags {
    my $self = shift;
    return $self->{mshdr}{aflags};
}
    
sub ioflags {
    my $self = shift;
    return $self->{mshdr}{ioflags};
}
    
sub qflags {
    my $self = shift;
    return $self->{mshdr}{qflags};
}
    
sub timecorrection {
    my $self = shift;
    return $self->{mshdr}{timecorrection};
}
    
sub numblockettes {
    my $self = shift;
    return $self->{mshdr}{numblockettes};
}
    
sub firstdata {
    my $self = shift;
    return $self->{mshdr}{firstdata};
}
    
sub firstblockette {
    my $self = shift;
    return $self->{mshdr}{firstblockette};
}
    
sub samplerate {
    my $self = shift;
    return $self->{mshdr}{samplerate};
}
    
# Derived values.

sub starttime {
    my $self = shift;
    return $self->{mshdr}{hdrtime};
}
    
sub endtime {
    my $self = shift;
    return $self->{mshdr}{endtime};
}
    
sub blockettelist {
    my $self = shift;
    return $self->{mshdr}{blockettelist};
}

sub msformat {
    my $self = shift;
    return $self->{mshdr}{msformat};
}

sub hdrwordorder {
    my $self = shift;
    return $self->{mshdr}{hdrwordorder};
}

sub datawordorder {
    my $self = shift;
    return $self->{mshdr}{datawordorder};
}

sub msreclen {
    my $self = shift;
    return $self->{mshdr}{msreclen};
}

sub msrecsize {
    my $self = shift;
    return $self->{mshdr}{msrecsize};
}

sub clockquality {
    my $self = shift;
    return $self->{mshdr}{clockquality};
}

sub usec99 {
    my $self = shift;
    return $self->{mshdr}{usec99};
}

sub framecount {
    my $self = shift;
    return $self->{mshdr}{framecount};
}

sub msrecord {
    my $self = shift;
    return $self->{msrecord};
}

sub name {'miniseed'}

sub dump_mshdr {
    my $self = shift;
    print("MiniSEED record dump:\n");
    printf ("seqno =\t%s\n", $self->seqno);
    printf ("msqual =\t%s\n",  $self->msqual);
    printf ("station =\t%s\n", $self->station);
    printf ("location =\t%s\n", $self->location);
    printf ("channel =\t%s\n", $self->channel);
    printf ("network = \t%s\n", $self->network);
    printf ("hdrtime = \t%s\n", $self->hdrtime);
    printf ("numsamples = \t%s\n", $self->numsamples);
    printf ("rate = \t%s\n", $self->rate);
    printf ("ratemult = \t%s\n", $self->ratemult);
    printf ("aflags = \t%s\n", $self->aflags);
    printf ("ioflags = \t%s\n", $self->ioflags);
    printf ("qflags = \t%s\n", $self->qflags);
    printf ("timecorrection = \t%s\n", $self->timecorrection);
    printf ("numblockettes = \t%s\n", $self->numblockettes);
    printf ("firstdata = \t%s\n", $self->firstdata);
    printf ("firstblockette = \t%s\n", $self->firstblockette);
    printf ("msformat = \t%s\n", $self->msformat);
    printf ("hdrwordorder = \t%s\n", $self->hdrwordorder);
    printf ("datawordorder = \t%s\n", $self->datawordorder);
    printf ("msreclen = \t%s\n", $self->msreclen);
    printf ("msrecsize = \t%s\n", $self->msrecsize);
    printf ("clockquality = \t%s\n", $self->clockquality);
    printf ("usec99 = \t%s\n", $self->usec99);
    printf ("framecount =\t%s\n", $self->framecount);
    printf ("msrecordlength =\t%s\n", length($self->msrecord));
#    printf ("msrecord = \t%s\n", $self->msrecord);
#    printf ("starttime = \t%s\n", $self->starttime);
#    printf ("endtime = \t%s\n", $self->endtime);
#    printf ("samplerate = \t%s\n", $self->samplerate);
#    printf ("blockettelist = \t%s\n", $self->blockettelist);
    print("\n");
}

sub readnext {
    my $self = shift;
    my $n = pop(@_);
    warn("MinSEED - neither filehandle nor input buffer defined\n"), return undef
	if (! (defined($self->{filehandle}) or defined($self->{inbuf})));
    warn("MinSEED - both filehandle and input buffer defined\n"), return undef
	if ((defined($self->{filehandle}) and defined($self->{inbuf})));
    my $nr = 0;
    for (@_) {
	if (defined($self->{filehandle})) {
	    $nr = read($self->{filehandle}, $_, $n);
	    return $nr;
	}
	else {
	    $nr = ($self->{inbufoffset}+$n > $self->{inbuflen}) ? $self->{inbuflen}-$self->{inbufoffset} : $n;
	    return 0 if ($nr <= 0);
	    $_ = substr($self->{inbuf},$self->{inbufoffset},$nr);
	    $self->{inbufoffset} += $nr;
	    return $nr;
	}
    }
}

sub read {
    my($self) = @_;
    my($msrec, $hsize, $nr);
    my($fhsize) = 48;
    my $mshdr = {
	seqno => 	'',
	msqual =>	'D',
	station => 	'',
	location => 	'',
	channel => 	'',
	network => 	'',
	hdrtime => 	'',
	numsamples => 	0,
	rate =>		0,
	ratemult => 	1,
	aflags => 	0,
	ioflags => 	0,
	qflags => 	0,
	timecorrection => 0,
	numblockettes => 0,
	firstdata => 	0,
	firstblockette => 0,
	msformat => 	undef,
	hdrwordorder =>	undef,
	datawordorder => undef,
	msreclen =>	undef,
	msrecsize =>	undef,
	clockquality =>	undef,
	usec99 =>	undef,
	framecount =>	undef,
	msrecord =>	undef,
	starttime =>	'',	# Derived
	endtime =>	'',	# Derived
	samplerate =>	0,	# Derived
	blockettelist => {},	# Derived
    };
    $nr = $self->readnext($msrec, $fhsize);
    return ($nr) if ($nr eq 0);
    warn("Error reading MiniSEED FixedRecordHeader\n"),return undef unless ($nr == $fhsize);
    $hsize = $nr;

    # Make no assumption about word order of input MiniSEED record.  
    # Unpack ascii data and time blob.
    my($template) = "A6AAA5A2A3A2Z10";
    my($seq,$msqual,$blank,$sta,$loc,$cha,$net,$datetime) = unpack($template,$msrec);
    # Verify basic info;
    warn("Error - MiniSEED record error - no blank in header\n"), return undef unless ($blank eq "");
    warn("Error - MiniSEED record error - bad seqno\n"), return undef unless ($seq =~ /^\d*$/);
    warn("Error - MiniSEED record error - bad msqual\n"), return undef unless ($msqual =~ /R|D|Q|M/);

    # Test the date field to determine MiniSEED wordorder.
    # WARNING: This check ONLY works for dates in the range [1800, ..., 2054].
    my(@y) = unpack("CC",$datetime);
    my($hdrwordorder);
    my($n,$N);
    if (($y[0] == 0x07 && $y[1] >= 0x08) or ($y[0] == 0x08 && $y[1] <  0x07)) {
	$hdrwordorder = $SEED_BIG_ENDIAN;
    }
    elsif (($y[1] == 0x07 && $y[0] >= 0x08) or ($y[1] == 0x08 && $y[0] <  0x07)) {
	$hdrwordorder = $SEED_LITTLE_ENDIAN;
    }
    else {
	warn("Error - MiniSEED record error - Unable to determine wordorder from time\n");
	return undef;
    }
    if ($hdrwordorder == $SEED_BIG_ENDIAN) {
	$n = 'n'; 
	$N = 'N';
    }
    else {
	$n = 'u';
	$N = 'U';
    }
    $mshdr->{hdrwordorder} = $hdrwordorder;

    # Save ascii data.
    $mshdr->{seqno} = $seq;
    $mshdr->{msqual} = $msqual;
    $mshdr->{station} = $sta;
    $mshdr->{location} = $loc;
    $mshdr->{channel} = $cha;
    $mshdr->{network} = $net;

    # Unpack and save the reset of the MiniSEED Fixed Data Header.
    my($template2) = "${n}${n}CCCx${n}${n}${n}${n}CCCC${N}${n}${n}";    
    my($yr,$doy,$hr,$min,$sec,$tick,@t) = unpack($template2, substr($msrec,20));
    $mshdr->{hdrtime} = sprintf ("%04d-%03dT%02d:%02d:%02d.%04d", $yr, $doy, $hr, $min, $sec, $tick);
    $mshdr->{numsamples} = shift(@t);
    $mshdr->{rate} = shift(@t);
    $mshdr->{ratemult} = shift(@t);
    $mshdr->{aflags} = shift(@t);
    $mshdr->{ioflags} = shift(@t);
    $mshdr->{qflags} = shift(@t);
    $mshdr->{numblockettes} = shift(@t);
    $mshdr->{timecorrection} = shift(@t);
    $mshdr->{firstdata} = shift(@t);
    $mshdr->{firstblockette} = shift(@t);

    # Now we have to look for a blockette 1000.
    # Read any unused space between the end of the Fixed Data Header
    # and the beginning of the blockettes.
    warn("Error - MiniSEED record error - No blockettes\n"), return undef
	unless ($mshdr->{numblockettes} > 0 and $mshdr->{firstblockette} >= $hsize);
    my($nskip) = $mshdr->{firstblockette} - $hsize;
    my($buf);
    if ($nskip > 0) {
	$nr = $self->readnext($buf, $nskip);
	warn("Error skipping to first blockette\n"), return undef if ($nr != $nskip);
	$msrec .= $buf;
	$hsize += $nr;
	$nskip = 0;
    }

    my($nbleft) = $mshdr->{numblockettes};
    my($msrecsize) = undef;
    while ($nbleft-- > 0) {
	# Read blockette header.
	$nr = $self->readnext($buf, 4);
	warn("Error reading blockette header\n"), return undef if ($nr != 4);
	my($bt,$nb) = unpack("${n}${n}",$buf);
	$msrec .= $buf;
	$hsize += $nr;
	if ($bt == 1000) {
	    # Read the contents of blockette 1000 and determine msrecsize.
	    $nr = $self->readnext($buf, 4);
	    warn("Error reading blockette 1000\n"), return undef if ($nr != 4);
	    my($msformat,$datawordorder,$msreclen) = unpack("CCCx",$buf);
	    $mshdr->{msformat} = $msformat;
	    $mshdr->{datawordorder} = $datawordorder;
	    $mshdr->{msreclen} = $msreclen;
	    $mshdr->{msrecsize} = 2**$msreclen;
	    $msrec .= $buf;
	    $hsize += $nr;
	    $nskip = ($nb > 0) ? $nb - $hsize : $mshdr->{firstdata} - $hsize;
	}
	elsif ($bt == 1001) {
	    # Read the contents of blockette 1001.
	    $nr = $self->readnext($buf, 4);
	    warn("Error reading blockette 1001\n"), return undef if ($nr != 4);
	    my($clockquality,$usec99,$framecount) = unpack("CCxC",$buf);
	    $mshdr->{clockquality} = $clockquality;
	    $mshdr->{usec99} = $usec99;
	    $mshdr->{framecount} = $framecount;
	    $msrec .= $buf;
	    $hsize += $nr;
	    $nskip = ($nb > 0) ? $nb - $hsize : $mshdr->{firstdata} - $hsize;
	}
        else {	    
	    # Unknown blockette.  Skip blockette.
	    $nskip = ($nb > 0) ? $nb - $hsize : $mshdr->{firstdata} - $hsize;
	}
	if ($nskip > 0) {
	    $nr = $self->readnext($buf, $nskip);
	    warn("Error skipping blockette or space between blockettes\n"), return undef
		if ($nr != $nskip);
	    $msrec .= $buf;
	    $hsize += $nr;
	    $nskip = 0;
	}
	warn("Error skipping blockette or space between blockettes\n"), return undef
	    if ($nskip < 0 and $nbleft > 0);
    }	    
    
    # We should now be done with the blockettes, and have the MiniSEED record size.
    # Read the rest of the MiniSEED record.
    warn("Error skipping blockette or space between blockettes\n"), return undef
	unless (defined $mshdr->{msrecsize} and $mshdr->{msrecsize} > 0);
    $nskip = $mshdr->{msrecsize} - $hsize;
    $nr = $self->readnext($buf, $nskip);
    warn("Error reading MiniSEED data\n"), return undef if ($nr != $nskip);
    $msrec .= $buf;
    $self->{msrecord} = $msrec;
    $self->{mshdr} = $mshdr;
    return 1;
}

sub get_my_wordorder {
    my $ival = 0x012345467;
    my $nval = unpack("N",$ival);
    my $my_wordorder = ($nval == $ival) ? $SEED_BIG_ENDIAN : $SEED_LITTLE_ENDIAN;
    return $my_wordorder;
}

sub print {
    my($self, $fh) = @_;
    print($fh $self->{msrecord}) if (defined $self->{msrecord});
}

#:: 1;
#:: __END__
#:: # Below is stub documentation for your module. You'd better edit it!
#:: 
#:: 
#:: =head1 NAME
#:: 
#:: MiniSEED - Perl extension for blah blah blah
#:: 
#:: =head1 SYNOPSIS
#:: 
#::   use MiniSEED;
#::   blah blah blah
#:: 
#:: =head1 DESCRIPTION
#:: 
#:: Stub documentation for MiniSEED, created by h2xs. It looks like the
#:: author of the extension was negligent enough to leave the stub
#:: unedited.
#:: 
#:: Blah blah blah.
#:: 
#:: =head2 EXPORT
#:: 
#:: None by default.
#:: 
#:: 
#:: 
#:: =head1 SEE ALSO
#:: 
#:: Mention other useful documentation such as the documentation of
#:: related modules or operating system documentation (such as man pages
#:: in UNIX), or any relevant external documentation such as RFCs or
#:: standards.
#:: 
#:: If you have a mailing list set up for your module, mention it here.
#:: 
#:: If you have a web site set up for your module, mention it here.
#:: 
#:: =head1 AUTHOR
#:: 
#:: Doug Neuhauser, E<lt>doug@geo.berkeley.eduE<gt>
#:: 
#:: =head1 COPYRIGHT AND LICENSE
#:: 
#:: Copyright (C) 2013 by Doug Neuhauser
#:: 
#:: This library is free software; you can redistribute it and/or modify
#:: it under the same terms as Perl itself, either Perl version 5.8.8 or,
#:: at your option, any later version of Perl 5 you may have available.
#:: 
#:: 
#:: =cut
#:: 
}
##############################################################################
##############################################################################

require 5.002;
use strict;
use FileHandle;
use Getopt::Std;
use File::Basename;
use Date::Manip;
use Env;
#use FileCache::Handle;
#use MiniSEED;

#require "/data/24/doug/perl/modules/MiniSEED/lib/MiniSEED.pm";
#require "/data/24/doug/perl/modules/FileCache::Handle.pm";

our ( $VERSION, $cmdname, $opt_h, $opt_D, $opt_T );
our ( $outdir, $template );

$VERSION = "1.00beta (2013.338)";

########################################################################
#	print_syntax	- print syntax and exit.
########################################################################
sub print_syntax {
    my ($cmdname) = @_;
    print
"$cmdname version $VERSION
$cmdname - Split multi-channel MiniSEED file into single channel MiniSEED files.
Syntax:
$cmdname  [-h] [-D dir] [-T template] [ms_input_file]
where:
	-h	Help - prints this help message.
	-D dir	Save MiniSEED files in specified directory.
		Create directory if needed.
	-T template
		Specifies a new template for the output filename
		for each data channel. Each channel filename is
		constructed from the template where the following
		substitutions are made based on the first MiniSEED
		record for the data channel.
		String   Replaced by
		%S       Station name
		%N       Network name
		%C       Channel name
		%L       Location name
		%l       Location name (blank replaced with '--')
		%Y       4 digit year (0000-9999)
		%y       2 digit year (00-99)
		%m       2 digit month (01-12)
		%d       2 digit day of month (01-31)
		%j       3 digit day of year (000-366)
		%H       2 digit hour (00-23)
		%M       2 digit minute (00-59)
		%T       6 digit time (hhmmss)
		The default template is: $template
	ms_input_file
		Input MiniSEED file.  If no file specified,
		or specified as '-', read input from stdin.
Notes:
Output files will be named:
	station.network.channel.location.D
Examples:
1.  mssplit < ms_file
2.  mssplit -D NC.12345678 NC.ms.12345678
3.  cat NC.ms.112345678 | mssplit -D NC.12345678
";
    exit(0);
}

{

####################################################################
# Initialization.
####################################################################

    STDERR->autoflush(1);
    STDOUT->autoflush(1);
    $template = "%S.%N.%C.%L.D.%Y.%j.%T";

########################################################################
#	Parse command line.
########################################################################
    $cmdname = basename($0);
    &getopts ('hD:T:');
    &print_syntax($cmdname) if ($opt_h);
    $outdir = $opt_D if ($opt_D ne "");
    $template = $opt_T if ($opt_T ne "");

    push (@ARGV,"-") if (@ARGV == 0);
    die ("Error: can specify at most 1 input file\n") if (@ARGV > 1);
    for my $file (@ARGV) {
	&ms_split($file);
    }
    exit 0;
}

sub ms_split 
{
    my($file) = @_;
    my $ifh = new FileHandle;
    die ("Error: creating FileHandle ifh\n") if (! defined $ifh);
   
    if ($file eq "-") {
	$ifh->fdopen(fileno(STDIN),"r") || die ("Error: fdopen() on STDIN\n");
    }
    else {
	$ifh->open($file, "4") || die ("Error: opening $file\n");
    }

    mkdir ($outdir) or die("Error $? mkdir $outdir\n") if ($outdir && ! -d $outdir);

    my $ms = new MiniSEED;
    die ("Error from creating MiniSEED::new\n") if (! defined $ms);
    $ms->set_filehandle($ifh) || die ("Error: set_filehandle() for MiniSEED\n");

    my %of;
    while ($ms->read()) {
	my $sncl = sprintf ("%s.%s.%s.%s", $ms->station, $ms->network, $ms->channel, $ms->location);
	my $hdrtime = $ms->hdrtime;
	if (! defined($of{$sncl})) {
#:: 	    my $fname = "$sncl.D.$hdrtime";
	    my $fname = &expand_ms_template($ms,$template);
	    $fname = "$outdir/$fname" if ($outdir ne "");
	    my $fh = new FileCache::Handle $fname;
	    die ("Error opening file for $fname\n") unless (defined $fh);
	    $of{$sncl} = {
		sncl => $sncl,
		fname => $fname, 
		fh => $fh, 
	    };
#	    print "New channel: sncl=$sncl filename=$of{$sncl}->{sncl}\n";
	}
	my($fh) =  $of{$sncl}->{fh};
	print $fh $ms->{msrecord};
    }
    close ($ifh);
    return 0;
}

######################################################################
# expand_ms_template
#	Generate a string using information from a MiniSEED object and a 
#	template string.
#   Input:
#	ms = MiniSEED object
#	template = template string
#   Output:
#	Generated string.  Undef if error.
######################################################################

sub expand_ms_template
{ 
    my($ms,$template) = @_;
    my($hdrtime) = $ms->hdrtime;
    my($msdate) = ParseDate($hdrtime);
    die ("Error parsing date: $hdrtime\n") if (! defined $msdate);
    my($in) = $template;
    my($out);
    my($rev) = scalar reverse $template;
    while (length($rev) > 0) {
	my($c) = chop($rev);
	if ($c eq "%") {
	    die ("Error: template ends with '%'\n") if (length($rev) == 0);
	    $c = chop($rev);
SWITCH:	    {
		if ($c eq 'Y') 	{ $out .= UnixDate($msdate,"%Y"); last SWITCH }
		if ($c eq 'y') 	{ $out .= UnixDate($msdate,"%y"); last SWITCH }
		if ($c eq 'j') 	{ $out .= UnixDate($msdate,"%j"); last SWITCH }
		if ($c eq 'm') 	{ $out .= UnixDate($msdate,"%m"); last SWITCH }
		if ($c eq 'd') 	{ $out .= UnixDate($msdate,"%d"); last SWITCH }
		if ($c eq 'H') 	{ $out .= UnixDate($msdate,"%H"); last SWITCH }
		if ($c eq 'M') 	{ $out .= UnixDate($msdate,"%M"); last SWITCH }
		if ($c eq 'T') 	{ $out .= UnixDate($msdate,"%H%M%S"); last SWITCH }
		if ($c eq 'S') 	{ $out .= $ms->station; last SWITCH }
		if ($c eq 'N') 	{ $out .= $ms->network; last SWITCH }
		if ($c eq 'C') 	{ $out .= $ms->channel; last SWITCH }
		if ($c eq 'L') 	{ $out .= $ms->location; last SWITCH }
		if ($c eq 'l') 	{ $out .= ($ms->location eq "" ? "--" : $ms->location); last SWITCH }
		if ($c eq 'Q') 	{ $out .= $ms->msqual; last SWITCH }
		die ("Error: Invalid conversion element: %$c\n");
	    }
	}
	else {
	    $out .= $c;
	}
    }
    return ($out);
}

#:: Newer perl 5.010 version.
#:: sub expand_ms_template
#:: { 
#::     my($ms,$template) = @_;
#::     my($hdrtime) = $ms->hdrtime;
#::     my($msdate) = new Date::Manip::Date;
#::     my($msdate) = new Date::Manip::Date;
#::     $msdate->parse($hdrtime) == 0 || die ("Error parsing date: $hdrtime\n");
#::     my($in) = $template;
#::     my($out);
#::     my($rev) = scalar reverse $template;
#::     while (length($rev) > 0) {
#:: 	my($c) = chop($rev);
#:: 	if ($c eq "%") {
#:: 	    die ("Error: template ends with '%'\n") if (length($rev) == 0);
#:: 	    $c = chop($rev);
#:: SWITCH:	    {
#:: 		if ($c eq 'Y') 	{ $out .= $msdate->printf("%Y"); last SWITCH }
#:: 		if ($c eq 'y') 	{ $out .= $msdate->printf("%y"); last SWITCH }
#:: 		if ($c eq 'j') 	{ $out .= $msdate->printf("%j"); last SWITCH }
#:: 		if ($c eq 'm') 	{ $out .= $msdate->printf("%m"); last SWITCH }
#:: 		if ($c eq 'd') 	{ $out .= $msdate->printf("%d"); last SWITCH }
#:: 		if ($c eq 'H') 	{ $out .= $msdate->printf("%H"); last SWITCH }
#:: 		if ($c eq 'M') 	{ $out .= $msdate->printf("%M"); last SWITCH }
#:: 		if ($c eq 'T') 	{ $out .= $msdate->printf("%H%M%S"); last SWITCH }
#:: 		if ($c eq 'S') 	{ $out .= $ms->station; last SWITCH }
#:: 		if ($c eq 'N') 	{ $out .= $ms->network; last SWITCH }
#:: 		if ($c eq 'C') 	{ $out .= $ms->channel; last SWITCH }
#:: 		if ($c eq 'L') 	{ $out .= $ms->location; last SWITCH }
#:: 		if ($c eq 'l') 	{ $out .= ($ms->location eq "" ? "--" : $ms->location); last SWITCH }
#:: 		if ($c eq 'Q') 	{ $out .= $ms->msqual; last SWITCH }
#:: 		die ("Error: Invalid conversion element: %$c\n");
#:: 	    }
#:: 	}
#:: 	else {
#:: 	    $out .= $c;
#:: 	}
#::     }
#::     return ($out);
#:: }
##############################################################################
##############################################################################