#!/usr/bin/perl -w
                                                                               
# Copyright (C) 2001  Britton Leo Kerin (fsblk@aurora.alaska.edu)

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.

=head1 NAME

soundgrab - interactively select and save sections of an audio file

=cut

use diagnostics;
use strict;

use Fcntl qw(:seek);
use File::Basename qw(basename fileparse);
use FileHandle;
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use POSIX qw(:errno_h :signal_h :sys_wait_h floor ceil);
use Text::ParseWords qw(parse_line shellwords);
# Replace the normal time function with one returning a high-res
# float.  Don't ask exactly what the resolution is; this is chainsaw
# real time here.
use Time::HiRes qw(time);

my $progname = basename($0);
my $version = "0.9.0";

=head1 SYNOPSIS

B<soundgrab> [option]... [I<file>]

=head1 DESCRIPTION

B<soundgrab> is a perl script which runs the rawrec and sox and
possibly the oggenc and flac executables to let the user play back a
raw audio file and interactively select and export portions of the
file to other files.  By default, the input file should contain 2
interleaved channels of signed 16 bit little endian raw audio data
sampled at 44.1 kHz.  A variety of output formats are available (some
depend on the presence of certain encoder binaries in the users path).

=head1 OPTIONS AND ARGUMENTS

=over 4

=item B<-b> I<KBITRATE>, B<--ogg-kbitrate>=I<KBITRATE>

Files exported in the Ogg Vorbis lossy compression format should use
approximately I<KBITRATE> kilobits per second encoding.

=item B<--ogg-bitrate>=I<KBITRATE>

Deprecated.  Use B<--ogg-kbitrate> instead.

=item B<-c> I<ICHANNELS>, B<--channels>=I<CHANNELS>

The file on which soundgrab is to operate contains I<CHANNELS>-channel
data.  One channel is mono, two is stereo.  Modern sound cards may
support 4 or more channels.  The default is 2.

=item B<-d>, I<DEVICE>, B<--audio-device>=I<DEVICE>

Use I<DEVICE> instead of the default /dev/dsp.

=item B<-f>, I<OFMT>, B<--outpuf-file-format>=I<OFMT>

The arguments to the export command (see online help) that do not end
in a known dot extension should be saved in format I<OFMT> in a file
with the appropriate dot extension appended.  I<OFMT> may be one of the following strings:

=over 4

=item B<cdr>

CD Mastering format.  This is two channel unsigned sixteen bit little
endian data with some blocking and padding.

=item B<flac>

FLAC lossless compressed format.

=item B<ogg>

Ogg vorbis lossy compressed format.

=item B<raw>

Raw data samples in the format specified with the
B<input-sample-format> option at the sampling rate specified with the
B<sampling-rate> option and containing the number of channels
specified with the B<channels> option.  If any of these options were
not specied the default for that option is used.

=back

The default for this option is B<cdr>.  The flac and ogg formats are
only available if the appropriate encoder is present on the system.

=item B<-i> I<IFMT>, B<--input-sample-format>=I<IFMT>

The samples for the individual channels in the argument file are in
format I<IFMT>, where I<IFMT> is one of the following strings:

=over 4

=item B<s16_le>

Signed sixteen bit little endian format.

=item B<u8>

Unsigned eight bit.

=back

=item B<-s> I<SPEED>, B<--sampling-rate>=I<SPEED>

The data in the argument file was sampled at I<SPEED> samples per
second.

=item B<-t> I<TIME>, B<--time-of-start>=I<TIME>

Recording of the volume to be dissected was begun at time I<TIME>.  If
this option is used, it will be possible to jump to 'times' in the
volume.  The format of the time string is the same as the format
described in the output of the online command 'help jump', except day
offsets are not allowed.

=item B<-v>, B<--verbose>

Enable verbose operation.

=item B<--version>

Print version information and exit.

=back

The single optional argument I<file> indicates the file name of the
volume to be dissected.

=head1 INTERACTIVE COMMANDS

soundgrab acts like a tape player with almost instantaneous fast
forward and rewind, the capability to jump to a particular point in
the tape, and the capability to name and save sections of the tape to
other files.  You can also browse through large volumes of audio,
playing only some number of seconds and then skipping some number of
seconds.  The few commands required to do all these things are all
documented online, just fire up soundgrab on an appropriate file of
raw audio data and type 'help'.

=head1 EXAMPLE

Use the at and rawrec programs to record your hour long two oclock
radio show which airs March 5, go to work, then come home later and
save your favorite bits with soundgrab:

    # Set mixer parameters to record from line in.
    aumix -f ~/.my_line_rec_settings -L
    echo 'rawrec -t 3600 two_oclock_show.raw' | at 14:00 Mar 5
    # I just wanna bang on the drum all day...
    # Set mixer parameters to allow playback of dsp data, 
    # probably just by setting the gain for the line input 
    # to 0.
    aumix -f ~/.my_dsp_play_settings -L
    # and dissect with soundgrab.
    soundgrab two_oclock_show.raw

Of course you have to have a working /dev/dsp (sound driver),
appropriate mixer settings (I recommend the aumix program), enough
disk space, and a tuned receiver plugged into your sound card.  But
remember that setting that stuff up isn't work 'cause nobody is making
you do it.

=head1 SEE ALSO

aumix(1), rawrec(1), sox(1), oggenc(1), ogg123(1), flac(1)

=head1 COPYRIGHT

soundgrab is Copyright (C) 2002  Britton Leo Kerin

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA.

=head1 BUGS

It is possible for soundgrab's notion of where it is in the volume to
get out of sync with the reality of whats being played at a given
instant.  Any command that moves or stops the head will generally fix
things.

There is no mpeg3 support because mpeg has a buggy license.

Perl version 5.8.0 at least sometimes seg faults when soundgrab exits.

oggenc version 1.0 based on libvorbis 1.0 at least doesn't handle its
--comment option correctly, resulting in a spurious warning when
outputing files in ogg format.

=head1 AUTHOR

Britton Leo Kerin (fsblk@aurora.uaf.edu)

=cut

# File name extensions we know about.  The array is generally used by
# fileparse and so features periods, the scalar is used as a pattern
# in matches against things which do not necessarily include periods
# (often because they are suffixes produced by fileparse) and so does
# not feature periods.
my @known_extensions = ('.cdr', '.flac', '.ogg', '.raw', '.wav');
my $known_extensions_pattern = '(cdr)|(flac)|(ogg)|(raw)|(wav)';

# Default values for options.
my $ogg_kbitrate = 256;	        # Default 256 kb/s for ogg lossy encoding.
my $channels = 2;		# Channels of data in raw audio file.
my $audio_device = "/dev/dsp";  # OSS style audio device file.
my $output_file_format = "cdr";	     # CD mastering format.
my $using_gnome = 0;		     # Use gnome GUI interface.
my $input_sample_format = "s16_le";  # Signed 16 bit little endian.
my $sampling_rate = 44100;	     # Sampling rate of raw data file.
# Time when recording of the volume was begun (undefined by default).
my $time_of_start;
my $verbose_flg = 0;
my $version_flg = 0;
my $help_flg = 0;

# Option strings and the variables they map to.
my %optctl = 
    ("ogg-kbitrate" => \$ogg_kbitrate,
     "ogg-bitrate" => \$ogg_kbitrate, # Deprecated, use ogg-kbitrate instead.
     "b" => \$ogg_kbitrate,
     "channels" => \$channels,
     "c" => \$channels, 
     "audio-device" => \$audio_device,
     "d" => \$audio_device,
     "output-file-format" => \$output_file_format,
     "f" => \$output_file_format,
     "gnome" => \$using_gnome,
     "input-sample-format" => \$input_sample_format,
     "i" => \$input_sample_format,
     "sampling-rate" => \$sampling_rate,
     "s" => \$sampling_rate,
     "time-of-start" => \$time_of_start,
     "t" => \$time_of_start,
     "verbose" => \$verbose_flg,
     "v" => \$verbose_flg,
     "version" => \$version_flg,
     "help" => \$help_flg,
     "?" => \$help_flg);

# Get the options, doing our own error printing.
$SIG{__WARN__} = sub { print STDERR "$progname: Option parse failed: ${my $tmp = shift; chomp($tmp); \$tmp}.  Try '$progname --help'.\n"; };
unless ( GetOptions(\%optctl, "ogg-kbitrate|ogg-bitrate|b=i", "channels|c=i",
		    "audio-device|d=s", "output-file-format|f=s", "gnome",
		    "input-sample-format|i=s", "sampling-rate|s=i",
		    "time-of-start|t=s", "verbose|v", "help|?", "version") ) {
    exit(1);
}
$SIG{__WARN__} = 'DEFAULT';	# Restore default __WARN__ handler.


# Some sanity checks on options go here.
unless ( ($ogg_kbitrate > 0) ) {
    print STDERR "$progname: bad kilobit rate (-b or --ogg-kbitrate option argument) '$ogg_kbitrate', value must be positive\n";
    exit(1);
}
unless ( ($input_sample_format eq "s16_le")
	 or ($input_sample_format eq "u8") ) {
    print STDERR "$progname: bad input sample format string (-i or --input-sample-format option argument) '$input_sample_format', try '$progname --help'.";
    exit(1);
}
unless ( $output_file_format =~ /^($known_extensions_pattern$)/ ) {
    print STDERR "$progname: bad output file format string (-f or --output-file-format option argument) '$output_file_format', try '$progname --help'\n";
    exit(1);
}
if ( $output_file_format eq "flac" and !&have_flac ) {
    print STDERR "$progname: couldn't find 'flac' program required to perform exports in the default format requested with -f or --output-file-format option\n";
    exit(1);
}
if ( !(&have_flac =~ m/^[1-9]\.[0-9]/) ) {
    print STDERR "$progname: version of flac executable found is not recent enough (version 1.0 or later required), cannot perform exports in the default format requested with -f or --output-file-format option\n";
    exit(1);
}

if ( $output_file_format eq "ogg" and !&have_oggenc ) {
    print STDERR "$progname: couldn't find 'oggenc' program required to perform exports in the default format requested with -f or --output-file-format option\n";
    exit(1);
}

if ( $version_flg ) {
    print <<END_VERSION_INFO;
soundgrab version $version

Copyright (C) 2002 Britton Leo Kerin (fsblk\@uaf.edu)
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
END_VERSION_INFO
    exit(0);
}

if ( $help_flg ) {
    pod2usage( -verbose => 1, -exitval => 0 );
}

# The time of day that recording of the current volume was begun, in
# seconds into the day.
my $volume_start_offset;

# Parse $time_of_start option to $volume_start_offset.
if ( defined($time_of_start) ) {
    unless ( defined($volume_start_offset 
		     = &time_to_offset($time_of_start)) ) {
	print STDERR "$progname: failed to parse option argument '$time_of_start'\n";
	exit(1);
    }
    if ( $volume_start_offset >= 86400 ) {
	print STDERR "$progname: option argument '$time_of_start' had illegal day offset (it doesn't make sense to use day offset in the option argument)\n";
	exit(1);
    }
}

# The name of the volume being dissected.
my $volume;
# Later on we want to be able to verify that the volume hasn't changed
# since we the last time we changed it.
my $last_volume_time_check;

# The mode of the head.  Stopped, playing, browsing, or temporarily
# playing (see the help for the play command).  When temporarily
# playing, the length of time to play and the name of the old mode is
# stored in this string.
my $mode;
# This regex matches temporary play mode and extracts the extra
# information stored in the mode string for this mode.  $1 gets the
# length of time to play in the current temporary play and $2 gets the
# old mode when this pattern is matched.
my $temporary_play_rgx = "^temporary play for (.*) seconds "
                         ."\\(old mode: (.*)\\)\$";

# After option processing is done, if there is an argument, it is the
# name of the volume to dissect.
if ( @ARGV == 0 ) {
    if ( defined($time_of_start) ) {
	print STDERR "$progname: warning: a time-of-start option was specified but got ignored, since there was no volume argument given to associate the start time with\n";
    }
} elsif ( @ARGV == 1 ) {
    # The name of the volume we are grabbing sound from.
    $volume = shift @ARGV;
    $last_volume_time_check = time;

    # Reasonable volume file name?
    if ( my $volume_file_error = &check_volume_file($volume) ) {
        print STDERR "$progname: $volume_file_error\n";
        exit(1);
    }

    # Now that we have a volume, the head can properly be said to have a mode.
    $mode = "stop";

} elsif ( @ARGV > 1 ) {
    print STDERR "$progname: too many arguments.  Try $progname --help.\n";
    exit(1);
}

# Verify that we have at least the basic required programs on the system.
unless ( `which rawplay` ) {
    print STDERR "$progname: could not find rawrec executable (is rawrec installed somewhere in your PATH?)\n";
    exit(1);
}
unless ( `which sox` ) {
    print STDERR "$progname: could not find sox executable (is sox installed somewhere in your PATH?)\n";
    exit(1);
}

# We can export in more formats if we have these things.  These
# functions return the numerical part of the version number if
# possible if the binary in question is found, or false if it isn't.
sub have_oggenc {
    if ( `which oggenc` ) {
	# old oggenc used to write to stderr when given --version option.
	if ( `oggenc --version 2>&1` =~ m/(\d+\.\d+(\.\d+)?)/ ) {
	    return $1;
	} else {
	    return 1;
	}
    } else {
	return 0;
    }
}
sub have_flac {
    if ( `which flac` ) {
	if ( `flac --version` =~ m/(\d+\.\d+(\.\d+)?)/ ) {
	    return $1;
	} else {
	    return 1;
	}
    } else {
	return 0;
    }
}

# Default base name for export commands with arguments.
my @session_time = localtime;
my $output_basename = "$progname"."_session_".($session_time[5]+1900)."-"
    .($session_time[4]+1)."-".$session_time[3]."-".$session_time[2]."-"
    .$session_time[1]."-".$session_time[0];

# The size of the volume in bytes.
my $volume_size;
if ( defined($volume) ) {
    $volume_size = (stat $volume)[7];
}

# Bits in a single one channel sample.
my $bps;
if ( $input_sample_format eq "s16_le" ) {
    $bps = 16;
} elsif ( $input_sample_format eq "u8" ) {
    $bps = 8;
} else {
    print STDERR "$progname: $input_sample_format: unknown input-sample-format\n";
    exit(1);
}

# The length of the volume in seconds.
my $volume_length;
if ( defined($volume_size) ) {
    $volume_length = $volume_size * 8 / ( $bps * $sampling_rate * $channels);
}

# The position of the mark, in seconds from the beginning of the
# volume.
my $mark_pos;

# The next com_name will use extension "_chunk$chunknum" if no FILE is
# given.
my $chunknum = 1;

# The default default argument for ff and rw commands.
my $default_ff_or_rw_arg = 100;
# The number of seconds the last ff or rw command moved the head by.
# (if ff or rw have not yet been used, this initialization constitutes
# the default for the first use if no argument is given).
my $last_ff_or_rw_arg = $default_ff_or_rw_arg;

# The time as returned by the function Time::HiRes::time when rawplay
# was last invoked.  Used later with $last_pos and another time call
# to determine the position in the volume at any point in time.
# start_time is undefined until a play command is issued.
my $start_time;

# The last known position of the player, in seconds into the
# volume. This is *not* continually updated, only when playing or
# browsing stops due to a user command or the natural completion of a
# rawplay process, so its wrong almost all the time.
my $last_pos = 0;

# Time to play in browse mode.
my $browse_play_time = 20;
# Time to skip between plays in browse mode.
my $browse_skip_time = 100;
# The user gets a status message indicating where the head was when
# some commands are executed when the head is close to the edge of a
# browsed or temporary play section, this controls how close to the
# edge the user has to be to get the message.  This default value may
# be reset for extremely long or short sections.
my $edge_margin = 1;

