#!/usr/bin/perl

=pod

This is the archive.pm Perl module for the TUSC layer of the Practical
Supercomputing Toolkit (PST), www.pstoolkit.org.

NOTES
  This module contains all the routines associated with the archive
  command that are site independent.  Site-specific routines are
  included in the local.pm module.

  CODE LAYOUT
    Three files contain the code for the PST "archive" command:
    "archive.pm" (this file), "local.pm," and "bin/archive."

    "bin/archive" contains the user interface for "archive";

    "archive.pm" contains "setup" routines to parse user input and define
    the hash tables %opts, %args, %errs, and %valid.  %opts and %args
    contain reorganized user input, and %errs and %valid contain data
    needed by other "archive" subroutines.

    "archive.pm" also contains "worker" routines which take %opts, %args,
    %errs, and %valid and call the "local" routines which do the actual
    work.

    "local.pm" contains the "local" routines comprising the site-specific
    commands needed to carry out archive's functionality.

    The subroutines and code in "bin/arhive" and "archive.pm" are intended
    to contain all the code that does not depend on the site, while
    "local.pm" is meant to contain site-dependent code only.

  COMMENT
    VERSION's 0.01 and 0.02 of "local.pm" included too much code that was
    site-independent, so VERSION 0.03 was written to prepare for the
    modifications needed to reduce "local.pm" to site-dependent code only.
    The intent is for VERSION 0.03 to contain adequate documentation so
    developers will understand the subroutines and the hash tables shared
    by the subroutines.  VERSION 0.04 includes new, leaner version of 
    "local.pm," which will include no hash table input or output arrays.
    This significantly simplifies implementation of "local.pm" at new 
    sites.

  DATA STRUCTURES, GENERAL
    Because some hash tables (some of them nested hash tables) are passed
    between subroutines, we provide brief documentation of those shared
    data structures here.  We also direct the user/developer to more
    complete descriptions of each of the shared data structures in
    specific subroutines either here or in "local.pm."  Before describing
    the nested hash tables, we must establish a convention for referring
    to the elements of hash tables and nested hash tables.

    KEY => VALUE pairs: the basic hash table is an associated array.  This
    means rather than referring to the elements of array @A via index
    numbers (e.g., $A[0], $A[1], ...), instead we refer to the elements of
    hash %A with the equivalent of "index names" (e.g., $A{VAL}, $A{MSG},
    ...).  The "index names" are called KEY's.  In Perl, to assign a VALUE
    to one of the KEY's of %A, simply type: $A{KEY}=VALUE; e.g.,
    $A{VAL}=103.  Alternately, Perl also permits the equivalent syntax:

    %A = ( VAL => 103, MSG => "This is a message" );

    for simultaneously assigning the VALUE "103" to the KEY "VAL" and
    the VALUE "This is a message" to the KEY "MSG".

    VALUE's need not only be strings or numbers in Perl; they can also be
    arrays (@a) or hashes (%a).  For example, to assign the hash table
    of the previous example (VAL=>103, MSG=>"This is a message") to the
    key BOY of %A, execute the following:

    $A{BOY}{VAL}=103;
    $A{BOY}{MSG}="This is a message";

    or

    %A = ( BOY => { VAL=>103, MSG=>"This is a message" } );

    Please refer Perl's documentation (man perl, www.perldoc.com, ...)
    for further discussion of Perl syntax.  For the discussion below, we
    will refer to nested hash tables as accepting KEY's for KEY's of hash
    tables.  e.g., %A in the example above has only one key named BOY.
    %{$A{BOY}} is a hash table with two KEY's: VAL and MSG.  $A{BOY}{VAL}
    contains the VALUE 103 and $A{BOY}{MSG} contains the VALUE "This is a
    message".

  DATA STRUCTURES, ARCHIVE
    %errs is a nested hash table of error messages.  In the interest of
      providing the user with uniform error messages and error codes
      across sites, %errs resides in "archive.pm" where its content can be
      kept separate from details of the local implementation.  Each KEY of
      the hash %errs contains a short, descriptive name of the associated
      error (e.g., MISSING_FILES, BAD_TARGET, etc).  Each of these KEY's
      points to two more KEY's: VAL and MSG, which contain the error code
      and the error message as VALUE's respectively.  Note: the VALUE
      $errs{$error_name}{VAL} is a number, while the VALUE
      $errs{$error_name}{MSG} is a format string with variables indicated
      by %s, %d, etc.  Hence, routines that print the error message
      $errs{$error_name}{MSG} must also provide values to substitute for
      the variables %s, %d, etc.  Here $error_name refers to the name of
      the KEY; e.g., $error_name=MISSING_FILES, $error_name=BAD_TARGET,
      etc.  See subroutine define_error_table() in archive.pm (this file)
      for all of the error messages generated by archive.

    %valid is a basic (i.e., non-nested) hash table whose KEY's are the
      names of archive's valid commands: get, put, ls, ....  The format
      of the VALUE associated with each KEY is "N:o1:o2:o3:...oM:" where
      N is the number of required arguments for the command identified by
      KEY and o1, o2, ... are valid command-line options for the command.
      For example,

      $valid{put}="1:retry:asf:C:D:s:f:i:p:M:n:t:S:z:";

      See subroutine define_valid_commands_and_options() in archive.pm
      (this file) for all of the KEY's and VALUE's for %valid.

    %opts is a nested hash table whose KEY's are names that describe
      options and some variables used by the "worker" subroutines.  Most
      of the KEY's of %opts point to VALUE's, but one (named HOST) points
      to a nested hash table with information about all the archival
      storage facility (asf) hosts at a site.  %{$opts{HOST}} has the
      following structure:

      HOST =  (
                $host1 => {
                            PROBE => $probe1,
                            HOME  => $home1,
                            USER  => $user1
                          },
                $host2 => {
                            PROBE => $probe2,
                            HOME  => $home2,
                            USER  => $user2
                          },
                   ...
              );

      where $host1, $host2, ... are the names of the asf hosts at the
      local site; $home1 is the name of the user's home directory on
      $host1; $probe1 is a flag (either "yes" or "no") that indicates
      "archive" will or will not check the status and type of files on the
      archival storage facility before and after a transfer (this feature is
      not yet implemented); and $user1 is the user name for the files to
      access on $host1.  (Nothing is currently done with $user1, $user2,
      ....  Originally I thought we could use this information to obtain
      the home directory for the user, in case we wanted to access his/her
      files, and we didn't know the user's home directory.  If we know the
      user's home directory already, then we don't need the user's name.
      Also, we may not be able to get the user's home directory at some
      sites simply from the user's name.  So, I suspect we may want to
      drop reference to the user's name altogether, but for now it is a
      variable that is stored.)  See the subroutine set_default_opts() in
      archive.pm (this file) for more description of %opts.

    %args is a nested hash table of user supplied arguments for the
      "archive" command (e.g., get, put, ls, ...) issued by the user.
      Note: %args contains only the arguments for the command, not the
      command or any command-line options.  The hash %args is generated
      by the routine define_args_hash() in archive.pm (this file).
      define_args_hash() simply defines a KEY for %args for each argument
      supplied by the user.  The list of user-supplied arguments is
      output as the reference $args to the array @args by subroutine
      parse_input().  define_args_hash() takes \@args as input and
      generates %args.  The VALUE for each KEY of %args is the key VAL,
      which is set by define_args_hash() to a number ($errs{RETRY}),
      indicating that the argument in question has not yet been processed
      by the "archive" command.  When the argument is successfully
      processed, the VALUE associated with
      $args{$user_supplied_argument}{VAL} is set to 0.  If processing of
      argument $user_supplied_argument fails fatally, then
      $args{$user_supplied_argument}{VAL} is set to the error code for
      the mode of failure, and processing of the argument is no longer
      attempted.  See subroutines parse_input() and define_args_hash() for
      more discussion of hash %args.

HISTORY
  6-8-2001: VERSION = 0.01

  6-9-2001: VERSION = 0.02
    1. modify all error messages to include archive.pm:subroutine name
    2. all header comment statements have been formatted
    3. open_tarfiles and archive_get subroutines added
    4. other subroutines modified as indicated in their history sections
    5. remove TAIL, HEAD, EXT, ROOT and use Set.pm instead

  7-9-2001: VERSION = 0.03
    1. this version contains more comment statements to document code
       and hash tables so others can more easily contribute to the code.

Authors throughout this module include Joe Werne, Michael J. Gourlay and
Chris Bizon.  All three participated in development, even in routines
that do not explicitly list their names.

Most of the HISTORY sections are no longer maintained since CVS now
handles that for us.

=cut

#================================================== Define PSTset module

package TUSC::archive;

use Exporter;
@ISA = "Exporter";
@EXPORT = qw(archive_ls define_error_table define_valid_commands_and_options set_default_opts find_separator parse_input archive_put define_args_hash archive_get archive_mv archive_rm archive_mkdir archive_rmdir archive_chmod archive_chgrp archive_chown archive_env archive_stat);

$VERSION = "0.04";

use constant PSTDIR => "/u/werne/PST";
use strict;
#use warnings;




