#!/usr/bin/perl

=pod

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

GENERAL NOTES FOR THE IMPLEMENTATION OF LOCAL ROUTINES

Each routine is very simple, and has the following structure.

1. Argument definition.  This is the line like:
   my($host,$path,$file) = @_
   It's turning the arguments from the caller into the local variables
   that you'll want to use, so don't mess with it.
2. A check on the hostname.  If you have multiple ASF's you might have to
   have different behavior for some of these functions, here represented
   by the (trivial) if ($host == "local") check.
3. The body. Usually a simple local command.
4. Return values as described in the comments for each subroutine.

NOTES
  This is the only file you need to edit to port the TUSC layer to your
  site.  You should make yourself familiar with every line of this file,
  but the routines below are designed so that you should only have to
  edit the code inside the blocks that are identified by LOCAL and local
  comment statements; e.g.,

#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

  If you find you need to edit more than these lines to port to your
  site, please share your code with 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 TUSC/local module

package TUSC::local;

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

$VERSION = "0.02";

<<<<<<< local.pm
#============================================================== 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; 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()

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

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

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.

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

=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 
#                                                                      #
#   The following lines store the output from the local ls command,    #
#   assumed to be located in /bin/ls.  Output from the command, using  #
#   the arguments passed by the user, is stored in $out{MSG}.  Exit    #
#   status is stored in $out{VAL}.                                     #
#                                                                      #
  if ($host eq "local") {                                              #
    $out{MSG}=`/bin/ls $opts $args 2>&1`; $out{VAL}=$?/256;            #
  }                                                                    #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local 

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

}




=======
>>>>>>> 1.10
#============================================================= LOCAL_GET

sub local_get 
{ 

=pod

Retrieve data from the archival storage facility.  

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

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

OUTPUT
  %opts -- updated %opts ($opts{fatal} possibly incremented).
  %out -- nested 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.
  %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 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.  The VALUE for MSG is the standard output 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
    $file1 -- set to each element of @list when transferring files. 
        $file1 is the remote file name on the asf host.  $file1 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 $file1 being transferred
    $local_size -- once transfer has succeeded, then the local file
        size is compared with the size of the file on the remote asf
        host.  $local_size 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.
    $remote_size -- set to the size of the file on the asf host.  see
        $local_size 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
  local_get() is called by archive_get().  local_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.  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 $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 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.
  
  7-11-2001: Joe Werne
    1. expanded header comments

=cut

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

#------------------------------------------------------------ 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 = ("$path$file");
        undef @links;
      }
        
#     attack @files and @links separately, start with @files and set 
#     the number of retry attempts to make to $r=$opts{retry}.  then
#     tackle @links, but only make $r=3 attempts.
      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;               #
#                                                                      #
#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 facility.  

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

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

OUTPUT
  %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

NOTES
  Since TEST's archival storage facility 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 %statout

  7-11-2001: Joe Werne
    1. expanded header comments; scoped all variables as my.

=cut

#------------------------------------------------------- scope variables
  my (%opts,%args,%errs,$host,%out,%statopts,%statout,@args,$dir,$path);
  my ($home,$line,$e);

#------------------------------------------------------------ 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})
  %statopts=%opts; $statopts{silent}=1;
  %statout = archive_stat(\%statopts,$host,\%errs);

# if host is up ...
  if ($statout{$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}=$statout{$host}{MSG};
    }
    if ($opts{silent}==0) {
      sprintf $errs{HOST_DOWN}{MSG},
        ("local.pm::archive_mkdir",$host,$statout{$host}{MSG});
    }
  }

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

}




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

sub archive_stat
{

=pod

Check the status of the 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 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

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

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

#------------------------------------------------------- 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 facility 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 variables.

EXAMPLE
  %e = local_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 
          local_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 local_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 local_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}="/home/bizon/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";                        #
#                                                                      #
#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";                                          #
#                                                                      #
#local-local-local-local-local-local-local-local-local-local-local-local

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

#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
#                                                                      #
#    specify the local site                                            #
#                                                                      #
  $e{PST_SITE}="TEST";                                                 #
#                                                                      #
#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 facility 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;

}




#==============================================================local_put
=pod
  local_put: put a local file on the ASF.

  inputs: $host: name of the ASF on which to put the file
          $path: directory on the ASF where the file will go
          $file: local file to be put

  outputs: $line: a string containing the stdout from the local put command
           $status: the status code returned by the local put command 
=cut
sub local_put
{

  my ($host,$path,$file)=@_;
  my ($line,$status);

  if ($host=="local")
  {
    $line=`/bin/cp -f $file $path 2>&1`; 
    $status=$?; #Perlese for the status returned by the last `` command.
  }
  
  return($line,$status);

}




#=======================================================directory_exists
=pod
  directory_exits: Determine whether a remote directory exists.

  inputs: $host: name of the ASF where the directory may exist
          $path: directory whose existence is in question

  outputs: $line: a string containing the stdout from the local put command
           $direxists: A string that contains "true" if the directory exists,
                       and "false" if it does not.
=cut

sub directory_exists
{

  my ($host,$path)=@_;
  my ($direxists);

  if ($host=="local")
  {
    if (-d $path) { $direxists = "true"; }
    else { $direxists = "false"; }
  }

  return($direxists);

}




#==========================================================get_file_size
=pod
  get_file_size: Get the size of a remote file (in bytes).

  inputs: $host: name of the ASF where the file lives.
          $path: directory on the ASF where the file lives.
          $file: name of the file to be sized.

  outputs: $size: Size of the remote file in bytes.
=cut
sub get_file_size
{

  my ($host,$path,$file)=@_;
  my ($size);

  if ($host=="local")
  {
      $size = -s "$path$file";  #perl's size checker
  }
  
  return($size);

}




#================================================================migrate

sub migrate
{

  my ($host,$path,$file)=@_;

  if ($host=="local")
  {
     print("migrate: COMMENT: Doing nothing.\n");
     print("  If this were a real archival system, this would migrate your file.\n");
  }

}

<<<<<<< local.pm



=======
#===============================================================local_ls

sub local_ls{

  my ($host,$options,$files)=@_;
  my ($message,$status};

  if ($host=="local")
  {
    $message=`/bin/ls $options $files 2>&1`;
    $status=$?; #perlese for get the status from the last `` command.
  }

  return ($message,$status);

  return ($message,$status);

}

>>>>>>> 1.10
#============================================================== Finished

1;

__END__