# pid of the currently running rawplay process.
my $rawplay_pid;

# Name indexed hash of references to hashes storing the starting and
# ending positions, and ogg comment fields, of chunks the user has
# named with the name command.  Because IDE disks at least arn't up to
# doing saves in the background while trying to play other parts of
# the volume, too much latency for timing to work right.
my %names;

# Watch for our rawplay child to die so we know for sure when we can
# safely start another rawplay.  Note that SIGCHLD is blocked during
# actual execution of the user command functions, partly because they
# modify or test some of the variables used in this handler, and do
# forks and waitpids of their own, and partly because we only want
# this handler called when a rawplay process exits normally, not when
# its killed due to a user command.
my $sigset_sigchld = POSIX::SigSet->new(SIGCHLD);
my $old_sigset = POSIX::SigSet->new;
my $sigchld_action = POSIX::SigAction->new('main::REAPER', $sigset_sigchld);
sigaction(SIGCHLD, $sigchld_action);
sub REAPER {
    while ( (my $stiff = waitpid(-1, WNOHANG)) > 0 ) {
        if ( (defined($rawplay_pid)) and ($stiff == $rawplay_pid) ) {
	    if ( $mode eq "play" ) {
		# Handle the case where rawplay exited normally by
		# coming to the end of the volume.
	        $last_pos = $volume_length;
		$mode = "stop";
		if ( $using_gnome ) {
		    &autostop_notify;
		}
	    } elsif ( $mode eq "browse" ) {
		# Browsemode requires some additional handling.
                if ( $last_pos + $browse_play_time + $browse_skip_time
                               >= $volume_length ) {
		    # Autostop at end of volume.
                    $last_pos = $volume_length;
                    $mode = "stop";
		    if ( $using_gnome ) {
			&autostop_notify;
		    }
                } else {
		    # Jump ahead and play the next section.
                    $last_pos += $browse_play_time + $browse_skip_time;
                    &play_core($browse_play_time);
		}
	    } elsif ( $mode =~ /$temporary_play_rgx/ ) {
		# Temporary play needs some additional handling.
                if ( $last_pos + $1 >= $volume_length ) {
		    # Autostop at end of volume.
                    $last_pos = $volume_length;
                    $mode = "stop";
		    if ( $using_gnome ) {
			&autostop_notify;
		    }
		} else {
		    $last_pos += $1;
		    if ( $2 eq "stop" ) {
			$mode = "stop";
		    } elsif ( $2 eq "play" ) {
			$mode = "play";
			&play_core($volume_length - $last_pos);
		    } elsif ( $2 eq "browse" ) {
			if ( $last_pos + $browse_skip_time 
			               >= $volume_length ) {
			    # We are at end of volume after browse skip.
			    $last_pos = $volume_length;
			    $mode = "stop";
			} else {
			    $last_pos += $browse_skip_time;
			    $mode = "browse";
			    &play_core($browse_play_time);
			}
		    } else {
			die "bug: invalid old mode substring";
		    }
		}
	    }
	}
    }
}

# References to IO procedures needed from both the command line and
# GUI interfaces.  These are filled in in the appropriate interface section,
# and called later by functions which are used by both interfaces.

# Take a prompt and a default for yes/no response, return true if yes.
my $prompt_yes_no_ref;
# Take a prompt string for a new name, return the new name entered.
my $prompt_new_name_ref;
# Print or log or otherwise deal with an error inside one of the com_
# functions.  Note that this function is not always used for
# errors that should never appear in the windowing mode.
my $com_error;
# Print or log or otherwise deal with an informative message inside
# one of the com_ functions.  Note that this function is not always
# used for errors that should never appear in windowing mode
my $com_message;

