#!/usr/bin/env perl
########################################################################
# Get a list of files on DATAPATH that match a pattern (or patterns)
# that are supplied on the command line. These patterns may contain
# shell wild cards (which must be quoted againsts shell expansion).
#
# Larry Solheim Mar 2010
#
# $Id$
########################################################################

require 5;

use File::Basename;
use Cwd qw(abs_path);

# Declare global variables
use vars qw( $DATAPATH %usrvar $verbose $Runame $masterdir $cfsuser );

chomp($Runame = `basename $0`);
$verbose = 0;
$quiet = 0;

# $prex = 1 means assume that each pattern is a perl regular expressions,
# otherwise each pattern will/may contain shell wildcards
$prex = 0;

# $short_list = 0 means list output a long listing with links resolved
# $short_list = 1 means list file names only
$short_list = 0;

# Boolean flag to determine if this program should check to see if a file
# found on DATAPATH is also on cfs
$check_on_cfs = 0;

my %matching;
my %match_name;
my %match_line;
my %match_mtime;

my %uniq_name;
my %uniq_line;
my %uniq_mtime;

my %require_uid;

$cfsuser = "";
$masterdir = "off";

# list_own = 1 means list only matching files that are owned by
# the invoking user
$list_own = 0;

# delete_files = 1 means delete all matching files from DATAPATH/RUNPATH
$delete_files = 0;

# require_3digit_sfx = 1 means that all matching file names
# must have a 3 digit numeric suffix attached
$require_3digit_sfx = 1;

# The set of command line parameters that may be defined by the user
my @cmdl_params = ( "verbose", "runid", "cfsuser", "masterdir", "owner" );

# Local variables
my ( @NonOpt );

# Process command line arguments
use Getopt::Long;
$Getopt::Long::ignorecase = 0;
$Getopt::Long::order = $PERMUTE;
&GetOptions("verbose"  => sub {$verbose++},
            "1"        => sub {$short_list=1},
            "2"        => sub {$short_list=2},
            "prex!"    => \$prex,
            "quiet!"   => \$quiet,
            "own!"     => \$list_own,
            "delete!"  => \$delete_files,
            "<>"       => sub {push @NonOpt,$_[0]})
    or usage(1);

# Process non option command line args
@pattern = ();
foreach (@NonOpt) {
  next unless $_;
  if (/\w+=/) {
    # This is a variable assignment
    my ($var,$val) = /^\s*(.*?)=(.*)/;
    # Strip quotes from the value, if any
    $val =~ s/^\s*"(.*)"\s*$/$1/;
    $val =~ s/^\s*'(.*)'\s*$/$1/;

    # Require a non NULL value
    unless ( $val eq "0" ) {
      die "Missing value for $_\n" unless $val;
    }

    # Check for valid parameter names
    my $found = 0;
    foreach my $parm (@cmdl_params) {
      if ( $parm eq $var ) {
        $found = 1;
        last;
      }
    }
    unless ($found) {
      die "Invalid command line parameter --> $var <--\n";
    }

    # Add variable defs found on the command line to the usrvar hash
    # Multiple variable assignments for the same variable will be added to a
    # list of values for that variable.
    # Each individual assignment will be split on whitespace and added
    # as a separate entry in the list of values.
    push @{$usrvar{$var}}, split(/\s+/,$val);
    next;
  }

  # Any remaining command line args should be patterns
  push @pattern, $_;
}

# Set verbose from a command line definition
if ( $usrvar{verbose} ) {
  # Only the first element of this array is significant, all others are ignored
  $verbose = @{$usrvar{verbose}}[0];
  if ( scalar(@{$usrvar{verbose}})>1 ) {
    warn "** WW ** Multiple values for verbose found on command line. --> @{$usrvar{verbose}} <--\n";
    warn "** WW ** Using verbose = $verbose\n";
  }
  die "verbose must be an integer.\n" unless $verbose =~/^\s*\d+\s*$/;
}

# Override any verbose setting when $quiet is requested by the user
$verbose = -1 if $quiet;