sub archive_ls
{

=pod

NAME
  archive_ls: List data on the archival storage facility.


USAGE
  (\%opts,\%out) = archive_ls(\%opts,$host,\%args,\%errs);


INPUT
  %opts -- command-line options; see set_default_opts().

  $host -- name of archival storage facility on which to perform "ls".
      See NOTES below.

  %args -- command-line arguments; see define_args_hash().

  %errs -- error-message list; see define_error_table().


OUTPUT
  %opts -- updated %opts ($opts{fatal} possibly incremented); see
      set_default_opts().

  %out  -- hash table with KEY's VAL and MSG.  The VALUE for VAL is set
      to the exit code for the "archive ls" operation, and the VALUE for
      MSG is set to the output from the worker_ls operation.  If an error
      is encountered, then the VALUE for MSG is set to the associated
      error message.


VARIABLES
  HASHES
    %args2 -- nested hash table with a KEY for each KEY of %args (see
        %args in INPUT section above).  The names of the KEY's for
        %args2 are the full path names (i.e., beginning with "/") of
        the corresponding KEY names of %args.  See NOTES below.

    %statopts -- modified copy of %opts with $statopts{silent}=1 used
        in call to archive_stat(); see %opts in INPUT section above.

    %statout -- output from archive_stat(); see archive_stat().

  ARRAYS
    @args2 -- list of KEY's of %args2

  SCALARS
    $arg -- set to each KEY of %args in foreach loop
    $arg2 -- set to each KEY of %args2 in foreach loop
    $args -- reference for input hash %args
    $args2 -- string joining all elements of @args2
    $errs -- reference for input hash %errs
    $opts -- reference for input hash %opts


NOTES
  $host: most archive routines operate on only one archival storage
  facility host at the current site.  they interact with the host
  specified by $opts{DEFAULT_HOST}.  $opts{DEFAULT_HOST} is set to the
  first host specified by the -asf option, if present, or it is set to
  the first host specified with the $ARCHIVE_HOST environment variable,
  or it is set to the default value indicated in local.pm:archive_env().
  a few routines (including archive_ls, archive_get, and archive_stat)
  are intended to sequence through multiple asf hosts, but they do not
  currently.  when they are finished, they should sequence through all
  the asf hosts by default or they should sequence through a subset of
  asf hosts identified by the -asf option.  but for now, these routines
  only interact with the single host specified by the $host input
  variable.  it is not my intent that $host will continue to be passed
  to archive_ls or these other routines when these routines are finished
  and behave as intended.  $host is present currently as a reminder to
  us which archive routines must be modified to sequence through
  multiple hosts.

  %args2: originally JW planned to have "archive_ls" return a separate
  exit code and message for each argument passed.  %args2 was intended
  to contain this information.  later JW dropped the idea of collecting
  information for each argument, and instead JW combined all the KEY's
  of %args2 into one string $args2.  %args2 continues to remain with
  in archive_ls() at the off chance we decide to do something with it.


AUTHOR
  Written 2001 by Joe Werne and Michael J. Gourlay


=cut

  # Link to "local.pm"
  use lib PSTDIR;
  use TUSC::local;

  # Unpack arguments from ARGS array
  my ($opts,$host,$args,$errs)=@_;

  # Dereference hash table variables
  #
  # [This is probably an unnecessarily complicated practice.
  #  For example, if you have a variable named %hashtable you can
  #  legally access its elements with a construct like $hashtable{key}.
  #  If, however, you assign %hashtable=%$hashtable then the meaning
  #  of $hashtable is less clear, especially to people not used to
  #  the ridiculously complicated scoping rules of Perl.  We should
  #  therefore simply give the references names like $optsRef and
  #  dereference them on the fly with constructs like $$optsRef{key}
  #  or optsRef->{key}.  This avoids the unnecessary population of the
  #  Perl variable namespace.  --MJG]

  my(%opts)=%$opts;
  my(%args)=%$args;
  my(%errs)=%$errs;

  # Declare local variables
  #
  # [Please document the meanings of each variable. --MJG]
  my (%out);
  my (%statopts);
  my (%statout);
  my ($arg);

  # [This is the stuff of comedic geek legends.
  #
  #  Please give these self-documenting names.
  #
  #  --MJG]

  my ($arg2);
  my ($args2);
  my (@args2);
  my (%args2);

  # If no arguments were passed, use home directory as argument
  if (! %args)
  {
    $args{$opts{HOST}{$host}{HOME}}{VAL}=$errs{RETRY}{VAL};
  }

  # Wait for $host to become available (controlled by $opts{retry})
  %statopts         = %opts;
  $statopts{silent} = 1;
  %statout          = archive_stat(\%statopts,$host,\%errs);

  if ($statout{$host}{VAL}==0)
  {
    # Make sure path for %args is full.
    # Store result in %args2.
    foreach $arg (keys %args)
    {
      # [?!?!?!? --MJG]
      $arg2 = $arg;

      # If $arg2 does not start with "/", prepend with home directory.
      if ($arg2 !~ /^\//)
      {
        $arg2="$opts{HOST}{$host}{HOME}$arg2"
      }
      $args2{$arg2}{VAL}=$args{$arg}{VAL};
    }

    # Join all keys in %args2 into a single string $args2.
    @args2 = keys %args2;
    $args2 = join " ", @args2;

    # perform ls for all %args2 using worker_ls().
    %out = worker_ls(\%opts,$host,$args2,\%errs);

    # print output of "ls" to STDOUT.
    if ($opts{silent}==0)
    {
      #print "archival storage facility = \"$host\"\n";
      print "$out{MSG}\n";
    }
  }
  else
  {
    $opts{fatal}++;

    # Set VAL and MSG for %out to archive_stat VAL and MSG.
    $out{VAL}=$statout{$host}{VAL};
    $out{MSG}=$statout{$host}{MSG};

    if ($opts{silent}==0)
    {
      # Warn user that host named $host is down.
      warn sprintf $errs{HOST_DOWN}{MSG},
        ("archive.pm:archive_ls",$host,$statout{$host}{MSG});
    }
  }

  return (\%opts,\%out);
}




sub define_error_table
{

=pod

NAME
  define_error_table: Assign table of error messages for PST routines


USAGE
  %errs=define_error_table();


ARGUMENTS
  none


RETURN VALUE
  %errs is a nested hash table of error messages.

        Each KEY is a short, descriptive name of the associated error
        (e.g., MISSING_FILES, BAD_TARGET, etc).

        Each associated value contains a hash table with two more KEYs:
        VAL and MSG, which contain the error code and the error message
        as VALUE's respectively.

        KEYS:

          RETRY = attempt execution (possibly again) for the associated
              argument

          FATAL_ERRS = report the number of fatal errors encountered

          BAD_CHOICE = report an incompatible selection of options
              and/or arguments for a command

          MISSING_ARGS = too few arguments have been specified

          MISSING_FILES = specified files were not found

          PRESENT_FILES = files should not exist, but they do

          INHERIT = arguments cannot be processed because of an
              inhereted error condition; e.g., files cannot be moved
              to the archival storage directory because the archival
              storage directory does not exist.

          BAD_TARGET = target file or directory is incompatible with
              specified operation

          ZERO_SIZE = the local file is zero size

          PERMISSION = incompatible permission for specified operation

          FILE_IS_DIR = local file is a directory, but -t option is not
              specified

          MISSING_TARGET = asf destination directory does not exist, and
              -p option was not specified

          BAD_FILE = specified files have incorrect type for specified
              operation

          TAR_FAILED = creation of local tarfile failed

          GZIP_FAILED = gzip compression operation failed

          UNEXPECTED = operation returned unexpected output

          UNKNOWN_HOST = specified asf is not in list of expected asf's

          MKDIR_FAILED = mkdir failed

          PUT_FAILED = archive put operation failed

          GET_FAILED = archive get operation failed

          BAD_HOME = see message below for BAD_HOME

          BAD_PROBE = see message below for BAD_HOME

          HOST_DOWN = asf is not available

          SIZE_MISMATCH = after transfer, the local and remote copies
              have different size


  The VALUE $errs{$error_name}{VAL} is a number, while the VALUE
  $errs{$error_name}{MSG} is a format string containing format
  conversion strings for various values, indicated by %s, %d, etc.
  Hence, routines that print the error message $errs{$error_name}{MSG}
  often must also provide values to substitute for the variables %s,
  %d, etc.  Here $error_name refers to the name of the KEY; e.g.,
  $error_name=MISSING_FILES, $error_name=BAD_TARGET, etc.


NOTES
  VAL should be renamed something less ambiguous like
  "ERROR_VALUE_INTEGER", since all hash tables have key-value pairs,
  so "VAL" does not sufficiently distinguish this value from any other
  encountered in a hash table.  Also, a hash table key named "VAL"
  is highly confusing.

  Also, the various "out" hash tables also uses keys named "VAL" and
  "MSG" although they have entirely unrelated meanings.  The "MSG"
  key here should therefore also be renamed, probably to something like
  "ERROR_MESSAGE_TEXT".

  --MJG



AUTHOR
  Written by Joe Werne and Michael J. Gourlay


SEE ALSO
  qprepInitializeErrorTable(in 'qprep.pm')


=cut

  my (%errs);

  %errs = (

    RETRY => {
      VAL => 99,
      MSG => "RETRY"},
    FATAL_ERRS => {
      VAL => 100,
      MSG => "%s: %d fatal error%s.  See man %s.\n"},
    BAD_CHOICE => {
      VAL => 101,
      MSG => "ERROR encountered in %s:\n   \"%s\" is not a valid %s for %s;\n   should be: %s.\n"},
    MISSING_ARGS => {
      VAL => 102,
      MSG => "ERROR encountered in %s:\n   Too few arguments; \"%s\" requires %d argument%s, but received %d.\n"},
    MISSING_FILES => {
      VAL => 103,
      MSG => "ERROR encountered in %s:\n   The following %s files do not exist: %s\n"},
    PRESENT_FILES => {
      VAL => 104,
      MSG => "ERROR encountered in %s:\n   The following %s files already exist: %s\n"},
    INHERIT => {
      VAL => 105,
      MSG => "ERROR encountered in %s:\n   The following arguments inherited a fatal error from %s: %s\n"},
    BAD_TARGET => {
      VAL => 201,
      MSG => "ERROR encountered in %s:\n   Target destination %s exists on the archival storage facility, and it is %s.\n"},
      ZERO_SIZE => {
      VAL => 206,
      MSG => "ERROR encountered in %s:\n   Specified local file %s is zero size.\n"},
    PERMISSION => {
      VAL => 207,
      MSG => "ERROR encountered in %s:\n   No %s permission for local file %s.\n"},
    FILE_IS_DIR => {
      VAL => 208,
      MSG => "ERROR encountered in %s:\n   %s is a directory.  -t option needed to transfer a directory.\n"},
    MISSING_TARGET => {
      VAL => 202,
      MSG => "ERROR encountered in %s:\n   Archival storage destination directory %s does not exist, and -p option was not specified.\n"},
    BAD_FILE => {
      VAL => 203,
      MSG => "ERROR encountered in %s:\n   The following arguments are not %s: %s\n"},
    TAR_FAILED => {
      VAL => 106,
      MSG => "ERROR encountered in %s:\n   Creation of local tarfile %s failed.\n"},
    GZIP_FAILED => {
      VAL => 107,
      MSG => "ERROR encountered in %s:\n   Creation of local gzip file %s failed.\n"},
    UNEXPECTED => {
      VAL => 204,
      MSG => "ERROR encountered in %s:\n   %s returned unanticipated output: %s.\n"},
    UNKNOWN_HOST => {
      VAL => 205,
      MSG => "ERROR encountered in %s:\n   %s is not in current list of archival storage facilities.\n   Known hosts include: %s"},
    MKDIR_FAILED => {
      VAL => 108,
      MSG => "ERROR encountered in %s:\n   mkdir failed when attempting to create %s.\n"},
    PUT_FAILED => {
      VAL => 109,
      MSG => "ERROR encountered in %s:\n   put failed when attempting to transfer %s.\n"},
    GET_FAILED => {
      VAL => 110,
      MSG => "ERROR encountered in %s:\n   get failed when attempting to transfer %s.\n"},
    BAD_HOME => {
      VAL => 111,
      MSG => "ERROR encountered in %s: Bad or inconsistent format\n for ARCHIVE_HOME and/or ARCHIVE_HOST.  These variables are\n either set by the environment variables \$ARCHIVE_HOST and\n \$ARCHIVE_HOME or by the archive_env routine in local.pm.  Both\n of these variables should be comma-separated lists indicating\n multiple hosts and associated home directories.  You can\n either specify only one value for \$ARCHIVE_HOME, which will\n be used for all hosts specified by \$ARCHIVE_HOST, or you\n can specify an equal number of \$ARCHIVE_HOME directories\n
and \$ARCHIVE_HOST systems\n"},
    BAD_PROBE => {
      VAL => 112,
      MSG => "ERROR encountered in %s: Bad or inconsistent format\n for ARCHIVE_PROBE and/or ARCHIVE_HOST.  These variables are\n either set by the environment variables \$ARCHIVE_HOST and\n \$ARCHIVE_PROBE or by the archive_env routine in local.pm.\n Both of these variables should be comma-separated lists\n indicating multiple hosts and associated \$ARCHIVE_PROBE\n flags.  Either only one value for \$ARCHIVE_PROBE should be\n specified, which will be used for all hosts specified by\n \$ARCHIVE_HOST, or you can specify an equal number of\n \$ARCHIVE_PROBE flags and \$ARCHIVE_HOST systems.\n"},
    HOST_DOWN => {
      VAL => 113,
      MSG => "ERROR encountered in %s:\n   Archival Storage Facility \"%s\" unavailable:\n   %s\n"},
    SIZE_MISMATCH => {
      VAL => 114,
      MSG => "ERROR encountered in %s:\n   Remote/local file sizes do not match for %s:\n   remote size = %s, local size = %s.\n"},

  );
}




sub define_valid_commands_and_options
{

=pod

NAME
  define_valid_commands_and_options:
    Define valid archive command names, the minimum number of arguments,
    and their options.


USAGE
  %valid = define_valid_commands_and_options();


ARGUMENTS
  none


RETURN VALUE
  %valid = Hash table whose KEYs are valid command names and whose
           VALUEs are a string of valid associated options.

           Valid command names include these:
             put, get, mv, rm, ls, stat, mkdir, rmdir, chmod, chgrp,
             chown.

           The format of a VALUE is "N:o1:o2:o3:...oM:" where N is
           the number of required arguments and o1, o2, ...  are names
           of valid user-specified options.


NOTES
  For documentation of the meaning of each command-line option, see
  the "archive" man page.  Note: the trailing colon ":" at the end of
  the value string is required.  %valid is used by the parse_input()
  subroutine to make sure the user has specified valid options and
  arguments.


AUTHOR
  Written 2001 by Joe Werne and Michael J. Gourlay

=cut

  # Declare local scope for variable
  my (%valid);

  # Assign valid command names and options.
  $valid{put}   = "1:retry:asf:C:D:s:f:i:p:M:n:t:S:z:";
  $valid{get}   = "1:retry:asf:C:s:f:i:p:M:n:S:z:x:";
  $valid{mv}    = "2:retry:asf:C:s:f:i:M:n:";
  $valid{rm}    = "1:retry:asf:C:s:f:i:R:r:n:";
  $valid{ls}    = "0:retry:asf:";
  $valid{stat}  = "0:retry:asf:s:";
  $valid{mkdir} = "1:retry:asf:C:s:p:m:n:";
  $valid{rmdir} = "1:retry:asf:C:s:p:n:";
  $valid{chmod} = "2:retry:asf:C:s:R:n:";
  $valid{chgrp} = "2:retry:asf:C:s:f:h:R:r:n:";
  $valid{chown} = "2:retry:asf:C:s:f:h:R:r:n:";

  # Return
  #
  # [This comment is entirely redundant with the code,
  #  so either explain it in English or omit the comment.  --MJG]
  return %valid
}




sub set_default_opts
{

=pod

NAME
  set_default_opts: set default values of options for archive.


EXAMPLE
  %opts = set_default_opts(\%errs);


INPUT
  %errs = error-message list; see define_error_table()


OUTPUT
  %opts = a nested hash table whose KEY's are names that describe
      options and some variables used by the "worker" subroutines.  (For
      a description of "worker" routines, see the comments at the top of
      archive.pm, which is this file.)  Most of the KEY's of %opts point
      directly to VALUE's, but one (named HOST) points to a nested hash
      table with information about all the archival storage facility
      (asf) hosts at a site.

      Below we list and describe all the KEY's for %opts and all the
      valid VALUE's each KEY can take.  See man page for "archive" (also
      included as comment statements in bin/archive) for a detailed
      description of all command-line options.

      KEYS:

      DEFAULT_HOST -- related to the ARCHIVE_HOST variable set in
          archive_env().  See comment statments in
          archive_env() for a complete discussion of
          ARCHIVE_HOST.  VALUE for DEFAULT_HOST is the first host name
          identified by ARCHIVE_HOST.  The -asf and -C command-line
          options may override the default setting.  See archive man
          page (also in comments in bin/archive) for a complete
          discussion of the -asf option.  If the user specifies a host
          name with the -C option, then DEFAULT_HOST will be
          overwritten.  See discussion for <path> above.  Precedence
          for specifying is -C, then -asf, then ARCHIVE_HOST from
          archive_env().

      HOST -- nested hash table with information about all the archival
          storage facility (asf) hosts at a site.  %{$opts{HOST}} has
          the following structure:

          HOST =  (
                    $host1 => {
                                PROBE => $probe1,
                                HOME  => $home1,
                                USER  => $user1
                              },
                    $host2 => {
                                PROBE => $probe2,
                                HOME  => $home2,
                                USER  => $user2
                              },
                       ...
                  );

          where $host1, $host2, ... are the names of the asf hosts at
          the local site; $home1 is the name of the user's home
          directory on $host1; $probe1 is a flag (either "yes" or "no")
          that indicates "archive" will or will not check the status and
          type of files on the archival storage facility before and
          after a transfer (this feature is not yet implemented); and
          $user1 is the user name for the files to access on $host1.
          (Nothing is currently done with $user1, $user2, ....
          Originally I thought we could use this information to obtain
          the home directory for the user, in case we wanted to access
          his/her files, and we didn't know the user's home directory.
          If we know the user's home directory already, then we don't
          need the user's name.  Also, we may not be able to get the
          user's home directory at some sites simply from the user's
          name.  So, I suspect we may want to drop reference to the
          user's name altogether, but for now it is a variable that is
          stored.)

      command -- VALUE is "" (default) or the user-specified archive
          command.  See man page for archive (also in /bin/archive
          comment statements).

      count -- VALUE is the current iteration counter for attempting to
          execute "archive".  The default value for count is 0 for no
          attempts yet made.  The maximum value for counter is N from
          the "-retry N" command-line option.  See <retry> above.

      dd -- related to the -- command-line option.  VALUE is 0
          (default) or 1 (-- specified).

      delete -- related to -D command-line option.  VALUE is 0 (default)
          or 1 (-D specified).  0: Retain local copy of archived data.
          1: Delete local copy of archived data.
          This is probably a bad name, since there is a perl function
          called delete.

      dev -- related to the undocumented -dev command-line option.
          VALUE is 0 (default) or 1 (-dev specified).  If $opts{dev} is
          non-zero, then additional messages (comments, warnings, etc)
          are printed by archive.  Developers should make use of
          $opts{dev} if they think additional information written to
          STDERR might be useful to other developers.

      extract -- related to the -x command-line option.  VALUE is 0
          (default) or 1 (-x specified).

      fatal -- VALUE is the number of fatal errors encountered by
          archive.  Subroutines should increment $opts{fatal} each time
          they encounter a fatal error.  /bin/archive uses
          $errs{FATAL_ERRS} to print an error message with the number
          of fatal errors encountered before exiting with non-zero exit
          status.  VALUE is 0 by default.

      force -- related to -f command-line option.  VALUE is 0 (default)
          or 1 (-f specified).  0: If permissions for files or
          directories on the archival storage facility are incompatible
          with the requested operation, print error message to STDERR
          and exit with non-zero exit status. 1: Override permissions
          on destination files or directories and complete requested
          operation.  This option causes archive to disregard the
          "interactive" option.

      gzip -- related to the -z command-line option.  VALUE is 0
          (default) or 1 (-z specified).  0: Copy files identified by
          @args to archival storage.  1: Use gzip utility to compress
          files before copying to archival storage.

      interactive -- related to -i command-line option.  VALUE is 0
          (default) or 1 (-i specified).  0: If permission settings
          allow or force=1, overwrite or remove existing
          files/directories.  1: Require interactive confirmation before
          overwriting or removing an existing file or directory.

      local -- VALUE is the name of the local host, i.e., name returned
          by Perl's hostname().

      lsopts -- valid VALUE's are all options for the local "/bin/ls"
          command.  Note: "archive ls" takes the options -retry N, -asf,
          and any other options available for the local "/bin/ls"
          command.  lsopts will contain the options the user specified
          for "archive ls" aside from the -retry N and -asf options.
          Default VALUE is "".

      lsuser -- This option exists to help parse_input() collect the
          user-specified command-line options which "archive ls" will
          pass to the local "/bin/ls" command.  Note, "-retry N" and
          "-asf" are not passed to "/bin/ls" by "archive ls".  See the
          description for <lsopts> above.  If the user provides input
          for <lsopts>, then the default command-line options are
          overwritten.  If the user specifies more than one command-line
          option (not counting -retry or -asf) with dashes "-", then the
          leading dashes must be stripped while collecting these options
          into a single string and stored in $opts{lsopts}.
          parse_input() uses $opts{lsuser} to keep track of whether it
          should overwrite the default option or concatenate multiple
          user-specified options.  The VALUE for lsuser is 0 (default)
          or 1 (user-specified <lsopts>).

      migrate -- related to -M command-line option.  VALUE is 0
          (default) or 1 (-M specified).  0: Do not initiate migration
          of archived data to offline media.  1: Attempt to immediately
          migrate archived data to offline media (if allowed for asf).

      mode -- VALUE is related to the argument of the "-mode <mode>"
          command-line option.  Here "mode" is <mode> modified by the
          value of umask, i.e., "mode"=<mode>-(<mode> & umask).  The
          default value for <mode> is 777 in this routine, but this
          value is overwritten in parse_input() if the user specifies
          the "-mode <mode>" command-line option.   Our intention is
          to accept symbolic modes (see man page for archive), but
          currently only numeric modes are implemented.

     *nowait -- related to the -n command-line option.  VALUE is 0
          (default) or 1 (-n specified).  0: Wait for completion before
          returning.  1: Perform in background mode and return 0 exit
          status.  If interactive=1, nowait=1 is ignored.

      parent -- related to the -p command-line option.  VALUE is 0
          (default) or 1 (-p specified).  0: If the parent directory of
          a target path name does not exist, print error message to
          STDERR and exit with non-zero exit status.  1: Create non-
          existent parent directories.

      path -- VALUE is the argument of the "-C path" command-line
          option.  The default VALUE is set by this routine to be "./".
          If the user specifies "-C path", then the default value is
          overwritten using the user-specified path.  The user-specified
          path has the general form <user>@<host>:<file>, where <user>@
          or <user>@<host>: are optional.  If the user chooses to
          include optional information in the path, then $opts{path}
          will contain the optional information temporarily (while in
          parse_path()), only until the optional information is parsed
          and stored in other variables, i.e., $opts{DEFAULT_HOST} and
          $opts{HOST}.  See DEFAULT_HOST and HOST below.  "path" is the
          destination directory on the asf.  If parent=1, "path" should
          be create (if it does not already exist) when putting data on
          the asf.  If path cannot be created or is not a directory,
          then "archive put" should print an error message to STDERR and
          return a non-zero exit status.

      recursive -- related to -r and -R command-line options.  VALUE is
          0 (default) or 1 (-r or -R specified).

      retry -- related to the "-retry N" command-line option.  VALUE is
          1000 (default) or N (if "-retry N" is specified).

      save -- related to the -S command-line option.  VALUE is 0
          (default) or 1 (-S specified).

      silent -- related to the -s command-line option.  VALUE is 0
          (default) or 1 (-s specified).  0: Print output to STDOUT
          and/or STDERR.  1: Do not print output to STDOUT/STDERR.

      symlink -- related to -h command-line option.  VALUE is 0
          (default) or 1 (-h specified).

      tar -- related to the "-t tarfile" command-line option.  VALUE is
          "" (default) or "tarfile" ("-t tarfile" specified).

      target -- VALUE is the target for "archive mv".  See man page for
          archive (also in /bin/archive comment statements).

VARIABLES
  HASHES
    %e -- returned by call to archive_env().
  ARRAYS
    @host -- archival storage facility hostnames identified by
        $e{ARCHIVE_HOST} returned from archive().  See NOTES
        for details.  See also OUTPUT section, specifically HOST under
        %opts.
    @home -- user root directories on the archival storage facility
        hosts.  See NOTES for details.  See also OUTPUT section,
        specifically HOST under %opts.
    @probe -- "probe" flags for the archival storage facility hosts.
        See NOTES for details.  See also OUTPUT section, specifically
        HOST under %opts.
  SCALARS
    $USER -- environment variable of same name.
    $mask -- value returned by call to unix `umask` function.
    $mode -- see discussion of "mode" under %opts in OUTPUT section.
    $home -- temporary variable set to each element of @home
    $host -- temporary variable set to each element of @host
    $i -- temporary counter variable set to each index of @host
    $probe -- temporary variable set to each element of @probe


SUBROUTINES
  assign_for_host()


NOTES
  To set up the hash table %{$opts{HOST}}, one must first call
  archive_env() to learn the list of archival storage facility
  hosts at the current site (contained in $e{ARCHIVE_HOST}) as well as
  the site-specific values for PROBE and HOME for each host.  Because
  these values can be specified in archive_env() in one of two ways (as a
  comma-separated list or as a single value relevant to all hosts -- see
  archive_env() for details), we check the values returned by
  archive_env() to make sure the implementation in archive_env() is self-
  consistent.  We do this by storing information in $e{ARCHIVE_HOST}
  $e{ARCHIVE_HOME} and $e{ARCHIVE_PROBE} in the temporary arrays @home,
  @host, and @probe, and then calling the routine assign_for_host() to
  make sure the elements in the temporary arrays are compatible.  We
  also check for correctness while we are at it.  See assign_for_host()
  for details.  Modified copies of @host, @home, and @probe are
  returned from assign_for_host(), each now containing the same number
  of elements, and these arrays are used to define the %{$opts{HOST}}
  hash table.  See OUTPUT section, specifically HOST under %opts for
  more information on the %{$opts{HOST}} hash table.

  [I believe this section should be renamed DESCRIPTION.
   NOTES section is meant to list bugs or implementation details that
   the client ideally should be able to ignore, but can not for some
   unfortunate reason.  A nickname for NOTES is BUGS.
   --MJG]

AUTHOR
  Written 5-2001 by Joe Werne


HISTORY
  6-9-2001: Joe Werne
    1. add -x, change -m to -M and -mode to -m, change default behavior
       of -t option

  7-10-2001: Joe Werne
    1. expand header comments.

=cut

  #----------------- Link to local.pm
  use lib PSTDIR;
  use TUSC::local;
  use Sys::Hostname;

  # Scope
  my (%opts,%e,$mode,$mask,@host,$host,@home,$home,@probe,$probe,%errs);
  my ($fatal,$e,$USER,$i);
  my ($errs)=@_; %errs=%$errs;
  my ($decmode);  #decimal representation of mode.

  $USER = $ENV{'USER'};              #------------------------ get $USER

  #define default mode
  $decmode = ~umask() & 0777;
  #convert to octal
  $mode = sprintf "%lo", $decmode;

  %e = archive_env(1);                 #---- Read variables from archive_env
  @home=split ",",$e{ARCHIVE_HOME};
  @host=split ",",$e{ARCHIVE_HOST};
  @probe=split ",",$e{ARCHIVE_PROBE};
                                     #-------- Reassign @home and @probe
  ($e,$home,$probe) = assign_for_host(\@home,\@probe,\@host,\%errs);
  @home=@$home; @probe=$probe; $fatal=$fatal+$e;
                                     #--------------- Set up {HOST} hash
  #
  # Each $host key has {HOME}, {PROBE}, and {USER} entries that indicate
  # the associated ARCHIVE_HOME, ARCHIVE_PROBE flag, and the default USER
  # for this element of ARCHIVE_HOST.  ARCHIVE_HOST, ARCHIVE_HOME, and
  # ARCHIVE_PROBE are obtained from the archive_env routine in local.pm.
  #
  $i=0;
  foreach (@host)
  {
    $host  = $host[$i];
    $home  = $home[$i];
    $home  =~ s/([^\/])$/$1\//;      #---- make sure $home ends with "/"
    $probe = $probe[$i];
    $opts{HOST}{$host}{PROBE}=$probe;
    $opts{HOST}{$host}{HOME}=$home;
    $opts{HOST}{$host}{USER}=$USER;
    $i++;
  }
  $opts{DEFAULT_HOST} = $host[0];    #-------------- Define default host

  $opts{lsopts}     = "";            #------------------------- <lsopts>
  $opts{path}       = "./";          #-------------------------- -C path
  $opts{recursive}  = 0;             #---------------------------- -R -r
  $opts{delete}     = 0;             #------------------------------- -D
  $opts{force}      = 0;             #------------------------------- -f
  $opts{symlink}    = 0;             #------------------------------- -h
  $opts{interactive}= 0;             #------------------------------- -i
  $opts{migrate}    = 0;             #------------------------------- -M
  $opts{mode}       = $mode;         #-------------------------- -m mode
  $opts{nowait}     = 0;             #------------------------------- -n
  $opts{parent}     = 0;             #------------------------------- -p
  $opts{retry}      = 1000;          #------------------------- -retry N
  $opts{silent}     = 0;             #------------------------------- -s
  $opts{tar}        = "";            #----------------------- -t tarfile
  $opts{extract}    = 0;             #------------------------------- -x
  $opts{gzip}       = 0;             #------------------------------- -z
  $opts{dd}         = 0;             #---------------------- double dash
  $opts{lsuser}     = 0;             #---------- user specified <lsopts>
  $opts{count}      = 0;             #------------------- -retry counter
  $opts{fatal}      = $fatal;        #--------------------- fatal errors
  $opts{command}    = "";            #-------------------------- command
  $opts{target}     = "";            #-------------------- target for mv
  $opts{dev}        = 0;             #----------------------------- -dev
  $opts{local}      = hostname();    #---------------------------- local

  return %opts;                      #-------------- Return default opts




  #----------------------------------------------------- ASSIGN_FOR_HOST
  sub assign_for_host
  {

=pod

  NAME
    assign_for_host:
      Check the syntax and compatibility of @home with @host.  Make sure
      elements of @home either begin with a "/" or are equal to "".


  EXAMPLE
    ($fatal,\@home,\@probe) = assign_for_host(\@home,\@probe,\@host,\%errs);


  INPUT
    @home  = list of home directories associated with @host; see
        set_default_opts().
    @probe = list of flags associated with each element of @host; see
        set_default_opts().
    @host  = list of hosts; see set_default_opts().
    %errs  = error-message list; see define_error_table()


  OUTPUT
    @home  = updated list of @home directories; see set_default_opts().
    @probe = updated list of @probe flags ("yes" or "no"); see
        set_default_opts().
    $fatal = number of fatal errors encountered.


  VARIABLES
    SCALARS
      $error -- internal error flag.
          0 = no error
          1 = problem with element of @home
          2 = problem with element of @probe
      $errs -- reference for input hash %errs
      $home -- reference for input array @home; also set to each element
          of @home in foreach loop.
      $host -- reference for input array @host
      $n -- $#home or $#probe
      $probe -- reference for input array @probe


  NOTES
    Make sure the number of elements present for @home and @probe
    are compatible with the number of elements in @host.  Correct
    possibilities are listed below, with $n substituted for either
    $#home or $#probe.

    1. $#host = $n;
    2. if $#host > $n, then $n=0.

    Once the number is verified, if (2) is the case, duplicate the
    number of entries in @home and/or @probe until you have an element
    of @home for every element of @host.

    This routine is called by set_default_opts().


  AUTHOR
    Written 6-2001 by Joe Werne


  HISTORY
    7-11-2001: Joe Werne
      1. scoped this routine inside set_default_opts(), since that is
         the only routine that calls this one.  expanded documentation.

=cut

    # Scope local variables
    my (@home,@probe,@host,%errs,$error,$n,$fatal);

    # Unpack subroutine parameters from Perl argument array.
    my ($home,$probe,$host,$errs)=@_;

    # Dereference user input
    @home=@$home;
    @probe=@$probe;
    @host=@$host;
    %errs=%$errs;

    # Check to make sure home is of correct form.
    # -------------------------------------------
    # If home does not begin with a "/" and is not "", then home has
    # incorrect form, and we print an error message to STDOUT.

    $error=0;
    $fatal=0;

    foreach $home (@home)
    {
      # $home must begin with "/" (i.e. contain an absolute path)
      # or be empty.
      if ($home !~ /^\// && $home ne "")
      {
        $error=1;
      }
    }

    # Check to make sure home-probe and host are compatible
    if ($error==0)
    {
      $n=$#home;

      # if no hosts are specified or more homes than hosts,
      if ($#host < 0 || $n > $#host)
      {
        # Set error condition to later trigger error report.
        $error=1;
      }
      elsif ($n != $#host)
      {
        # if different number of homes and hosts ...

        # ... and number of homes is not 1...
        if ($n != 0)
        {
          # Set error condition to later trigger error report.
          $error=1;
        }
        else
        {
          # ... or if number of homes is 1, then
          # set as many elments for home as there are for host.
          @home = ($home[0]) x ($#host+1);
        }
      }
    }

    # Check to make sure probe and host are compatible
    $n=$#probe;

    if ($#host < 0 || $n > $#host)
    {
      # if no hosts are specified or more homes than hosts,
      # set error condition.
      $error=2;
    }
    elsif ($n != $#host)
    {
      # different number of homes and hosts ...

      #   ... and number of homes is not 1, then error
      if ($n != 0)
      {
        $error=2;
      }
      else
      {
        # ... or if number of homes is 1, then
        # set as many elments for home as there are for host.
        @probe = ($probe[0]) x ($#host+1);
      }
    }

    # Print error message
    if ($error==1)
    {
      $fatal++;
      warn sprintf $errs{BAD_HOME}{MSG}, ("archive.pm:assign_for_host");
    }
    if ($error==2)
    {
      $fatal++;
      warn sprintf $errs{BAD_PROBE}{MSG}, ("archive.pm:assign_for_host");
    }

    # Return
    #
    # [This comment is entirely redundant with the code,
    #  so either explain it in English or omit the comment.  --MJG]
    return ($fatal,\@home,\@probe);
  }
}





sub find_separator
{

=pod

NAME
  find_separator:
    Define a string $sep that can serve as a list separator that does not
    conflict with input list @a.


EXAMPLE
  $sep -- find_separator(@a);

  [This example is syntactically invalid.  The decrement operator,
   "--", was probably meant to be "=", the assignment operator.
   Also, this section should probably be renamed USAGE.
   --MJG]


INPUT
  @a -- list of string variables

  [This section should probably be renamed ARGUMENTS.  --MJG]


OUTPUT
  $sep -- acceptable list separator

  [This section should probably be renamed RETURN VALUES since $sep is
   not an argument. --MJG]


VARIABLES
  [These are implementation details, and should not be part of the
   contract.  They belong inside the routine definition, at the first
   occurence of each variable, e.g., before each "my" declaration.  --MJG]

  SCALARS
    $sep1 -- previous attempt for separator $sep
    $ok -- flag when set to "OK" indicates an acceptable separator has
        been found
    $tmp -- temporary array used to test the $sep separator.  If $tmp
        matches $sep, then $sep must be modified.
    $n -- 65 plus a random number from 0 to 25.  $n is the index for
        an ascii character of the alphabet.


NOTES
  find_separator() was written to define a list separator that did not
  conflict with a given list.  It looks like we have removed the part of
  the code that previously used find_separator(), so it appears not to
  be needed in the current version of archive.


AUTHOR
  Written 6-2001 by Joe Werne


HISTORY
  7-11-2001: Joe Werne
    1. expanded header comments

=cut

  # Scope variables
  #
  # [What does each of these variables mean, in English?
  #  See my comments in header, above. --MJG]

  my ($sep);
  my ($sep1);
  my ($ok);
  my (@a);
  my ($tmp);
  my ($n);

  # Read @a
  #
  # [See my comments near the second occurence of "Read @a", below. --MJG]
  @a=@_;

  # Initialize $sep,$sep1,$ok

  $sep=":";
  $sep1="";
  $ok="";

  # Read @a
  #
  # [ What does this mean, in English?
  #   This comment is identical to the one above.
  #   Surely these blocks of code do different things.
  #   --MJG]
  until ($ok eq "OK")
  {
    $tmp = join "$sep1",@a;
    if ($tmp =~ /$sep/)
    {
      $n=int(rand(26))+65;
      $sep1=$sep;
      $sep=$sep.chr($n);
    }
    else { $ok = "OK" }
  }

  # Return $sep
  #
  # [Which means what, in English?
  #  This comment is entirely redundant with the code,
  #  so either explain it in English or omit the comment.
  #  What are the possible values?  What does each imply?
  #  Document them in a RETURN VALUES section in header comment, above.
  #  --MJG]
  return $sep;

}





sub parse_input
{

=pod

NAME
  parse_input:
    Parse user input to obtain the archive command, options, and arguments.
    User input is checked for correctness.

  [By "user input", did you mean "command-line arguments"?
   In this module, the phrase "user input" seems to refer to multiple
   things, including "routine arguments" and "command-line arguments",
   but it does not seem to ever refer to an input file stream provided
   by the user.
   --MJG]


USAGE
  (\%opts,\@args) = parse_input(\@v,\%opts,\%errs,\%valid);


INPUT
  [Perhaps this section refers to the ARGUMENTS.  --MJG]

  @v     = all arguments and command-line options passed by the user
  %opts  = default command-line options; see set_default_opts()
  %errs  = error-message list; see define_error_table()
  %valid = valid command names and their options; see
           define_valid_commands_and_options()

OUTPUT
  [Perhaps this section refers to the RETURN VALUES. --MJG]

  %opts  = modified options consistent with user data
  @args  = archive command arguments; these arguments do not include
           any command-line options or the command name.

VARIABLES
  [Most/all of these are implementation details that need not concern
   the client (i.e. the routine that calls this routine), so these
   comments belong inside the routine definition (below), not in
   the contract (i.e. client usage) documentation (i.e. this header
   documentation).  -MJG]

  ARRAYS
    @tmp -- temporary array
    @arg2 -- temporary array used when separating @args on non-escaped
        white space
    @b -- temporary array used when separating @args on non-escaped
        white space

  SCALARS
    $v -- reference for input array @v
    $opts -- reference for input hash %opts
    $errs -- reference for input hash %errs
    $valid -- reference for input hash %valid; temporary string used to
        check the validity of the user-specified archive command
        ($command); output from is_option_valid(), which is 0 if option
        is valid.
    $command -- archive command specified by user
    $tmp -- temporary string
    $e -- output from check_host(), which is equal to the number of
        bad hosts specified by the user with the -asf option.
    $last -- index for last argument passed by user
    $i -- index of all the arguments and options specified by user


SUBROUTINES
  check_host()
  check_mode()
  check_number_of_args()
  is_option_valid()
  parse_path()
  separate_string()
  set_only_one_host()


NOTES


AUTHOR
  Written 2001 by Joe Werne


HISTORY
  6-9-2001: Joe Werne
    1. change -m to -M, so we can make -mode = -m
    2. change -mode to -m, to satisfy mkdir convention
    3. add -dev to turn on development messages (undocumented feature)
    4. correct bug in error message for invalid option; also, increment
       $opst{fatal} if bad option is encountered.
    5. add -x for extract tar files with "get"; only allow -t for "put"

  7-11-2001: Joe Werne
    1. expanded header comments; scope the following routines inside
       this routine: check_host(), parse_path(), check_mode(),
       separate_string(), set_only_one_host(), is_option_valid(),
       check_number_of_args().
=cut

  # Define code
  # [By "Define code" do you mean something like "link to external
  #  routines, as defined in local.pm"? --MJG]

  use lib PSTDIR;
  use TUSC::local;

  # Scope local variables
  #
  # [Move documentation from header comment to here. --MJG]
  my ($command);
  my ($e);
  my ($i);
  my ($last);
  my ($tmp);
  my (%errs);
  my (%opts);
  my (%valid);
  my (@arg2);
  my (@args);
  my (@b);
  my (@tmp);
  my (@v);

  # Read user input
  # Read user input from @_ array.
  #
  # [I suspect this comment really means "Unpack subroutine arguments."  --MJG]
  #
  my ($v,$opts,$errs,$valid)=@_;

  # Dereference user input
  #
  # [See my comments elsewhere regarding this practice.  --MJG]
  @v=@$v;
  %opts=%$opts;
  %errs=%$errs;
  %valid=%$valid;

  # Check for zero [a lack of command line (? --MJG)] arguments.
  # If no variables are passed, then the user has forgotten to specify
  # archive's command argument.  In this case increment fatal and exit.
  if ($#v == -1)
  {
    warn sprintf $errs{MISSING_ARGS}{MSG},
        ("archive.pm:parse_input", "archive",1,"",0);
    $opts{fatal}++;
    return (\%opts,\@args);
  }
  else
  {
    # Deduce command and check for validity
    $command = shift @v;
    $command =~ s/\s//g;
    $opts{command}=$command;
    $valid = join ":", keys %valid;
    $valid = ":".$valid.":";
    if ($valid !~ /:$command:/)
    {
      $tmp = join ", ", keys %valid;
      $tmp =~ s/(.*, )/$1or /;
      warn sprintf $errs{BAD_CHOICE}{MSG},
       ("archive.pm:parse_input",$command,"command","archive",$tmp);
      $opts{fatal}++;
      return (\%opts,\@args);
    }
  }

  # Separate options and arguments.
  # Step through all of the variables passed by the user.
  for ($i = 0; $i <= $#v; $i++)
  {

    # options.  [??? --MJG]
    #   Check to see if the variable begins with a dash "-".
    if ($v[$i]=~/^-/ && $opts{dd}==0 )
    {

      #------------------------------------------------------ last option (--)
      #     If the variable begins with a dash, check to see if the variable
      #     is "--", in which case the rest of the variables passed are
      #     intended by the user to be command arguments.
      if ($v[$i] eq "--")
      { $opts{dd}=1 }

      #------------------------------------------------------------- -asf host
      #     Is "-asf host" a valid option for $command?  If so, verify host
      #     using check_host().
      #     Increment $i.
      elsif ($v[$i] eq "-asf")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        $i++;
        if ($valid !=0)
        {
          $opts{fatal}++
        }
        else
        {
          @tmp=split ",",$v[$i];
          $e=check_host(\%opts,\@tmp,\%errs);
          $opts{fatal}=$opts{fatal}+$e;
          if ($e == 0)
          {
            $opts{DEFAULT_HOST}=$tmp[0];
          }
        }
      }

      #-------------------------------------------------------------- -retry N
      #     Is "-retry N" a valid option for $command?  If so, store next
      #     variable in $opts{retry} and strip whitespace and verify N is a
      #     number.
      elsif ($v[$i] eq "-retry")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        $i++;
        if ($valid !=0)
        { $opts{fatal}++ }
        else {
          $opts{retry}=$v[$i]; $opts{retry}=~s/\s//g;
          if ($opts{retry} !~ /^[0-9]+$/)
          {
            warn sprintf $errs{BAD_CHOICE}{MSG},
              ("archive.pm:parse_input",$opts{retry},"number N",
               "-retry N","a number");
            $opts{fatal}++;
          }
        }
      }

      #-------------------------------------------------------------- <lsopts>
      #     If $command is "ls", then options are collapsed (i.e., dashes are
      #     removed) and stored in $opts{lsopts}.  On the first pass through
      #     this loop, $opts{lsuser}=0, so the else block is executed.  The
      #     else block sets $opts{lsuser}=1 and replaces $opts{lsopts} with
      #     user input.  If $opts{lsuser}=1, then the option is appended to
      #     $opts{lsopts}.
      elsif ($command eq "ls")
      {
        $v[$i] =~ s/^-//;
        if ($opts{lsuser})
        { $opts{lsopts}=$opts{lsopts}.$v[$i]; }
        else { $opts{lsuser}=1; $opts{lsopts}=$v[$i] }
      }

      #--------------------------------------------------------------- -C path
      #     Is "-C path" a valid option for $command?  If so, store next
      #     variable in $opts{path}.  Just before exiting parse_input, we call
      #     a routine called parse_path(), which parses the path and may
      #     affect information in $opts{HOST}.  Since we want "-C path" with
      #     host information to take precedence over "-asf host", we postpone
      #     calling parse_path until we've parsed all the options.
      #     parse_path() returns an error code if $opts{path} is erroneous.
      elsif ($v[$i] eq "-C")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        $i++;
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{path}=$v[$i]; }
      }

      #------------------------------------------------------------ -t tarfile
      #     Is "-t tarfile" a valid option for $command?  If so, store the
      #     next variable in $opts{tar}.
      elsif ($v[$i] eq "-t")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        $i++;
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{tar}=$v[$i]; }
      }

      #-------------------------------------------------------------------- -x
      #     Is "-x" a valid option for $command?  If so, $opts{extract}=1.
      elsif ($v[$i] eq "-x")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{extract}=1 }
      }

      #-------------------------------------------------------------------- -S
      #     Is "-S" a valid option for $command?  If so, $opts{save}=1.
      elsif ($v[$i] eq "-S")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{save}=1 }
      }

      #--------------------------------------------------------------- -m mode
      #     Is "-m mode" a valid option for $command?  If so, store next
      #     variable in $opts{mode} and call check_mode() to verify format of
      #     the "mode" variable.  Increment $i.
      elsif ($v[$i] eq "-m")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        $i++;
        if ($valid !=0)
        { $opts{fatal}++ }
        else { $opts{mode}=$v[$i]; %opts=check_mode(\%opts,\%errs); }
      }

      #-------------------------------------------------------------------- -R
      #     Is "-R" a valid option for $command?  If so, $opts{recursive}=1.
      elsif ($v[$i] eq "-R")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{recursive}=1 }
      }

      #-------------------------------------------------------------------- -D
      #     Is "-d" a valid option for $command?  If so, $opts{delete}=1.
      elsif ($v[$i] eq "-D")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{delete}=1 }
      }

      #-------------------------------------------------------------------- -f
      #     Is "-f" a valid option for $command?  If so, $opts{force}=1.
      elsif ($v[$i] eq "-f")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{force}=1 }
      }

      #-------------------------------------------------------------------- -h
      #     Is "-h" a valid option for $command?  If so, $opts{symlink}=1.
      elsif ($v[$i] eq "-h")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else {$opts{symlink}=1 }
      }

      #-------------------------------------------------------------------- -i
      #     Is "-i" a valid option for $command?  If so, $opts{interactive}=1.
      elsif ($v[$i] eq "-i")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{interactive}=1 }
      }

      #-------------------------------------------------------------------- -M
      #     Is "-M" a valid option for $command?  If so, $opts{migrate}=1.
      elsif ($v[$i] eq "-M")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{migrate}=1 }
      }

      #-------------------------------------------------------------------- -n
      #     Is "-n" a valid option for $command?  If so, and
      #     $opts{interactive} is not equal to 1, $opts{nowait}=1.
      elsif ($v[$i] eq "-n")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ }
        elsif ($opts{interactive} !=1)
        { $opts{nowait}=1 }
      }

      #-------------------------------------------------------------------- -p
      #     Is "-p" a valid option for $command?  If so, $opts{parent}=1.
      elsif ($v[$i] eq "-p")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{parent}=1 }
      }

      #-------------------------------------------------------------------- -r
      #     If "-r" is encountered, it might be the <mode> argument to chmod.
      #     Therefore, check first to see if $command eq "chmod".  If so, then
      #     assume <mode>="-r" (for now).  Otherwise, verify that "-r" is a
      #     valid option for $command.  If so, $opts{recursive}=1.
      elsif ($v[$i] eq "-r")
      {
        if ($command eq "chmod")
        { push @args,$v[$i] }
        else {
          $valid = is_option_valid($v[$i],$valid{$command},$command);
          if ($valid !=0)
          { $opts{fatal}++ } else {$opts{recursive}=1}
        }
      }

      #-------------------------------------------------------------------- -s
      #     Is "-s" a valid option for $command?  If so, $opts{silent}=1.
      elsif ($v[$i] eq "-s")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{silent}=1 }
      }

      #-------------------------------------------------------------------- -z
      #     Is "-z" a valid option for $command?  If so, $opts{gzip}=1.
      elsif ($v[$i] eq "-z")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{gzip}=1 }
      }

      #------------------------------------------------------------------ -dev
      #     Is "-dev" a valid option for $command?  If so, $opts{dev}=1.
      elsif ($v[$i] eq "-dev")
      {
        $valid = is_option_valid($v[$i],$valid{$command},$command);
        if ($valid !=0)
        { $opts{fatal}++ } else { $opts{dev}=1 }
      }

      #--------------------------------------------------------- Chmod <mode>?
      #     After comparing with all valid options, see if chmod is the
      #     archive command.  If so, this might be chmod's <mode>, so put
      #     $v[$i] in @args for now.
      elsif ($command eq "chmod")
      {
        push @args,$v[$i]
      }

      #-------------------------------------------------------- Invalid option
      #     It appears we have an invalid option.
      #     Store $valid{$command} in $tmp, then reformat so leading number
      #     and colon ":" and trailing colon are removed, then remaining
      #     colons are replaced with ", ", except for the last, which is
      #     replaced with ", or ".  Report error.
      else
      {
        $opts{fatal}++;
        $tmp=$valid{$command};
        #       remove trailing ":"; split on ":"; remove first element; sort
        $tmp=~s/:$//; @tmp=split /:/,$tmp; shift @tmp; @tmp=sort @tmp;
        #       join back into a string, separated by ", "; substitute "or "
        $tmp=join ", ",@tmp; $tmp=~s/(.*, )/$1or /;
        warn sprintf $errs{BAD_CHOICE}{MSG},("archive.pm:parse_input",
          $v[$i],"option","archive $command",$tmp);
      }
    }

    #---------------------------- Collect archive command arguments in @args
    #   Store the rest of the arguments passed by the user in @args.
    else
    {
      push @args,$v[$i]
    }
  }

  #--------------------------------- Check the number of elements in @args
  # Verify user has specified the right number of arguments for $command.
  $valid =
    check_number_of_args(\@args,$valid{$command},$command,\%errs);
  if ($valid != 0)
  {
    $opts{fatal}++
  }

  #--------------------------------- Check correctness of <mode> for chmod
  # If $command eq "chmod", set $opts{mode}=$args[0], remove first element
  # of @args, and verify format for <mode>.
  else
  {
    if ($command eq "chmod")
    {
      $opts{mode}=shift @args; %opts=check_mode(\%opts,\%errs);
    }

    #--------------------------------------- Adjust $opts{tar}, if required.
    #   if ($opts{tar} ne "") then
    #       If $opts{gzip}==0, add ".tar" if not present
    #       If $opts{gzip}==1, add ".tgz" if not present
    #
    if ($opts{tar} ne "")
    {
      if ($opts{gzip}==0)
      {
        $opts{tar}=~s/\.tar$//;
        $opts{tar}="$opts{tar}.tar";
      }
      else
      {
        $opts{tar}=~s/\.tar$|\.tgz$|\.tar.gz$//;
        $opts{tar}="$opts{tar}.tgz";
      }
    }
  }

  #------------------------- Separate arguments on non-escaped white space
  # Because quotes may have been used in specifying arguments, multiple
  # arguments may be combined into individual elements of the @args list.
  # Here we separate all combined arguments on non-escaped white space.
  # If $command=mv, then consider all but the last argument in @args,
  # because the last argument is mv's <target>, and we want archive_mv to
  # handle <target>.
  if ($command eq "mv")
  {
    $last=$#args-1
  }
  else
  {
    $last=$#args
  }

  for ($i = 0; $i <= $last; $i++)
  {
    @b = separate_string($args[$i]);
    push @arg2,@b;
  }

  # If $command=mv, set $opts{target} to last argument received.
  if ($command eq "mv")
  {
    $opts{target}=$args[$#args];
  }
  else
  {
    $opts{target}="";
  }

  # reassign @args  [for what purpose --MJG]
  @args = @arg2;

  #
  # Define default @arg and prepend $opts{path} for ls
  #
  # w.r.t. ls, JW decided against this behavior below, as JW thinks ls should
  # operate relative to $home.  this way you can ls more than one system,
  # with the command accessing different $home directories if required.
  # ls (or calls to it) will have to detect (! @args).
  #
  # if ($command eq "ls") {
  #   unless (@args) { @args=($opts{path}) }
  #   else {
  #     $i=0; foreach (@args) {$args[$i]="$opts{path}/$args[$i]"; $i++}
  #   }
  # }
  #------------------------------------------------------------ Parse path
  %opts = parse_path(\%opts,\%errs);

  #
  #--------------------------- Insure only one host is specified for: put,
  #                            mv, rm, mkdir, rmdir, chmod, chgrp & chown.
  #
  $tmp=":put:mv:rm:mkdir:rmdir:chmod:chgrp:chown:";
  if ($tmp=~/:$opts{command}:/) {
    $tmp  = $opts{DEFAULT_HOST};
    %opts = set_only_one_host($tmp,\%opts);
  }

  # Return
  #
  # [This comment is entirely redundant with the code,
  #  so either explain it in English or omit the comment.  --MJG]
  return (\%opts,\@args);




  #---------------------------------------------------------- CHECK_HOST

  sub check_host
  {

=pod

  Check the @host list against valid options.

  EXAMPLE
    $error = check_host(\%opts,\@host,\%errs);

  INPUT
    %opts  = current command-line options; see set_default_opts()
    @host  = list of potential hosts
    %errs  = error-message list; see define_error_table()

  OUTPUT
    $error = exit status equal to number of bad hosts passed as input

  VARIABLES
    ARRAYS
      @host -- list or recognized hosts
    $SCALARS
      $errs -- reference for input hash %errs
      $fhost -- comma-separated list of hosts in @host; $fhost is used
          to generate a possible error message
      $host -- reference for input array @host
      $host_ok -- same as $fhost, but with a comma on the end
      $opts -- reference for input hash %opts

  NOTES
    This routine is called by parse_input().

  AUTHOR
    Written 5-2001 by Joe Werne

  HISTORY
    6-10-2001: Joe Werne
      1. do not call set_default_opts() in this routine

    7-11-2001: Joe Werne
      1. expanded header comments; scope inside parse_input()
=cut

  #---------------------------------------------------- link to local.pm
  use lib PSTDIR;
  use TUSC::local;
  #----------------------------------------------------- Scope variables
    my (%opts,%errs,@host,$fhost,$error,$host_ok);

  #------------------------------------------ Read and dereference %opts
    my ($opts,$host,$errs)=@_;
    %opts=%$opts; @host=@$host; %errs=%$errs;
    $error=0;

  #--------------------------------------------------- Get default hosts
    @host=keys %{$opts{HOST}};
    $fhost = join ", ",@host;
    $host_ok="$fhost,";

  #------------------------------------------- Check against known hosts
    foreach $host (@host) {
      if ($host_ok !~ /$host,/) {
        $error++;
        if ($opts{silent}==0) {
          warn sprintf $errs{UNKNOWN_HOST}{MSG},
            ("archive.pm:check_host",$host,$fhost);
        }
      }
    }
    return $error;
  }




  #---------------------------------------------------------- PARSE_PATH

  sub parse_path
  {

=pod

  Parse the archival storage path sent by the user.

  EXAMPLE
    %opts = parse_path(\%opts,\%errs);

  INPUT
    %opts = current command-line options; see set_default_opts()
    %errs = error-message list; see define_error_table()

  OUTPUT
    %opts = updated command-line options

  VARIABLES
    HASHES
      %host -- used with string $host to store definition of single HOST
          in $opts{HOST}: $opts{HOST}={%host};
      %opts2 --
    ARRAYS
      @host -- array used to pass $host as a single-element list to
          check_host()
      @tmp -- temporary work array
    SCALARS
      $data -- set to each KEY of %{$opts{HOST}} in foreach loop
      $error -- output returned by check_host(); see check_host()
      $errs -- reference for input hash %errs
      $home -- user root directory.  If the user specifies a path that
          includes a host name, then $home is set to the user root
          directory associated with the asf host selected by the user.
      $host -- host name possibly included in $opts{path}.  If the user
          has specified a path that includes a host name, this host name
          is used as the default and only asf host.
      $opts -- reference for input hash %opts
      $owner -- owner name possibly included in $opts{path}.  If the
          user has specified a path that includes an owner name, this
          owner name is used as the default and only owner name.
      $probe -- probe flag for $host.  If the user specifies a path that
          includes a host name, then $probe is set to the value of the
          probe flag associated with the asf host selected by the user.

  NOTES
    This routine is called by parse_input().

    If path contains host information, validate the host information
    provided by the user, then make the path-specified host the default
    host.  If path contains owner information in addition to host
    information, make the user-provided owner information the default
    owner.  If path specifies host but does not contain owner info, use
    the default owner associated with host.

    Currently archive does not use owner information, but we deal with it
    here for some future eventuality.

  AUTHOR
    Written 6-2001 by Joe Werne

  HISTORY
    6-10-2001: Joe Werne
      1. do not call set_default_opts() within this routine.

    7-11-2001: Joe Werne
      1. expanded header comments; scope inside parse_input().

=cut

  #----------------------------------------------- Scope local variables
    my (@tmp,%opts,$data,$host,$home,$owner,%opts2,@host);
    my (%errs,$error,$probe,%host);
  #------------------------------------------ Read and dereference %opts
    my ($opts,$errs)=@_;
    %opts=%$opts; %errs=%$errs;
  #-------------------------------------- Separate host from $opts{path}
  #  Split "path" at the first occurance of ":".  If ":" is found in path,
  #  then set $host to the left hand side, and set path to the right hand
  #  side, then split $host at the first occurance of "@".  If path
  #  contains host information, path takes precedence over "-asf host".
  #  Implementation of path's precedence over -asf host is accomplished
  #  by calling this routine in parse_input after all options have been
  #  parsed.
  #
  # add trailing "/" to $opts{path} if not already there.
    $opts{path}=~s/\/$//; $opts{path}="$opts{path}/";
    @tmp=split /:/,$opts{path},2; $data=$#tmp;
    if ($data == 1) {
  #--------------------------- Read $host, path; initialize $home,$owner
      $host=$tmp[0]; $opts{path}=$tmp[1];
      $owner="";
  #------------------------------------------ Separate $owner from $host
  #   if "@" is found in $host, set $owner to the left hand side, and set
  #   $host to the right hand side.
      @tmp=split /@/,$host,2;
      if ($#tmp == 1) { $owner=$tmp[0]; $host=$tmp[1]; }
  #--------------------------------------------- Check validity of $host
  #   note: check_host only makes use of $opts{silent} from %opts.
      @host=($host); $error=check_host(\%opts,\@host,\%errs);
      $opts{fatal} = $opts{fatal}+$error;
  #------------------------- Obtain appropriate $home variable for $host
      if ($error == 0) {
  #     if we are in this loop, then $home will be set, because
  #     $error=0 implies $host is valid.
        foreach $data (keys %{$opts{HOST}}) {
          if ($host eq $data) {
            $home =$opts{HOST}{$host}{HOME};
            $probe=$opts{HOST}{$host}{PROBE};
  #         if $owner is not set, then set it.
            if (! $owner) { $owner=${$opts{HOST}{$host}{USER}}; }
          }
        }
  #---------------------------------------------------- Now update %opts
        $host{$host}{HOME}  = $home;
        $host{$host}{PROBE} = $probe;
        $host{$host}{USER}  = $owner;
  #     by reassigning $opts{HOST}, we now have only one key: $host.
        $opts{HOST} = {%host};
        $opts{DEFAULT_HOST} = $host;
      }
    }
  #-------------------------------------------------------------- Return
    return %opts;
  }




  #---------------------------------------------------------- CHECK_MODE

  sub check_mode
  {

=pod

  Check the format of the user-supplied mode in the "-m mode" option.

  EXAMPLE
    %opts = check_mode(\%opts,\%errs);

  INPUT
    %opts -- current command-line options; see set_default_opts()
    %errs -- error-message list; see define_error_table()

  OUTPUT
    %opts -- updated command-line options

  VARIABLES
    ARRAYS
      @mode -- list containing split of symbolic $mode on commas
      @modenew -- list of possibly reformatted symbolic modes
      @tmp -- temporary work array
    SCALARS
      $data -- set to each element of @mode in foreach loop
      $errs -- reference for input hash %errs
      $lm -- length in bytes of $mode string
      $mode -- same as $opts{mode}; see set_default_opts()
      $operator -- operator specified in symbolic specification of the
          mode.  should be +, -, or =.
      $opts -- reference for input hash %opts
      $permissions -- permissions specified in symbolic specification of
          the mode.  should be r, w, or x.
      $who -- owner specified in symbolic specification of the mode.
          should be u, g, o, or a.

  NOTES
    This routine is called by parse_input().

    Only the beginnings of symbolic-mode specification is included.
    Symbolic modes are currently not implemented in archive.  A problem
    with implementing symbolic modes is they are relative to the current
    mode of an existing file.  Since Perl only handles absolute modes,
    we must write all the code to obtain the current mode of an existing
    file and compute the absolute mode given the user-supplied symbolic
    mode.  We've not yet written a method to obtain the current mode of
    a file; therefore, we cannot yet make use of symbolic modes.

    Nevertheless, ...

    Symbolic modes: This routine removes redundancy in symbolic modes
    (e.g., u+rrrwx ==> u+rwx) without warning the user.  Also if "who"
    contains "a", then "who" is replaced with "ugo".

    Absolute modes: This routine makes sure $mode starts with 0 and
    only contains digits in [0-7].

  AUTHOR
    Written 5-2001 by Joe Werne

  HISTORY
    7-11-2001: Joe Werne
      1. expanded header comments; scope inside parse_input()

=cut

  #----------------------------------------------- Scope local variables
    my (@tmp,%opts,$data,$opts,$lm,$mode,@mode,@modenew);
    my ($who,$operator,$permissions,$errs,%errs);

  #-------------- Read and dereference %opts, then read $mode from %opts
    my ($opts,$errs)=@_;
    %opts=%$opts; %errs=%$errs; $mode=$opts{mode};

  #----------------------------------------- Strip whitespace from $mode
    $mode=~s/\s//g;

  #--------------------------------------------- $mode has symbolic form
  # If $mode does not contain numbers 0 through 7, then $mode must be in
  # symbolic format.
    if ($mode=~/[^0-7]/) {

  #
  # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
  #                                                       #
  #  TO DO: symbolic mode not yet fully implemented.      #
  #  warn user for now, but advertise it will work later. #
  #                                                       #
  # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
  #
  warn "# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #\n";
  warn "#                                                             #\n";
  warn "#  symbolic format for mode spcification not yet implemented. #\n";
  warn "#  symbolic mode will be implemented when finished.           #\n";
  warn "#  for now, please use absolute mode: e.g., 777               #\n";
  warn "#                                                             #\n";
  warn "# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #\n";

  $opts{fatal}++;

  #---------------------- Split $mode into comma-separated list of modes
      @mode=split /,/,$mode;

  #------------------------------------------ Consider each mode in list
      foreach $data (@mode) {

  #---------------------------- Define $who, $operator, and $permissions
        $data=~/([\+\-\=])/; $who=$`; $operator=$1; $permissions=$';

  #-------------------------------------------- Check for valid operator
        if (! $operator) {
          warn sprintf $errs{BAD_CHOICE}{MSG},("archive.pm:check_mode",
           "","operator","archive $opts{command} mode","+, -, or =");
          $opts{fatal}++;
        }

  #---------------- Sort $permissions characters and squash redundancies
        else {
          @tmp=split //,$permissions;
          @tmp=sort @tmp; $permissions=join "",@tmp;
          $permissions=~y/[rwx]/[rwx]/s;

  #----------------------------------------- Check for valid permissions
          if ($permissions !~ /^[rwx]{1,3}$/) {
           warn sprintf $errs{BAD_CHOICE}{MSG},("archive.pm:check_mode",
             "$permissions","permission","archive $opts{command} mode",
             "constructed from r, w, and/or x only");
            $opts{fatal}++;
          }
          else {

  #--------------------------------- If $who not defined, set $who="ugo"
            if (! $who) { $who="ugo" }

  #------------------------ Sort $who characters and squash redundancies
            @tmp=split //,$who; @tmp=sort @tmp; $who=join "",@tmp;
            $who=~y/[agou]/[agou]/s;

  #------------------------------------------------- Check for valid who
            if ($who !~ /^[agou]{1,4}$/) {
              warn sprintf $errs{BAD_CHOICE}{MSG},("archive.pm:check_mode",
               $who,"user designator","archive $opts{command} mode",
               "constructed from u, g, o, and/or a only");
              $opts{fatal}++;
            }
            elsif ($who =~ /a/) {
              $who = "ugo"; push @modenew,$who.$operator.$permissions;
            }
          }
        }
      }
      $mode = join ",",@modenew;
    }

  #--------------------------------------------- $mode has absolute form
    else {

  #---------------------------------------- Strip leading 0's from $mode
      $lm=length($mode)-1; $mode=~s/^0{1,$lm}//;

  #------------------------------------- $mode has invalid absolute form
      if ($mode !~ /^[0-7]{1,3}$/) {
        warn sprintf $errs{BAD_CHOICE}{MSG},("archive.pm:check_mode",
         $mode,"mode","archive $opts{command}",
         "[[ugoa]][+-=][rwx] or nnn, where n is [0-7]");
        $opts{fatal}++;
      }

  #--------------------------------------- $mode has valid absolute form
      else { if ($mode !~ /^0/) {$mode="0".$mode} }
    }
    $opts{mode}=$mode;
    return %opts;
  }




  #----------------------------------------------------- SEPARATE_STRING

  sub separate_string
  {

=pod

  Separate string $a on non-escaped white space.  Return list of
  resulting elements in @list.

  EXAMPLE
    @list = separate_string($a);

  INPUT
    $a -- input string

  OUTPUT
    @list -- output list, separated on non-escaped white space

  VARIABLES
    ARRAYS
      @tmp -- temporary list used to store $a separated on white space
      @b -- temporary list used to accumulate sequential elements of
          @tmp ending in \ plus the next element of @tmp.  When an
          element of @tmp is encountered that does not end in \, then
          all elements of @b are joined into $b (using " " as the
          separator), and the result is added to @list.
    SCALARS
      $i -- index for @tmp
      $b -- elements to be added to @list

  NOTES
    This routine is called by parse_input().

  AUTHOR
    Written 6-2001 by Joe Werne

  HISTORY

=cut

  #----------------------------------------------------- Scope variables
    my (@tmp,@b,$i,$b,@list);

  #----------------------------------- Split input string on white space
    @tmp=split /\s/,$_[0];

  #------------------------------------------------------- Initialize @b
  # @b begins as the 1st element of @tmp.
    @b = ($tmp[0]);

  #--------------------------------------- Step through elements of @tmp
  # For each element of @tmp, except for the 1st one ...
    for ($i = 1; $i <= $#tmp; $i++) {

  #------------------------------------------ Rejoin escaped white space
  #   If @b's last element ends with "\", append the current element of
  #   @tmp to @b,
      if ($b[$#b] =~ /\134$/) { push @b,$tmp[$i] }

  #   otherwise, join all elements of @b to form $b, and push $b onto
  #   the end of @list.  Then set @b to the current element of @tmp.
      else { $b=join " ",@b; push @list,$b; @b=($tmp[$i]) }
    }

  # Join the last round of elements of @b to form $b, and push $b onto
  # the end of @list.
    $b=join " ",@b; push @list,$b;

  #-------------------------------------------------------- Return @list
    return @list;
  }




  #--------------------------------------------------- SET_ONLY_ONE_HOST

  sub set_only_one_host
  {

=pod

  Insure only one host is specified for the following commands: put, mv,
  rm, mkdir, rmdir, chmod, chgrp & chown.

  EXAMPLE
    %opts = set_only_one_host($default,\%opts);

  INPUT
    $default -- host to specify as default and only host
    %opts -- command-line options; see set_default_opts()

  OUTPUT
    %opts -- updated command-line options with only one host; see
        set_default_opts().

  VARIABLES
    HASHES
      %host -- temporary hash used to redefine %{$opts{HOST}}
    SCALARS
      $opts -- reference for input hash %opts

  NOTES
    This routine is called by parse_input().

    Use $default as one and only host.  Use associated values for HOME,
    USER, and PROBE.

  AUTHOR
    Written 6-2001 by Joe Werne

  HISTORY

=cut

  #----------------------------------------------------- Scope variables
    my (%opts,%host);

  #---------------------------------------------------------- Read input
    my ($default,$opts)=@_;

  #--------------------------------------------------- Dereference input
    %opts=%$opts;

  #--------------------------------------------- Reduce to only one host
  # set up hash with only the default entry
    $host{$default}{HOME}  = $opts{HOST}{$default}{HOME};
    $host{$default}{PROBE} = $opts{HOST}{$default}{PROBE};
    $host{$default}{USER}  = $opts{HOST}{$default}{USER};

  # assign $opts{HOST} to the hash for the default just built.
    $opts{HOST}            = {%host};
    $opts{DEFAULT_HOST}    = $default;

  #-------------------------------------------------------------- Return
    return %opts;
  }




  #----------------------------------------------------- IS_OPTION_VALID

  sub is_option_valid
  {

=pod

  Check input $option against input list of valid options $option_list.
  If $option is contained in $option_list, then return 0, else return 1.

  EXAMPLE
    $out = is_option_valid($option,$option_list,$command);

  INPUT
    $option -- option passed by user
    $option_list -- colon-separated list of valid options for $command
    $command -- archive command

  OUTPUT
    $out -- 0 if option is valid, 1 otherwise

  VARIABLES
    ARRAYS
      @tmp -- temporary array used for formatting error message
    SCALARS
      $tmp -- temporary string used for formatting error message

  NOTES
    This routine is called by parse_input().

  AUTHOR
    Written 5-2001 by Joe Werne

  HISTORY
    6-9-2001: Joe Werne
      1. fix reformatting bug in creating comma-separated options list
      2. fix bug in $out specification and test

    7-11-2001: Joe Werne
      1. expanded header comments; scope inside parse_input().

=cut

  #------------------------------ Scope variables and read input from @_
    my ($out,$tmp,@tmp);
    my ($option,$option_list,$command) = @_;
  #-------------------------------------- Strip leading "-" from $option
    $option=~s/^-//;
  #---------------------------- Is $option in the list of valid options?
    if ($option_list =~ /:$option:/) {$out=0} else {$out=1};
  #------------------------------------------------- Print error message
  # It appears we have an invalid option.  Store $option_list in $tmp,
  # then reformat so leading number and colon ":" and trailing colon are
  # removed, then remaining colons are replaced with ", ", except for the
  # last, which is replaced with ", or ".  Report error.
    if ($out != 0) {
      $tmp=$option_list;
  #   remove trailing ":"; split on ":"; remove first element; sort
      $tmp=~s/:$//; @tmp=split /:/,$tmp; shift @tmp; @tmp=sort @tmp;
  #   join back into a string, separated by ", "; substitute "or "
      $tmp=join ", ",@tmp; $tmp=~s/(.*, )/$1or /;
      warn sprintf $errs{BAD_CHOICE}{MSG},
        ("archive.pm:is_option_valid",$option,"option",
        "archive $command",$tmp);
    }
  #-------------------------------------------------------------- Return
    return $out;
  }




  #------------------------------------------------ CHECK_NUMBER_OF_ARGS

  sub check_number_of_args
  {

=pod

  Check number of arguments passed by user ($#args) against list of
  valid options $options_list (whose leading entry contains the minimum
  number of arguments).

  EXAMPLE
    $out = check_number_of_args(\@args,$option_list,$command,\%errs);

  INPUT
    @args -- argument list passed by user
    $option_list -- colon-separated list of valid options for $command
        with first entry equal to the minimum number of arguments
    $command -- archive command
    %errs -- error table; see define_error_table()

  OUTPUT
    $out -- 0 if $#args is correct, 1 otherwise

  VARIABLES
    ARRAYS
      @tmp -- used to split the leading number from $option_list; the
          minimum number of arguments identified by the leading number
          in $option_list is stored in $tmp[0].
    SCALARS
      $n -- number of arguments passed by user
      $plural -- "s" if minimum number of arguments needed is more than
          one, "" if equal to one.  This string is used to format the
          error message.
      $args -- reference for input array @args
      $errs -- reference for input hash %errs

  NOTES
    This routine is called by parse_input().

  AUTHOR
    Written 5-2001 by Joe Werne

  HISTORY
    6-9-2001: Joe Werne
      1. fix bug in $out specification and test

    7-11-2001: Joe Werne
      1. expanded header comments; scope inside parse_input().

=cut

  #------------------------------ Scope variables and read input from @_
    my (@args,@tmp,$out,$n,$plural,%errs);
    my ($args,$option_list,$command,$errs)=@_;

  #--------------------------------------------------- Dereference @args
    @args=@$args; %errs=%$errs;

  #--------------------------- Strip of leading number from $option_list
    @tmp = split /:/,$option_list,2;

  #--------- Is $#args+1 >= the minimum number of arguments to $command?
    $n=$#args+1; if ($n >= $tmp[0]) {$out=0} else {$out=1};

  #------------------------------------------------- Print error message
    if ($out != 0) {
      if ($tmp[0] == 1) {$plural=""} else {$plural="s"};
      warn sprintf $errs{MISSING_ARGS}{MSG},
       ("archive.pm:check_number_of_args",
       "archive $command",$tmp[0],$plural,$n);
    }

  #-------------------------------------------------------------- Return
    return $out;
  }

}




sub archive_get
{

=pod

NAME
  archive_get: Transfer files from archival storage facility


USAGE
  (\%opts,\%out) = archive_get(\%opts,$host,\%args,\%errs)


ARGUMENTS
  %opts -- command-line options; see set_default_opts()
  $host -- ASF host; see archive_ls()
  %args -- command-line arguments; see define_args_hash()
  %errs -- error-message list; see define_error_table()


VARIABLES
  HASHES
    %statopts -- modified copy of %opts with $statopts{silent}=1 used
        in call to archive_stat(); see %opts in INPUT section above.
    %out2 -- temporary output hash; used for output from archive_stat()
        and open_tarfiles().  See archive_stat() and open_tarfiles().
    %translate -- hash table which translates between local and remote
        file names.  Remote files reside on the archival storage
        facility.  Each KEY of %translate is set to the local file name.
        The VALUE for each KEY is set to the remote file name.

  ARRAYS
    @files -- list of KEY's for %args; @files is passed to worker_get()
    @localFiles -- list of the local file names for all the files that
        were successfully transferred by worker_get().

  SCALARS
    $args -- reference for input hash %args
    $e -- exit status from gunzip command
    $errs -- reference for input hash %errs
    $file -- set to each element of @files and each KEY of %out from
        worker_get() in foreach loops
    $localFile -- set to each element of @localFiles.
    $opts -- reference for input hash %opts
    $line -- standard output from gunzip command
    $line2 -- formatted output for GZIP_FAILED



RETURN VALUES
  %opts -- updated %opts ($opts{fatal} possibly incremented).
  %out -- nested hash with a KEY equal to each KEY of %args.  Each KEY
      points to the KEY's VAL and MSG.  The VALUE for VAL is the exit
      code for "local get", 0 if successful or $errs{GET_FAILED}{VAL}
      if unsuccessful, or $errs{SIZE_MISMATCH}{VAL} if 0 exit status
      is reported during transfer, but the local and remote file sizes
      do not match, or $errs{TAR_FAILED}{VAL} or $errs{GZIP_FAILED}{VAL}
      as appropriate.  The VALUE for MSG is the standard output from
      the successful file-transfer operation, $errs{GET_FAILED}{MSG},
      $errs{SIZE_MISMATCH}{VAL}, $errs{TAR_FAILED}{MSG}, or
      $errs{GZIP_FAILED}{MSG}, depending on the exit status.


SEE ALSO
  open_tarfiles(3),
  archive (1)


NOTES


AUTHOR
  Written by Joe Werne and Michael J. Gourlay


HISTORY
  This history list is no longer maintained.

  6-11-2001: Joe Werne
    1. Remove errant comments that claim worker_get calls archive_stat.

  7-11-2001: Joe Werne
    1. expanded header comments; scope open_tarfiles() inside this
       routine.

=cut

  use Cwd;
  use SET::Set;

  # Unpack arguments from ARGS array
  my ($opts,$host,$args,$errs) = @_;

  # Declare local variables
  my (%out);
  my ($out);
  my (%out2);
  my ($rm_return_status);
  my (@files);
  my ($line);
  my ($line2);
  my ($e);
  my ($file);
  my ($localFile);
  my (@localFiles);
  my (%translate);
  my (%statopts);

  # Dereference hash tables frmo argument references
  my(%opts)=%$opts;
  my(%args)=%$args;
  my(%errs)=%$errs;

#--------------------------------- collect source file names into @files
  @files = keys %args;

#------------------------------------------------- make sure $host is up
# silently make sure $host is up.
  %statopts=%opts; $statopts{silent}=1;
  %out2 = archive_stat(\%statopts,$host,\%errs);

# if archive_stat failed, return %out with error flags set.
# note: since we set $statopts{silent}=1, archive_stat did not write
# to STDERR, so we must write the error message here.
  if ($out2{$host}{VAL} != 0) {
    foreach $file (@files) {
      $out{$file}{VAL}=$out2{$host}{VAL};
      $out{$file}{MSG}=$out2{$host}{MSG};
    }
    if ($opts{silent}==0) {
      warn sprintf $errs{HOST_DOWN}{MSG},
        ("local.pm:archive_get",$host,$out2{$host}{MSG});
    }
    return (\%opts,\%out);
  }
#--------------------------------------------------- Get output from ASF
  ($opts,$out) = worker_get(\%opts,$host,\@files,\%errs);
  %opts=%$opts;
  %out=%$out;

#-------------------------------------------------- Get local file names
  #TAIL should probably be replaced with File::Basename::basename [CB].
  foreach $file (keys %out) {
    $localFile = TAIL($file);

#   set up a translation hash %translate so we can associate local file
#   names with the remote files.  we only need to set this up for files
#   that were successfully transferred from ASF.  also, collect the
#   names of all files in @localFiles that successfully transferred.
    if ($out{$file}{VAL}==0) {
      $translate{$localFile} = $file;
      push @localFiles,$localFile;
    }
  }

#---------------------------------- open any (possibly gzipped) tarfiles
# Attempt to extract the contents of files in the list @localFiles.
# This list contains only files that were successfully transferred.
# Files named in @localFiles that are not tarfiles (i.e., do not have
# .tar or .tgz extentions) are not modified by open_tarfiles() and they
# have associated flags $out2{$file}{VAL} set to $errs{RETRY}{VAL}.
  if ($opts{extract}==1) {
    %out2=open_tarfiles(\%opts,\@localFiles,\%errs);
  }

#-------------------------------------------------- gunzip any .gz files
# Now we gunzip any .gz files, but we only consider those files in
# @localFiles that were not touched by open_tarfiles().   open_tarfiles()
# may have deleted some files (the .tgz or .tar.gz ones), and we don't
# want error messges from trying to ungzip them again.
# We can tell if
# a file in the list @localFiles was not modified by open_tarfiles()
# because %out2 has the flag $out2{$localFile}{VAL} set to
# $errs{RETRY}{VAL}.  If a file is gunzipped here, then we set its exit
# code to 0 or $errs{GZIP_FAILED}{VAL}, as appropriate.  If it is not
# gunzipped (because it does not end with .gz), then we do not modify
# its exit code, instead leaving it as $errs{RETRY}{VAL}.  This will
# indicate that the file was neither untarred nor unzipped because it
# did not need either operation.  When we prepare the %out hash for
# return by this routine, we will not modify any %out entries
# associated with a $localFile having $out2{$localFile}{VAL} set
# to $errs{RETRY}{VAL}.
  if ($opts{gzip}==1) {
#   consider each of the local files
    foreach $localFile (@localFiles) {

#     if we were using open_tarfiles, but it didn't touch anything
#     if file has VAL=RETRY (which means open_tarfiles didn't touch it)
      if ( !$opts{extract} || $out2{$localFile}{VAL}==$errs{RETRY}{VAL} ) {

#       ... and if the file name ends in .gz, gunzip away!
        if ($localFile=~/\.gz$/ ) {
          $line=`gunzip -f $localFile 2>&1`; $e=$?;
          if ($e != 0) {
            $line2 = sprintf $errs{GZIP_FAILED}{MSG},
                ("archive.pm:archive_get",$localFile);
            $out2{$localFile}{VAL} = $errs{GZIP_FAILED}{VAL};
            $out2{$localFile}{MSG} = $line2;
            if ($opts{silent}==0) { warn $line2; warn $line; }
          }
          else {
            $out2{$localFile}{VAL} = 0;
            $out2{$localFile}{MSG} = $line;
          }
        }
      }
    }
  }

#------------------------------ Include tar and gzip exit status in $out
# incorporate exit status for open_tarfiles() and gunzip into %out
# provided $out2{$localFile}{VAL} is not $errs{RETRY}{VAL}, in which
# case neither open_tarfiles() nor gunzip were attempted for $localFile.
  foreach $localFile (@localFiles) {
    if ($out2{$localFile}{VAL} != $errs{RETRY}{VAL}) {
      $out{$translate{$localFile}}{VAL}=$out2{$localFile}{VAL};
      $out{$translate{$localFile}}{MSG}=$out2{$localFile}{MSG};
    }
  }

#---------------------------------------------------------------- return
  return (\%opts,\%out);




  #------------------------------------------------------- OPEN_TARFILES

  sub open_tarfiles
  {

=pod

  Open local tarfiles in @files in the current working directory subject
  to options specified in %opts.

  EXAMPLE
    %out = open_tarfiles(\%opts,@files,\%errs);

  INPUT
    %opts -- command-line options; see set_default_opts()
    @files -- list of files, some of which may be tarfiles to be opened
    %errs -- error-message list; see define_error_table()

  OUTPUT
    %out -- nested hash containing a KEY for each element of @files.
        Each KEY points to KEY VAL, which will have one of the following
        VALUE's: 0 if tar was successful; $errs{RETRY}{VAL} if no action
        is required because the file is not a .tar, .tgz, or .tar.gz
        file; $errs{TAR_FAILED}{VAL} if the tar command failed; and
        $errs{GZIP_FAILED}{VAL} if gzip failed.

  OPTIONS
    $opts{gzip}, $opts{silent}

  VARIABLES
    SCALARS
      $eg -- exit status for gzip command
      $et -- exit status for tar command
      $e -- sum of $et and $eg
      $file -- set to each element of @files in foreach loop
      $d -- flag indicating element is a tarfile
      $opts -- reference for input hash %opts
      $files -- reference for input array @files
      $errs -- reference for input hash %errs

  NOTES
    This routine is called by archve_get().

  AUTHOR
    Written 6-8-2001 by Joe Werne

  HISTORY
    7-11-2001: Joe Werne
      1. expanded header comment; scope inside archive_get().

=cut

  #----------------------------------------------------- Scope variables
    my (%opts,@files,%errs,%out,$eg,$et,$e,$file,$d);

  #----------------------------------------------------- Read user input
    my ($opts,$files,$errs)=@_;

  #---------------------------------------------- Dereference user input
    %opts=%$opts; @files=@$files; %errs=%$errs;

  #-------------------------------------------------- Open the tar files
  # If tarfile is gzipped (and therefore has extension .tgz or .tar.gz),
  # gunzip the files before untarring.  Collect gzip exit status in $eg
  # and tar exit status in $et.
  #
  # consider each $file in @files
    foreach $file (@files) {

  #   if $file ends with .tar.gz or .tgz, gunzip, then send to tar pipe.
  #   set $d=1.
      if ($file=~/\.tar.gz$|\.tgz$/) {
        open PIPE, "| tar xf - ";
        print PIPE `gunzip -f < $file`; $eg=$?;
        close PIPE; $et=$?;
        $out{$file}{VAL}=$et+$eg;
        $d=1;
      }

  #   or, if $file ends with .tar, untar $file directly.  set $d=1.
      elsif ($file=~/\.tar$/) {
        `tar xf $file`; $et=$?; $eg=0;
        $out{$file}{VAL}=$et+$eg;
        $d=1;
      }

  #   otherwise, this is not a tarfile, and no action is required, so
  #   set VAL=RETRY, $eg=$et=0, $d=0.
      else {
        $eg=0; $et=0;
        $out{$file}{VAL}=$errs{RETRY}{VAL};
        $d=0;
      }

  #   combine error flags
      $e=$eg+$et;

  #----------------------- Check exit status and print message to STDOUT
  #   If exit status is not zero ...
      if ($e!=0)
      {

  #     If gzip failed, set flag and print error message.
        if ($eg!=0)
        {
          $out{$file}{VAL}=$errs{GZIP_FAILED}{VAL};
          if ($opts{silent}==0)
          {
            warn sprintf $errs{GZIP_FAILED}{MSG},
              ("archive.pm:open_tarfiles",$file);
          }
        }

  #     Else, if tar failed, print error message.  Note: if gzip already
  #     failed, don't bother with this error message.
        if ($et!=0)
        {
          $out{$file}{VAL}=$errs{TAR_FAILED}{VAL};
          if ($opts{silent}==0) {
            warn sprintf $errs{TAR_FAILED}{MSG},
              ("archive.pm:open_tarfiles",$file);
          }
        }
      }

      elsif ($d==1 && $opts{save}==0)
      {
        # or, if exit status is zero and $d=1 and save=0, delete tarfile.
        `/bin/rm -f $file`;
        $rm_return_status=$?;
      }
    }

    return %out;
  }

}




sub archive_put
{

=pod

NAME
  archive_put: Transfer data to archival storage facility.


USAGE
  (\%opts,\%out) = archive_put(\%opts,\%args,\%errs)


ARGUMENTS
  %opts -- command-line options; see set_default_opts()
  %args -- command-line arguments; see define_args_hash()
  %errs -- error-message list; see define_error_table()


DESCRIPTION
  Options used are those in $opts{tar}


VARIABLES
  HASHES
    %mkdirargs -- nested input hash for call to archive_mkdir() with
        only one KEY, $opts{path}, and $mkdirargs{$opts{path}}{VAL}=
        $errs{RETRY}{VAL}; see archive_mkdir() for details.
    %mkdirout -- output hash from archive_mkdir(); see archive_mkdir().

  ARRAYS
    @files -- list of source files we must transfer to the asf host.  If
        the "-t tarfile" option is used, then @files contains only one
        element equal to the name of the tarfile.  If "-t tarfile" is
        not specified, then @files contains elements corresponding to
        each KEY of %args.

  SCALARS
    $args -- reference to input hash %args
    $eg -- exit code for gzip command
    $errs -- reference to input hash %errs
    $i -- index for @files in foreach loop
    $opts -- reference to input hash %opts
    $mkdirout -- reference to output hash %mkdirout
    $line -- standard output from gzip command


RETURN VALUES
  %opts -- updated %opts ($opts{fatal} possibly incremented).
  %out -- nested hash with KEY's equal to elements of @files passed to
      worker_put().  See @files in section VARIABLES below.  Each KEY
      points to the KEY's VAL and MSG.  The VALUE for VAL is the exit
      code for "local put", 0 if successful or $errs{PUT_FAILED}{VAL}
      if unsuccessful, or $errs{SIZE_MISMATCH}{VAL} if 0 exit status
      is reported during transfer, but the local and remote file sizes
      do not match.  The VALUE for MSG is the standard output from the
      successful file-transfer operation, $errs{PUT_FAILED}{MSG} or
      $errs{SIZE_MISMATCH}{VAL}, depending on the exit status.  If a
      fatal error is encountered in archive_mkdir(), then the VALUE's
      for VAL and MSG will be $mkdirout{$opts{path}}{VAL} and
      $mkdirout{$opts{path}}{MSG}.  See %mkdirout in section VARIABLES
      below.  See NOTES section below.


NOTES
  archive_mkdir():
    archive_mkdir() is called when -p is present to make sure the 
    target directory exists.  archive_mkdir() calls the routine 
    make_one_remote_dir(), which recursively makes all parent 
    directories that do not already exist.  before attemting to make
    a directory, make_one_remote_dir() first checks to see if the 
    directory exists already.  
    
  %out:
    the output from this routine is too dependent on worker_put().
    worker_put() should be stripped to the bare essentials, and
    archive_put() should perform the establishment of %out.


SEE ALSO
  create_tarfile(3), archive(1)


AUTHOR
  Written by Joe Werne, Chris Bizon and Michael J. Gourlay


=cut

  use File::Basename;

  # Unpack arguments from ARGS array
  my ($opts,$args,$errs) = @_;

  # Dereference hash variables from argument references
  my(%opts)=%$opts;
  my(%args)=%$args;
  my(%errs)=%$errs;

  # Declare local variables
  my (%out);
  my (@files);
  my ($line);
  my ($eg);
  my ($i);
  my (%mkdirargs);
  my (%mkdirout);
  my (%statout);
  my ($mkdirout);
  my ($host);
  my ($file);
  my ($out);
  my (@nonexistentfiles);
  my ($badfile);
  my ($user)  = $opts{HOST}{$host}{USER};
  my ($path);
  my ($filename);

  # Collect source file names into @files
  @files = keys %args;

  #check for nonexistent files
  @nonexistentfiles = get_nonexistent_files(@files);

  #if there are nonexistent files, print errors, set codes and return.
  if (scalar @nonexistentfiles != 0){
    $opts{fatal}++;
    if ($opts{silent}==0) {
      warn "No files put:\n";
      warn sprintf $errs{MISSING_FILES}{MSG},
      ("archive.pm:archive_put");
    }
    foreach $badfile (@nonexistentfiles){
      $out{$badfile}{VAL}=$errs{MISSING_FILES}{VAL};
      if ($opts{silent}==0) {
        warn "     $badfile\n";
      }
    }
    return (\%opts,\%out);
  }


  # Identify host from $opts{HOST}:
  #
  # Use host specified by $opts{DEFAULT_HOST}.
  #
  # Note: this variable is set in set_default_opts, but can be
  # overwritten by parse_input with the -asf option.

   $host=$opts{DEFAULT_HOST};

  # This section is a little wonky in terms of the logic and could
  #  probably benefit from being re-examined [CB].

  # Check/make destination directory:
  #
  # Make sure destination directory exists on $opts{DEFAULT_HOST}.
  #
  # NOTE: archive_mkdir runs archive_stat, so by calling archive_mkdir,
  # we are also ensuring $host is up.
  #
  # NOTE: archive_mkdir() currently reports when it attempts to make a
  # directory that already exists.  We can either have archive_mkdir()
  #   1. check for the existance of all directories it is about to make
  #      and not attempt to make the directory if it already exists or
  #   2. force archive_mkdir() to operate in silence and trap any other
  #      error archive_mdir() might report.

  # if -p option is passed, make target directory

  if ($opts{parent}==1)
  {

    $mkdirargs{$opts{path}}{VAL}=$errs{RETRY}{VAL};
    ($opts,$mkdirout) = archive_mkdir(\%opts,\%mkdirargs,\%errs);
    %opts=%$opts;
    %mkdirout=%$mkdirout;

    # if archive_mkdir() failed, return %out with error flags set.
    # Note: archive_mkdir() already wrote its error message to STDOUT.
    if ($opts{fatal} != 0)
    {
      foreach $file (@files)
      {
        $out{$file}{VAL}=$mkdirout{$opts{path}}{VAL};
        $out{$file}{MSG}=$mkdirout{$opts{path}}{MSG};
      }
      if ($opts{silent}==0)
      {
        warn sprintf $errs{MKDIR_FAILED}{MSG},
          ("archive.pm:archive_put",$opts{path});
      }
      return (\%opts,\%out);
    }

  }

  # otherwise, if -p option is not passed, then make sure the archival
  # storage system is up and the target directory exists.

  else
  {

    %statout = archive_stat(\%opts,$host,\%errs);

    # if host is operating ...

    if ($statout{$host}{VAL}==0)
    {

      # if target directory $opts{path} does not start with "/", prepend 
      # with home directory before checking for its existence.

      $path = $opts{path};
      if ($path !~ /^\//)
      {
        $path="$opts{HOST}{$host}{HOME}$path"
      }

      # if target directory does not exist, set flags and return error.

      if (!site_directory_exists($user, $host, $path))
      {
        $opts{fatal}++;
        foreach $file (@files){
          $out{$file}{VAL}=$errs{MISSING_TARGET}{VAL};
          $out{$file}{MSG}=$errs{MISSING_TARGET}{MSG};
        }
        if ($opts{silent}==0) {
          warn sprintf $errs{MISSING_TARGET}{MSG},
           ("archive.pm:archive_put",$opts{path});
        }
        return (\%opts,\%out);
      }

    }

    # or, if host is down, set VAL and MSG and write error

    else
    {

      $opts{fatal}++;
      foreach $file (@files)
      {
        $out{$file}{VAL}=$errs{HOST_DOWN}{VAL};
        $out{$file}{MSG}=$statout{$host}{MSG};
      }
      if ($opts{silent}==0)
      {
        sprintf $errs{HOST_DOWN}{MSG},
          ("archive.pm:archive_put",$host,$statout{$host}{MSG});
      }
      return (\%opts,\%out);
    }

  }


# If "-tarfile" option existed...
  if ($opts{tar})
  {
    # Create the tarfile (possibly also gzipped)
    %out = create_tarfile(\%opts,\@files,$opts{tar},\%errs);

    # Get output file name, store in @files
    @files = keys %out;

    # If tar failed....
    if ($out{$files[0]}{VAL}!=0)
    {
      # undef @files so worker_put can not attempt transfer
      undef @files;
      $opts{fatal}++;
    }
  }

  # gzip all the source files:
  #
  # If a tarfile is not being created, then we might have to gzip files
  # inside this routine, rather than inside create_tarfile().
  # Note we do not enter this block if the "-t tarfile" option was specified.
  elsif ($opts{gzip}==1)
  {

    # Initiate @files counter, and consider each $file in turn
    $i=0;
    foreach (@files)
    {

      # Before attempting gzip, make sure file is not already a .gz file.
      if ($files[$i] !~ /\.gz$/)
      {

        # Execute "gzip -f" and store exit status in $eg
        $line=`gzip -f -c $files[$i] > "$files[$i].gz"`;
        $eg=$?/256;

        # Add .gz to file name in $files[$i]
        $files[$i] = "$files[$i].gz";

        # If gzip failed, print error message, set VAL
        if ($eg !=0)
        {
          $out{$files[$i]}{VAL}=$errs{GZIP_FAILED}{VAL};
          if ($opts{silent}==0)
          {
            warn sprintf $errs{GZIP_FAILED}{MSG},
              ("archive.pm:archive_put",$file);
            warn $line;
          }
        }

        # or, if gzip succeeded, set VAL=0
        else
        {
          $out{$files[$i]}{VAL}=0;
        }
      }

      # If file is already a .gz file, set VAL=0
      else
      {
        $out{$files[$i]}{VAL}=0;
      }

      # increment @files counter
      $i++;
    }
  }

  # Send output to ASF
  #
  # If @files is defined, transfer @files
  if (@files)
  {
    ($opts,$out) = worker_put(\%opts,\@files,\%errs);
    %opts=%$opts; %out=%$out;
  }

  #if we zipped files for transfer, get rid of the .gz ones.
  if ($opts{gzip}==1)
  {
    unlink @files;

    #things get annoying here if we also need to delete the source files, since
    #that's usually up to worker_put.  Looks like a refactoring candidate [CB].
    if ($opts{delete}==1)
    {
      print "Must delete\n";
      foreach $filename (@files){
        $filename = basename($filename,".gz");
        print "  deleteing $filename";
        unlink $filename;
      }
    }

  }

  return (\%opts,\%out);
}




sub create_tarfile
{

=pod

Create the local tarfile $file from source files @files in the current
directory subject to the options in %opts.

EXAMPLE
  %out = create_tarfile(\%opts,@files,$file,\%errs);

INPUT
  %opts -- command-line options; see set_default_opts()
  @files -- list of input files to be tarred up
  $file -- name of output tarfile
  %errs -- error-message list; see define_error_table()

OUTPUT
  %out -- nested output hash with one KEY equal to the name of the
      tarfile $file.  This KEY points to two other KEY's: VAL
      and MSG.  The VALUE for VAL is set to 0 if successful,
      $errs{TAR_FAILED}{VAL} if tar failed, or
      $errs{GZIP_FAILED}{VAL} if gzip failed.  The VALUE for
      MSG is set to "tar succeeded for $file\n" if successful,
      $errs{TAR_FAILED}{VAL} if tar failed, or
      $errs{GZIP_FAILED}{VAL} if gzip failed.

OPTIONS
  $opts{gzip}, $opts{silent}

VARIABLES
  SCALARS
    $e -- sum of $et and $eg
    $eg -- exit code for gzip command
    $errs -- reference for input hash %errs
    $et -- exit code for tar command
    $files -- reference for input array @files
    $opts -- reference for input hash %opts

NOTES
  The tarfile name $file is assumed to have the correct suffix already
  specified in its name, and it is not checked here.

  If you decide to keep track of output for each transfer attempted,
  remember to inherit flags from $file to $src after calling this
  routine.

AUTHOR
  Written 6-7-2001 by Joe Werne

HISTORY
  6-8-2001: Joe Werne
    1. ensure flag=0 (not RETRY) if success
    2. delete source files if tar is successful and "delete" is used

  7-11-2001: Joe Werne
    1. expanded header comments; scoped routine inside archive_put.

=cut

  # Declare local variables
  my (%out);
  my ($eg);
  my ($et);
  my ($e);
  my ($rm_return_status);

  # Unpack arguments from ARGS array
  my ($opts,$files,$file,$errs)=@_;

  # Dereference hash and array variables from references in arguments
  my(%opts)=%$opts;
  my(@files)=@$files;
  my(%errs)=%$errs;

  # Create tar files
  #
  # If user specified gzip, tar the files, then pipe to gzip.  Otherwise,
  # just tar the files.  Store gzip exit status in $eg and tar exit
  # status in $et.
  if ($opts{gzip}==1)
  {
    open PIPE, "| gzip -f > $file";
    print PIPE `tar cf - @files`; $et=$?/256;
    close PIPE; $eg=$?;
  }
  else
  {
    `tar cf - @files > $file`; $et=$?/256; $eg=0;
  }
  $e=$et+$eg;

  # Set error flag
  $out{$file}{VAL}=$e;

  # Check exit status and print message to STDOUT
  #
  # If exit status is not zero ...
  if ($e!=0)
  {

    # If tar failed, print error message.
    if ($et!=0)
    {
      $out{$file}{VAL}=$errs{TAR_FAILED}{VAL};
      if ($opts{silent}==0)
      {
        warn sprintf $errs{TAR_FAILED}{MSG},
          ("archive.pm:create_tarfile",$file);
      }
    }

    # Else, if gzip failed, set flag and print error message.  Note: if
    # tar already failed, don't bother with this error.
    elsif ($eg!=0)
    {
      $out{$file}{VAL}=$errs{GZIP_FAILED}{VAL};
      if ($opts{silent}==0)
      {
        warn sprintf $errs{GZIP_FAILED}{MSG},
          ("archive.pm:create_tarfile",$file);
      }
    }
  }

  # or, if exit status is 0 and $opts{delete}=1, then delete source files.
  elsif ($opts{delete}==1)
  {
    `/bin/rm -fR @files`;
    $rm_return_status=$?;
    $out{$file}{VAL}="tar succeeded for $file\n";
  }

  return %out;
}




sub define_args_hash
{

=pod

NAME
  define_args_hash: Construct hash from list of user supplied arguments.


USAGE
  %args = define_args_hash(\%opts,\@args,\%errs);


ARGUMENTS
  %opts -- command-line options; see set_default_opts()
  @args -- user-supplied arguments; see parse_input()
  %errs -- error-message list; see define_error_table()


RETURN VALUE
  %args -- nested hash table with a KEY for each user-supplied
      argument.  Each KEY points to a key named VAL with VALUE
      set to $errs{RETRY}{VAL}.  See NOTES below.


VARIABLES
  SCALARS
    $args -- reference for input array @args
    $errs -- reference for input hash %errs
    $opts -- reference for input hash %opts


NOTES
  %args is a nested hash table of user supplied arguments for the
  "archive" command (e.g., get, put, ls, ...) issued by the user.  %args
  contains only the arguments for the command, not the command or any
  command-line options.  The VALUE for each KEY of %args is the key VAL,
  which is set in this routine to $errs{RETRY}{VAL}, indicating that the
  argument in question has not yet been processed by the "archive"
  command.  When the argument is successfully processed, the VALUE
  associated with $args{$user_supplied_argument}{VAL} is set to 0.  If
  processing of argument $user_supplied_argument fails fatally, then
  $args{$user_supplied_argument}{VAL} is set to the error code for
  the mode of failure, and processing of the argument is no longer
  attempted.


AUTHOR
  Written by Joe Werne, Chris Bizon and Michael J. Gourlay


HISTORY
  This history list no longer mainteined

  7-10-2001: Joe Werne
    1. expanded header comment statements

=cut

  # Unpack arguments from ARGS array
  my ($opts,$args,$errs)=@_;

  # Dereference hash and array variables from references in arguments
  my (%opts)=%$opts;
  my (@args)=@$args;
  my (%errs)=%$errs;

  # Declare local variables
  my ($i);
  my (%args);

  # Strip trailing and studdering "/" from @args
  foreach (@args)
  {
    $args[$i]=~s/\/$//;
    $args[$i]=~s/\/+/\//;
    $i++;
  }

  # Define %args
  foreach $args (@args)
  {
    $args{$args}{VAL} = $errs{RETRY}{VAL};
  }

  return %args;
}




#============================================================ ARCHIVE_MV

sub archive_mv
{
# (\%opts,\%out)=archive_mv(\%opts,\%args,\%errs)
#------------------------------------------------- Scope local variables
  my (%opts,%args,%errs,$fatal,%out);
#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;
#----------------------------------------------------- dereference input
  %opts=%$opts; %args=%$args; %errs=%$errs;
#----------------------------------------------------------- Print error
  warn "dev-note: archive_mv not yet implemented on local system.\n";
#---------------------------------------------------------------- Return
  return (\%opts,\%out);
}




#============================================================ ARCHIVE_RM

sub archive_rm
{
# (\%opts,\%out)=archive_rm(\%opts,\%args,\%errs)
#------------------------------------------------- Scope local variables
  my (%opts,%args,%errs,$fatal,%out);
#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;
#----------------------------------------------------- dereference input
  %opts=%$opts; %args=%$args; %errs=%$errs;
#----------------------------------------------------------- Print error
  warn "dev-note: archive_rm not yet implemented on local system.\n";
#---------------------------------------------------------------- Return
  return (\%opts,\%out);
}




#========================================================= ARCHIVE_RMDIR

sub archive_rmdir
{
# (\%opts,\%out)=archive_rmdir(\%opts,\%args,\%errs)
#------------------------------------------------- Scope local variables
  my (%opts,%args,%errs,$fatal,%out);
#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;
#----------------------------------------------------- dereference input
  %opts=%$opts; %args=%$args; %errs=%$errs;
#----------------------------------------------------------- Print error
  warn "dev-note: archive_rmdir not yet implemented on local system.\n";
#---------------------------------------------------------------- Return
  return (\%opts,\%out);
}




#========================================================= ARCHIVE_CHMOD

sub archive_chmod
{
# (\%opts,\%out)=archive_chmod(\%opts,\%args,\%errs)
#------------------------------------------------- Scope local variables
  my (%opts,%args,%errs,$fatal,%out);
#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;
#----------------------------------------------------- dereference input
  %opts=%$opts; %args=%$args; %errs=%$errs;
#----------------------------------------------------------- Print error
  warn "dev-note: archive_chmod not yet implemented on local system.\n";
#---------------------------------------------------------------- Return
  return (\%opts,\%out);
}




#========================================================= ARCHIVE_CHGRP

sub archive_chgrp
{
# (\%opts,\%out)=archive_chgrp(\%opts,\%args,\%errs)
#------------------------------------------------- Scope local variables
  my (%opts,%args,%errs,$fatal,%out);
#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;
#----------------------------------------------------- dereference input
  %opts=%$opts; %args=%$args; %errs=%$errs;
#----------------------------------------------------------- Print error
  warn "dev-note: archive_chgrp not yet implemented on local system.\n";
#---------------------------------------------------------------- Return
  return (\%opts,\%out);
}




#========================================================= ARCHIVE_CHOWN

sub archive_chown
{
# (\%opts,\%out)=archive_chown(\%opts,\%args,\%errs)
#------------------------------------------------- Scope local variables
  my (%opts,%args,%errs,$fatal,%out);
#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;
#----------------------------------------------------- dereference input
  %opts=%$opts; %args=%$args; %errs=%$errs;
#----------------------------------------------------------- Print error
  warn "dev-note: archive_chown not yet implemented on local system.\n";
#---------------------------------------------------------------- Return
  return (\%opts,\%out);
}




sub archive_mkdir
{

=pod

NAME
  archive_mkdir: Make directories on archival storage facility.


USAGE
  %out = archive_mkdir(\%opts,\%args,\%errs);


ARGUMENTS
  %opts -- command-line options; see set_default_opts()
  %args -- command-line arguments; see define_args_hash()
  %errs -- error-message list; see define_error_table()


RETURN VALUES
  %opts -- updated command-line options
  %out -- nested hash with KEY's equal to KEY's of %args.  Each KEY
      points to the KEY's VAL and MSG.  The VALUE for VAL is the exit
      code for the "archive mkdir" operation, 0 if successful or
      $errs{MKDIR_FAILED}{VAL} if unsuccessful.  The VALUE for MSG
      is a string equal to the standard output from the unix mkdir
      command.  If the asf host is down, then the VALUE for VAL is
      set to $errs{HOST_DOWN}{VAL} and the VALUE for MSG is set to
      $statout{$host}{MSG}.


OPTIONS
  $opts{mode}*, $opts{parent}, $opts{silent}

  *partially implemented.  we'd like mode to allow ugoa+rwx format.
  currently we can specify octal mode format.


VARIABLES
  HASHES
    %statopts -- copy of %opts with $statopts{silent}=1.  used for input
        to archive_stat().
    %statout -- output from archive_stat(); see archive_stat()

  ARRAYS
    @args -- list of KEY's for input hash %args

  SCALARS
    $args -- reference for input hash %args
    $dir -- set to each element of @args in foreach loop
    $e -- exit status from unix mkdir command
    $errs -- reference for input hash %errs
    $home -- string set to home directory for $host
    $host -- string set to $opts{DEFAULT_HOST}
    $line -- standard output from unix mkdir command
    $opts -- reference for input hash %opts; options for unix mkdir
        command.
    $path -- full path name (begins with "/") for each $dir


AUTHOR
  Written by Joe Werne, Chris Bizon and Michael J. Gourlay


=cut

  # Unpack subroutine arguments from ARGS array.
  my ($opts,$args,$errs)=@_;

  # Dereference hash variables from references in arguments
  my (%opts)=%$opts;
  my (%args)=%$args;
  my (%errs)=%$errs;

  # Declare local variables
  my ($host);
  my (%out);
  my (%statopts);
  my (%statout);
  my (@args);
  my ($dir);
  my ($path);
  my ($home);
  my ($line);
  my ($e);
  my ($exists);
  my ($user);

  # Obtain list of @args
  @args=keys %args;

  # Identify host from $opts{DEFAULT_HOST}
  $host=$opts{DEFAULT_HOST};
  $user=$opts{HOST}{$host}{USER};

  # Make sure $host is operating
  #
  # Wait for $host to become available (controlled by $opts{retry})
  %statopts=%opts;
  $statopts{silent}=1;
  %statout = archive_stat(\%statopts,$host,\%errs);

  # if host is operating ...
  if ($statout{$host}{VAL}==0)
  {
     if ($opts{parent}==1)
     {
       $opts="-p -m $opts{mode}"
     }
     else
     {
       $opts="-m $opts{mode}"
     }

      # consider each directory $dir to create
      foreach $dir (@args)
      {

        # if $dir does not start with "/", prepend with $home.
        $path=$dir;
        $home=$opts{HOST}{$host}{HOME};
        if ($path!=~/^\//)
        {
          $path="$home$path"
        }

        ($line,$e) =
          make_one_remote_dir($user, $host,$path,$opts{mode},$opts{parent});
        $e = $e / 256;

        # Set message flag
        $out{$dir}{MSG}=$line;

        # Print feedback to user
        if ($opts{silent}==0 && $line ne "")
        {
          warn $line;
        }


        if (!site_directory_exists($user, $host, $path))
        {

          $opts{fatal}++;
          $out{$dir}{VAL}=$errs{MKDIR_FAILED}{VAL};
          if ($opts{silent}==0) {
            warn sprintf $errs{MKDIR_FAILED}{MSG},
              ("archive.pm:archive_mkdir",$path);
          }
        }
        else
        {
          $out{$dir}{VAL}=0;
        }
      }
  }


  # or, if host is down, set VAL and MSG and write error
  else
  {
    $opts{fatal}++;
    foreach $dir (@args)
    {
      $out{$dir}{VAL}=$errs{HOST_DOWN}{VAL};
      $out{$dir}{MSG}=$statout{$host}{MSG};
    }
    if ($opts{silent}==0)
    {
      sprintf $errs{HOST_DOWN}{MSG},
        ("archive.pm::archive_mkdir",$host,$statout{$host}{MSG});
    }
  }

  return (\%opts,\%out);
}




sub archive_env
{

=pod

NAME
  archive_env: Store site-specific variables in a hash table


EXAMPLE
  %e = archive_env();


INPUT
  none


OUTPUT
  %e -- output hash containing KEY => VALUE pairs relevant to the local
      site.  The KEY's and VALUE's are described below.

    KEYS:

      PSTDIR -- VALUE is the location of the PST root directory.  VALUE
          is set by pstinstall2 during PST installation.

      ARCHIVE_HOST -- comma-separated list (no white space) of the valid
          archival storage facility names for the current site.  The
          first name in the list is the name of the default system.  If
          an environment variable with the name ARCHIVE_HOST exists, it
          is used to set the VALUE; if not, the default value coded into
          archive_env() is used.

      ARCHIVE_HOME -- comma-separated list (no white space) of the user
          root directories on the archival storage facility identified
          by ARCHIVE_HOST.  If more than one directory is specified in
          ARCHIVE_HOME, then each directory must identify the user root
          directory for the corresponding archival storage facility
          identified by ARCHIVE_HOST.  That is, in this case there
          should be an equal number of systems and root directories
          specified.  If only one directory is specified by
          ARCHIVE_HOME, then the same directory will be used for all
          of the archival storage facilities specified by ARCHIVE_HOST.
          If an environment variable with the name ARCHIVE_HOME exists,
          it is used to set the VALUE; if not, the default value coded
          into archive_env() is used.

      ARCHIVE_PROBE -- comma-separated list (no white space) of flags
          that indicate whether or not we will attempt to check the
          status and type of files on the archival facility before and
          after transfer.  VALUE is "yes" if we will check the status.
          VALUE is "no" if we will not.  A reason for setting
          ARCHIVE_PROBE="no" could be failure in accurate or complete
          reporting of file types by the archival storage facility.  As
          with ARCHIVE_HOME, the number of items in the comma-separated
          list determines the flag for each archival storage facility.
          If an environment variable with the name ARCHIVE_PROBE exists,
          it is used to set the VALUE; if not, the default value coded
          into archive_env() is used.

      PST_NOTE -- VALUE is a string variable containing a note that is
          communicated to new users during installation.  PST_NOTE
          should provide useful information about environment variables
          and directories used by the TUSC layer of the toolkit.
          Variables and directories that must be set and those that
          can be set should be clearly identified.  Man pages for the
          toolkit should also be mentioned in PST_NOTE.  Any other basic
          information for the user can also be communicated through the
          PST_NOTE string variable.

      PST_SITE -- VALUE is the name of the SITE; e.g., ERDC, NAVO, ASC,
          ARL, AHPCRC, PST, SDSC, ....

VARIABLES
  SCALARS
    $USER -- set to environment variable of same name

NOTES
  This routine is called by set_default_opts() and pstinstall2.

AUTHOR
  Written 6-2001 by Joe Werne

HISTORY
  7-10-2001: Joe Werne
    1. expanded header comments.

=cut

#-----------------------------------------------------------------------
  my (%e,$USER);
  $USER = $ENV{'USER'};
#---------------------------------------------------- Specify $e{PSTDIR}
#PST BEGIN(1)
#  $e{PSTDIR}=PSTDIR;
#PST END(1)
#---------------------------------------------- Specify $e{ARCHIVE_HOME}
  if (exists $ENV{'ARCHIVE_HOME'} && $ENV{'ARCHIVE_HOME'} ne "") {
    $e{ARCHIVE_HOME}=$ENV{'ARCHIVE_HOME'}
  }
  else {

    #specify default $ARCHIVE_HOME
    $e{ARCHIVE_HOME}=site_get_archive_home($USER);
    #take off newlines.
    chomp $e{ARCHIVE_HOME};

  }
#---------------------------------------------- Specify $e{ARCHIVE_HOST}
  if (exists $ENV{'ARCHIVE_HOST'} && $ENV{'ARCHIVE_HOST'} ne "") {
    $e{ARCHIVE_HOST}=$ENV{'ARCHIVE_HOST'}
  }
  else {

#   specify default $ARCHIVE_HOST
    $e{ARCHIVE_HOST}=site_get_archive_host($USER);

  }
#---------------------------------------------- Specify $e{PST_SITE}
  $e{PST_SITE} = site_get_site();
#--------------------------------------------- Specify $e{ARCHIVE_PROBE}
  if (exists $ENV{'ARCHIVE_PROBE'} && $ENV{'ARCHIVE_PROBE'} ne "") {
    $e{ARCHIVE_PROBE}=$ENV{'ARCHIVE_PROBE'}
  }
  else {

    if (site_get_archive_check_status_and_type($e{ARCHIVE_HOST}))
    {
      $e{ARCHIVE_PROBE} = "yes";
    }
    else
    {
      $e{ARCHIVE_PROBE} = "no";
    }

  }

  #offer a note for the user
  $e{PST_NOTE}=site_get_archive_note($USER,$e{ARCHIVE_HOST});


  return %e;

}




#=======================================================================
#                                                                      #
#                                                                      #
#               Everything above is the parsing (front end) code.      #
#                                                                      #
#               Everything below is the worker (middle layer) code.    #
#                                                                      #
#                                                                      #
#=======================================================================




sub worker_put
{

=pod

NAME
  worker_put:  Move data to the archival storage facility.


USAGE
  (\%opts,\%out) = worker_put(\%opts,\@args,\%errs);


ARGUMENTS
  %opts -- command-line options; see archive.pm:set_default_opts()
  @args -- list of files to transfer; see archive.pm:archive_put()
  %errs -- error-message list; see archive.pm:define_error_table()


OPTIONS
  delete, migrate, *nowait, parent, save, silent, where * denotes
  options that are not yet implemented.


VARIABLES
  SCALARS
    $args -- reference to input array %args
    $e -- set to exit code for file-transfer command
    $errs -- reference to input hash %errs
    $home -- string set to user root directory on asf $host
    $host -- string set to the default asf host $opts{DEFAULT_HOST};
    $file -- set to each element of @args
    $line -- set to standard out for the file-transfer command;  For the
        TEST version of worker_put(), $line=`/bin/cp -f $file $path 2>&1`
    $localSize -- once transfer has succeeded, then the local file
        size is compared with the size of the file on the remote asf
        host.  $localSize is set to the size of the local file.
    $opts -- reference to input hash %opts
    $path -- full-path version (begins with "/") of $opts{path}
    $success -- string set to "no" while transfer attempts have not
        yet succeeded or "yes" if transfer is successful.
    $try -- counter for retry attempts to transfer files;


RETURN VALUES
  %opts -- updated %opts ($opts{fatal} possibly incremented).
  %out -- nested hash with KEY's equal to elements of @args.
      Each KEY points to the KEY's VAL and MSG.

      The VALUE for VAL is the exit code for "local put", 0 if
      successful or $errs{PUT_FAILED}{VAL} if unsuccessful, or
      $errs{SIZE_MISMATCH}{VAL} if 0 exit status is reported during
      transfer, but the local and remote file sizes do not match.

      The VALUE for MSG is the standard output from the successful
      file-transfer operation, $errs{PUT_FAILED}{MSG} or
      $errs{SIZE_MISMATCH}{VAL}, depending on the exit status.


NOTES
  worker_put() is called by archive_put().  worker_put() copies a set of
  files in the current working directory to $opts{path} on the archival
  storage facility.

  For the TEST version of local.pm, we assume that the local system is
  unix-like, and we use common unix utilities.  worker_put() works like
  cp, but always only with a destination directory specified (either
  with "-C path" or with the user's root directory on the asf if -C is
  not specified).

  Target directory existence and permissions should be checked by
  archive_put() before calling this routine.  Therefore, this routine
  does not need to quibble with permissions, etc., and the
  $opts{force}=1 option is implied.


AUTHOR
  Written by Joe Werne and Michael J. Gourlay


HISTORY
  This history list is no longer maintained.  See logs in CVS.

  6-8-2001: Joe Werne
    1. fix $try counter at bottom of while loop to increment.  $try
       previously erroneously named $j.
    2. fix $opts{fatal} test after calling archive_mkdir
    3. if mkdir fails, set VAL flags for files to exit status of mkdir
    4. introduce $success so $try-while test is only at bottom of block
    5. add file-size-mismatch error message and value
    6. remove specification of mkdir options (which are now handled by
       a call to archive_mkdir)
    7. set $path variable
    8. include comments denoted LOCAL+ or local- to offset regions that
       must be modified for site-specific implementation
    9. remove source files if "delete" is used.  remove tarfiles if
       transfer successful, unless "save" is specified.

  6-10-2001: Joe Werne
    1. change "cp $file $path$file" to "cp $file $path"

  6-11-2001: Joe Werne
    1. upon "put" failure, check to see if $path exists.  if not, set
       $try to $opts{retry} so you'll jump out of while-loop.  this is
       the strategy only for local.pm.test, and should not be used with
       other site-specific local.pm files.  for sites which use archival
       storage strategies that mimic (or literally are) local unix file
       systems, it might be good after 5 or so failed attempts to send
       a warning message to the user, suggesting the mass-storage
       directory might not exist.  that way the user can be prompted,
       but not harassed after every failed attempt.

  7-11-2001: Joe Werne
    1. expanded header comments; scope additional variables as "my".

=cut

  # Unpack arguments from Perl ARGS array
  my ($opts,$args,$errs)=@_;

  # Dereference hash and array variables from references in arguments.
  my (%opts)=%$opts;
  my (@args)=@$args;
  my (%errs)=%$errs;

  # Declare local variables
  my ($host);
  my ($try);
  my (%out);
  my ($e);
  my ($file);
  my ($line);
  my ($success);
  my ($home);
  my ($path);
  my ($exists);
  my ($remoteFile);
  my ($user)=$opts{HOST}{$host}{USER};

  # Identify host from $opts{HOST}:
  # Use host specified by $opts{DEFAULT_HOST}.
  #
  # Note: This variable is set in set_default_opts, but can be
  # overwritten by parse_input with the "-a" [command line?  --MJG] option.

  $host=$opts{DEFAULT_HOST};

  # Define $path:
  # If $opts{path} does not start with "/", prepend with $home.
  $path=$opts{path};
  $home=$opts{HOST}{$host}{HOME};
  if ($path!=~/^\//)
  {
    $path="$home$path"
  }

  # Process each command-line argument in turn.
  foreach $file (@args)
  {
    # Set the status for this file to "RETRY"
    $out{$file}{VAL}=$errs{RETRY}{VAL};
    $out{$file}{MSG}=$errs{RETRY}{MSG};

    # Try for $opts{retry} number of attempts
    $try=0;
    $success="no";
    while ($success ne "yes")
    {
      ($line,$e) = site_put($user, $host, $path, $file);
      $e=$e/256;

      # Assign return-code integer value and text message for put
      # attempt for this file
      $out{$file}{MSG}=$line;
      $out{$file}{VAL}=$e;

      # If transfer failed, print error message.
      if ($e != 0)
      {
        $out{$file}{VAL}=$errs{PUT_FAILED}{VAL};

        # If failure resulted because the destination directory does not
        # exist, do not try again.
        if (!site_directory_exists($user, $host, $path))
        {
          $try = $opts{retry}
        }

        if ($opts{silent}==0)
        {
          warn sprintf $errs{PUT_FAILED}{MSG},
            ("worker_put",$file);
          warn "$out{$file}{MSG}\n";
        }
      }

      # or, if transfer succeeds and
      #    1. "-t tarfile" is used with save=0, or
      #    2. "-t tarfile" is not used and delete=1,
      # then prepare to delete local file.
      #
      elsif ( ($opts{tar} ne "" && $opts{save}==0  )
           || ($opts{tar} eq "" && $opts{delete}==1) )
      {

        # Delete local copy of file only if local and remote files are
        # the same.
        #
        if (site_files_are_same($user, $host, $file, "$path/$file"))
        {
          `/bin/rm -f $file 2>&1`;
        }
        else
        {
          # This error message should reflect file mismatch, not size
          # mismatch per se.   --MJG
          $line = sprintf $errs{SIZE_MISMATCH}{MSG},
            ("worker_put",$file);
          $out{$file}{MSG}=$line;
          $out{$file}{VAL}=$errs{SIZE_MISMATCH}{VAL};
          if ($opts{silent}==0) { warn $line; }
        }
      }

      # Increment $try counter.
      $try++;

      # If put failed, sleep for (5 + 2 * $try) seconds
      if ($try<$opts{retry} && $out{$file}{VAL}!=0)
      {
        sleep 5+2*$try;
      }
      # or, if we succeeded, set success flag to terminate "while" loop.
      else
      {
        $success="yes"
      }
    }

    # If migrate=1, then migrate remote file off-line in background.
    if ($opts{migrate}==1)
    {
      site_migrate($user, $host, $path.$file) ;
    }
  }

  # Return
  #
  # [This comment is entirely redundant with the code,
  #  so either explain it in English or omit the comment.  --MJG]
  return (\%opts,\%out);
}




sub worker_ls
{

=pod

NAME
  worker_ls: List full pathnames indicated by string $args2 on $host="local"


USAGE
  %out -- worker_ls(\%opts,$host,$args,\%errs);


ARGUMENTS
  %opts -- command-line options; see archive.pm:set_default_opts()
  $host -- name of asf host; see archive.pm:archive_ls()
  $args -- white-space separated string of pathnames
  %errs -- error-message list; see archive.pm:define_error_table()


RETURN VALUE
  %out -- hash with KEY's VAL and MSG.
      The VALUE for VAL is set to the exit status integer value of the
      `/bin/ls` command.

      The VALUE for MSG is set to the standard output string for
      `/bin/ls`.


VARIABLES
  SCALARS
    $opts -- reference to input hash %opts; also set to options for
        `/bin/ls`
    $errs -- reference to input hash %opts


AUTHOR
  Written by Joe Werne and Michael J. Gourlay


HISTORY
  This history list is no longer maintained.  See CVS logs.

  6-10-2001: Joe Werne
    1. add LOCAL+LOCAL ... comment statements
    2. add $host to arguments passed.

  7-11-2001: Joe Werne
    1. expanded header comments

=cut

  # Unpack arguments from ARGS array.
  my ($opts,$host,$args,$errs)=@_;

  # Dereference hash variables from references in arguments
  my (%opts)=%$opts;
  my (%errs)=%$errs;

  # Declare local variables
  my (%out);
  my ($message);
  my ($status);

  my ($user)=$opts{HOST}{$host}{USER};

  # Set command line options for site-specific directory listing command
  if ($opts{lsopts} eq "")
  {
    $opts=""
  }
  else
  {
    $opts="-$opts{lsopts}"
  };

  # Perform site-specific directory listing
  ($message,$status) = site_ls($user, $host,$opts,$args);

  $out{MSG} = $message;
  $out{VAL} = $status / 256;

  return %out;
}




sub worker_get
{

=pod

NAME
  worker_get: Retrieve data from the archival storage facility.


EXAMPLE
  (\%opts,\%out) = worker_get(\%opts,$host,\@args,\%errs);


INPUT
  %opts -- command-line options;      (see set_default_opts())
  $host -- ASF hostname;              (see archive_get())
  @args -- list of files to retrieve; (see archive_get())
  %errs -- error-message list;        (see define_error_table())


OUTPUT
  %opts -- updated %opts ($opts{fatal} possibly incremented).

  %out -- of form $out{$file}{VAL} and $out{$file}{MSG},
      where each "$file" key is an element of the input list @args.

      Associated with each such $file entry are these keys: VAL and MSG.

      The value associated with the VAL key is the exit code integer
      value for "site_get".  This value is

        () 0 (zero) if site_get succeeded,

        () $errs{GET_FAILED}{VAL} if site_get failed,

        () or $errs{SIZE_MISMATCH}{VAL} if site_get claims to have
           succeeded, but the local and remote file sizes do not match.

      The value associated with the MSG key is the standard output
      string from the successful file-transfer operation,
      $errs{GET_FAILED}{MSG} or $errs{SIZE_MISMATCH}{VAL}, depending on
      the exit status.



OPTIONS
  $opts{silent}, $opts{migrate}, $opts{nowait}*,

  where * denotes options that are note yet implemented.


VARIABLES
  ARRAYS
    @files -- list of files in $line; @files is edited to remove
        all directories.

    @links -- list of symbolic links encountered in $line; ideally
        @links will contain no elements because we are able to identify
        which links are files (and therefore store them with @files).
        for example, when Perl's -d test operator is used, @links will
        be empty because -d determines if a link is a directory or a
        file, regardless the number of links which must be traversed.
        when we are unable to determine which links point to directories
        and which point to files, we will try to transfer the elements
        in @links, but we will not repeat our attempts for $opts{retry}
        times.  instead we will only make 3 attempts.

    @list -- list of files to transfer.  @list is first set to @files
        so that each of the files identified by the elements of @files
        can be transferred.  @list is next set to @links so we may
        attempt to transfer the elements of @links (which we hope are
        plain files, but which may be directories, which we will not
        be able to transfer).


  SCALARS
    $args -- reference for input array @args

    $errs -- reference for input hash %errs

    $file -- set to each element of @args

    $remoteFile -- set to each element of @list when transferring files.
        $remoteFile is the remote file name on the asf host.  $remoteFile is
        also used as a temporary variable when removing directories
        from @files.

    $home -- string set to user root directory on asf $host

    $i -- index set to 0 when attempting to transfer files identified
        by @files.  $i is set to 1 when attempting to transfer files
        in @links.

    $line -- string set to the output from `/bin/ls -ld $path$file`;
        this string is edited to obtain a list of files to transfer
        from the asf.

    $localFile -- local file name for $remoteFile being transferred

    $localSize -- once transfer has succeeded, then the local file
        size is compared with the size of the file on the remote asf
        host.  $localSize is set to the size of the local file.

    $opts -- reference for input hash %opts

    $path -- full-path version (begins with "/") of $opts{path}

    $r -- number of retry attempts.  $r=$opts{retry} when we are
        attempting to transfer files which we know are plain files.
        when files are symbolic links and we cannot be sure that they
        are not directories, then $r=3.

    $remoteSize -- set to the size of the file on the asf host.  see
        $localSize above.

    $success -- string set to "no" while transfer attempts have not
        yet succeeded or "yes" if transfer is successful.

    $try -- counter for retry attempts to transfer files;


NOTES
  worker_get() is called by archive_get().  worker_get() retrieves a set
  of files in $opts{path} on the archival storage facility to the
  current working directory.

  For the TEST version of local.pm, we assume that the local system is
  unix-like, and we use common unix utilities.  worker_get works like cp.

  Source directory existence and permissions and target existence and
  permissions should be checked by archive_get() before calling this
  routine.  Therefore, this routine does not need to quibble with
  permissions, etc., and the $opts{force}=1 option is implied.

  If this routine fails in successfully transferring the data, it
  retries for a number of times ($r).  If we are certain the remote
  files are plain files, this routine makes $r=$opts{retry} attempts.
  If the remote files are symbolic links, and therefore we cannot be
  certain they are plain files (they may be directories), then this
  routine makes $r=3 attempts.


AUTHOR
  Written 2001 by Joe Werne, Michael J. Gourlay


HISTORY
  Ths history list is no longer maintained.  See CVS logs.

  6-11-2001: Joe Werne
    1. check for wildcard in remote file name specification. If present,
       expand wildcards with site_ls.

  6-12-2001: Joe Werne
    1. identify two ways to detect symbolic links when wildcards are
       used on the remote system: Perl's (-d file) test and parsing
       "ls -l" output.  only attempt three tries at getting symbolic
       link files, as they may be directories, and we don't want the
       loop to continue $opts{retry} times.

  7-11-2001: Joe Werne
    1. expanded header comments

=cut

  use SET::Set;
  use File::Basename;

  # Accept arguments to this subroutine.
  my ($optsRef,$host,$argsRef,$errsRef)=@_;

  # Dereference hashes and arrays from references in arguments.
  my (%opts)=%$optsRef;
  my (@args)=@$argsRef;
  my (%errs)=%$errsRef;

  # Declare local variables
  my ($argName);
  my ($try);
  my (%out);
  my ($file);
  my (@files);
  my ($line);
  my ($success);
  my ($path);
  my ($remoteFile);
  my ($localFile);
  my ($localSize);
  my ($remoteSize);
  my ($links);
  my (@links);
  my ($list);
  my (@list);
  my ($i);
  my ($e);
  my ($home);
  my ($user);
  my ($r);

  # Define $path:
  $path=$opts{path};
  $home=$opts{HOST}{$host}{HOME};
  $user=$opts{HOST}{$host}{USER};

  # If $opts{path} does not start with "/", prepend with $home.
  if ($path !~ /^\//)
  {
    $path="$home$path";
  }

  #the error message here needs to be fixed somewhat (don't mention -p) [CB].
  #check for path to get files from.
  if (! site_directory_exists($user,$host,$path)){
    $opts{fatal}++;
    foreach $file (@args){
      $out{$file}{VAL}=$errs{MISSING_TARGET}{VAL};
      $out{$file}{MSG}=$errs{MISSING_TARGET}{MSG};
    }
    if ($opts{silent}==0) {
      warn sprintf $errs{MISSING_TARGET}{MSG},
       ("archive.pm:archive_get",$opts{path});
    }
    return (\%opts,\%out);
  }

  # Unglob all the files and end up with the list of properly pathed files
  # in @files.  From this code (which I moved, but didn't really modify),
  # it appears that there is no way for @links to come out with any value.
  # What's going on with links? [CB]
  foreach $file (@args)
  {

    # Look for glob pattern wildcards in $file
    if ($file =~ /\*|\?|\[/)
    {
      $list = site_unglob_files($user, $host, $path, $file);
      @list = split /\n/,$list;
      push (@files,@list);
    }
    else
    {
      push (@files,"$path$file");
    }

  }

  # loop over files
  foreach $remoteFile (@files)
  {

    #worry about links
    if (site_link_exists($user,$host,$remoteFile))
    {
       $remoteFile = resolve_link($user,$host,$remoteFile);
    }


    #now that links are resolved, get the file.
    if (site_file_exists($user,$host,$remoteFile))
    {
      # Define local file name
      $localFile = basename($remoteFile);

      # Define argument name
      $argName =  $remoteFile;
      $argName =~ s/^$path//;

      # Set the file flag to $errs{RETRY}{VAL}
      $out{$argName}{VAL}=$errs{RETRY}{VAL};
      $out{$argName}{MSG}=$errs{RETRY}{MSG};

      # Try for $r number of attempts
      $try=0;
      $success="no";
      while ($success ne "yes")
      {
        ($line, $e) = site_get($user, $host, $remoteFile);

        # Assign return codes from getting this file.
        $out{$argName}{MSG}=$line;
        $out{$argName}{VAL}=$e;

        # If transfer failed, report error message.
        if ($e != 0)
        {
          $out{$argName}{VAL}=$errs{GET_FAILED}{VAL};
          if ($opts{silent}==0)
          {
              warn sprintf $errs{GET_FAILED}{MSG},
                ("worker_get",$argName);
              warn "$out{$argName}{MSG}\n";
          }
        }
        else
        {
          # or, if exit status indicates transfer succeeded, verify
          # files are the same, just to be sure.
          if(!site_files_are_same($user, $host, $localFile, $remoteFile))
          {
            # This error message should reflect file mismatch, not size
            # mismatch per se.   --MJG
            $line = sprintf $errs{SIZE_MISMATCH}{MSG},
              ("worker_get",$remoteFile,$remoteSize,$localSize);
            $out{$argName}{MSG}=$line;
            $out{$argName}{VAL}=$errs{SIZE_MISMATCH}{VAL};
            if ($opts{silent}==0)
            {
              warn $line;
            }
          }
        }

        # Increment $try counter
        $try++;

        # if get failed, sleep for several seconds
        if ($try<$r && $out{$argName}{VAL}!=0)
        {
          sleep 5+2*$try;
        }
        else
        {
          # or, if we succeeded, set succeed flag to exit while loop.
          $success="yes"
        }
      }

      # if migrate=1, then migrate remote file off-line in background.
      if ($opts{migrate}==1)
      {
        # `dmput -r $remoteFile`
        site_migrate($user, $host, $remoteFile);
      }
    }
    else
    {
      # There's a problem with args/out that comes up with unglobbing:
      # args is the input list of file names.  It can have globbed files.
      # They get unglobbed here.  Then, there may be an error associated
      # with only one of those files (it's a link; it's a directory).
      # The out hash table only has a keys that correspond to the initial
      # (globbed) arguments, so we lose some granularity on the error
      # reporting. [CB]
      warn sprintf $errs{MISSING_FILES}{MSG},("archive.pm:archive_get");
      if ($opts{silent}==0) {
        warn "     $remoteFile\n";
      $out{$localFile}{VAL}=$errs{MISSING_FILES}{VAL};
      $out{$localFile}{MSG}=$errs{MISSING_FILES}{MSG};
      $opts{fatal}++;
      }
    }
  }

  # Return
  #
  # [This comment is entirely redundant with the code,
  #  so either explain it in English or omit the comment.  --MJG]
  return (\%opts,\%out);
}





sub resolve_link{

=pod
  NAME
    resolve_link:  Follow a (remote) link to a file, a directory, or nothing.


  USAGE
    $resolved = resolve_link($user,$host,$link);


  ARGUMENTS
    $user:

    $host: host where new directory will exist.

    $link: the link to resolve.


  RETURN VALUES
    $resolved: A file or directory that is (directly or indirectly) pointed
       to by $link, or an empty string (signifying an error, such as
       circular links).  This function does not verify that the returned
       file actually exists or that it is a file instead of a directory
       -- these are up to the caller.

  NOTES
     We want to watch out for things like circular links.  Here, we
     do so by simply counting the number of links we traverse to get
     to the end.  If we go past some set value (here 1000), we
     It appears that cp (at least on linux) doesn't maintain a stack of
     links and check, but simply has a cutoff # of links it will traverse.
     This appears to be how cp handles this (at least under linux).
     archive will fail if there are more than 1000 legitmate links  in
     a row, but if that's the case, the user has bigger problems than
     archive not working.

=cut


  my ($user,$host,$link)=@_;   # the use, the remote host, and the remote link
  my ($counter) = 0;           # number of times we've followed a link.
  my ($maxcount) = 1000;       # maximum number of times we'll go down a link

  #follow links till we get to something that isn't a link or we've
  #gone down $maxcount of them.
  do
  {
     $link = site_follow_link($user,$host,$link);
     $counter++;
  } while (link_exists($user,$host,$link) && $counter < $maxcount);

  #if we exited because we went down too many links, set the return value
  # to something that won't exist.
  if ($counter >= $maxcount){ $link = ""; }

  return $link;

}




sub make_one_remote_dir
{
=pod
  NAME
    make_one_remote_dir:  Make a single directory on the ASF.


  USAGE
    ($message,$status) = 
       make_one_remote_dir($user,$host,$directory,$mode,$b_parent);

  ARGUMENTS
    $user: user in whose file space a directory is being made
    $host: host where new directory will exist.
    $directory: the directory to create.
    $mode: the octal mode with which to create the directory.
    $b_parent: a boolean (1 or 0).  If 1, create parent directories.


  RETURN VALUES
    $message: the output from the local creation command for the
                  lowest level directory

    $status: the status from the local creation command


  NOTES
    We do not want to saddle local.pm with the problem of making or  
    checking the existence of a parent directory for one we are about
    to make.  When asked to make a directory, this function checks to 
    see if its parent exists.  If it doesnt, and b_parent is 1, then 
    it creates that directory by a recursive call to 
    make_one_remote_dir($$$$), and then makes the present directory in 
    the parent.

=cut

  # Unpack subroutine arguments from ARGS array
  my($user, $host, $directory, $mode, $b_parent) = @_;

  # Declare local variables
  my ($parentDir);
  my ($message);
  my ($status);

  $parentDir = head($directory);

  #if the parent is not there, but we are allowed to make it, do so.
  if (!site_directory_exists($user, $host, $parentDir) && $b_parent)
  {
    make_one_remote_dir($user,$host,$parentDir,$mode,$b_parent);
  }

  #make this directory assuming that the parent exists (we just made it).
  ($message,$status) = site_mkdir($user, $host, $directory, $mode);

  return ($message,$status);
}




sub head
{
=pod
 Given a string that has a directory or filename, return its head:
 Examples
   head("a/b/c/")
   head("a/b/c")
  both return "a/b"

 INPUT: $directory: the string to be headed

 OUTPUT: $match[0]: the head

=cut
  my ($directory) = @_;
  my ($copy,$lastchar,@match);

  #if the last char is /, remove it
  $copy = $directory;
  $lastchar = chop $copy;
  if ($lastchar eq "/")
  { $directory = $copy; }

  # find the largest substring in $directory that ends in / and return it.
  # m: match, .*: largest string starting with anything ?=/: ends in / g:return
  @match = ($directory =~ m(.*(?=/))g);

  return $match[0];
}




sub archive_stat
{

=pod

NAME
  archive_stat: Check status of archival storage facilities
                listed in keys %{$opts{HOST}}.


EXAMPLE
  %out = archive_stat(\%opts,$host,\%errs);


INPUT
  %opts -- command-line options; see set_default_opts()
  $host -- archival storage facility to probe; see archive_ls()
  %errs -- error-message list; see define_error_table()


OUTPUT
  %out -- nested hash with a single KEY set to $host.  When archive_stat
      is complete, additional KEY's will exist for all hosts specified
      by the -asf option, or, if -asf is not present, then KEY's will
      exist for all hosts indicated by the %{$opts{HOST}} hash.  See
      comment statements re $host in archive_ls().  Each KEY (for now
      there is only one) points to KEY's VAL and MSG.  The VALUE for VAL
      is the exit code for the "archive stat" operation, 0 if the system
      is up or $errs{RETRY}{VAL} if the system is down.  The VALUE for
      MSG is the last output prepared for STDOUT (see NOTES below) from
      archive_stat().


VARIABLES

  HASHES
    %report -- hash containing output messages in KEY => VALUE pairs.
        KEY "up" has associated VALUE "on-line"; KEY "down" has VALUE
        "unavailable".

  ARRAYS
    @host -- list of hosts identified by the keys of %{$opts{HOST}}

  SCALARS
    $errs -- reference for input hash %opts
    $fhost -- string of comma-separated list of the elements of @host.
        $fhost is needed for a possible error message.
    $form -- format string for output to STDOUT
    $hour -- 3rd element returned by localtime
    $line -- output prepared using $form for STDOUT
    $mday -- 4th element returned by localtime
    $min -- 2nd element returned by localtime
    $mon -- 5th element returned by localtime + 1
    $opts -- reference for input hash %opts
    $report -- set to $report{up} if the system is up or $report{down}
        if the system is down.
    $s -- optional note for $line; see "archive" man page (also included
        as comments in bin/archive.
    $sec -- 1st element returned by localtime
    $success -- string set to "no" while system is found to be
        unavailable or "yes" if the system is up.
    $try -- counter for retry attempts to check system status;  if
        the system is down, archive_stat() will check its status
        $opts{retry} times until the system is up.
    $year -- 6th element returned by localtime + 1900


NOTES
  archive_stat prints the output string:

  hh:mm:ss mm/dd/yyyy status [note]

  status is either "on-line" or "unavailable" and is printed after the
  date reported by the system from which archive_stat was invoked.

  Currently archive_stat() is conducted the retry attempts (up to
  $opts{retry} times).  This really should be moved out of local.pm,
  so new developers don't have to look at so much Perl.


AUTHOR
  Written by Joe Werne, Michael J. Gourlay


HISTORY
  This history list is no longer maintained.

  6-9-2001: Joe Werne
    1. add $out{$host}{MSG} to output
    2. introduce $success so $try-while test is only at bottom of block

  6-11-2001: Joe Werne
    1. prepare message outside of silent-test

  7-11-2001: Joe Werne
    1. expanded header comments

=cut

  # Extract arguments from ARGS array
  my ($opts,$host,$errs)=@_;

  # Dereference argument hash variables
  my(%opts)=%$opts;
  my(%errs)=%$errs;

  # Declare local variables
  my (%out);
  my (@host);
  my ($fhost);
  my (%report);
  my ($report);
  my ($s);
  my ($try);
  my ($sec);
  my ($min);
  my ($hour);
  my ($mday);
  my ($mon);
  my ($year);
  my ($form);
  my ($line);
  my ($success);
  my ($day);

  ##################
  $report{up}  ="on-line";
  $report{down}="unavailable";
  $form        ="%2.2d:%2.2d:%2.2d %2.2d/%2.2d/%4.4d %s %s %s\n";

  # Check hosts
  # -----------

  # Get host list from %opts.
  @host = keys %{$opts{HOST}}; $fhost=join ", ",@host;

  # Initiate $host flag to RETRY.
  $out{$host}{VAL}=$errs{RETRY}{VAL};

  # Try up to $opts{retry} times
  $try=0;
  $success="no";
  while ($success ne "yes")
  {
    if (TUSC::local::site_archive_system_is_up($host, $opts{HOST}{$host}{HOME}))
    {

      $report=$report{up};
      $out{$host}{VAL}=0;
    }
    else
    {
      $report=$report{down};
    }

    # Prepare output message
    ($sec,$min,$hour,$mday,$mon,$year)=(localtime)[0,1,2,3,4,5];
    $year=$year+1900;
    $mon=$mon+1;
    $s="";
    $line = sprintf $form,
      ($hour,$min,$sec,$mon,$day,$year,$host,$report,$s);

    # Print output message to STDOUT.
    #
    # For the TEST version of archive_stat, it seems prudent to make
    # stat failures verbose.  Print first attempt only if
    # $opts{silent}==0.  Print output for all subsequent attempts,
    # regardless the value of $opts{silent}.
    if ($opts{silent}==0 || $try>0)
    {
      print $line;
      if ($report eq $report{down})
      {
        print "Does $opts{HOST}{$host}{HOME} exist?\n";
      }
    }

    $try++;
    if ($out{$host}{VAL}!=0 && $try<$opts{retry})
    {
      sleep 5+2*$try;
    }
    else
    {
      $success="yes"
    }
  }
  $out{$host}{MSG}=$line;

  return %out;
}


sub get_nonexistent_files{

  #
  # Passed in a list of files to check the existence of.
  # Pass back a list that contains the files that don't exist.
  #

  my (@filestocheck) = @_;
  my (@nonexistent);
  my ($currentfile);

  foreach $currentfile (@filestocheck){
    if (! -e $currentfile){
       push @nonexistent,$currentfile;
    }
  }

  return @nonexistent;

}


# [What does this "1" do and mean? I suspect it simply evaluates to "1",
# so that this module can execute and return a value,
#  but for what purpose?  Document this.  --MJG]

1;

# [What does this "__END__" do and mean?  Document this.--MJG]

__END__
