#!/usr/bin/perl

=pod

This is the TEST distribution of local routines for the TUSC layer of
the PST toolkit (www.pstoolkit.org).

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. local_get subroutine added
    3. other subroutines modfied according to their history statements
    4. include LOCAL+LOCAL and local-local to identify regions that MUST
       by updated for site-specific implementation
                
=cut

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

package TUSC::local;

use Exporter;
@ISA = "Exporter";
@EXPORT = qw(local_env archive_mkdir local_put local_get archive_stat local_ls);

$VERSION = "0.02";

#============================================================== LOCAL_LS

sub local_ls 
{

=pod

list full pathnames indicated by string $args2 on $host="local"

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

INPUT
  %opts = command-line options
  $host = name of archival storage system
  $args = white-space separated string of pathnames
  %errs = error table

OUTPUT
  %out  = hash of form $out{VAL}=exit status; $out{MSG}=ls output.

NOTES

AUTHOR
  Written 6-2001 by Joe Werne    

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

=cut

#------------------------------------------------------- scope variables
  my (%opts,%errs,%out);

#------------------------------------------------------------ read input
  my ($opts,$host,$args,$errs)=@_;

#----------------------------------------------------- dereference input
  %opts=%$opts; %errs=%$errs;

#------------------------------------------------------------ Perform ls
  if ($opts{lsopts} eq "") {$opts=""} else {$opts="-$opts{lsopts}"};

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
##if ($host eq "local")
  {
    $out{MSG}=`/bin/ls $opts $args 2>&1`; $out{VAL}=$?;                #
  }                                                                    #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

#---------------------------------------------------------------- Return
  return %out;

}

#============================================================= LOCAL_PUT

sub local_put 
{ 

=pod

Move data to the archival storage system.  

EXAMPLE
  (\%opts,\%out) = local_put(\%opts,\@args,\%errs);

INPUT
  %opts = command-line options
  @args = list of files to transfer
  %errs = error-message list

OUTPUT
  %opts = updated %opts ($opts{fatal} possibly incremented).
  %out  = output hash of form $out{$file}{VAL} and $out{$file}{MSG}, 
          where each key is an element of the input list @args.  VAL
          reports the exit status.  MSG reports STDOUT/STDERR.

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

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

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

  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 force=1 option is
  implied.

AUTHOR
  Written 6-2001 by Joe Werne    

HISTORY
  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, checked to see if $path exists.  if not, 
       set $try to $opts{retry} so you'll jump out of while-loop.
  
=cut

#------------------------------------------------------- scope variables
  my (%opts,@args,%errs,@hosts,$host,$try,%out,%opts2,%out2,%args2);
  my ($files,$lines,$file,@file,@lines,$line,$success,$out2);
  my ($local_size,$remote_size);

#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;

#----------------------------------------------------- dereference input
  %opts=%$opts; @args=@$args; %errs=%$errs;


#---------------------------------------- identify host from $opts{HOST}
# use host specified by $opts{DEFAULT_HOST}. note: this variable is set
# in default_opts, but can be overwritten by parse_input with the -a
# 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="msas2:$home$path"
  }

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
#  for $host="local" <= if block included in case there is more than   #
#  one ASF at your site.                                               #
#                                                                      #
##if ($host eq "local")
  {
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

#   consider each argument in turn.
    foreach $file (@args) {

#     first set the file flag to $errs{RETRY}{VAL}
      $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") {

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
#   use /bin/cp rather than perl's "rename", because "rename" does     #
#   not work across file systems.  collect exit status with $e.        #
#                                                                      #
#####   $line=`/bin/cp -f $file $path 2>&1`; $e=$?/256;                #
        print "/usr/bsd/rcp $file $path ## home is $home\n" ;
        $line=`/usr/bsd/rcp $file $path 2>&1`; $e=$?/256;
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

#       assign values for MSG and VAL.
        $out{$file}{MSG}=$line; $out{$file}{VAL}=$e;

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

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
#    If failure resulted because the destination directory does not    #
#    exist, don't try again.                                           #
#                                                                      #
          if (! -d $path) { $try=$opts{retry} }                        #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

          if ($opts{silent}==0) {
            warn sprintf $errs{PUT_FAILED}{MSG}, 
              ("local.pm:local_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) )  { 

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
#         delete only if files are same size                           #
#                                                                      #
          $local_size = -s $file;                                      #
          $remote_size= -s "$path$file";                               #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

          if ($local_size==$remote_size) {
            `/bin/rm -f $file 2>&1`;
          } 
          else {
            $line = sprintf $errs{SIZE_MISMATCH}{MSG},
              ("local.pm:local_put",$file,$remote_size,$local_size);
            $out{$file}{MSG}=$line;
            $out{$file}{VAL}=$errs{SIZE_MISMATCH}{VAL};
            if ($opts{silent}==0) { warn $line; }
          }
        }

#       increment $try
        $try++;

#       if we failed, sleep for 5 + 2 * $try seconds
        if ($try<$opts{retry} && $out{$file}{VAL}!=0) {sleep 5+2*$try;}

#       or, if we succeeded, set succeed flag
        else {$success="yes"}
      }

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
#    if migrate=1, then migrate remote file off-line in background.    #
#                                                                      #
#     if ($opts{migrate}==1) { `dmput -r $path$file` }                 #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 
    }
  }