# Set masterdir from a command line definition
if ( $usrvar{masterdir} ) {
  if ( $short_list ) {
    usage(1, "masterdir may not be used with a short list option \"--1\" or \"--2\".");
  }
  # Only the first element of this array is significant, all others are ignored
  $masterdir = @{$usrvar{masterdir}}[0];
  if ( scalar(@{$usrvar{masterdir}})>1 ) {
    warn "** WW ** Multiple values for masterdir found on command line. --> @{$usrvar{masterdir}} <--\n";
    warn "** WW ** Using masterdir = $masterdir\n";
  }
  $masterdir = lc($masterdir);
  die "Invalid value for masterdir = $masterdir\n" unless $masterdir =~ /^(on|off)$/;
  # Setting masterdir = on implies check_on_cfs = T
  $check_on_cfs = 1 if $masterdir =~ /^on$/;
}

# Set runid from a command line definition
if ( $usrvar{runid} ) {
  if ( $short_list ) {
    usage(1, "runid may not be used with a short list option \"--1\" or \"--2\".");
  }
  if ( $usrvar{cfsuser} ) {
    usage(1, "Both runid and cfsuser were specified on the command line.");
  }
  unless ( scalar(@{$usrvar{runid}}) ) {
    usage(1, "runid must be a list.\n");
  }
  # Setting runid implies masterdir = on
  $masterdir = "on";
  # Setting runid implies check_on_cfs = T
  $check_on_cfs = 1;
}

# Set cfsuser from a command line definition
if ( $usrvar{cfsuser} ) {
  if ( $short_list ) {
    usage(1, "cfsuser may not be used with a short list option \"--1\" or \"--2\".");
  }
  if ( $usrvar{runid} ) {
    usage(1, "Both runid and cfsuser were specified on the command line.");
  }
  if ( $usrvar{masterdir} ) {
    usage(1, "Both masterdir and cfsuser were specified on the command line.");
  }
  # Only the first element of this array is significant, all others are ignored
  $cfsuser = @{$usrvar{cfsuser}}[0];
  if ( scalar(@{$usrvar{cfsuser}})>1 ) {
    warn "** WW ** Multiple values for cfsuser found on command line. --> @{$usrvar{cfsuser}} <--\n";
    warn "** WW ** Using cfsuser = $cfsuser\n";
  }
  $cfsuser = lc($cfsuser);
  if ( $cfsuser eq "file" ) {
    # In this case look for cfs files in the dir of the owner of the file
    $cfsuser = "";
  } elsif ( length($cfsuser) == 3 ) {
    # When cfsuser is 3 chars long assume it is the last 3 chars of acrnXXX
    substr($cfsuser,0,0) = "acrn";
  }
  if ( $cfsuser ) {
    # Ensure cfsuser is a valid user name
    my ($xname) = getpwnam $cfsuser;
    die "Invalid cfsuser = $cfsuser  ...Not a valid user name.\n" unless $xname;
  }
  # Setting cfsuser implies check_on_cfs = T
  $check_on_cfs = 1;
}

# Set owner from a command line definition
if ( $usrvar{owner} ) {
  if ( $short_list ) {
    usage(1, "owner may not be used with a short list option \"--1\" or \"--2\".");
  }
  if ( $list_own ) {
    usage(1, "owner may not be used with the --own option.");
  }
  foreach ( @{$usrvar{owner}} ) {
    my $owner = lc;
    if ( length($owner) == 3 ) {
      # When owner is 3 chars long assume it is the last 3 chars of acrnXXX
      substr($owner,0,0) = "acrn";
    }
    if ( $owner ) {
      # Ensure owner is a valid user name
      my ($name,$pw,$uid) = getpwnam $owner;
      die "Invalid owner = $owner  ...Not a valid user name.\n" unless $uid;
      $require_uid{$uid} = $owner;
    }
  }
  # Define the list_own as T if any valid uids were found
  $list_own = 1 if scalar keys %require_uid;
}

if ($verbose > 10) {
  foreach (sort keys %usrvar) {
    print "$_ = ",join(",",@{$usrvar{$_}}),"\n";
  }
  print "patterns: ",join(",",@pattern),"\n";
}