# Using the GNOME GUI.
if ( $using_gnome ) {

    # FIXME: Get it working and remove this.
    print STDERR "Sorry, the GNOME interface is not function yet.  Please Try back next version.\n";
    exit(1);


# Why do the GNOME functions defined here make such nasty use of
# command line functions, instead of having both GNOME and command
# line interfaces call some kernel functions?  Because I wrote the
# command line version first, I'll probably continue to use it more
# myself, and I would rather have the GNOME interface extremely crufty
# and leave the command line version fairly clean and simple than make
# both interfaces slighthly more crufty plus have to rewrite a bunch
# of stuff.

# The SIGCHLD handler runs this function, so be careful...
sub autostop_notify { 
    # FIXME: make this work.
    print STDERR "autostop_notify: I'm stubbed out, fix me\n";
}

require Gtk::GladeXML;
import Gtk::GladeXML;
require Gnome;
Gnome->import();

Gtk::GladeXML->init();

Gnome->init($progname, $version);

my $gui = Gtk::GladeXML->new("./glade_gui/soundgrab_interface.glade");

# Some widgets are needed frequently, have external memory, or for
# some other reason do best with permanent references rather than
# being loaded on the fly by functions that need them.

# Everybody uses the main application window.
my $main_window = $gui->get_widget('main_window');
# A lot of commands use the application bar.
my $appbar = $gui->get_widget('main_window_appbar');
# Entry widgets with memory.
my $jump_gnomeentry = $gui->get_widget('jump_gnomeentry');
my $name_gnomeentry = $gui->get_widget('name_gnomeentry');
# History memory for GnomeEntry widgets.
# FIXME: GNOME 2.0 deprecates the automatic history memory I think.
$jump_gnomeentry->set_history_id('jump_gnomeentry_history');
$name_gnomeentry->set_history_id('name_gnomeentry_history');
# History lists never gets longer than 10 items.
# FIX ME: this doesn't seem to do anything.
$jump_gnomeentry->set_max_saved(10);
$name_gnomeentry->set_max_saved(10);

# Offsets associated with slider end point positions for the current
# voluem and zoom level.
my $slider_start_offset = 0;
my $slider_end_offset;
if ( defined($volume_length) ) {
    $slider_end_offset = $volume_length;
}

# Placement coordinates in the main_window_fixed GtkFixed for the
# marker arrow eventbox widget which cause the GtkArrow is contains to
# point to the start and end positions of the slider.
my $mark_arrow_eventbox_y_coord = 76;
my %mark_arrow_eventbox_start_slider = 
    ( 'x_coord' => 44,
      'y_coord' => $mark_arrow_eventbox_y_coord );
my %mark_arrow_eventbox_end_slider = 
    ( 'x_coord' => 464,
      'y_coord' => $mark_arrow_eventbox_y_coord );

# Define a message buffer class.
{
    # Namespaces are global so we use an appropriately hierarchical
    # package name.
    package Soundgrab::GnomeGUI::MsgBuf;

    # Creata a new message buffer object.
    sub new {
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->flush();
	return $self;
    }

    # Flush the buffer, returning its contents as a string.
    sub flush {
	my $self = shift;
	my $buf_val = $self->{'buf_string'};
	$self->{'buf_string'} = "";
	return $buf_val;
    }

    # Add an error to the buffer.
    sub add {
	my $self = shift;
	$self->{'buf_string'} .= shift;
    }

    # Returns true if the buffer is empty.
    sub is_empty {
	my $self = shift;
	return $self->{'buf_string'} ? 0 : 1;
    }
}

# Buffer for errors which occur during execution of com_ functions.
my $com_err_buf = Soundgrab::GnomeGUI::MsgBuf->new();
# Buffer for messages which occur during execution of com_ functions.
my $com_msg_buf = Soundgrab::GnomeGUI::MsgBuf->new();

# The GNOME incarnations of some IO functions used in the com_
# functions can now be filled in.
$com_error = sub {
    # Error message from com_ functions are buffered and dealt with
    # after the function that genated them returns.
    $com_err_buf->add(shift);
};
$com_message = sub {
    # Informative messages from com_ functions are handled using the
    # same method as errors, but with a different buffer.
    $com_msg_buf->add(shift);
};
$prompt_yes_no_ref = sub {
    my ($prompt, $default_response) = @_;

    my $mbox = Gnome::MessageBox->new($prompt, "question", "Yes", "No");

    # Look for a local variable specifying the parent window.  GUI
    # handlers may set this variable so this function can set its
    # parent window correctly.
    if ( defined($main::prompt_yes_no_ref_parent_window) ) {
	$mbox->set_parent($main::prompt_yes_no_ref_parent_window);
    }

    # Set default button number according to default response argument.
    if ( $default_response eq "y" ) {
	$mbox->set_default(0);
    } else {
	$mbox->set_default(1);
    }

    # Run the dialog and return the users response.
    my $user_action = $mbox->run_and_close();
    if ( $user_action == -1 ) {	# Window closed from window manager.
	return ( $default_response eq "y" ) ? 1 : 0;
    } else {
	# 'not' because Yes is button zero, No is button one.
	return not $user_action;
    } 
};

# Fill in the text of some labels and the appbar.
if ( defined($volume) ) {
    $appbar->push("soundgrab ready to dissect current volume.");
    $gui->get_widget('volume_name_label')->set($volume);
    $gui->get_widget('head_pos_label')->set(sprintf("0/%.2f",
						    $volume_length));
    $gui->get_widget('mark_pos_label')->set("Unplaced");
    $gui->get_widget('startscale_label')->set($slider_start_offset);
    $gui->get_widget('endscale_label')->set($slider_end_offset);
} else {
    $appbar->push("soundgrab started without a volume argument.");
    $gui->get_widget('volume_name_label')->set("No current volume");
    $gui->get_widget('head_pos_label')->set("NA");
    $gui->get_widget('mark_pos_label')->set("NA");
    $gui->get_widget('startscale_label')->set("");
    $gui->get_widget('endscale_label')->set("");
}

# Menu bar entries.

# Volume selection.
sub on_open_volume_activate {
    $gui->get_widget('volume_fileselection')->show();
    # FIXME: Do some filename tab completion with complete?
}
sub on_volume_fileselection_cancel_button_clicked {
    $gui->get_widget('volume_fileselection')->hide();
}
sub on_volume_fileselection_ok_button_clicked {
    my $volume_fileselection = $gui->get_widget('volume_fileselection');
    &com_volume($volume_fileselection->get_filename());
    unless ( $com_err_buf->is_empty() ) {
	&gnome_error($volume_fileselection, $com_err_buf->flush());
	$volume_fileselection->grab_focus();
    } else {
	$slider_start_offset = 0;
	if ( defined($volume_length) ) {
	    $slider_end_offset = $volume_length;
	}
	$gui->get_widget('volume_name_label')->set($volume);
	$gui->get_widget('head_pos_label')->set(sprintf("0/%.2f",
							$volume_length));
	$gui->get_widget('mark_pos_label')->set("Unplaced");
	$gui->get_widget('startscale_label')->set($slider_start_offset);
	$gui->get_widget('endscale_label')->set($slider_end_offset);
	$appbar->push("Volume loaded.");
	$volume_fileselection->hide();
    }
}

# Serious ugliness here.  This stuff will only make sense if you
# remember that this function essentially parses the output of
# com_export to a GUI form.
sub on_export_activate {
    # Convenience variables.
    my $appbar = $gui->get_widget('main_window_appbar');
    my $export_progress_window = $gui->get_widget('export_progress_window');

    my %chunk_sizes;	    # Sizes of chunks, in seconds.
    my $total_of_sizes = 0; # Total of all chunk sizes.
    foreach ( keys %names ) {
	$chunk_sizes{$_} = $names{$_}{end} - $names{$_}{start};
	$total_of_sizes += $chunk_sizes{$_};
    }

    # These variables are state memory used by the polymorphed
    # com_message fctn (see below).
    my $exported_chunk_count = 0 ; # Number of chunks exported so far.
    my $fraction_done = 0;  # Fraction of exporting work done so far.
    my $crnt_name;	    # Name of chunk currently being worked on.

    # And now for a little temporary extra polymorphism of the I/O
    # functions used by com_export(), with a bit of intracall state
    # memory from the lexically scoped variables above.  God I love
    # perl.  Writing it that is, not reading it.
    my $base_com_message = $com_message; # Save base com_message definition.
    $com_message = sub { 	         # New temporary definition.
	my $arg = shift;

	# Handle some of the funny messages com_export can generate.
	if ( $arg =~ /(There are no unexported named chunks to export\.)/x ) {
	    &gnome_message($main_window, $1);
	    $appbar->push("Exported nothing.");
	    return(0);
	} 
	if ( $arg =~ /Stopping player while exporting/ ) {
	    $gui->get_widget('stop_radiobutton')->set_active();
	    $appbar->push("Player stopped while exporting...");
	    # Give user time to read message.  Emulate nanosleep,
	    # since apparently neither Time::HiRes nor POSIX modules
	    # provide it.
	    select(undef, undef, undef, 0.5);
	}
	if ( $arg =~ /Stopping browse while exporting/ ) {
	    $gui->get_widget('stop_radiobutton')->set_active();
	    $appbar->push("Browse stopped while exporting...");
	    # Give user time to read message.  Emulate nanosleep,
	    # since apparently neither Time::HiRes nor POSIX modules
	    # provide it.
	    select(undef, undef, undef, 0.5);
	}
	if ( $arg =~ / # Directory existence or permission problems.
	                (Directory\s.*\sdoes\snot\sexist.)
	               |(No\spermission\sto\screate\s.*\sin\s.*)
	             /x ) {
	    &gnome_error($main_window, $arg);
	    return(1);
	}

	my $export_label = $gui->get_widget('export_action_label');

	if ( $arg =~ /^((Encoding\sand\swriting|Writing)\s\"(.*)\"
			\.\.\.)\s$/x ) {
	    $export_label->set($1);
	    $crnt_name = $3;
	    # If this is the first exported chunk...
	    if ( $exported_chunk_count == 0 ) {
		# show the window for the first time (this export).
		$export_progress_window->show();
		return(0);
	    }
	}

	if ( $arg =~ /^done.\n$/ ) {
	    $appbar->set_progress($fraction_done 
				  += $chunk_sizes{$crnt_name}/$total_of_sizes);
	    $exported_chunk_count++;
	    # If we just finished exporting the last chunk...
	    if ( $exported_chunk_count == keys(%names) ) {
		# hide the window.
		$export_progress_window->hide();
	    }
	}
    };

    &block_sigchld;
    &com_export();
    &unblock_sigchld;

    # Return to base com_message behavior.
    $com_message = $base_com_message;
}

sub on_exit_activate {
    if ( %names ) {
	local $main::prompt_yes_no_ref_parent_window = $main_window;
        unless ( &$prompt_yes_no_ref("Named chunks of the current input volume have been defined which have 
not yet been exported with the export command.  Quit anyway (y/N)? ", "n") ) {
	    return(0);
	}
    }
    if ( $mode =~ /^(?:play|browse|$temporary_play_rgx)$/ ) {
        &stop_core;
    }
    Gtk->main_quit();
}

sub on_preferences_activate {
    print STDERR "on_references_activate: no preferences yet\n";
}

sub on_manual_activate {
    print STDERR "on_manual_activate: no manual yet\n";
}

sub on_about_activate {
    $gui->get_widget('about_soundgrab')->show();
}

sub on_frw_button_clicked {
    &gnome_rw($gui->get_widget('frw_spinbutton')->get_value_as_float());
}

sub on_rw_button_clicked {
    &gnome_rw($gui->get_widget('rw_spinbutton')->get_value_as_float());
}

sub on_f_button_clicked {
    &gnome_ff($gui->get_widget('f_spinbutton')->get_value_as_float());
}

sub on_ff_button_clicked {
    &gnome_ff($gui->get_widget('ff_spinbutton')->get_value_as_float());
}

sub on_zoom_button_clicked {
    print "zoom: so far unimplemented rescaling magic\n";
}

sub on_jump_button_clicked {
    my $jump_gtkentry = $jump_gnomeentry->gtk_entry();
    $jump_gtkentry->set_text("");
    $jump_gtkentry->grab_focus();
    my $jump_dialog = $gui->get_widget('jump_dialog');
    $jump_dialog->set_parent($gui->get_widget('main_window'));
    $jump_dialog->close_hides(1);
    # I think this depends on the jump_ok_button button having, in the
    # C language binding, GTK_WIDGET_HAS_DEFAULT(wid) true, in order
    # to make is so when the dialog first pops up the user can type
    # into the $jump_gtkentry, and then hit return to automaticly
    # activate the jump_ok_button.  Possibly gnome_dialog_set_default
    # should be used instead of setting the GTK_WIDGET_HAS_DEFAULT
    # property from glade, but gnome_dialog_set_default has a weird
    # integer macro argument and I can't figure out what the perl
    # binding wants for an argument.  (Sun, 11 Nov 2001)
    $jump_dialog->editable_enters($jump_gtkentry);
    $jump_dialog->show();

    # Note the dialog is not run, so the application is not blocked
    # and the user can do other things before filling in the jump
    # field and hitting ok/return to make the actual jump happen.
}

sub on_jump_ok_button_clicked {
    my $jump_error_flag = 0;	# True if jump failed somehow.
    my $jump_dialog = $gui->get_widget('jump_dialog');
    my $jump_gtkentry_val = $jump_gnomeentry->gtk_entry()->get_text();
    if ( $jump_gtkentry_val eq "" ) {
	$jump_error_flag = 1;
	&gnome_error($jump_dialog, "jump needs a non-null argument");
    } else {
	&block_sigchld;
	&com_jump($jump_gtkentry_val);
	&unblock_sigchld;
	unless ( $com_err_buf->is_empty ) {
	    $jump_error_flag = 1;
	    &gnome_error($jump_dialog, $com_err_buf->flush());
	}
	$jump_gnomeentry->append_history(0, $jump_gtkentry_val);
    }

    # If there was a problem, put the user back in the jump dialog.
    if ( $jump_error_flag ) {
	$jump_gnomeentry->gtk_entry()->grab_focus();
    } else { # Otherwise, close.
	$jump_dialog->close();
    }
}

sub on_jump_cancel_button_clicked {
    $gui->get_widget('jump_dialog')->close();
}

sub on_mark_button_clicked {
    &block_sigchld;
    &com_mark();
    &unblock_sigchld;
    unless ( $com_err_buf->is_empty() ) {
	&gnome_error($main_window, $com_err_buf->flush());
    } else {
	&position_mark_arrow;
    }
}

sub on_name_button_clicked {
    my $name_gtkentry = $name_gnomeentry->gtk_entry();
    $name_gtkentry->set_text("");
    $name_gtkentry->grab_focus();
    my $name_dialog = $gui->get_widget('name_dialog');
    $name_dialog->set_parent($gui->get_widget('main_window'));
    $name_dialog->close_hides(1);
    # I think this depends on the name_ok_button button having, in the
    # C language binding, GTK_WIDGET_HAS_DEFAULT(wid) true, in order
    # to make is so when the dialog first pops up the user can type
    # into the $name_gtkentry, and then hit return to automaticly
    # activate the name_ok_button.  Possibly gnome_dialog_set_default
    # should be used instead of setting the GTK_WIDGET_HAS_DEFAULT
    # property from glade, but gnome_dialog_set_default has a weird
    # integer macro argument and I can't figure out what the perl
    # binding wants for an argument.  (Sun, 11 Nov 2001)
    $name_dialog->editable_enters($name_gtkentry);
    $name_dialog->show();

    # Note the dialog is not run, so the application is not blocked
    # and the user can do other things before filling in the name
    # field and hitting ok/return to make the actual name happen.
}

sub on_name_ok_button_clicked {
    my $name_error_flag = 0;	# True if name failed somehow.
    my $name_dialog = $gui->get_widget('name_dialog');
    my $name_gtkentry_val = $name_gnomeentry->gtk_entry()->get_text();
    if ( $name_gtkentry_val eq "" ) {
	$name_error_flag = 1;
	&gnome_error($name_dialog, "name needs a non-null argument");
    } else {
	&block_sigchld;
	&com_name($name_gtkentry_val);
	&unblock_sigchld;
	unless ( $com_err_buf->is_empty() ) {
	    $name_error_flag = 1;
	    &gnome_error($name_dialog, $com_err_buf->flush());
	}
	unless ( $com_msg_buf->is_empty() ) {
	    &gnome_message($name_dialog, $com_msg_buf->flush());
	}
	$name_gnomeentry->append_history(0, $name_gtkentry_val);
    }

    # If there was a problem, put the user back in the name dialog.
    if ( $name_error_flag ) {
	$name_gnomeentry->gtk_entry()->grab_focus();
    } else { # Otherwise, close.
	$name_dialog->close();
    }
}

sub on_name_cancel_button_clicked {
    $gui->get_widget('name_dialog')->close();
}

sub gnome_rw {
    my $arg = shift;

    $com_msg_buf->flush();
    &block_sigchld;
    &com_rw($arg);
    &unblock_sigchld;
    my $msg = $com_msg_buf->flush();
    if ( $msg =~ /^(.*\.)?(Rewind stopped at beginning of volume\.)/ ) {
	$gui->get_widget('main_window_appbar')->push($2);
    }
}

sub gnome_ff {
    my $arg = shift;
    
    $com_msg_buf->flush();
    &block_sigchld;
    &com_ff($arg);
    &unblock_sigchld;
    my $msg = $com_msg_buf->flush();
    if ( $msg =~ /^(.*\.)?(Stopped at end of volume\.)/ ) {
	$gui->get_widget('main_window_appbar')->push($2);
	# Make sure the appropriate radiobutton is selected.
	$gui->get_widget('stop_radiobutton')->set_active();
    }
}

sub position_mark_arrow {
    my $main_window_fixed = $gui->get_widget('main_window_fixed');
    my $mark_arrow_eventbox = $gui->get_widget('mark_arrow_eventbox');
    my $mark_arrow = $gui->get_widget('mark_arrow');
    if ( ($mark_pos >= $slider_start_offset) 
	 and ($mark_pos <= $slider_end_offset) ) {
	$mark_arrow->set('down', 'etched-in');
	my $position_fraction = $mark_pos / $volume_length;
	my $x_span = $mark_arrow_eventbox_end_slider{'x_coord'}
	             - $mark_arrow_eventbox_start_slider{'x_coord'};
	# In this crazy not-yet-C99 world, sprintf is the best way to
	# round.
	my $new_x_coord = $mark_arrow_eventbox_start_slider{'x_coord'}
	                  + sprintf("%.0f", $position_fraction * $x_span);
	$main_window_fixed->move($mark_arrow_eventbox, $new_x_coord, 
				 $mark_arrow_eventbox_y_coord);
	# It seems its you don't have to show() the eventbox to see
	# either the arrow inside it or the eventbox's tooltip.
	# FIX ME: this (see above comment) seems wacky.
	# $mark_arrow_eventbox->show();
	$mark_arrow->show();
    } # Add here else part to display arrow when mark is off slider range.
}

# Display an error message, blocking the parent window until acknowledged.
sub gnome_error {
    my $parent = shift;
    unless ( defined($parent) and (ref($parent) =~ /^(Gnome::)|(Gtk::)/) ) {
	die "internal function gnome_error didn't get a Gnome or Gtk object for its first argument, looks like a bug";
    }
    my $error_string = shift;
    unless ( defined($error_string) ) {
	die "internal function gnome_error didn't get a second argument, looks like a bug";
    }

    my $mbox = Gnome::MessageBox->new($error_string, "error", "Ok");
    $mbox->set_parent($parent);
    $mbox->run_and_close();
}

# Display an informative message, blocking other windows until
# acknowledged.
sub gnome_message {
    my $parent = shift;
    unless ( defined($parent) and (ref($parent) =~ /^(Gnome::)|(Gtk::)/) ) {
	die "internal function gnome_message didn't get a Gnome or Gtk object for its first argument, looks like a bug";
    }
    my $message_string = shift;
    unless ( defined($message_string) ) {
	die "internal function gnome_message didn't get a second argument, looks like a bug";
    }

    my $mbox = Gnome::MessageBox->new($message_string, "info", "Ok");
    $mbox->set_parent($parent);
    $mbox->run_and_close();
}

$gui->signal_autoconnect_from_package('main');

$main_window->show();

Gtk->main();

} else { # Not using the GNOME GUI.

require Term::ReadLine;
import Term::ReadLine;

# Interactive command line commands.
my %commands =
    ('play' => { func => \&com_play, doc => "usage: play [TIME]
Start playing at the current head position.

Advanced usage: 

With the optional TIME argument, TIME seconds worth of audio will be
played, then soundgrab will drop back into the mode it was in before
the play command (i.e. back into browse or stop mode)."
               },
     'stop' => { func => \&com_stop, doc => "usage: stop
Stop the head at the current position.  There may be a noticable delay
before playing stops, but the recorded head position should coincide
with the time when the stop command is issued.  Unless your system is
really loaded when the command is isued, in which case it may not.
This is perl real time we're talking about after all :)"
               },
     'mark' => { func => \&com_mark, doc => "usage: mark
Place the marker at the current head position."
               },
     'name' => { func => \&com_name, doc => "usage: name [NAME]
Name the data between the mark and the current position NAME, or with
a default base name followed by a timestamp corresponding to the start
time of this soundgrab session followed by a new chunk number if no
NAME argument was given.  If you specify a name with extension '.cdr',
'.flac, '.ogg', '.raw', or '.wav', that format will be used when the
chunk is exported (assuming the correct encoder binary is available on
the system, and assuming the simple form of the export command is
used), otherwise the output file format set from the command line or
the command line default will be used and the appropriate extension
added.  Existing named chunks of data can be viewed with the list
command."
               },
     'oggment' => { func => \&com_oggment, doc => "usage: oggment NAME [comment COM] [artist ART] [title TITLE] [album ALB]

Set the in-file ogg tags to be stored in the file to which chunk name
NAME is to be exported.  These tags persist if the name of the chunk
is changed, but only end up in files exported in ogg format.  The COM,
ART, TITLE or ALB strings should be double quoted.  For example:

   oggment some_chunk.ogg comment \"example comment\" artist \"example artist\"

will (over)write soundgrab's notions of the ogg comment and artist
tags for chunk 'some_chunk.ogg'."
                  },
     'list' => { func => \&com_list, doc => "usage: list
List the names, start offsets, and end offsets of all named chunks.
Offsets are in seconds from the start of the volume being dissected."
               },
     'delete' => { func => \&com_delete, doc => "usage: delete NAME_1 [NAME_2 NAME_3 ... NAME_N]
Delete chunk definitions from the chunk list.  This command has no
effect on files, so it doesn't affect chunks which have already been
exported."
                 },
     'changename' => { func => \&com_changename, doc => "usage: changename OLDNAME NEWNAME
Change the name of the chunk named OLDNAME to NEWNAME."
                     },
     'export' => { func => \&com_export, doc => "usage: export [CHUNK_1 CHUNK_2 ... CHUNK_N FILE_NAME]
If no arguments are given, export all the named chunks of data to
files with the corresponding names, and remove the names from the
chunk list.

Advanced usage:

If any optional arguments are supplied, at least two must be.  The
last argument is the file name into which all preceding arguments are
to be concatenated.  If this FILE_NAME argument has a known extension,
the corresponding export format is used, otherwise, the default format
set from the command line or the command line default is used and the
corresponding exension added.  The names (including the extensions) of
the chunks themselves are generally not relevant to the output format
use, but if and oly if the ogg export format is used, any ogg comments
attached to the individual chunks are conncatenated together and
preserved.  Though every defined chunk will have some standard
extension, it isn't necessary to type them in, because chunk names
given to export can be abbreviated to uniqueness.  When the export is
complete, chunks CHUNK_1, CHUNK_2, ..., CHUNK_N are removed from the
chunk list, leaving other named chunk definitions unaffected.  No
shell-style tilde expansion is performed on the chunk names given, so
they must be literally identical (after completion) to defined chunk
names."
                 },
     'ff' => { func => \&com_ff, doc => "usage: ff [TIME]
Move the head forward SECS seconds, or the number of seconds moved by
the last ff or rw command if no SECS argument is given, or
$default_ff_or_rw_arg seconds if no SECS argument is given and this is
the first ff or rw command issued.

You can also use units like this: 'f 1d2h3.2m5.4' to fast forward 1
day, 2 hours, 3.2 minutes, and 5.4 seconds."
             },
     'rw' => { func => \&com_rw, doc => "usage: rw [TIME]
Move the head back SECS seconds, or the number of seconds moved by the
last ff or rw command if no SECS argument is given, or
$default_ff_or_rw_arg seconds if no SECS argument is given and this is
the first ff or rw command issued.

You can also use units like this: 'r 1d2h3.2m5.4' to rewind 1 day, 2
hours, 3.2 minutes, and 5.4 seconds."
             },
     'jump' => { func => \&com_jump, doc => "usage: jump POSITION
Jump head to position POSITION seconds into volume, or to the position
of the mark if the POSITION argument is a single 'm'.

Advanced usage: 

If the -t command line option or optional argument to the 'volume'
command was used to associate a time with the start of the volume,
jump can take a time for its POSITION argument.  Example position
arguments: '15:00', '4:33:20.2p', '4:10' (means 4:10 AM), '12:10'
(means 12:10 PM).  If you have a volume longer than 24 hours, you can
append +Nd to the time string to refer to the time of the day N days
after the first: '1:35:23.55pm+2d'.

You can also say, for example 'j 1d2h3.2m5s' to jump to a point 1 day,
2 hours, 3.2 minutes, and five seconds into the volume."
               },
     'head' => { func => \&com_head, doc => "usage: head
Show the position and status of the head, as the offset from the
beginning of the volume."
               },
     'checkmark' => { func => \&com_checkmark, doc => "usage: checkmark
Show the position of the mark, as the offset from the beginning of the
volume out of the total volume length in seconds."
                    },
     'browse' => { func =>\&com_browse, doc => "usage: browse [PLAY SKIP]

Start browsing.  When browsing, the player head will repeatedly play
PLAY seconds worth of data, then skip SKIP seconds worth.  The head
always starts over by playing PLAY seconds worth after being moved or
stopped by a user command.  If no arguments are supplied browse remembers 
the values of PLAY and SKIP it used last time and uses them again, or if 
there isn't a last time, uses the values $browse_play_time and $browse_skip_time.

To stop browsing, just use the stop or play commands.

It can be hard to be sure when browsing exactly where the head was
when a given command (mark, stop, ff, etc.) took effect, so an
informative message is displayed if soundgrab notices that the head is
near the beginning or end of a PLAY section when such a command is
issued."
                 },
     'volume' => { func => \&com_volume, doc => "usage: volume NAME [TIME-OF-START]
Begin dissecting volume file NAME.  The head is positioned at the
start of the new volume and the mark is unplaced.  If TIME-OF-START is
specified, it must follow the format of the time-of-start command line
option argument, and has the same meaning.  The sample format and sampling
rate parameters must be the same for the new volume as those specified on 
the command line."
                 },
     'help' => { func => \&com_help, doc => "usage: help [COMMAND_NAME]
Display help on command COMMAND_NAME, or general help if no
COMMAND_NAME argument is given."
               },
     '?' => {func => \&com_help, doc => "Synonym for 'help'."
            },
     'quit' => { func => \&com_quit, doc => "Quit $progname."
             }
     );

# This gets set when the user uses the quit command.
my $done = 0;

my $term = Term::ReadLine::Gnu->new('soundgrab');

# Tell the completer that we want to try completion ourselves first.
$term->Attribs->{attempted_completion_function} = \&soundgrab_completion;

# Turn off all internal fontification and such.
$term->Term::ReadLine::Gnu::ornaments(0);

# Disable implicit calls of add_history().
$term->MinLine(0);

# The command line incarnations of some IO functions used in the com_
# functions can now be filled in.
$prompt_yes_no_ref = sub { 
    unless ( @_ == 2 ) {
        die "bug: internal function prompt_yes_no_ref got wrong number of arguments";
    }  

    my $response = $term->readline(shift);
    my $default = shift;

    if ( $default eq "y" ) {
	if ( $response =~ /^(\s*[nN]\s*)$/ ) {
	    return 0;
	} else {
	    return 1;
	}
    } elsif ( $default eq "n" ) {
	if ( $response =~ /^(\s*[yY]\s*)$/ ) {
	    return 1;
	} else {
	    return 0;
	}
    } else {
        die "internal function prompt_yes_no_ref got bad 2nd argument";
    }
};
$prompt_new_name_ref = sub {
    my $arg = shift;		# Prompt to use to ask for new name.

    my @words;
    unless ( @words = shellwords($term->readline($arg)) ) {
        @words = &$prompt_new_name_ref("Failed to parse new name.  Mismatched or mis-escaped single or double quote(s)?
Try again: ");
    }
    # parse_line, on which shellwords is based, puts a leading null in
    # the returned array if the string started with a seperator.
    if ( $words[0] eq "" ) {
        shift(@words);
    }
    # parse_line, on which shellwords is based, has an icky tendency
    # to extend arrays with undef (as of 1 Jan 2002).  Defend against
    # this.
    if ( ($#words == 1) and (!defined$words[$#words]) ) {
        pop(@words);
    }
    # Unless we now have the expected single defined word, try again.
    unless ( @words == 1 and defined $words[0] ) {
        @words = &$prompt_new_name_ref("Failed to parse new name.  Maybe the new name contained an unquoted space?
Try again: ");
    }

    return $words[0];
};
$com_error = sub {
    print STDERR shift;
};
$com_message = sub {
    print shift;
};

# Default prompt.
my $prompt = $progname."> ";

# Name of immediately preceeding automaticly repeatable command, or
# undef if there is no preceeding command or the preceeding command is
# not automaticly repeatable.
my $last_auto_repeatable_command;

# Main input loop.
{
    my $line;

    while ( $done == 0 ) {
	$line = $term->readline($prompt);
	last unless defined($line);
	# Autorepeat the last command if line was blank and we have
	# something to repeat.
	if ( $line =~ /^\s*$/ and 
	     defined($last_auto_repeatable_command) ) {
	    execute_command($last_auto_repeatable_command);
	} else { # otherwise, really parse the line for commands.
	    # Entire command line, may contain multiple semicolon
	    # seperated commands.
	    my @commands_on_line;
	    unless ( @commands_on_line = parse_line(';', 1, $line) ) {
		# If line was not empty (which also causes parse_line
		# to return empty list) ...
		if ( $line ) {
		    # then report the error.
		    print STDERR "Failed to parse command line, mismatched or mis-escaped single or 
double quote(s)?\n";
		}
		next;
	    }
	    # Defensive programming protects against current (30 Dec
	    # 2001) weird behavior of parse_line (it puts undef in
	    # returned array when it parses a line ending in the
	    # delimeter) but should work if/when parse_line gets fixed
	    # also.
	    unless ( defined($commands_on_line[$#commands_on_line]) ) { 
		$commands_on_line[$#commands_on_line] = "";
	    }
	    # Most recently processed individual non-empty command.
	    my $latest_command;
	    # Flag true if the last command completed successfully.
	    my $command_success_flag;
	    # Try to run the individual command(s) on the line.
	    foreach my $command ( @commands_on_line ) {
		# Unless the command was empty, execute it.
		unless ( $command =~ /^\s*$/ ) {
		    $latest_command = &stripwhite($command);
		    $command_success_flag 
			= not &execute_command($latest_command);
		}
	    }
	    
	    # Handle remembering of commands that can be automaticly
	    # repeated by hitting enter on a blank line.
	    
	    # Assume we aren't looking at a repeatable command.
	    $last_auto_repeatable_command = undef;
	    
	    if ( (@commands_on_line == 1) and ($command_success_flag) ) {
		# The potentially abbreviated command name and the
		# rest of the arguments as typed on the command line.
		# We know it is parsable by shellwords, completes and
		# is unique because we have $command_success_flag from
		# the above if.
		my ($abbrev, @rest) = shellwords($latest_command);
		my $actual_name = (&soundgrab_completion($abbrev, $abbrev, 0, 
							 length($abbrev)))[0];
		# If we have a repeatable command (play is only
		# repeatable if it has arguments)...
		if (    $actual_name =~ /^((ff)|(rw)|(browse))$/ 
		     or $actual_name eq "play" and @rest ) {
		    # Remember ff, rw, browse, or temp play for auto repeat.
		    $last_auto_repeatable_command = $latest_command;
		}
	    }
	}
    } continue {
	# Any nonempty command line typed by the user goes in the
	# history.  Normally this is done implicitly by readline.
	unless ( $term =~ /^\s*$/ ) {
	    $term->AddHistory($line);
	}
    }
}

exit(0);

# Execute a command.
sub execute_command {
    my $command_with_args = shift;
    my ($com_name, @com_args);
    unless ( ($com_name, @com_args) = shellwords($command_with_args) ) {
	printf STDERR "Failed to parse command, mismatched (double) quote(s)?\n";
	return(1);
    }
    my $command = find_command($com_name);

    unless ( $command ) {
        print STDERR "$com_name: no such command or unambiguous command abreviation in soundgrab, try help\n";
        return(1);
    }

    # Issue dire warnings if the volume appears to have been screwed with.
    # FIXME: probably needs gnome mode I/O fixed.
    if ( defined($volume) ) {
	&volume_sanity_check($volume);
    }

    # Block delivery of SIGCHLD during user command execution.
    &block_sigchld;

    # Run the command function, saving the value returned.  Commands
    # use shell type return convention, i.e. they return non-zero when
    # there's a problem.
    my $command_func_return_value = &{$command->{func}}(@com_args);
    
    # Unblock SIGCHLD.
    &unblock_sigchld;

    return($command_func_return_value);
}

# Look up command by NAME and return pointer to command, or undef if
# NAME isn't a complete command name and we can't successfully and
# unambiguously complete it.
sub find_command {
    my $name = shift;
    unless ( exists($commands{$name}) ) {
	my @candidates = &soundgrab_completion($name, $name, 0, length($name));
        # If exactly one possible command completion...
	if ( @candidates == 1 ) {
	    # return hash for that command,
	    return $commands{$candidates[0]}
	} else {
	    # otherwise, return failure code.
	    return undef;
	}
    } else {
	return $commands{$name};
    }
}

# Attempt to complete the contents of TEXT.  START and END bound the
# region of LINE that contains the word to complete.  TEXT is the word
# to complete.  We can use the entire contents of LINE in case we want
# to do some simple parsing.  Return the array of matches, or NULL if
# there aren't any.
sub soundgrab_completion {
    my ($text, $line, $start, $end) = @_;
    my @matches = ();

    # If this word is the first non-whitespace on the line, then it is
    # a command to complete.  Next we try to complete the name of a
    # currently defined chunk.  If that fails, and if I'm understandig
    # things correctly, readlines implicit complete takes over from
    # soundgrab_completion and we may end up completing the name of a
    # file in the current directory.

    # Look for a command to complete whenever $text is the first space
    # delimited token on $line, otherwise look to complete a
    # chunkname, failing that default readline completion will take
    # over automaticly.
    if ( substr($line, 0, $start) =~ /^\s*$/ ) {
	@matches = $term->completion_matches($text, \&command_generator);
    } else {
        @matches = $term->completion_matches($text, \&chunkname_generator);  
    }

    return @matches;
}

# Generator functions for command completion.  STATE lets us know
# whether to start from scratch; without any state (i.e. STATE == 0),
# then we start at the top of the list.

# Term::ReadLine::Gnu has a list_completion_function similar to this
# function.
{
    my @names;			# Command names to consider for completion.
    my $list_index;		# Index of command name to consider next.

    sub command_generator {
	my ($text, $state) = @_;

	# If this is a new word to complete, initialize now.  This
        # includes getting the list of completion candidates, and
        # initializing the index variable to 0.
	unless ( $state ) {
	    $list_index = 0;
	    @names = keys(%commands);
	}

	# Return the next name which partially matches from the command list.
        while ( $list_index < @names ) {
	    $list_index++;
	    if ($names[$list_index - 1] =~ /^\Q$text\E/) {
		return $names[$list_index - 1];
	    }
	}

	# If no names matched, then return NULL.
	return undef;
    }
}

# Generator function for chunkname completion.
{
    my @names;			# Chunks names to consider for completion.
    my $list_index;		# Index of chunk name to consider next.

    sub chunkname_generator {
	my ($text, $state) = @_;

	# If this is a new word to complete, initialize now.  This
        # includes getting the list of completion candidates, and
        # initializing the index variable to 0.
	unless ( $state ) {
	    @names = keys(%names);
	    $list_index = 0;
	}

	# Return the next name which partially matches from the command list.
        while ( $list_index < @names ) {
	    $list_index++;
	    if ($names[$list_index - 1] =~ /^\Q$text\E/) {
		return $names[$list_index - 1];
	    }
	}

	# If no names matched, then return NULL.
	return undef;
    }
}

# Display commane line help.
sub com_help {
    my $arg = shift;
    unless ( defined($arg) ) {
	my $help_text  = <<END_INTERACTIVE_HELP;
Terms:  head   refers to the player head.  Think in terms of a cassette
               player.  The head has a position in the volume, and may
               be stopped or playing (or browsing).  Playing stops 
               automaticly when the head reaches the end of the volume.

        mark   refers to a marker which you can place on the volume using
               the 'mark' command.  The mark is placed at the position of
               the head at the instant you issue the 'mark' command.  Only
               one mark can exist on the volume at a time.

Once you have a mark on the volume, you use the 'name' command to give
the audio data between the mark and the head position a name.  The
head can be before the mark if that is convenient.  When you have
named all the sections you are interested in saving to files, you use
the 'export' command to do the actual saving.

The browse command lets you automaticly skip through the contents of
the volume (great for channel flippers :).

All commands can be used at any time, whether the volume is being
played or browsed, or is stopped.  

Commands may be abbreviated to uniqueness.  Multiple commands
seperated by semicolons may be placed on the same command line.
Hitting return on a blank line will repeat any successful ff, rw, or
browse command that appeared by itself (i.e. without any unquoted
semicolons) on the immediately preceeding line.

For help on individual commands use help <command_name>.  Available
commands: play, stop, mark, name, list, delete, changename, export,
ff, rw, jump, head, checkmark, browse, volume, help, quit.
END_INTERACTIVE_HELP

        # If we have a decent terminal and a pager, use them,
        if ( (($ENV{'TERM'} eq "linux") or ($ENV{'TERM'} eq "xterm")) 
	     and ($ENV{'PAGER'}) ) {
	    if ( system("echo '$help_text' | $ENV{'PAGER'}") ) {
		die "'system(\"echo '$help_text' | $ENV{'PAGER'}\")' failed";
	    }
	} else { # if no decent pager, just dump help text.
	    print $help_text;
	}
    } elsif ( $commands{$arg} ) {
	# Funny print because I can't bring myself to trust the first
	# argument to interpolate properly into a string, though it
	# seems to work.
	print(($commands{$arg}->{doc}), "\n");
    } else {
	print STDERR "help: $arg: no help on that topic.  Try just 'help'.\n";
    }
    return(0);
}

# The user wishes to quit this program.  If unexported named chunks
# exist make sure the user knows.  Clean up and set DONE
# appropriately.
sub com_quit {
    # Argument processing.
    if ( @_ ) {
        print STDERR "quit: quit does not take any arguments\n";
	return(1);
    }

    if ( %names ) {
        unless ( &$prompt_yes_no_ref("Named chunks of the current input volume have been defined which have not 
yet been exported with the export command.  Quit anyway (y/N)? ", "n") ) {
	    return(0);
	}
    }
    if ( $mode =~ /^(?:play|browse|$temporary_play_rgx)$/ ) {
        &stop_core;
    }
    $done = 1;

    return(0);
}

} 

# End of command line interface part.

# Both interfaces use many of these functions.

# Start play mode from stop, browse, or temporary play mode.
sub com_play {
    # Argument processing.
    if ( @_ > 1 ) {
        print STDERR "play: too many arguments\n";
	return(1);
    }
    my $arg = shift;		# Optional argument.

    &check_volume_loaded("play") or return(1);

    if ( $last_pos >= $volume_length ) {
	print STDERR "play: head is already at end of volume\n";
	return(1);
    }

    # Remember the mode we were in before this play command, or before
    # the first temporary play command if we were in temporary play
    # mode.
    my $orig_mode;	
    unless ( $mode =~ /$temporary_play_rgx/ ) {
	$orig_mode = $mode;
    } else {
	$orig_mode = $2;
    }

    if ( $mode eq "play" ) {
        print STDERR "play: the volume is already being played\n";
    } else {
        if ( $mode eq "browse" ) {
	    my $stop_pos = $last_pos + &tdelta;
            if ( $stop_pos - $last_pos < $edge_margin ) {
		# Slight lie; we havn't actually entered play mode yet.
                &$com_message("Entered play mode from near the beginning of a played browse section.\n");
            } elsif ( $stop_pos - $last_pos > $browse_play_time
		                              - $edge_margin ) {
		# Slight lie; we havn't actually entered play mode yet.
                &$com_message("Entered play mode from near the end of a browse section.\n");
	    }
            &stop_core;
        } elsif ( $mode =~ /$temporary_play_rgx/ ) {
	    &stop_core;
	}
	unless ( defined($arg) ) {
	    # No arg means go into play mode.
	    &play_core($volume_length - $last_pos);
	    $mode = "play";
	} else {
	    # Got optional arg, so go into temporary play mode.

	    # Set the edge margin to be small for very short play sections.
	    if ( $arg < 2 ) {
		$edge_margin = $arg / 2;
	    }
	    &play_core($arg);
	    $mode = "temporary play for $arg seconds (old mode: $orig_mode)";
	}
    }
    
    return(0);
}

# Start rawplay process with a time limit option.  The argument to this
# procedure is the time limit to give rawplay.
sub play_core {
    @_ == 1 or die "bug: internal function got wrong number of arguments";
    my $arg = shift;

    # Don't try to play more data than the volume contains.  A small
    # safety margin is included in case rounding causes problems.
    my $rawplay_play_time = $arg;
    if ( $rawplay_play_time > $volume_length - $last_pos - 0.01 ) {
	$rawplay_play_time = $volume_length - $last_pos - 0.01;
    }

    undef $rawplay_pid;
    $rawplay_pid = fork;
    unless ( defined($rawplay_pid) ) {
        die "$progname: couldn't fork $!\n";
    } elsif ( $rawplay_pid == 0 ) { # child
        exec "rawplay -B 262144 -c $channels -d $audio_device -f $input_sample_format -s $sampling_rate -j $last_pos -t $rawplay_play_time $volume" or die "$progname: couldn't exec: $!\n";
    } else { # parent
        $start_time = time;
    }

    return(0);
}

# The stop command.
sub com_stop {
    # Argument processing.
    if ( @_ ) {
        print STDERR "stop: stop does not take any arguments\n";
	return(1);
    } 

    &check_volume_loaded("stop") or return(1);

    if ( $mode eq "stop" ) {
	print STDERR "stop: already stopped $last_pos seconds into volume\n";
    } else {
        if ( $mode eq "browse" ) {
	    my $stop_pos = $last_pos + &tdelta;
            # Note with these messages we are lying to the user a bit, since 
            # we haven't yet done the actual stop, but the message is much 
            # more intelligable this way.
            if ( $stop_pos - $last_pos < $edge_margin ) {
                &$com_message("Player stopped near the beginning of a played browse section.\n");
            } elsif ( $stop_pos - $last_pos > $browse_play_time
                                              - $edge_margin ) {
                &$com_message("Player stopped near the end of a played browse section.\n");
	    }
	}
        &stop_core;
    }

    return(0);
}

# The core stop function.  Unlike the core play procedure, this
# procedure sets the mode.
sub stop_core {
    $last_pos = $last_pos + &tdelta;
    $mode = "stop";
    # rawplay might exit between the check on the mode and this 
    # point, so we check to be sure we have successfully signaled 
    # before doing blocking waitpid.  I think this is not required 
    # since SIGCHLD is blocked during user command execution and 
    # there is therefore no chance of the handler reaping the child, 
    # but it doesn't hurt to be paranoid.
    if ( kill 'TERM', $rawplay_pid ) {
        waitpid $rawplay_pid, 0;
    }
}

# Place the mark at the current position of the head in volume.  The
# mark works as in emacs, i.e. there can be only one mark at a time,
# and the export command works between the mark and the current
# position.
sub com_mark {
    # Argument processing.
    if ( @_ ) {
        print STDERR "mark: mark does not take any arguments\n";
	return(1);
    } 

    &check_volume_loaded("mark") or return(1);

    if ( $mode =~ /^(?:play|browse|$temporary_play_rgx)$/ ) {
        $mark_pos = $last_pos + &tdelta;
    } else {
        $mark_pos = $last_pos;
    }
    # If browsing, make sure user knows where the head was when name went off.
    if ( $mode eq "browse" ) {
        if ( $mark_pos - $last_pos < $edge_margin ) {
            &$com_message("Mark placed near the beginning of a played section in browse mode.\n");
        } elsif ( $mark_pos - $last_pos > $browse_play_time - $edge_margin ) {
            &$com_message("Mark placed near the end of a played section in browse mode.\n");
        }
    }
    if ( $mode =~ /$temporary_play_rgx/ and $2 eq "browse" ) {
	if ( $mark_pos - $last_pos > $1 - $edge_margin ) {
	    # If the mark end up falling right after the temporary
	    # play, browse mode will catch it (in other modes no jump
	    # will have occured, so there is no possibility of
	    # confusion.
	    &$com_message("Mark placed near the end of a \"temporary play\" section.\n");
	}
    }

    return(0);
}

# Name the data between the mark and the current position of the head.
sub com_name {
    my $out_name = shift;
    if ( defined($out_name) and defined(shift) ) {
        &$com_error("name: too many arguments\n");
        return(1);
    }

    &check_volume_loaded("name") or return(1);

    my $pos_now;		# up to date position of head
    if ( $mode =~ /^(?:play|browse|$temporary_play_rgx)$/ ) {
        $pos_now = $last_pos + &tdelta;
    } else {
	$pos_now = $last_pos;
    }

    # We must have an appropriate mark on the volume.
    unless ( defined($mark_pos) ) {
	&$com_error("name: the mark has not yet been placed on the volume\n");
	return(1);
    } 
    unless ( abs($pos_now - $mark_pos) >= 0.05 ) {
	&$com_error("name: current head position is less than 1/20 second away from mark position, this is less than the operating resolution of $progname\n");
	return(1);
    }

    # Unless the name command was given an argument, choose default name.
    unless ( defined($out_name) ) {
	$out_name = $output_basename."_chunk".$chunknum++;
    }

    # Other commands (as of Mon Apr 23 2001, changename) name chunks.
    $out_name = &name_chunk_core($out_name, "name");

    # If browsing, make sure user knows where the head was when name went off.
    if ( $mode eq "browse" ) {
        if ( $pos_now - $last_pos < $edge_margin ) {
            &$com_message("Chunk named has an endpoint near the beginning of a browse mode played section.\n");
        } elsif ( $pos_now - $last_pos > $browse_play_time - $edge_margin ) {
            &$com_message("Chunk named has an endpoint near the end of a browse mode played section.\n");
        }
    }  
    # If near end of temporary play section and heading back to browse
    # mode, make sure user knows where the head was when the name went
    # off.
    if ( $mode =~ /$temporary_play_rgx/ and $2 eq "browse" ) {
	if ( $pos_now - $last_pos > $1 - $edge_margin ) {
	    # If the mark ends up falling right after the temporary
	    # play, browse mode will catch it (in other modes no jump
	    # will have occured, so there is no possibility of
	    # confusion.
	    &$com_message("Chunk named has endpoint near the end of a \"temporary play\" section.\n");
	}
    }

    # We don't want to change the current position or the mark
    # position, but if the head is actually before the mark, we
    # need to define the starting and ending points of the chunk
    # we are about to export differently.
    my $chunk_start;
    my $chunk_end;
    if ( $mark_pos < $pos_now ) {
	$chunk_start = $mark_pos;
	$chunk_end = $pos_now;
    } else {
	$chunk_start = $pos_now;
	$chunk_end = $mark_pos;
    }

    # Add the newly defined chunk to the global chunk list.  The ogg_*
    # entries may possibly be filled in later by another command.
    $names{$out_name} = {start => $chunk_start, end => $chunk_end, 
			 ogg_comment => undef, ogg_artist => undef, 
			 ogg_title => undef, ogg_album => undef};

    return(0);
}

# Common code shared between com_name and com_changename.  Barely
# worth having common, weird looks for ogg comments which are the last
# args to both commands.
sub name_chunk_core {
    # First argument is the name we hope to use.
    my $name = shift;
    # Second argument is the name of the command that called this
    # function, for error reporting.
    my $calling_com_name = shift;

    # Ensure we have a good directory part, prompting if we have to.
    my $out_name = &ensure_writable_directory($name);

    # Ensure we have a known extension to deal with.
    $out_name = &ensure_known_extension($name, $calling_com_name);
    
    # Get tilde expanded version of current intended name.
    my $x_out_name = &tilde_expand_path($out_name);

    # If a chunk with the name we are trying to give the current chunk
    # already exists, or if a file with a name the same as the tilde
    # expanded version of the chunk name we are trying to create
    # already exists, see if the user wants to pick another name.

    # Flag true with meaningful value iff we are given a directory
    # name which tilde-expands to the tilde expansion of an existing
    # chunk name.
    my $new_exp_match_exist = 0;
    foreach my $existing_name (keys %names) {
	if ( $x_out_name eq &tilde_expand_path($existing_name) ) {
	    $new_exp_match_exist = $existing_name;
	}
    }
    while ( (-e $x_out_name) or (exists($names{$out_name})) or
	    (exists($names{$x_out_name})) or ($new_exp_match_exist)) {
	my $pick_new = 0;	# True if we decide we want to pick a new name.
	if ( -e $x_out_name ) {
	    # New name will clobber an existing file.
	    if ( &$prompt_yes_no_ref("A file with name
   $x_out_name
already exists.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    }
	} elsif ( exists($names{$out_name}) ) {
	    # New name will redefine an existing chunk.
	    if ( &$prompt_yes_no_ref("Another chunk with name 
   $out_name
has already been defined.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    }
	} elsif ( exists($names{$x_out_name}) ) {
	    # New name will result in an extra definition referring to
	    # same file.
	    if ( &$prompt_yes_no_ref("A tilde-equivalent chunk with name
   $x_out_name
has already been defined.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    } else {
		# Ditch existing tilde-equivalent chunk.
		delete($names{$x_out_name});
	    }
	} elsif ( $new_exp_match_exist ) {
	    # New name will result in an extra definition referring to
	    # same file.
	    if ( &$prompt_yes_no_ref("A tilde-equivalent chunk with name
   $new_exp_match_exist
has already been defined.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    } else {
		# Ditch existing tilde-equivalent chunk.
		delete($names{$new_exp_match_exist});
	    }
	}

	if ( $pick_new ) {
	    # Get new name, deal with extension, and perform tilde
	    # expansion as before, then try again.
	    $out_name = &$prompt_new_name_ref("New name: ");
	    $out_name = &ensure_writable_directory($out_name);
	    $out_name = &ensure_known_extension($out_name, $calling_com_name);
	    $x_out_name = &tilde_expand_path($out_name);
	    # Redo the check for the complicated condition in while loop.
	    $new_exp_match_exist = 0;
	    foreach my $existing_name (keys %names) {
		if ( $x_out_name eq &tilde_expand_path($existing_name) ) {
		    $new_exp_match_exist = $existing_name;
		}
	    }
	} else {
	    last;
	}
    }

    return $out_name;
}

# Set ogg in-file comment fields for a named chunk.
sub com_oggment {
    # First argument is chunk name we are adding comments to.
    my $arg = shift;

    unless ( defined($arg) ) {
	print STDERR "oggment: at least one argument required\n";
	return(1);
    }

    &check_volume_loaded("oggment") or return(1);

    unless ( exists($names{$arg}) ) {
        print STDERR "oggment: no chunk named
   $arg
is currently defined\n";
        return(1);
    }
    unless ( $arg =~ /\.ogg$/ ) {
        print STDERR "oggment: the chunk name
   $arg
will not be exported in ogg format (wrong extension)\n";
	return(1);
    }

    # Parse remaining comment arguments.
    while ( defined(my $com_option = shift) ) {
        unless ( $com_option =~ /(comment)|(artist)|(title)|(album)/ ) {
            print STDERR "oggment: unrecognized ogg comment field name '$com_option'\n";
            return(1);
        }
	my $com_arg = shift;
        unless ( defined($com_arg) ) {
            print STDERR "oggment: ogg comment field argument '$com_option' needs an argument of its own\n";
            return(1);
	}

	# Record ogg comment fields for chunks in the global chunk
	# list.
        if ( $com_option =~ /comment/ ) {
            $names{$arg}{ogg_comment} = "$com_arg";
	} elsif ( $com_option =~ /artist/ ) {
            $names{$arg}{ogg_artist} = "$com_arg";
        } elsif ( $com_option =~ /title/ ) {
            $names{$arg}{ogg_title} = "$com_arg";
        } elsif ( $com_option =~ /album/ ) {
            $names{$arg}{ogg_album} = "$com_arg";
        }
    }

    return(0);
}

# List all the currently defined chunks.
sub com_list {
    # Argument processing.
    if ( @_ ) {
        print STDERR "list: list does not take any arguments\n";
	return(1);
    }

    &check_volume_loaded("list") or return(1);

    if ( !%names ) {
	print "No unexported named chunks are currently defined. \n";
	return(0);
    }

    my $chunkname;
    my $chunkstart;
    my $chunkend;

format LIST_TOP =
Chunk Name                                            Start           End
--------------------------------------------       --------      --------
.

format LIST =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       @####.##      @####.##
$chunkname, $chunkstart, $chunkend
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
$chunkname
.

    STDOUT->format_name("LIST");
    STDOUT->format_top_name("LIST_TOP");
    # We are using this interactively, no formfeeds wanted.
    $^L = "";

    foreach my $name ( sort keys %names ) {
	$chunkname = $name;
	$chunkstart = $names{$name}{start};
	$chunkend = $names{$name}{end};
	write;
    }

    # Force a new form to be started by the next write.
    $- = 0;

    STDOUT->format_name("STDOUT");
    STDOUT->format_top_name("STDOUT_TOP");

    return(0);
}

# Delete a chunk from the list of named chunks.
sub com_delete {
    my $arg = shift;
    unless ( defined($arg) ) {
	print STDERR "delete: at least one argument required\n";
	return(1);
    }

    &check_volume_loaded("delete") or return(1);

    my @delete_list;		# Chunks to be deleted.

    # Verify arguments and build deletion list.  
    while ( defined($arg) ) {
	unless ( exists($names{$arg}) ) {
	    print STDERR "delete: no chunk named
   $arg
is currently defined, not deleting anything\n";
	    return(1);
	}
        push(@delete_list, $arg);
	$arg = shift;
    }

    # Delete chunk definitions.
    foreach ( @delete_list ) {
	delete $names{$_};
    }

    return(0);
}

# Change the name of an existing chunk.
sub com_changename {
    # There must be two arguments.
    unless ( @_ == 2 ) {
	print STDERR "changename: wrong number of arguments, exactly two arguments required\n";
	return(1);
    }

    &check_volume_loaded("changename") or return(1);

    # Process the first two command arguments.
    my $arg1 = shift;
    my $arg2 = shift;
    unless ( exists($names{$arg1}) ) {
        print STDERR "changename: no chunk named
   $arg1
is currently defined\n";
        return(1);
    }

    # New name to use.
    my $new_name = &name_chunk_core($arg2, "changename");

    # In with the new name, out with the old.
    $names{$new_name} = $names{$arg1};
    delete $names{$arg1};

    return(0);
}

# Export and merge chunks given as arguments into a single file given
# as the last argument.  The extension of the file determines the
# output format used in the same way as for chunks. 
sub export_and_merge_specific_chunks {
    @_ >= 2 or die "bug: wrong number of arguments to internal function";

    # This is only called from com_export, and we call some functions
    # that need to know their callers name for error reporting, so we
    # have this.
    my $calling_com_name = "export";

    # Arguments are names or abbreviations of chunks and file name we
    # hope to export them to.
    my $file_name = pop(@_);
    my @chunks = @_;

    # Validate the chunk abbreviations or names, expanding
    # abbreviations in place.
    foreach my $chunk ( @chunks ) {
	my @matches;		# Names matching current chunk specifier.
        foreach my $name ( keys %names ) {
	    if ( $name =~ m/^$chunk.*/ ) {
		push(@matches, $name);
	    }
	}
	# If we have a single unique expansion for an abbreviation...
	if ( @matches == 1 ) {
	    # then expand the abbreviation in place,
	    $chunk = $matches[0];
	    next;
	} elsif ( @matches > 1 ) {
	    # otherwiise report the ambiguity and give up.
	    print STDERR "export: chunk abbreviation 
   $chunk 
is ambiguous (not exporting anything)\n";
	    return 1;
	}
	unless ( exists($names{$chunk}) ) {
	    print STDERR "export: no chunk named or abbreviated 
   $chunk
is defined (not exporting anything)\n";
	    return 1;
	}
    }

    # Make sure we have a good directory part and a known extension.
    my $out_name = &ensure_writable_directory($file_name);
    $out_name = &ensure_known_extension($out_name,  $calling_com_name);

    # If a file with a name the same as the tilde expanded version of
    # the file we are trying to create already exists, see if the user
    # wants to pick another name.
    my $x_out_name = &tilde_expand_path($out_name);
    while ( -e $x_out_name ) {
	if ( -e $x_out_name ) {
	    # New name will clobber an existing file.
	    if ( &$prompt_yes_no_ref("A file with name
   $x_out_name
already exists.  Pick a different name (Y/n)? ", "y") ) {
		# Get new name, ensure that its got a reasonable
		# directory part, deal with extension, and perform
		# tilde expansion as before, then try again.
		$out_name = &$prompt_new_name_ref("New name: ");
		$out_name = &ensure_writable_directory($out_name);
		$out_name = &ensure_known_extension($out_name, 
						    $calling_com_name);
		$x_out_name = &tilde_expand_path($out_name);
	    } else {
		last;
	    }
	}
    }

    # In a token effort at efficiency, we use block copies of about 50
    # bytes, on the assumption that 1/100 of a second more or less
    # isn't likely to matter.  It is critical that the block size
    # actually used be aligned with respect to the size of the raw
    # samples, i.e. wrt (($bps / 8) * $channels).
    my $block_size = 50;
    $block_size += (($bps / 8) * $channels)
	           - $block_size % (($bps / 8) * $channels);

    # Try to ensure that we will have enough space on the device.
    {
	my $total_time_length = 0; # Total time length of data being exported.
	foreach ( @chunks ) {
	    $total_time_length += $names{$_}{end} - $names{$_}{start};
	}
	my ($file, $path, $suffix) = fileparse($x_out_name, @known_extensions);
	my $space_needed = &space_required($total_time_length, $block_size,
					   $suffix);
	unless ( &have_sufficient_storage_space($path, $space_needed) ) {
	    chomp(my $crnt_date = `date`);
	    unless ( &$prompt_yes_no_ref("You probably don't have enough disk space to export all those chunks
at the moment ($crnt_date).  Try to export them anyway (y/N)? ", "n") ) {
		return 0;	# It's a bit peculiar to call this success.
	    }
	}
    }

    # Construct the system command to which we will pipe data for
    # export.
    
    my $sox_args;
    if ( $input_sample_format eq "s16_le" ) {
	$sox_args = "-t sw ";
    } elsif ($input_sample_format eq "u8" ) {
	$sox_args = "-t ub ";
    }
    $sox_args .= "-r $sampling_rate -c $channels - ";

    # Currently, we let sox use the extension of the $output_file to
    # determine the format to convert to, unless the output format is
    # to be raw data, in which case we use the format used for the
    # argument file, or ogg or flac encoded data, in which case we
    # convert to a reasonable format with sox and let the appropriate
    # encoder take it from there.
    if ( $out_name =~ /(\.raw)$/ ) {
	# Actually, there is no good reason to use sox at all here, we
	# are just piping the data through unchanged.
	    if ( $input_sample_format eq "s16_le" ) {
		$sox_args .= "-t sw ";
	    } elsif ($input_sample_format eq "u8" ) {
		$sox_args .= "-t ub ";
	    }
	}

    # Quoted, tilde-expanded name safe for passing to shell.  To allow
    # most arbitrary stupid file names.
    my $qx_name = &quoteify($x_out_name);

    # Both oggenc and flac can now accept things in various raw forms,
    # stop depending on sox to (possibly) resample?  At the moment, I
    # think I trust sox most to do this reasonably well.
    if ( $out_name =~ /((\.flac)|(\.ogg))$/ ) {
	$sox_args .= "-r 44100 -c $channels -t sw - | ";
    } else {
	$sox_args .= "$qx_name ";
    }
    my $system_pipe .= "sox $sox_args ";

    if ( $out_name =~ /(\.flac)$/ ) {
	$system_pipe .= "flac --silent --verify --channels=$channels --bps=16 --sample-rate=44100 --endian=little --sign=signed -o $qx_name -";
    }

    # If we are outputting in ogg format, concatenate any comments
    # attached to ogg chunks together and preserve them.

    if ( $out_name =~ /(\.ogg)$/ ) {
	# Flag true iff 1 or more chunks have comment fields. 
	my $have_ogg_comment = 0; 
	my $cated_ogg_comment = ""; # Concatenated ogg comment fields.
	# Flag true iff 1 or more chunks have artist fields.
	my $have_ogg_artist = 0;
	my $cated_ogg_artist = "";  # Concatenated ogg artist fields.
	# Flag true iff 1 or more chunks have title fields.
	my $have_ogg_title = 0;
	my $cated_ogg_title = "";   # Concatenated ogg title fields.
	# Flag true iff 1 or more chunks have album fields.
	my $have_ogg_album = 0;
	my $cated_ogg_album = "";   # Concatenated ogg album fields.

	# Iterate over defined chunks looking for ogg comments.
	foreach ( @chunks ) {
	    next unless $_ =~ /(\.ogg)$/;
            # Ogg comment, artist, etc. fields probably contain weird
            # chars so they get quoted.
	    if ( defined($names{$_}{ogg_comment}) ) {
		$have_ogg_comment = 1; # Set flag true.
		$cated_ogg_comment .= $names{$_}{ogg_comment};
	    }
	    if ( defined($names{$_}{ogg_artist}) ) {
		$have_ogg_artist = 1; # Set flag true.
		$cated_ogg_artist .= $names{$_}{ogg_artist};
	    }
	    if ( defined($names{$_}{ogg_title}) ) {
		$have_ogg_title = 1; # Set flag true.
		$cated_ogg_title .= $names{$_}{ogg_title};
	    }
	    if ( defined($names{$_}{ogg_album}) ) {
		$have_ogg_album = 1; # Set flag true.
		$cated_ogg_album .= $names{$_}{ogg_album};
	    }
	}

	# We only want to use a comment option to oggenc if the user
	# actually entered a blank comment.  If we have comment text,
	# it probably contains weird characters, so we quoteify it.
	my $comment_option_text = $have_ogg_comment
	                          ? "--comment=".&quoteify($cated_ogg_comment)
				  : "";
	my $artist_option_text = $have_ogg_artist
	                         ? "--artist=".&quoteify($cated_ogg_artist)
				 : "";
	my $title_option_text = $have_ogg_title
	                        ? "--title=".&quoteify($cated_ogg_title)
			        : "";
	my $album_option_text = $have_ogg_album
	                        ? "--album=".&quoteify($cated_ogg_album)
			        : "";

	# Append the oggenc encoder to the system pipeline command.
	$system_pipe .= "oggenc --raw --raw-chan=$channels --bitrate=$ogg_kbitrate --quiet --output=$qx_name $comment_option_text $artist_option_text $title_option_text $album_option_text -";
    }

    # Open the volume itself for reading.
    open(CURRENT_VOLUME, $volume)
	or die "couldn't open volume file '$volume' for reading: $!";

    # Open the processing pipeline to be used to export.
    unless ( open(CONCATENATED_CHUNKS, '|-', $system_pipe) ) {
	# This pipeline might bug out in many ways, so we try to
	# preserve the users chunk list and keep going, rather than
	# just die'ing.
	print STDERR "export: probable bug: couldn't open system pipeline\n";
	return(1);
    }

    # Write the chunks to the destination file.
    if ( $out_name =~ /((\.flac)|(\.ogg))$/ ) {
	&$com_message("Encoding and writing to \"$out_name\"\n"); 
    } else {
	&$com_message("Writing to \"$out_name\"\n");
    }
    &$com_message("(ignoring individual chunk extensions): \n");
    foreach my $chunk ( @chunks ) {
	# Get the components of the name we are exporting to.
	my ($name, $path, $suffix) = fileparse($chunk, @known_extensions);

	# For convenience and clarity, unpack values from array.
	my $chunk_start = $names{$chunk}{start};
	my $chunk_end = $names{$chunk}{end};
	# Number of blocks to skip at beginning of volume.
	my $skip = floor($chunk_start * $sampling_rate * $bps * $channels
			 / (8 * $block_size));
	# Number of blocks to copy.
	my $count = ceil((($chunk_end - $chunk_start) * $sampling_rate * $bps
			   * $channels ) / ( 8 * $block_size));

	# Seek to the start of the current chunk.
	seek(CURRENT_VOLUME, $skip * $block_size, SEEK_SET)
	    or die "seek in volume file '$volume' failed: $!";

	# Warn user that directory part of chunk name is being ignored.
	if ( $path ne "./" or $chunk =~ m/^\.\// ) {
	    &$com_message("export: warning: ignoring path part of chunk name '$chunk'\n");
	}
	# Print normal progress message.
	&$com_message("Processing \"$chunk\"... ");

	# Copy the data from the volume to the output pipe.
	my $data_buffer;
	for ( 1 .. $count ) {
	    my $rtn = read(CURRENT_VOLUME, $data_buffer, $block_size);
	    unless ( $rtn == $block_size ) {
		if ( defined($rtn) ) {
		    die "read in volume file '$volume' did not read enough";
		} else {
		    die "read in volume file '$volume' failed: $!";
		}
	    }
	    print CONCATENATED_CHUNKS $data_buffer;
	}
	&$com_message("done.\n"); # Progress message.
	delete $names{$chunk};
    }

    # Close the output pipe (flushing it).
    close(CONCATENATED_CHUNKS)
	or die "close of system pipe '$system_pipe' failed";

    return 0;
}
		
# Export all of the individual chunks currently defined.
sub export_all_individual_chunks {
    # Argument processing.
    @_ == 0 or die "bug: wrong number or arguments to internal function";

    # In a token effort at efficiency, we use bs of about 50 for dd,
    # on the assumption that 1/100 of a second more or less isn't
    # likely to matter.  It is critical that the block size actually
    # used in the dd command be aligned with respect to the size of
    # the raw samples, i.e. wrt (($bps / 8) * $channels).
    my $block_size = 50;
    $block_size += (($bps / 8) * $channels)
	           - $block_size % (($bps / 8) * $channels);
    
    # For each named chunk...
    foreach my $name ( sort keys %names ) {

	# Get the components of the name we are exporting to.
	my ($fname, $path, $suffix) = fileparse($name, @known_extensions);

	# Guard against some fs changes.
	my $x_path = &tilde_expand_path($path);
	unless ( -e $x_path ) {
	    &$com_message("Directory
   $path
does not exist.  Something must have changed since you named this chunk.  
Skipping named chunk
   $name\n");
            next;
	}
	unless ( -w $x_path and -x $x_path ) {
	    &$com_message("No permission to create
   $fname$suffix
in
   $path
Permissions must have changed since you named this chunk, skipping it.\n");
	    next;
	}

	# For convenience and clarity, unpack values from array.
	my $chunk_start = $names{$name}{start};
	my $chunk_end = $names{$name}{end};

	# Try to detect and behave sensibly if the user doesn't have
	# the disk space to export the current file at the moment.
	# The numeric constants here are related to the details of
	# input and output audio formats.
	my $space_needed = &space_required($chunk_end - $chunk_start, 
					   $block_size, $suffix);
	unless ( &have_sufficient_storage_space($path, $space_needed) ) {
	    chomp(my $crnt_date = `date`);
	    unless ( &$prompt_yes_no_ref("You probably don't have enough disk space for:
   $name
at the moment ($crnt_date).  Try to export it anyway (y/N)? ", "n") ) {
		next;
	    }
	}

	# Number of blocks to skip at beginning of volume.
	my $skip = floor($chunk_start * $sampling_rate * $bps * $channels
			 / (8 * $block_size));
	# Number of blocks to copy.
	my $count = ceil((($chunk_end - $chunk_start) * $sampling_rate * $bps
			   * $channels ) / ( 8 * $block_size));

	# Now we construct the command string which will do the work
        # exporting this chunk.  The standard error of dd gets thrown
        # away because it writes status information we don't want to see
        # there.
	my $system_arg = "dd if=$volume bs=$block_size skip=$skip count=$count 2>/dev/null | ";
	my $sox_args;
	if ( $input_sample_format eq "s16_le" ) {
	    $sox_args = "-t sw ";
	} elsif ($input_sample_format eq "u8" ) {
	    $sox_args = "-t ub ";
	}
	$sox_args .= "-r $sampling_rate -c $channels - ";

	# Currently, we let sox use the extension of the $output_file
	# to determine the format to convert to, unless the output
	# format is to be raw data, in which case we use the format
	# used for the argument file, or ogg or flac encoded data, in
	# which case we convert to a reasonable format with sox and
	# let the appropriate encoder take it from there.
	if ( $name =~ /(\.raw)$/ ) {
	    # Actually, there is no good reason to use sox at all here, we
            # are just piping the data through unchanged.
	    if ( $input_sample_format eq "s16_le" ) {
		$sox_args .= "-t sw ";
	    } elsif ($input_sample_format eq "u8" ) {
		$sox_args .= "-t ub ";
	    }
	}

        # Quoted, tilde-expanded name safe for passing to shell.  To
        # allow most arbitrary stupid file names.
	my $qx_name = &quoteify(&tilde_expand_path($name));

	# Both oggenc and flac can now accept things in various raw
	# forms, stop depending on sox to (possibly) resample?  At the
	# moment, I think I trust sox most to do this reasonably well.
	if ( $name =~ /((\.flac)|(\.ogg))$/ ) {
	    $sox_args .= "-r 44100 -c $channels -t sw - | ";
	} else {
	    $sox_args .= "$qx_name ";
	}
	$system_arg .= "sox $sox_args ";

	if ( $name =~ /(\.flac)$/ ) {
	    $system_arg .= "flac --silent --verify --channels=$channels --bps=16 --sample-rate=44100 --endian=little --sign=signed -o $qx_name -";
	}

        if ( $name =~ /(\.ogg)$/ ) {

	    # We only want to give comment options to oggenc if the
	    # user actually specified (possibly blank) comments.  
	    my $comment_option_text;
            if ( defined($names{$name}{ogg_comment}) ) {
	        $comment_option_text = "--comment="
		                       .&quoteify($names{$name}{ogg_comment});
	    } else {
		$comment_option_text = "";
	    }
	    my $artist_option_text;
	    if ( defined($names{$name}{ogg_artist}) ) {
	        $artist_option_text = "--artist="
	                  	      .&quoteify($names{$name}{ogg_artist});
	    } else {
		$artist_option_text = "";
	    }
	    my $title_option_text;
            if ( defined($names{$name}{ogg_title}) ) {
		$title_option_text = "--title="
		                     .&quoteify($names{$name}{ogg_title});
	    } else { 
		$title_option_text = "";
	    }
	    my $album_option_text;
            if ( defined($names{$name}{ogg_album}) ) {
		$album_option_text = "--album="
		                     .&quoteify($names{$name}{ogg_album});
	    } else {
                $album_option_text = "";
	    }

	    # Append the oggenc encoder to the system command.	    
	    $system_arg .= "oggenc --raw --raw-chan=$channels --bitrate=$ogg_kbitrate --quiet --output=$qx_name $comment_option_text $artist_option_text $title_option_text $album_option_text -";
	}

        if ( $name =~ /((\.flac)|(\.ogg))$/ ) {
	    &$com_message("Encoding and writing \"$name\"... ");
	} else {
	    &$com_message("Writing \"$name\"... ");
	}
	my $export_pid = fork;
	unless ( defined($export_pid) ) {
	    die "$progname: couldn't fork: $!\n";
	} elsif ( $export_pid == 0 ) { # child
	    # Make this intense stuff as nice as possible.
	    setpriority 0, 0, 20;
	    # Note that this doesn't really trap many of the many many
            # things that could be wrong with this exec.
	    exec "$system_arg" or die "export: exec($system_arg) failed\n";
	} else {		       # parent
	    waitpid $export_pid, 0;
	    &$com_message("done.\n");
	    delete $names{$name};
	}
    }

    return 0;
}


# Export all the named chunks to files.
sub com_export {
    # Argument processing.
    if ( @_ > 0 and @_ < 2 ) {
        print STDERR "export: if any arguments are supplied, at least two must be\n";
	return(1);
    }

    &check_volume_loaded("export") or return(1);

    unless ( keys %names ) {
	&$com_message("There are no unexported named chunks to export.\n");
	return(0);
    }

    # If playing, browsing, or temporary playing, stop doing so, to
    # give the drive a break.
    my $old_mode = $mode;	# Remember what we were doing.
    if ( $mode eq "play" ) {
	&$com_message("Stopping player while exporting (give your drive a break)...\n");
	&stop_core;
    } elsif ( $mode eq "browse" ) {
        &$com_message("Stopping browse while exporting (give your drive a break)...\n");
        &stop_core;
    } elsif ( $mode =~ /$temporary_play_rgx/ ) {
	# Time to temporary play after resuming playing.
	my $new_temp_time = $1 - &tdelta;
	$old_mode =~ s/for\s*\d+[.]?\d*\s*seconds
              	      /for\ $new_temp_time\ seconds/x;
	&$com_message("Stopping temporary play while exporting (give your drive a break)...\n");
	&stop_core;
    }

    # Run the appropriate form of the command depending on the
    # argument count.
    my $return_code;
    if ( @_ > 0 ) {
	$return_code = &export_and_merge_specific_chunks(@_);
    } else {
	$return_code = &export_all_individual_chunks(@_);
    }

    # Resume play, browse, or temporary play if we were before the
    # export command.
    # FIXME: use core functions or check for being at end/other things
    # that produce diagnostics before invoking user command functions?
    if ( $old_mode eq "play" ) {
	&$com_message("Player restarted.\n");
	&com_play();
    } elsif ( $old_mode eq "browse" ) {
        &$com_message("Browse restarted.\n");
        &com_browse();
    } elsif ( $old_mode =~ /$temporary_play_rgx/ ) {
	&$com_message("Temporary play resumed.\n");
	# com_play with an argument temporary plays for argument seconds.
	&com_play($1);
    }

    return($return_code);
}

# Immediately move the head forward $arg seconds, or the number of
# seconds given as the argument to the last ff or rw command if no
# argument was included for this command, or the default initialized
# value of $last_ff_or_rw_arg seconds if this is the first use of ff
# or rw and no argument is given.
sub com_ff {
    my $arg = shift;
    unless ( defined($arg) ) {
	$arg = $last_ff_or_rw_arg;
    }

    if ( defined(shift) ) {
        print STDERR "ff: too many arguments\n";
        return(1);
    }

    &check_volume_loaded("ff") or return(1);

    my $ff_secs;		# Argument cooked to time in seconds.
    unless ( defined($ff_secs = &quantity_time_to_seconds($arg)) ) {
	print STDERR "ff: don't know how to handle argument '$arg'\n";
	return(1);
    }

    $last_ff_or_rw_arg = $ff_secs;
    if ( $mode eq "play" ) {
	# Recall that stop_core updates $last_pos to $last_pos + &tdelta
	&stop_core;
	if ( $last_pos + $ff_secs >= $volume_length ) {
	    $last_pos = $volume_length;
	    &$com_message("Stopped at end of volume.\n");
	} else {
	    $last_pos += $ff_secs;
	    &com_play();
	}
    } elsif ( $mode eq "browse" ) {
        my $ff_start_point = $last_pos + &tdelta;
        if ( $ff_start_point - $last_pos < $edge_margin ) {
            &$com_message("Fast forward executed from near the beginning of a played section.\n");
        } elsif ( $ff_start_point - $last_pos > $browse_play_time
                                                - $edge_margin ) {
            &$com_message("Fast forward executed from near the end of a played section.\n");
        }
        &stop_core;
        if ( $last_pos + $ff_secs >= $volume_length ) {
            $last_pos = $volume_length;
            &$com_message("Stopped at end of volume.\n");
        } else {
            $last_pos += $ff_secs;
            &com_browse();
        }
    } elsif ( $mode =~ /$temporary_play_rgx/ ) {
	my $ff_start_point = $last_pos + &tdelta;
	if (     $ff_start_point - $last_pos > $1 - $edge_margin 
	     and $2 eq "browse" ) {
	    &$com_message("Fast forward executed from near the end of a \"temporary play\".\n");
	}
	&stop_core;
	if ( $last_pos + $ff_secs >= $volume_length ) {
	    $last_pos = $volume_length;
	    &$com_message("Stopped at end of volume.\n");
	} else {
	    $last_pos += $ff_secs;
	    if ( $2 eq "play" ) {
	        &com_play();
	    } elsif ( $2 eq "browse" ) {
		&com_browse();
	    } # Only other old mode is stop mode, which needs no handling.
	}
    } elsif ( $mode eq "stop" ) {
	if ( ($last_pos += $ff_secs) > $volume_length ) {
	    $last_pos = $volume_length;
	    &$com_message("Stopped at end of volume.\n");
	}
    } else {
	die "bug: invalid mode";
    }

    return(0);
}

# Immediately move the head backward $arg seconds, or the number of
# seconds moved by the last ff or rw command, or the default
# initialized value of $last_ff_or_rw_arg seconds if this is the first
# use of ff or rw.
sub com_rw {
    my $arg = shift;
    unless ( defined($arg) ) {
	$arg = $last_ff_or_rw_arg;
    }

    if ( defined(shift) ) {
        print STDERR "rw: too many arguments\n";
        return(1);
    }

    &check_volume_loaded("rw") or return(1);

    my $rw_secs;		# Argument cooked to time in seconds.
    unless ( defined($rw_secs = &quantity_time_to_seconds($arg)) ) {
	print STDERR "rw: don't know how to handle argument '$arg'\n";
	return(1);
    }

    # Well this shows bogosity of having ff or rw remember the last
    # arg.  If user request rw 100 from pos 10, then should next ff be
    # 10 or 100?  No good answer.
    $last_ff_or_rw_arg = $rw_secs;
    if ( $mode eq "play" ) {
	&stop_core;
	if ( ($last_pos -= $rw_secs) < 0 ) {
            $last_pos = 0;
	    &$com_message("Rewind stopped at beginning of volume.\n");
        } 
	&com_play();
    } elsif ( $mode eq "browse" ) {
        my $rw_start_point = $last_pos + &tdelta;
        if ( $rw_start_point - $last_pos < $edge_margin ) {
            &$com_message("Rewind executed from near the beginning of a played section.\n");
        } elsif ( $rw_start_point - $last_pos > $browse_play_time
                                                - $edge_margin ) {
            &$com_message("Rewind executed from near the end of a played section.\n");
        }
        &stop_core;
        if ( ($last_pos -= $rw_secs) < 0 ) {
	    $last_pos = 0;
            &$com_message("Rewind stopped at beginning of volume.\n");
        }
	&com_browse();
    } elsif ( $mode =~ /$temporary_play_rgx/ ) {
	my $rw_start_point = $last_pos + &tdelta;
	if (     $rw_start_point - $last_pos > $1 - $edge_margin
	     and $2 eq "browse" ) {
	    &$com_message("Rewind executed form near the end of a \"temporary play\".\n");
	}
	&stop_core;
	if ( ($last_pos -= $rw_secs) < 0 ) {
	    $last_pos = 0;
	    &$com_message("Rewind stopped at beginning of volume.\n");
	}
	if ( $2 eq "play" ) {
	    &com_play();
	} elsif ( $2 eq "browse" ) {
	    &com_browse();
	} # Only other old mode is stop mode, which needs no handling.
    } elsif ( $mode eq "stop" ) {
	if ( ($last_pos -= $rw_secs) < 0 ) {
            $last_pos = 0;
	    &$com_message("Rewind stopped at beginning of volume.\n");
        }
    } else {
	die "bug: invalid mode";
    }

    return(0);
}

# Jump the head to the position given as an argument.
sub com_jump {
    my $arg = shift;
    unless ( defined($arg) ) {
	&$com_error("jump: argument required\n");
	return(1);
    }
    if ( defined(shift) ) {
        &$com_error("jump: too many arguments\n");
        return(1);
    }

    &check_volume_loaded("jump") or return(1);

    # The value of the argument as an offset.
    my $offset;

    # Turn the argument into an offset.

    if ( $arg eq "m") {
	# Translate 'm' to the mark position if possible.
        if ( defined($mark_pos) ) {
          $offset = $mark_pos;
        } else {
          &$com_error("jump: 'm' given as argument but the mark has not been placed yet\n");
          return(1);
        }
    } elsif ( $arg =~ /:/ ) {
	# Translate a time argument to an offset if possible.
	my $day_offset;		# value of arg in seconds from start of day.
	unless ( defined($time_of_start) ) {
	    &$com_error("jump: '$arg' looks like a time string, but the start time of the volume was not set with the -t command line option\n");
	    return(1);
	}
	unless ( defined(my $day_offset = &time_to_offset($arg)) ) {
	    &$com_error("jump: failed to convert argument which looked like a TIME string (it contained a colon) to an offset\n");
	    return(1);
	} else {
	    $offset = $day_offset - $volume_start_offset;
	    if ( ($offset < 0) or ($offset > $volume_length) ) {
		my $err_string = "jump: TIME argument '$arg' ";
		unless ( $arg =~ /[aApP][mM]?$/ ) {
		    $err_string .= "(understood to be in 24 hour format) ";
		}
		$err_string .= "is not in this volume, given command line option argument '$time_of_start'";
		unless ( $time_of_start =~ /[aApP][mM]?$/ ) {
		    $err_string .= " (understood to be in 24 hour format)";
		}
		&$com_error("$err_string\n"); 
		return(1);
	    }
	}
    } else {
	# Translate a quantitfy of time with units to an offset if possible.
	unless ( defined($offset = &quantity_time_to_seconds($arg)) ) {
	    &$com_error("jump: don't know how to handle argument: $arg\n");
	    return(1);
	} 
    }

    if ( ($offset < 0) or ($offset > $volume_length) ) {
	&$com_error("jump: $arg: not a valid offset from the beginning of the volume\n");
	return(1);
    }


    # Flag to say don't restart playing or browsing if user jumped to
    # the end of the volume (with rounding protection).
    my $no_resume_flag = ($offset > $volume_length - 0.01);
    if ( $mode eq "play" ) {
	&stop_core;
	$last_pos = $offset;
	# Don't resume in case the user jumped straight to volume end.
	&com_play() unless $no_resume_flag;
    } elsif ( $mode eq "browse" ) {
        &stop_core;
        $last_pos = $offset;
	# Don't resume in case the user jumped straight to volume end.
        &com_browse() unless $no_resume_flag;
    } elsif ( $mode =~ /$temporary_play_rgx/ ) {
	unless ( $no_resume_flag ) {
	    if ( $2 eq "play" ) {
		&com_play();
	    } elsif ( $2 eq "browse" ) {
		&com_browse();
	    } 
	}
    # Only other old mode is stop mode, which needs no handling.
    } elsif ( $mode eq "stop" ) {
	$last_pos = $offset;
    } else {
	die "invalid mode";
    }

    return(0);
}

# Report on the position and status of the player head.
sub com_head {
    # Argument processing.
    if ( @_ ) {
        print STDERR "head: head does not take any arguments\n";
	return(1);
    }

    &check_volume_loaded("head") or return(1);

    # We may need to cook the result of &tdelta a bit, so local version.
    my $l_tdelta;
    if ( $mode =~ /^(?:play|browse|$temporary_play_rgx)$/ ) {
	# All these modes have may need slight &tdelta cooking, and
	# are gauranteed to have the variables &tdelta needs defined.
	$l_tdelta = &tdelta;
	# This can happen because we block signals during user functions.
	if ( $l_tdelta > $volume_length - $last_pos ) {
	    $l_tdelta = $volume_length - $last_pos; 
	}
    }
    if ( $mode eq "play" ) {
        printf "%.2f/%.2f  playing.\n", $last_pos + $l_tdelta, $volume_length;
    } elsif ( $mode eq "browse" ) {
	# This can happen because we block signals during user functions.
	if ( $l_tdelta > $browse_play_time ) {
	    $l_tdelta = $browse_play_time;
	}
        printf "%.2f/%.2f  browsing (%.2f/%.2f seconds into current section).\n", $last_pos + $l_tdelta, $volume_length, $l_tdelta, $browse_play_time;
    } elsif ( $mode =~ /$temporary_play_rgx/ ) {
	# This can happen because we block signals during user functions.
	if ( $l_tdelta > $1 ) {
	    $l_tdelta = $1;
	}
	printf "%.2f/%.2f  temporay play (%.2f/%.2f seconds played, old mode: $2).\n", $last_pos + $l_tdelta, $volume_length, $l_tdelta, $1;
    } elsif ( $mode eq "stop" ) {
	printf "%.2f/%.2f  stopped.\n", $last_pos, $volume_length;
    } else {
	die "bug: invalid mode";
    }

    return(0);
}

# Report on the position of the mark.
sub com_checkmark {
    # Argument processing.
    if ( @_ ) {
        print STDERR "checkmark: checkmark does not take any arguments\n";
	return(1);
    }

    &check_volume_loaded("checkmark") or return(1);

    unless ( defined($mark_pos) ) {
	print "The mark has not yet been placed on the volume.\n";
    } else {
	printf "%.2f/%.2f\n", $mark_pos, $volume_length;
    }

    return(0);
}

# Start browsing the volume at the current head position.
sub com_browse {
    # Command argument processing.
    my $arg1 = shift;
    my $arg2 = shift;
    if ( defined($arg1) xor defined($arg2) ) {
        print STDERR "browse: if one argument is supplied, both must be\n";
        return(1);
    }

    &check_volume_loaded("browse") or return(1);

    unless ( defined($arg1) ) {
        $arg1 = $browse_play_time;
    }
    unless ( defined($arg1 = &quantity_time_to_seconds($arg1)) ) {
	print STDERR "browse: don't know how to handle argument: $arg1\n";
	return(1);
    }
    unless ( defined($arg2) ) {
        $arg2 = $browse_skip_time;
    }
    unless ( defined($arg2 = &quantity_time_to_seconds($arg2)) ) {
	print STDERR "browse: don't know how to handle argument: $arg2\n";
	return(1);
    }
    if ( defined(shift) ) {
        print STDERR "browse: too many arguments\n";
        return(1);
    }

    if ( $last_pos >= $volume_length ) {
	print "browse: head is already at end of volume\n";
	return(1);
    }

    # Set command memory.
    $browse_play_time = $arg1;
    $browse_skip_time = $arg2;

    # Now that we think we have valid options, we stop the player if needed.
    if ( $mode =~ /^(?:play|browse|$temporary_play_rgx)$/ ) {
        &stop_core;
    }

    # Set the edge margin to be small for very short play sections.
    if ( $browse_play_time < 2 ) {
        $edge_margin = $browse_play_time / 2;
    }

    # Kick off browse mode.
    &play_core($browse_play_time);
    $mode = "browse";

    return(0);
}

# Set or reset the volume being dissected, and possibly the associated
# TIME-OF-START.
sub com_volume 
{
    if ( @_ > 2 ) {
	print STDERR "volume: too many arguments\n";
	return(1);
    }

    # Do we have a reasonable looking new volume name to go to?
    my $new_volume = shift;
    unless ( defined($new_volume) ) {
	print STDERR "volume: argument required\n";
	return(1);
    }

    # Reasonable volume file name?
    if ( my $volume_file_error = &check_volume_file($new_volume) ) {
        &$com_error("volume: $volume_file_error\n");
        return(1);
    }

    # In case the user doesn't want to pitch currently defined chunks.
    if ( %names ) {
	unless ( &$prompt_yes_no_ref("Named chunks of the current input volume have been defined which have not yet been
exported with the export command.  Load new volume anyway (y/N)? ", "n") ) {
	    return(0);
	}
    }

    # Do we have a reasonable new time_of_start? 
    my $new_time_of_start = shift;
    my $new_volume_start_offset;
    if ( defined($new_time_of_start) ) {
	unless ( defined($new_volume_start_offset 
			 = time_to_offset($new_time_of_start)) ) {
	    print STDERR "volume: failed to parse argument '$new_time_of_start'\n";
	    return(1);
	}
	if ( $volume_start_offset >= 86400 ) {
	    print STDERR "volume: argument '$new_time_of_start' had illegal day offset\n";
	    return(1);
	}    
    }

    # New volume name and time_of_start look reasonable.  Stop head if
    # necessary.
    if ( defined($volume) ) {	# If we already had a volume loaded...
	# we might be in a mode which requires stopping the player,
	if ( $mode eq "play" ) {
	    &stop_core;
	    &$com_message("Playing stopped for volume change.\n");
	} elsif ( $mode eq "browse" ) {
	    &stop_core;
	    &$com_message("Browsing stopped for volume change.\n");
	} elsif ( $mode =~ /$temporary_play_rgx/ ) {
	    &stop_core;
	    &$com_message("Temporary play stopped for volume change.\n");
	}
    } else {
	# otherwise, we have just loaded the first volume and need to
	# set the head mode explicitly for the first time.
	$mode = "stop";
    }

    # (Re)set globals.

    $volume = $new_volume;
    $volume_size = (stat $volume)[7];
    $volume_length = $volume_size * 8 / ( $bps * $sampling_rate * $channels);
    $last_volume_time_check = time;
    undef $start_time;
    $last_pos = 0;

    # The start offset may or may not have been reset via argument to
    # this command function.
    if ( defined($new_time_of_start) ) {
	$volume_start_offset = $new_volume_start_offset;
    } else {
	undef $volume_start_offset;
    }
    
    undef $mark_pos;
    undef %names;
} 

# Functions that check for and/or report errors.  These may also use
# different output facilities depending on which interface is in use.

# Return a string indicating problems with a volume file.  If the null
# string is returned, there were no problems.
sub check_volume_file {
    # Argument is the name of the file we intend to treat as a volume.
    my $volume_file = shift;

    # Reasonable volume name?
    if ( !(-e $volume_file) ) {
	return "'$volume' does not exist\n";
    }
    if ( -d $volume_file ) {
        return "'$volume' is a directory, not a file\n";
    }
    # FIXME: Add more bogus file type checks?
    if ( !(-r $volume_file) ) {
	return "'$volume' is not readable\n";
    }

    # If we make it here, no problems were found.
    return "";
}

# Verify that there is a volume loaded or complain and return failure.
sub check_volume_loaded {
    # Argument is the name of the command doing the checking.
    my $com_name = shift;

    if ( defined($volume) ) {
	return 1;
    } else {
	&$com_error("$com_name: there is no volume loaded currently (try 'help volume')\n"); 
	return 0;
    }
}

# The volume might have been accidently diddled with on disk, which of
# course can cause just about anything to happen.  This checks for
# changes and reports them.
sub volume_sanity_check {
    # Argument processing.
    unless ( @_ == 1 ) {
	die "bug: internal function volume_sanity_check got wrong number of arguments";	
    }    
    my $arg = shift;
    
    if ( !(-e $volume) ) {
	&$com_error("$progname: '$volume' file no longer exists, this means trouble...\n");
	return 0;
    }
    if ( !(-r $volume) ) {
	&$com_error("$progname: '$volume' is no longer readable, this means trouble...\n");
	return 0;
    }
    if ( (stat($volume))[9] > $last_volume_time_check ) {
	&$com_error("$progname: '$volume' appears to have changed since it was loaded, this could mean trouble...\n");
	$last_volume_time_check = time;
	return 0;
    }
    
    # Made it through the checks, so return true.
    return 1;
}

# Utility functions.

# We frequently need to no the elapsed time since the last time we
# invoked the player.  To find out where we are now.
sub tdelta {
    return time - $start_time;
}

# Ensure that the directory part of the given name is workable.  If
# its not, repeatedly prompt the user until we get a name with a
# workable directory part, and return that.
sub ensure_writable_directory {    
    # Argument processing.  The only argument is the name.
    if ( @_ != 1 ) {
	die "bug: internal function ensure_writable_directory got wrong number of arguments";
    }
    my $name = shift;

    my $out_name = $name;	# Potentially corrected version of name.

    # fileparse from File::Basename.
    my ($fname, $path, $suffix) = fileparse($out_name, @known_extensions);

    # Get a tilde expanded form of the path part.
    my $x_path = &tilde_expand_path($path);

    # Path portion of file name must already exist and be executable
    # to us, so we can create files there later.
    while ( !(-e $x_path) or !(-w $x_path and -x $x_path) ) {
	my $gripe_string;
	if ( !(-e $x_path) ) {
	    $gripe_string = "Path 
   $path
does not exist.  Try another name: ";
	} else { # must be here because !(-w $x_path and -x $x_path)
	    $gripe_string = "No permission to create files in
   $path
Try another name: ";
	}
	$out_name = &$prompt_new_name_ref($gripe_string);

	# Parse new name and expand path for next iteration of while.
	($fname, $path, $suffix) = fileparse($out_name, @known_extensions);
	$x_path = &tilde_expand_path($path);
    }

    return $out_name;
}

# If we can't deal with files of the type corresponding to the suffix
# we see on the argument, warn user and change to the default
# extension (the default extension is tested to be ok at startup).  If
# we don't see a suffix we recognize, silently add the default
# extension.  Returns the new name.
sub ensure_known_extension {
    # Argument processing.  The only argument is the name.
    if ( @_ != 2 ) {
	die "bug: internal function ensure_known_extension got wrong number of arguments";
    }
    my $name = shift;
    my $calling_com_name = shift;

    # Oggenc must be present.
    if ( ($name =~ /\.ogg$/) and (!&have_oggenc) ) {
	print STDERR "$calling_com_name: warning: oggenc executable not found, changing extension for this chunk to default output file type extension '.$output_file_format'\n";
	$name =~ s/\.ogg$/\.$output_file_format/;
    }

    # Flac must be present.
    if ( ($name =~ /\.flac$/) and (!&have_flac) ) {
	print STDERR "$calling_com_name: warning: flac executable not found, changing extension for this chunk to default output file type extension '.$output_file_format'\n";
	$name =~ s/\.flac$/\.$output_file_format/;
    } elsif ( !(&have_flac =~ m/^[1-9]\.[0-9]/) ) {
	# Flac must be version 1.0 or later, since command line syntax
	# has changed.
	print STDERR "$calling_com_name: warning: flac executable found is not a recent enough version (version 1.0 or later is require), changing extension for this chunk to default output file type extension '.$output_file_format'\n";
	$name =~ s/\.flac$/\.$output_file_format/;
    }

    unless ( $name =~ /\.($known_extensions_pattern)$/ ) {
	$name .= '.'.$output_file_format;
    }

    return $name;
}

# Given a length of time in seconds, the IO block size to be used, and
# a file format extension (raw, cdr, flac, etc.), return an estimate
# in bytes of the space required to store the given amount of data in
# the given format, plus a reasonable safety margin.
sub space_required {
    # Get arguments.
    @_ == 3 or die "bug: wrong number of arguments to internal function";
    my ($time_length, $block_size, $format) = @_;

    my $space_needed;	# Bytes storage probably needed for this chunk.
    my $space_margin;	# Safety margin required for chunk, in bytes.
    if ( $format =~ /^\.?cdr$/ ) {
	$space_needed = $time_length * 44100 * (16 / 8) * 2;
	$space_margin = 2 * $block_size + 100000;
    } elsif ( $format =~ /^\.?flac$/ ) {
	# Assume flac can achieve at least 0.7 compression factor.
	$space_needed = 0.7 * $time_length * 44100 * (16 / 8) * $channels;
	$space_margin = $space_needed * 0.2; # compression factor varies
    } elsif ( $format =~ /^\.?ogg$/ ) {
	# Here I assume kbit in ogg refers to 1024 bits, not 1000.
	# Close enough.  Also, this assumes encoding uses the
	# specified kbit rate regardless of number of channels.
	$space_needed = $time_length * ($ogg_kbitrate * 1024 / 8);
	$space_margin = $space_needed * 0.2; # compression factor varies
    } elsif ( $format =~ /^\.?raw$/ ) {
	$space_needed = $time_length * $sampling_rate * ($bps / 8) 
	                * $channels;
	$space_margin = (2 * $block_size);
    } elsif ( $format =~ /^\.?wav$/ ) {
	# Like for raw, above, but more paranoid because I don't know much
	# about wavs.
	$space_needed = $time_length * $sampling_rate * ($bps / 8) 
	                * $channels;
	$space_margin = 2 * $block_size + 100000;
    }

    return $space_needed + $space_margin;
}

# Return true iff the filesystem containing the path given as the
# first argument has at least as much space available as specified in
# bytes by the second argument.
sub have_sufficient_storage_space
{
    @_ == 2 or die "bug: wrong number of arguments to internal function";
    my ($path, $byte_count) = @_;

    # Output of the df command.
    my @df_fields = split(/\s+/, `df --portability $path`);
    $df_fields[1] =~ m/(\d+)-blocks/ or die "bug: df output misinterpreted";
    my $df_block_size = $1;

    return $byte_count <= $df_fields[10] * $df_block_size;
}

# Strip whitespace from the start and end of string, returned stripped
# string.  Note that trailing newlines get removed.
sub stripwhite {
    my $string = shift;
    $string =~ s/^\s*//;
    $string =~ s/\s*$//;
    return $string;
}

# Perform tilde expansion on a path argument.  Works like the
# shell: if expansion fails, you get the argument back unmodified.
# The returned path features a trailing backslash iff the argument
# featured one.
sub tilde_expand_path {
    my $path = shift;

    # Won't expand usernames with spaces.  With only a leading tilde
    # followed by word characters this shouldn't be a dangerous thing
    # to pass on to test -d and ls -d commands.  Bash at least now
    # expands some other magic strings with '+', '-', and number
    # characters, but we don't give it a chance at the moment.
    if ( $path =~ /^(~\w*)(\/.*)?$/ and !system("test -d $1") ) {
	chomp($path = `ls -d $1`);
	$path .= $2;
    }

    return $path;
}

# Quotify a string for subsequent passage to the shell.  This kind of
# mucking around is *dangerous*, you must know exactly what you are
# doing and think extremely carefully and you can still get burned.
sub quoteify {
    my $arg = shift; 		# Get argument.
    
    $arg =~ s/\'/\'\"\'\"\'/g;	# Quoteify arg assuming surrounding quotes.
    
    return "'".$arg."'";	# Surround with quotes and return.
}

# Check the validity of a signless decimal number argument, return
# true or false.
sub is_signless_decimal_num {
    my $arg = shift;

    if ( $arg =~ /^\s*\d+[.]?\d*\s*$/ ) {
	return 1;
    } else {
	return 0;
    }
}

# Check the validity of a whole number argument, return true of false.
sub is_whole_num {
    # Argument processing.
    unless ( @_ == 1 ) {
	die "bug: internal function is_whole_num got wrong number of arguments";
    }
    my $arg = shift;

    if ( $arg =~ /^\s*\d+\s*$/ ) {
	return 1;
    } else {
	return 0;
    }
}

# Convert a positive quantity of time possibly containing minute,
# hour, or day units in addition to seconds to seconds.  Return undef
# on error.
sub quantity_time_to_seconds {
    # Argument processing.
    unless ( @_ == 1 ) {
	die "bug: internal function quantity_time_to_seconds got wrong number of arguments";
    }
    my $arg = shift;
    if ( $arg eq "" ) {
	die "bug: internal function quantity_time_to_seconds got null string for an argument";
    }

    # Match subexpression in time quantity.
    unless ( $arg =~ /
 	              ^\s* # Whitespace at the start of the argument.
	              (?:(?=\d)(\d*[.]?\d*)d)?	# Optional days part
                      (?:(?=\d)(\d*[.]?\d*)h)?  # Optional hours part
                      (?:(?=\d)(\d*[.]?\d*)m)?  # Optional minutes part
	              (?:(?=\d)(\d*[.]?\d*)s?)? # Optional seconds part
                      \s*$ # Whitespace at the end of the argument.
	             /x ) {
	return undef;
    } else {
	my ($days, $hours, $minutes, $seconds) = ($1, $2, $3, $4);

	# Fill in parts which didn't occur in pattern with defaults.
	$days ||= 0;		# Set if undefined.
	$hours ||= 0;		# Set if undefined.
	$minutes ||= 0;		# Set if undefined.
	# Careful, pattern which becomes $seconds matches the empty string.
	$seconds ||= 0;		# Set if undefined or empty string.

	# Return quantity of time in seconds.
	return $days * 86400 + $hours * 3600 + $minutes * 60 + $seconds;
    }
}
	

# Convert my own kind of time string to seconds into day.  Return
# undef on error.
sub time_to_offset {
    # Argument processing.
    unless ( @_ == 1 ) {
	die "bug: internal function time_to_offset got wrong number of arguments";	
    }    
    my $arg = shift;
 
    # Break off day offset part, if present.
    my ($time, $day_offset) = split(/\+/, $arg);
    if ( defined($day_offset) ) {
	unless ( &is_signless_decimal_num($day_offset 
					  =~ s/^(\d+)(d|da|day|days)?$/$1/) ) {
	    return undef;
	}
    }

    # Deal with am/pm.
    my $am_flag = 0;
    my $pm_flag = 0;    
    if ( $time =~ /(.*)[pP][mM]?$/ ) {
	$time = $1;
	$pm_flag = 1;
    }
    if ( $time =~ /(.*)[aA][mM]?$/ ) {
	$time = $1;
        $am_flag = 1;
    }

    # Break into time units.
    my ($hours, $mins, $secs) = split(/:/, $time);

    # Hours and minutes must be given.
    unless ( defined($hours) and defined($mins) ) {
	return undef;
    }

    # Get to 24 hour form.
    if ( $am_flag or $pm_flag ) {
	unless ( ($hours >= 1) and ($hours <= 12) ) {
	    return undef;
	} 
	if ( ($pm_flag) and ($hours != 12) ) {
	    $hours += 12;
	}
	if ( ($am_flag) and ($hours == 12) ) {
	    $hours -= 12;
	}
    }

    # If seconds or day offset fields weren't given, they are zero.
    unless ( defined($secs) ) {
	$secs = 0;
    }
    unless ( defined($day_offset) ) {
	$day_offset = 0;
    }
    # Check fields for sanity, if sane, compute and return.
    unless ( &is_whole_num($hours) and
	     (($hours >= 0) and ($hours <= 23)) and
	     &is_whole_num($mins) and
	     (($mins >= 0) and ($mins <= 59)) and
	     &is_signless_decimal_num($secs) and
	     (($secs >= 0) and ($secs < 60)) and
	     &is_whole_num($day_offset) and
	     ($day_offset >= 0) ) {
	return undef;
    } else {
	return $day_offset * 86400 + $hours * 3600 + $mins * 60 + $secs;
    }
}

# Notational shorthand for blocking of SIGCHLD.
sub block_sigchld {
    unless ( defined sigprocmask(SIG_BLOCK, $sigset_sigchld, $old_sigset) ) {
        die "$progname: could not block SIGCHLD\n";
    }
}

# Notational shorthand for unblocking of SIGCHLD.
sub unblock_sigchld {
    unless ( defined sigprocmask(SIG_UNBLOCK, $sigset_sigchld) ) {
        die "$progname: could not unblock SIGCHLD\n";
    }
}