#---------------------------------------------------------------- return
  return (\%opts,\%out);
}

#============================================================= LOCAL_GET

sub local_get 
{ 

=pod

Retrieve data from the archival storage system.  

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

INPUT
  %opts = command-line options
  $host = ASF host
  @args = list of files to retrieve
  %errs = error-message list

OUTPUT
  %opts = updated %opts ($opts{fatal} possibly incremented).
  %out  = output hash of form $out{$file}{VAL} and $out{$file}{MSG}, 
          where each key is an element of the input list @args.  VAL
          reports the exit status.  MSG reports STDOUT/STDERR.

OPTIONS
  silent, migrate, *nowait, where * denotes options that are note yet 
  implemented.

NOTES
  local_get is called by archive_get.  local_get retrieves a set of 
  files in $opts{path} on the archival storage system 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.  local_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 force=1 option is implied.

AUTHOR
  Written 6-9-2001 by Joe Werne    

HISTORY
  6-11-2001: Joe Werne
    1. check for wildcard in remote file name specification. If present,
       expand wildcards with local_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.
  
=cut

  use SET::Set;
#------------------------------------------------------- scope variables
  my (%opts,@args,%errs,@hosts,$host,$try,%out,%opts2,%out2,%args2);
  my ($files,$lines,$file,@files,@lines,$line,$success,$opts2,$out2);
  my ($path,$file1,$localfile,$local_size,$remote_size,@links,@list);
  my ($i);

#------------------------------------------------------------ read input
  my ($opts,$host,$args,$errs)=@_;

#----------------------------------------------------- dereference input
  %opts=%$opts; @args=@$args; %errs=%$errs;

#---------------------------------------------------------- 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"}

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
#   if $host="local" <= if block included in case there is more than   #
#   one ASF at your site.                                              #
#                                                                      #
##if ($host eq "local")
  {
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

#   consider each argument in turn.
    foreach $file (@args) {

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL 
#                                                                      #
#     look for wildcards in $file ...                                  #
#                                                                      #
      if ($file =~ /\*|\?|\[/) {                                       #
#                                                                      #
#       if wildcards are present, list remote files for matches,       #
#                                                                      #
        $line=`/bin/ls -ld $path$file`;                                #
#                                                                      #
#       next remove identified directories by removing all lines that  #
#       start with "d"                                                 #
#                                                                      #
        $line=~s/^d.*\n//gm;                                           #
#                                                                      #
#       now, this didn't get rid of ALL the directories, because       #
#       some may by symbolic links to directories.  there are two      #
#       strategies below for dealing with symbolic links.  you may     #
#       have other techniques at your site for dealing with links.     #
#       we could also write code to traverse all the links, but        #
#       that's not implemented here yet.  please use whatever          #
#       technique seems best at your site for removing symbolic links  #
#       which point to directories.                                    #
#                                                                      #
#       technique A:  Perl's (-d file) test                            #
#                                                                      #
#       0. clear @list                                                 #
        undef @list;                                                   #
#                                                                      #
#       1. extract the file names from each line of $line;             #
        $line=~s/.* ($path[^\s]+).*/$1/mg;                             #
#                                                                      #
#       2. split $line into elements for @files.                       #
        @files=split /\n/,$line;                                       #
#                                                                      #
#       3. for each element of @files, remove all directories and      #
#          symbolic links pointing to directories.                     #
        foreach $file1 (@files) {if (! -d $file1) {push @list,$file1}} #
        @files=@list; undef @links;                                    #
#                                                                      #
#                                                                      #
#       technique B:  using "/bin/ls -ld" output                       #
#                                                                      #
#       1. split $line into elements for @files.                       #
####    @files=split /\n/,$line;                                       #
#                                                                      #
#       2. separate out the links (those lines that start with "l")    #
####    @links=grep /^l/,@files;                                       #
#                                                                      #
#       3. if links are found, warn the user.                          #
####    if (@links) {                                                  #
####        warn "\n";                                                 #
####        warn "WARNING: local.pm:local_get currently does not make more\n";
####        warn "  than three attempts to transfer symbolic links because\n";
####        warn "  they may be directories.\n\n";                       #
####     }                                                             #
#                                                                      #
#       4. now remove the links from @files                            #
####    $line=join "\n",@files;                                        #
####    $line=~s/^l.*\n//gm;                                           #
#                                                                      #
#       5. of what remains, save the file name and split into @files   #
####    $line=~s/.* ($path[^\s]+).*/$1/mg;                             #
####    @files=split /\n/,$line;                                       #
#                                                                      #
#       6. do the same for the links                                   #
####    $line=join "\n",@links;                                        #
####    $line=~s/.* ($path[^\s]+).*/$1/mg;                             #
####    @links=split /\n/,$line;                                       #
#                                                                      #
#     now we have two lists @files and @links.  we attempt to get the  #
#     @files $opts{retry} times, but we only try the @links 3 times.   #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

      }                                                                #

#     if there are no wildcards, assume the user did not attempt to
#     get a file which is a link to a directory.
      else {
        @files = ($file);
        undef @links;
      }
        
#     attack @files and @links separately, start with @files
      for ($i==0; $i<2; $i++) {
        if ($i==0) { @list=@files; $r=$opts{retry}; }
        elsif ($i=1) { @list=@links; $r=3; }

#       consider each match separately
        foreach $file1 (@list) {

#         define local file name
          $localfile = TAIL($file1);

#         define argument name
          $args = $file1;
          $args =~ s/^$path//; 

#         first set the file flag to $errs{RETRY}{VAL}
          $out{$args}{VAL}=$errs{RETRY}{VAL};
          $out{$args}{MSG}=$errs{RETRY}{MSG};

#         try for $r number of attempts
          $try=0; $success="no";
          while ($success ne "yes") {

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#  use /bin/cp rather than perl's "rename", because "rename" does not  #
#  work across file systems.  collect exit status with $e.             #
#                                                                      #
#######     $line=`/bin/cp -f $file1 . 2>&1`; $e=$?/256;               #
            print "/usr/bsd/rcp msas2:$home$file1 . ## home is $home\n" ;
            $line=`/usr/bsd/rcp msas2:$home$file1 . 2>&1`; $e=$?/256;
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

#           assign values for MSG and VAL.
            $out{$args}{MSG}=$line; $out{$args}{VAL}=$e;

#             if transfer failed, print error message.
              if ($e != 0) {
                $out{$args}{VAL}=$errs{GET_FAILED}{VAL};
                if ($opts{silent}==0) {
                  warn sprintf $errs{GET_FAILED}{MSG}, 
                    ("local.pm:local_get",$args);
                  warn "$out{$args}{MSG}\n";
                }
              }
              else {

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#  or, if exit status indicates transfer succeeded, check file sizes   #
#  to be sure.                                                         #
#                                                                      #
                $local_size = -s $localfile;                           #
                $remote_size= -s "$file1";                             #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

                if ($local_size!=$remote_size) {
                  $line = sprintf $errs{SIZE_MISMATCH}{MSG},
                    ("local.pm:local_get",$file1,$remote_size,$local_size);
                  $out{$args}{MSG}=$line;
                  $out{$args}{VAL}=$errs{SIZE_MISMATCH}{VAL};
                  if ($opts{silent}==0) { warn $line; }
                } 
              }

#             increment $try
              $try++;

#             if we failed, sleep for 5+2*$try seconds
              if ($try<$r && $out{$args}{VAL}!=0) {sleep 5+2*$try;}

#           or, if we succeeded, set succeed flag
            else {$success="yes"}
          }

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#     if migrate=1, then migrate remote file off-line in background.   #
#                                                                      #
#         if ($opts{migrate}==1) { `dmput -r $file1` }                 #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

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

#========================================================= ARCHIVE_MKDIR

sub archive_mkdir 
{

=pod

Make directories on the archival storage system.  

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

INPUT
  %opts = command-line options
  %args = command-line arguments
  %errs = error-message list

OUTPUT
  %opts = updated command-line options
  %out  = output hash of form $out{$file}{VAL} and $out{$file}{MSG}, 
          where each key is an element of the input list @args.  VAL
          reports the exit status.  MSG reports STDOUT/STDERR.

OPTIONS
  mode*, parent, silent

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

NOTES
  Since TEST's archival storage system is just a unix file system, mkdir
  works in the usual way.

AUTHOR
  Written 6-2001 by Joe Werne    
  
HISTORY
  6-9-2001: Joe Werne
    1. set $out{$dir}{VAL} and $out{$dir}{MSG} correctly
    2. hold archive_stat output in %out2

=cut

#------------------------------------------------------- scope variables
  my (%opts,%args,%errs,@hosts,$host,%out,$nhosts,$fhost,%opts2);
  my (%out2,$out2);

#------------------------------------------------------------ read input
  my ($opts,$args,$errs)=@_;

#----------------------------------------------------- dereference input
  %opts=%$opts; %args=%$args; %errs=%$errs;

#-------------------------------------------------- obtain list of @args
  @args=keys %args;

#-------------------------------- identify host from $opts{DEFAULT_HOST}
  $host=$opts{DEFAULT_HOST};

#------------------------------------------------- make sure $host is up
# wait for $host to become available (controlled by $opts{retry})
  %opts2=%opts; $opts2{silent}=1;
  %out2 = archive_stat(\%opts2,$host,\%errs);

# if host is up ...
  if ($out2{$host}{VAL}==0) {
 
#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#   if $host="local" ... (Just in case you have more than one ASF),    #
#   then set options for mkdir                                         #
#                                                                      #
##  if ($host eq "local")
    {
      if ($opts{parent}==1) { $opts="-p -m $opts{mode}" }              #
      else { $opts="-m $opts{mode}" }                                  #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

#     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"}
 
#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#       create $path                                                   #
#                                                                      #
        $line = `mkdir $opts $path 2>&1`; $e=$?/256;                   #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

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

#       print feedback to user
        if ($opts{silent}==0 && $line ne "") {
          warn $line;
        }
 
#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#       if path is not a directory, print message; increment fatal.    #
        if (! -d $path) {                                              #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

          $opts{fatal}++;
          $out{$dir}{VAL}=$errs{MKDIR_FAILED}{VAL};
          if ($opts{silent}==0) { 
            warn sprintf $errs{MKDIR_FAILED}{MSG},
              ("local.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}=$out2{$host}{MSG};
    }
    if ($opts{silent}==0) {
      sprintf $errs{HOST_DOWN}{MSG},
        ("local.pm::archive_mkdir",$host,$out2{$host}{MSG});
    }
  }

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

}

#========================================================== ARCHIVE_STAT

sub archive_stat
{

=pod

Check the status of the archival storage systems listed in 
keys %{$opts{HOST}}.  

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

INPUT
  %opts = command-line options
  $host = archival storage system to prope
  %errs = error table

OUTPUT
  %out  = output hash of form $out{$host}{VAL}, where keys $host
          identify the archival storage system, and VAL=0 if the
          system is up or $errs{RETRY}{VAL} if the system is down.
          $out{$host}{MSG} returns the last STDOUT from archive_stat.

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.

AUTHOR
  Written 6-7-2001 by Joe Werne    

HISTORY
  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
  
=cut

#------------------------------------------------------- Scope variables
  my (%opts,%out,%errs,$host,@host,$fhost,%report,$report,$s,$try);
  my ($sec,$min,$hour,$mday,$mon,$year,$form,$line);

#------------------------------------------------------- Read input data
  my ($opts,$host,$errs)=@_;

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

#------------------------------------------------------ Define variables
  $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};

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#  "local" is our pretend archival storage system for local.pm.TEST.   #
#                                                                      #
##if ($host eq "local")
  {
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

#   try up to $opts{retry} times
    $try=0; $success="no";
    while ($success ne "yes") {

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#  since the TEST version of local.pm uses a file system for archival  #
#  storage, just see if the specified home directory is present        #
#                                                                      #
      if (-e $opts{HOST}{$host}{HOME}) {                               #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

        $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 the 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
  return %out;

}

#============================================================= LOCAL_ENV

sub local_env
{

=pod

Specify site-specific environment variables and other information.

EXAMPLE
  %out = local_env();

INPUT
  none

OUTPUT
  %out = output hash containing $out{PSTDIR}, $out{ARCHIVE_HOST}, etc.

NOTES
  PSTDIR      =location of PST root directory
  ARCHIVE_HOST=$msas
  ARCHIVE_HOME=$ARC
  ARCHIVE_PROBE="yes"

  ARCHIVE_PROBE  indicates whether or not we will attempt to check the 
  status and type of files on the archival system before and after 
  transfer.  A reason for setting ARCHIVE_PROBE="no" could be failure 
  in accurate or complete reporting of file types.

  PST_SITE="TEST"; this is not an environment variable, but rather a
  location to identify the local site name.

  PST_NOTE is not an environment variable, but is a place to communicate
  useful information to the new user about the environment variables.

  PSTDIR is set by pstinstall2 during PST installation.

  Multiple archival storage facilities can be specified by creating
  comma-separated lists (no white space) for ARCHIVE_HOST, ARCHIVE_HOME,
  and ARCHIVE_PROBE.

AUTHOR
  Written 6-2001 by Joe Werne    

HISTORY
  
=cut

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

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#   specify default $ARCHIVE_HOME                                      #
#                                                                      #
### $e{ARCHIVE_HOME}="/tmp/$USER/DATA_ARCHIVE";                        #
    $e{ARCHIVE_HOME}=$ARC;
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

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

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#   specify default $ARCHIVE_HOST                                      #
#                                                                      #
### $e{ARCHIVE_HOST}="local";                                          #
    $e{ARCHIVE_HOST}=msas2;
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

  }

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#    specify the local site                                            #
#                                                                      #
##$e{PST_SITE}="TEST";                                                 #
  $e{PST_SITE}="ASC";
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local


#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#    Specify the local site                                            #
#                                                                      #
  $e{ARCHIVE_PROBE}="yes";                                             #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

#LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL+LOCAL
#                                                                      #
#    offer a note for the user                                         #
#                                                                      #
  $e{PST_NOTE}= <<here_1;
  NOTE: See the man pages for the PST routines that use these environment
  variables.  Man pages are included in the PST distribution and are 
  available on-line at pstoolkit.org.  

  If you choose not to set these environment variables, then the 
  default values specified here will be used.  Please make sure your 
  \$ARCHIVE_HOME directory exists.

  There is no actual separate archival storage system accessed for the 
  TEST version of PST.  Unix file-system utilities are used.
here_1
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local
#---------------------------------------------------------------- Return
  return %e;

}

#============================================================== Finished

1;

__END__