usage(1, "A pattern is required on the command line.\n") unless scalar(@pattern);

usage(1, "DATAPATH is not defined in your environment.\n") unless $ENV{DATAPATH};
$DATAPATH = $ENV{DATAPATH};

# Get the invoking users uid
chomp($invusr = `whoami`);
$invuid = getpwnam($invusr);

# Assign the invoking users uid to require_uid unless owner=... was supplied
$require_uid{$invuid} = $invusr unless scalar keys %require_uid;

# Translate user ids to user names and visa versa
while ( my ($name, $pw, $uid) = getpwent ) {
  $UID{$name} = $uid;
  $USR{$uid}  = $name;
  if ($verbose > 10) {
    print "$USR{$uid} <=>  $UID{$name}\n";
  }
}

# Translate group ids to group names and visa versa
while ( my ($name, $pw, $gid) = getgrent ) {
  $GID{$name} = $gid;
  $GRP{$gid}  = $name;
  if ($verbose > 10) {
    print "$GRP{$gid} <=>  $GID{$name}\n";
  }
}

# Define some numbers used below to create a "human readable" listing
my $TByte = 1024*1024*1024*1024;
my $GByte = 1024*1024*1024;
my $MByte = 1024*1024;
my $KByte = 1024;

# Get a list of all files in DATAPATH
opendir(DIR,$DATAPATH);
  # Ignore all ".*" entries
  @dlist = grep !/^\./, readdir DIR;
closedir(DIR);
if ( $verbose > 0 ) {
  print "Found ",scalar(@dlist)," directory entries in $DATAPATH.\n";
}

if ($verbose > 10) {
  print join("\n",@dlist),"\n";
}

my $total_size = 0;
my $total_hits = 0;

# Iterate over all patterns and assign match_name and uniq_name for all matches
# Some of these matches may be discarded below after the matching files have been
# stat'ed, if the user has specifed the --own command line option or defined owner
foreach my $pat (@pattern) {
  if ($prex) {
    # The input pattern is assumed to be a perl regex
    $ppat = $pat;
  } else {
    # The input pattern (possibly) contains shell wildcards
    # Replace the input pattern with a perl regex
    $ppat = $pat;
    # replace '[!' with '[^'
    $ppat =~ s/\Q[!/[^/g;
    # replace '.' with '\.'
    my $repl = '\.';
    $ppat =~ s/\./$repl/g;
    # replace '*' with '.*'
    $ppat =~ s/\*/.*/g;
    # replace '?' with '.'
    $ppat =~ s/\?/./g;
  }
  if ($verbose > 10) {
    print "pat = $pat    ppat = $ppat\n";
  }

  # Grep through files on DATAPATH
  @hits = sort grep /$ppat/,@dlist;

  # Accumulate a list of matching file names as keys in a hash
  foreach ( @hits ) {
    # Determine file name and edition number for the current match
    my ($name, $ed) = /^(.*?)(?:\.(\d\d\d))?$/;
    $ed = 0 unless $ed;

    # Filter out any file name that does not end with a 3 digit numeric suffix
    next if $require_3digit_sfx and !$ed;

    # match_name will contain, as keys, a list of all matching file names
    # with any numeric suffix attached
    $match_name{$_} = 1;

    # uniq_name will contain, as keys, a list of unique matching file names
    # with any numeric suffix removed
    # Define the value of uniq_name to be the maximum edition number
    # of the file found on disk, or 0 if there was no edition number
    if ( defined $uniq_name{$name} ) {
      $uniq_name{$name} = $ed > $uniq_name{$name} ? $ed : $uniq_name{$name};
    } else {
      $uniq_name{$name} = $ed;
    }
  }

  if ( $verbose > 1 ) {
    my $nhits = scalar(@hits);
    if ( $nhits == 1 ) {
      printf "%10d%s\n",$nhits," file name contains the pattern --> $pat <--";
    } else {
      printf "%10d%s\n",$nhits," file names contain the pattern --> $pat <--";
    }
  }

}

unless ( $short_list ) {
  # Stat each matching file and store file information
  # Print a long listing for each file name that matches
  foreach ( sort keys %match_name ) {
    my $fname = "$DATAPATH/$_";

    # Determine file name and edition number for the current match
    my ($curr_name, $curr_ed) = /^(.*?)(?:\.(\d\d\d))?$/;
    $curr_ed = 0 unless $curr_ed;

    # Stat this file
    my $fail = 0;
    my @curr_stat = stat($fname) or $fail = 1;
    if ( $fail ) {
      if ( $! =~ /Permission \s*denied/i ) {
        # If permissions are the problem then we won't be able to see the
        # link target using abs_path($fname), so just use $fname
        warn "** WW ** Cannot stat $fname  $!\n" if $verbose > 0;
      } else {
        # Otherwise use abs_path($fname) to resolve links
        warn "** WW ** Cannot stat ",abs_path($fname),"  $!\n" if $verbose > 0;
      }
      # Remove this name from the list of matching names
      undef $match_name{$_};
      # Remove this file name from uniq_name only when the current edition number
      # is the same as the edition number defined as the value of uniq_name, that
      # is, the current edition number is the maximum edition number on disk
      undef $uniq_name{$curr_name} if $curr_ed == $uniq_name{$curr_name};
      next;
    }

    # Determine output list info from stat info
    # @curr_stat ==
    #   ( $dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime )
    my $uid   = $curr_stat[4];
    my $owner;
    if ( $USR{$uid} ) {
      $owner = $USR{$uid};
    } else {
      my ($oname) = getpwuid $uid;
      $owner = $oname ? $oname : $uid;
    }
    if ($list_own) {
      # List only files owned by the invoking user or by users
      # listed in owner=... supplied on the command line
      my $do_not_use = 1;
      foreach (keys %require_uid) {
        $do_not_use = 0 if $uid == $_;
      }
      if ( $do_not_use ) {
        # Remove this name from the list of matching names
        if ($verbose > 10) {
          print "Ignoring $fname because $owner is not an allowed owner.\n";
        }
        undef $match_name{$_};
        undef $uniq_name{$curr_name};
        next;
      }
    }
    my $gid   = $curr_stat[5];
    my $group;
    if ( $GRP{$gid} ) {
      $group = $GRP{$gid};
    } else {
      my ($gname) = getgrgid $gid;
      $group = $gname ? $gname : $gid;
    }
    my $bsize = $curr_stat[7]; # file size in bytes
    if ( $bsize > $TByte ) {
      # size in TBytes
      $size = sprintf("%5.1fT",1.0*$bsize/$TByte);
    } elsif ( $bsize > $GByte ) {
      # size in GBytes
      $size = sprintf("%5.1fG",1.0*$bsize/$GByte);
    } elsif ( $bsize > $MByte ) {
      # size in MBytes
      $size = sprintf("%5.1fM",1.0*$bsize/$MByte);
    } elsif ( $bsize > $KByte ) {
      # size in KBytes
      $size = sprintf("%5.1fK",1.0*$bsize/$KByte);
    } else {
      $size = $bsize;
    }
    my $mtime = $curr_stat[9];   # last modify time since epoch
    my ($sec,$min,$hour,$mday,$mon,$year) = localtime( $mtime );
    my $curr_date = sprintf("%4.4d-%2.2d-%2.2d %2.2d:%2.2d",
                            $year+1900, $mon+1, $mday, $hour, $min);

    # Create a string containing the current list output line
    my $list_line = sprintf("%8s %8s %7s %s $fname",$owner,$group,$size,$curr_date);

    # Increment total size and total count
    $total_size += $bsize;
    $total_hits++;

    # Augment the list of matching names with extra info
    # These names will contain numeric suffixes
    $match_line{$_} = "$list_line";
    $match_mtime{$_} = $mtime;

    if ( defined $uniq_name{$curr_name} ) {
      # Also assign related unique name hashes (names without numeric suffixes)
      $uniq_line{$curr_name} = "$list_line";
      $uniq_mtime{$curr_name} = $mtime;
    }

    if ( $check_on_cfs ) {
      # Add this file info to a set of lists of hashes that will be used below
      # to determine if the files are also on cfs
      # Create a separate list for each file owner
      # Note that this list will not contain numeric suffixes on file names
      my %cfs_info;
      $cfs_info{file_name} = $curr_name;
      $cfs_info{list_line} = "$list_line";
      $cfs_info{mtime}     = $mtime;
      push @{$matching{$owner}}, \%cfs_info;
    }

    unless ( $check_on_cfs ) {
      unless ( $delete_files ) {
        # Write the current line
        print "$list_line\n";
      }
    }

  }
}

if ( $short_list and !$check_on_cfs ) {
  unless ( $delete_files ) {
    # When a short list is requested, the previous loop will not write any output
    # In this case dump the short list names to stdout, one per line
    my $nfiles = 0;
    if ( $short_list == 1 ) {
      # Print a list of unique file names (without any numeric suffix)
      foreach (sort keys %uniq_name) {
        $nfiles++;
        print "$_\n";
      }
    } elsif ( $short_list == 2 ) {
      # Print a list of unique file names, using only the file names with
      # the highest edition number that was found on disk
      foreach (sort keys %uniq_name) {
        $nfiles++;
        if ( $uniq_name{$_} > 0 ) {
          printf "%s.%3.3d\n",$_,$uniq_name{$_};
        } else {
          print "$_\n";
        }
      }
    }
    if ( $verbose > -1 ) {
      if ( scalar(@pattern) == 1 ) {
        print "Number of files matching pattern --> @pattern <-- is $nfiles\n";
      } else {
        print "Number of files matching patterns --> @pattern <-- is $nfiles\n";
      }
    }
  }
}

# oncfs will be assigned keys that are file names that are found on cfs
my %oncfs;

if ( $check_on_cfs ) {
  # Determine if any of the matching files are also on cfs

  my $lsarc_opts = "";

  print "Looking for files on cfs...\n";

  if ( ($cfsuser or $usrvar{runid} or $masterdir eq "on") and scalar(keys %uniq_name) ) {
    # Look for file in the cfs dir of a particular user,
    # regardless of who owns the disk file or
    # in the masterdir if either runid or masterdir are defined

    # Define file1, file2,... in the current environment with the
    # file names found in the uniq_name list
    # These file names will then be read by lsarc when it runs below
    my $nlist = 0;
    foreach ( keys %uniq_name ) {
      $nlist++;
      my $var = sprintf("file%d",$nlist);
      $ENV{$var} = "$_";
    }
    # Set the file(nlist+1) environment variable to null.
    # Setting this variable to null ensures that lsarc will not read
    # more than nlist file names from the environment.
    my $var = sprintf("file%d",$nlist+1);
    $ENV{$var} = "";

    if ( $usrvar{runid} ) {
      # Explicitly setting runid on the command line tells lsarc to look
      # in the "official" directory of the CFS database
      # Adding the --others option tells lsarc to always look in the "others"
      # dir as well as in the dir associated with runid
      my $runids = join(' ',@{$usrvar{runid}});
      $lsarc_opts = "--env --with_individual --others runid=\"$runids\" ";
    } elsif ( $masterdir eq "on" ) {
      # Invoking --global tells lsarc to look at every runid found in masterdir
      # This is very expensive
      $lsarc_opts = "--env --with_individual --global ";
    } elsif ( $cfsuser ) {
      # Invoking --user==$cfsuser tells lsarc to look in the cfs dir of a particular user
      $lsarc_opts = "--env --with_individual --user==$cfsuser ";
    } else {
      $lsarc_opts = "--env --with_individual ";
    }
    if ( $verbose > 10 ) {
      print "lsarc $lsarc_opts\n";
    }
    my @cfs_hits = syscmd( "lsarc $lsarc_opts" );

    # Create a hash containg a key for each file name that was found on cfs
    foreach my $line ( @cfs_hits ) {
      # The line "Reinitializing data base to find individual files."
      # is expected  ...ignore it
      next if $line =~ /^\s*Reinitializing/;
      my @ll = split(" ", $line);
      if ( scalar(@ll) > 6 ) {
        $oncfs{$ll[6]} = 1;
      } else {
        warn "** WW ** Invalid line returned from lsarc: --> $line <--\n";
      }
    }

    # Print the list of files found and whether or not they are also on cfs
    foreach ( sort keys %uniq_name ) {
      my $line = $uniq_line{$_} ? $uniq_line{$_} : $_;
      if ( $oncfs{$_} ) {
        # This file was found on cfs
        print " ON CFS: $line\n";
      } else {
        # This file was not found on cfs
        print " -N/A- : $line\n";
      }
    }

  } elsif ( scalar(keys %matching) ) {

    # Look for files in the cfs dir of the owner of the disk file
    foreach my $owner (keys %matching) {
      # Define file1, file2,... in the current environment with the
      # file names in the current owner list
      # These file names will then be read by lsarc when it runs below
      my $nlist = 0;
      foreach my $href ( @{$matching{$owner}} ) {
        $nlist++;
        my $var = sprintf("file%d",$nlist);
        $ENV{$var} = "$href->{file_name}";
      }
      # Set the file(nlist+1) environment variable to null.
      # Setting this variable to null ensures that lsarc will not read
      # more than nlist file names from the environment.
      my $var = sprintf("file%d",$nlist+1);
      $ENV{$var} = "";

      $lsarc_opts = "--env --with_individual --user==$owner";
      if ( $verbose > 10 ) {
        print "lsarc $lsarc_opts\n";
      }
      my @cfs_hits = syscmd( "lsarc $lsarc_opts" );

      # Create a hash containg a key for each file name that was found on cfs
      foreach my $line ( @cfs_hits ) {
        # The line "Reinitializing data base to find individual files."
        # is expected  ...ignore it
        next if $line =~ /^\s*Reinitializing/;
        my @ll = split(" ", $line);
        if ( scalar(@ll) > 6 ) {
          $oncfs{$ll[6]} = 1;
        } else {
          warn "** WW ** Invalid line returned from lsarc: --> $line <--\n";
        }
      }

      # Print the list of files found and whether or not they are also on cfs
      foreach my $href ( @{$matching{$owner}} ) {
        if ( $oncfs{$href->{file_name}} ) {
          # This file was found on cfs
          print " ON CFS: $href->{list_line}\n";
        } else {
          # This file was not found on cfs
          print " -N/A- : $href->{list_line}\n";
        }
      }
    }
  } else {
    warn "** WW ** There are no matching files to look for on cfs.\n";
  }
}

if ( $delete_files ) {
  # Create a list of file names to be deleted
  my @del_list = ();
  foreach ( sort keys %match_name ) {
    if ( $check_on_cfs ) {
      # Only delete files if they are on cfs
      # Remove any trailing numeric suffix and assign sname
      my $sname = $_;
      $sname =~ s/^(.*?)(?:\.\d\d\d)?$/$1/;
      if ( $oncfs{$sname} ) {
        # The file is on cfs, delete it from disk
        push @del_list, $_;
      }
    } else {
      # Delete every matching file
      push @del_list, $_;
    }
  }
  # Delete all files in del_list
  cccdel( @del_list );
  # fdbdel( @del_list );
}

if ( $total_hits > 1 ) {
  my $tsize = "";
  if ( $total_size > $TByte ) {
    # size in TBytes
    $tsize = sprintf("%6.2fT",1.0*$total_size/$TByte);
  } elsif ( $total_size > $GByte ) {
    # size in GBytes
    $tsize = sprintf("%6.2fG",1.0*$total_size/$GByte);
  } elsif ( $total_size > $MByte ) {
    # size in MBytes
    $tsize = sprintf("%6.2fM",1.0*$total_size/$MByte);
  } elsif ( $total_size > $KByte ) {
    # size in KBytes
    $tsize = sprintf("%6.2fK",1.0*$total_size/$KByte);
  } else {
    $tsize = $total_size;
  }
  printf "Total size of all matching file names is $tsize in $total_hits files.\n";
}

exit 0;
########################################################
##################### End of main ######################
########################################################

sub usage {
    my($err, $msg) = @_;

    $err = 0  unless defined $err;
    $msg = "" unless defined $msg;

    warn("$msg\n\n") if $msg;

    my $USAGE = <<'END_OF_USAGE';
    Usage: lsdat [options] pattern [pattern|definition ...]
  Purpose: List files on DATAPATH given a pattern or patterns
           Optionally look for these same files on cfs

  Any patterns that contain shell wild cards must be enclosed in single quotes.

  Patterns may be anchored at the start of the file name using "^" as the first
  character in the pattern (e.g. ^mc_abc )

  Patterns may be anchored at the end of the file name use "$" as the last character
  in the pattern. The "$" must be protected from expansion by the shell using either
  single quotes or preceeding the "$" with a back slash. (e.g. '_m12_rs$' )

  Defining either runid or cfsuser on the command line will cause lsdat to also look
  on cfs for any files found on DATAPATH that match the user supplied pattern(s).
  Only one of runid or cfsuser may be defined on the command line.
  The short list option "--1" may not be used when either runid or cfsuser is defined.

  When runid or cfsuser is defined then the output will be a long list with each line
  prefixed by either the string " ON CFS:" if the file was found on cfs, or the string
  " -N/A- :" if the file was not found on cfs.

  Be aware that when runid is defined only the files found on cfs that are associated
  with those runids will be searched. Similarly when cfsuser is defined then only files
  found on the cfs that are associated with the specified user (or disk file owner when
  cfsuser=file) are searched. This means that false negatives are possible, but the user
  can mitigate these false negatives by selecting disk files using patterns that are
  consistent with their choice of runid or cfsuser. False positives are not possible
  unless the cfs database is corrupted (this is very rare).

  When patterns are too general and therefore match many (perhaps thousands) of files,
  the response of the program will degrade when "long list" output is requested. In this
  circumstance the user should restrict the number of files by proving a more specific
  pattern. Doing a short list (--1) using the general pattern will provide useful
  information about how modify the search pattern to restrict the match.

  Options:
    --1        ..Output only file names, one name per line (this is the number 1)
                 All matching file names will have the edition number stripped
                 and all duplicates will be removed.
    --2        ..Output only file names, one name per line
                 Only the highest edition number for each file will be displayed.
                 Invoking --1 or --2 is much faster than the default long list.
    --own      ..All files listed are owned by the invoking user
    --delete   ..Delete files that from disk
                 Any files that match an input pattern will be deleted from disk.
                 If the cfs check is invoked via either runid=... or cfsuser=... then
                 file will be deleted from disk only if they are also found on cfs.
    --verbose  ..Increase verbosity (additive)
    --quiet    ..Suppress all warning/info messages (overrides verbose)

  Definitions:
    runid=LIST      ..A white space separated list of runids
                      Defining runid implies masterdir=on for the cfs search.
    cfsuser=STRING  ..The name of a user with files on cfs
                      If cfsuser is defined to be the string "file" then the cfs
                      directory of the owner of the disk file will be searched.
                      If cfsuser is 3 chars long then "acrn" will be prepended.
    owner=LIST      ..A white space separated list of file owners
                      Only files owned by a member of this list will be processed.
                      The option --own and the definition owner=LIST are mutually exclusive.
                      If any element of owner is 3 chars long then "acrn" will be prepended.
    verbose=INT     ..Set verbosity to any integer

  Examples:
    To find all file names that contain the string "_2361_2370_gz" use
      lsdat _2361_2370_gz

    To find all file names that match the pattern "mc_ebh_*_rs" use
      lsdat 'mc_ebh_*_rs'

    To find all file names that match the pattern "mc_ebh_*_rs" and belong to any of the
    login names "acrnocn acrncbn acrngcm abcdefg" (note that this will actually fail
    beacuse abcdefg is not a valid login name) use
      lsdat 'mc_ebh_*_rs' owner='ocn cbn acrngcm abcdefg"

    To find all file names that start with "sc_ebh_" and also determine if they are on cfs
      lsdat '^sc_ebh_' runid=ebh

    To quickly find all files that start with "sc_crc_" and the number of such files use
      lsdat -1 '^sc_crc_'

    To find the latest edition number of a file named "my_file" use
      lsdat -2 '^my_file.[0-9][0-9][0-9]$'

    To delete all files found on DATAPATH that start with 'sc_exx_' use
      lsdat --delete ^sc_exx_

    To delete all files that contain the string '_ezz_' but only if those files are also
    saved on cfs, use (note that -d and --delete are equivalent options)
      lsdat -d _ezz_ runid=ezz

END_OF_USAGE

    print "$USAGE";
    exit($err);
}

sub syscmd {
  use strict;
  my $cmd = shift;
  my $show_stdout = shift;
  my $stop_on_error = shift;

  die "Missing system command string\n" unless $cmd;

  $stop_on_error = 1 unless defined $stop_on_error;

  if ( $verbose > 1 ) {
    print "$cmd\n";
  }

  chomp(my @sh_out = `$cmd 2>&1`);
  my $sh_err = $?;
  if ( $show_stdout or $sh_err ) {
    foreach (@sh_out) {print "$_\n"}
  }
  if ( $stop_on_error and $sh_err ) {
    die "** EE **  Problem executing\n   $cmd\n";
  }

  # Return command stdout in array context, otherwise return command status
  return wantarray ? @sh_out : $sh_err;

}

sub cccdel {
  # Delete a list of files from DATAPATH/RUNPATH using
  # the CCCma routines access and delete
  use strict;
  my $lfile = ".lsdat_del_$$";
  foreach (@_) {
    # Determine the actual location of this file (e.g. on RUNPATH)
    my ($name, $path, $sfx) = fileparse("$_",());
    unless ( $path =~ /^\// ) {
      # If this is not an absolute pathname then assume DATAPATH
      $path = $DATAPATH;
    }

    # abs_path will determine a full pathname and resolve links
    my $fullpath = abs_path( "$path/$name$sfx" );

    # Now $path will be the dir in which this file actually lives
    ($name, $path, $sfx) = fileparse("$fullpath",());

    # The basename with suffix
    my $fname = "$name$sfx";

    # Determine the edition number, if any
    my ($ed) = $fname =~ /^.*?\.(\d\d\d)$/;
    $fname =~ s/^(.*?)(?:\.\d\d\d)?$/$1/;

    my $ed_opt = " ";
    $ed_opt = "ed=$ed" if $ed;

    my $cmd = "cd $path; access $lfile $fname nocp na $ed_opt; delete $lfile na";
    if ( $verbose > 10 ) {
      print "$cmd\n";
    }
    syscmd( "$cmd" );
    unlink "$path/$lfile" if -e "$path/$lfile";
    if ( $verbose > -1 ) {
      if ( -e $fullpath ) {
        print "        $fullpath   not deleted.\n";
      } else {
        print "Removed $fullpath\n";
      }
    }

  }
  return 1;
}

sub fdbdel {
  # Delete a list of files from DATAPATH/RUNPATH using
  # the CCCma file database utility fdb
  use strict;
  foreach (@_) {
    # Determine the file name without any leading path info
    my ($name, $path, $sfx) = fileparse("$_",());

    # The basename with suffix
    my $fname = "$name$sfx";

    # Determine the edition number, if any
    my ($ed) = $fname =~ /^.*?\.(\d\d\d)$/;
    $fname =~ s/^(.*?)(?:\.\d\d\d)?$/$1/;

    # Attempt to get the full pathname from the database
    # Ignore errors since this is not vital information
    # A file name may be missing from the database but exits on disk
    my @fullpath = syscmd("fdb path $fname $ed",0,0);

    # Use fdb to delete the file from the database and from disk
#DBG: This will fail if the file is not in the database
#DBG: Should this fall back to access/delete in the case of an error
    syscmd( "fdb delete $fname $ed" );
    if ( $verbose > -1 ) {
      if ( scalar(@fullpath) ) {
        if ( -e $fullpath[0] ) {
          print "        $fullpath[0]   not deleted.\n";
        } else {
          print "Removed $fullpath[0]\n";
        }
      } else {
        print "Removed $fname\n";
      }
    }

  }
  return 1;
}