################################################################################
#
#  kPerl Core Library Group
#  Library Concerning Command Line Interface and User Interaction
#
#  copyright (c)
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 1998-2002, 2004
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - related functions in other packages:
#   &MainLib::File::LogOpen
#   &MainLib::File::LogClose
#   &MainLib::File::TrueStdout
#
# - individual description of functions at the beginning of the code blocks
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @EXPORT
#
# - command line interface
#   &GetoptsNArgs
#
# - user interaction
#   &QueryConfirm
#   &QueryStr
#
# - messaging, logging
#   &InargFileExists
#   &GetWriteHandle
#
#
#  STD OPTIONS
#
#   -debug      print debug protocol to STDERR
#
################################################################################

package MainLib::Cmdline;

# includes
use strict; #use warnings;  # OK 20040813

# symbol export
use Exporter qw(import);
our @EXPORT = qw (
  &GetoptsNArgs
  &QueryConfirm &QueryStr
  &InargFileExists &GetWriteHandle
  );


################################################################################
# command line interface
################################################################################


# get arguments and switches from command line environment
#
# INTERFACE
# - options:
#   -args        reference to array containing the arguments to be processed,
#                default: @main::ARGV. The array remains unchanged.
#   -FuncSwitch  reference to code for processing of switches, default:
#                &main::AddSwitch. This function shoult meet following
#                features:
#                arg1        current switch (without the '-' character)
#                -args       reference to array containing all arguments
#                            following the current argument. The array
#                            may be manipulated by the function taking
#                            effect also on the argument processing here.
#                -VarSwitch  hash reference for storage of switches
#   -VarSwitch   value handed over to switch-processing function (see option
#                -FuncSwitch) via option -VarSwitch.
#
# - return val:  - program / function arguments (array @ProgArgs)
#
# DESCRIPTION
# - Arguments having the '-' char as first character are regarded as
#   switches. They're handed over to the referenced function for switch
#   processing.
# - switch arguments are processed by a function referenced by
#   option -FuncSwitch or &main::AddSwitch (default).
#
sub GetoptsNArgs {
  my (%opt) = @_;
  my ($pFuncSwitch);
  my ($bScanSwitch, @ArgRaw, @ArgPure);

  # parameters
  if (exists ($opt{-args})) { @ArgRaw = @{$opt{-args}}; }
  @ArgRaw or @ArgRaw = @main::ARGV;
  $pFuncSwitch = $opt{-FuncSwitch} || \&main::AddSwitch;
  $bScanSwitch = 1;

  # work through command line values
  while (defined ($_ = shift @ArgRaw)) {
    if ($_ =~ m/^--$/) { $bScanSwitch = 0; next; }
    if ($bScanSwitch and $_ =~ m/^-(.+)/) {
      &$pFuncSwitch ($1, -args=>\@ArgRaw, -VarSwitch=>$opt{-VarSwitch});
    } else {
      push @ArgPure, $_;
    }
  }

  return @ArgPure;
}


################################################################################
# user interaction
################################################################################


# get confirmation via user prompt
#
# INTERFACE
# - return val: confirmation status (boolean)
#
# DESCRIPTION
# - This function performs command line interaction! Output is done to STDOUT.
#
sub QueryConfirm {
  my ($choice);

  { # redo block
    print " (Y/N) ";
    $choice = uc (scalar <STDIN>);
    chomp ($choice);
    if ($choice eq 'Y') { return 1 }
    if ($choice eq 'N') { return 0 }

    # unknown input
    redo;
  }
}


# get word input via user prompt
#
# INTERFACE
# - argument 1*: suggested string
# - options:
#   -ClipSpace   clip whitespace character from the beginning and end of the
#                input
# - return val:  entered string or confirmed suggestion
#
# DESCRIPTION
# - This function performs command line interaction! Output is done to STDOUT.
#
sub QueryStr {
  my ($StrSugg, %opt) = @_;
  my ($StrGet);

  { # redo block

    # add suggested string to output
    if ($StrSugg) {
      print " (\"$StrSugg\") ";
    }
    # get command line input
    $StrGet = <STDIN>;
    chomp ($StrGet);

    # empty string entered?
    # -> repeat query or return suggested string
    if ($StrGet =~ m/^\s*$/) {
      if ($StrSugg) { return $StrSugg }
      else { redo }
    }

    # return entered string
    if ($opt{-ClipSpace}) {
      $StrGet =~ s/^\s+//;
      $StrGet =~ s/\s+$//;
    }
    return $StrGet;
  }
}


################################################################################
# messaging, logging
################################################################################


# standard check for input file argument
#
# INTERFACE
# - argument 1: path of input file
# - options:
#   -exit       use this function for exit if the input file is not existent
#               or readable
#   -stdin      allow input argument "-" as an alias for STDIN
# - return val: - path of input file if valid
#               - undef if invalid
#
# DESCRIPTION
# - code examples to be used in main body, program mode manifold section:
#   # for program mode function called in a loop: skip non-existing files
#     foreach $arg (@ProgArg) {
#       &InargFileExists($_,-stdin=>1) or next;
#       &ProgDo ($arg);
#     }
#   # filter arguments for non-existing files
#     for (my $CtArg=0; $CtArg<int(@ProgArg); ++$CtArg) {
#       unless (&InargFileExists($ProgArg[$CtArg],-stdin=>1)) {
#         splice @ProgArg, $CtArg, 1; $CtArg --;
#       }
#     }
#     &ProgDo (@ProgArg);
#   # check first argument
#     &InargFileExists ($ProgArg[0], -stdin=>1, -exit=>\&Usage);
#     &ProgDo ($ProgArg[0]);
#     &ProgDo (@ProgArg);
#   # check existence of fixed number of first arguments
#     for (my $CtArg=0; $CtArg<2; ++$CtArg) {
#       &InargFileExists ($ProgArg[$CtArg], -stdin=>1, -exit=>\&Usage);
#     }
#     &ProgDo (@ProgArg);
#
sub InargFileExists {
  my ($PathIn, %opt) = @_;
  my $bErr = 0;

  if ($PathIn eq '-' and $opt{-stdin}) { return $PathIn }
  if (! -e $PathIn) {
    printf STDERR "ERROR: specified input file %s does not exist\n", $PathIn||"''";
    $bErr ++;
  }
  elsif (! -r $PathIn) {
    printf STDERR "ERROR: unable to read from input file %s\n", $PathIn||"''";
    $bErr ++;
  }

  # sample error flags
  if ($bErr) {
    if ($opt{-exit}) { &{$opt{-exit}}() }
    return undef;
  }

  # tests passed
  return $PathIn;
}


# create an output filehandle, verbose success status management
#
# INTERFACE
# - argument 1: output filename
#
# - options:
#   -access     access type, 'w' (default) or 'a'
#   -exit       on error, exit program with error code, default: do not
#   -filestm    file info statement, part of the message
#                 sprintf('writing %s %s',$filestm,$FileOut)
#               defaut "file"
#   -HdlOnErr   on error, use specified message output handle, default STDERR
#               An undefined or NULL value causes skip of messaging
#   -HdlOnSucc  on success, use specified message output handle, default STDOUT
#               An undefined or NULL value causes skip of messaging
#   -SubOnErr   on error, precede output by package statement (boolean value)
#   -SubOnSucc  on success, precede output by package statement (boolean value)
#
# - return val: requested output filehandle (reference to FileHandle)
#
# DESCRIPTION
# - This function prints standard messages, depending on the success status
#   of the trial to create an output filehandle.
# - code examples:
#   # allow exit
#     $hOut = &GetWriteHandle ($FileOut, -exit=>1);
#     print $hOut "...\n";
#   # skip invalid output files
#     if ($hOut = &GetWriteHandle($FileOut,-filestm=>'plot image data to file')) {
#       &DataPrint (\%graph, -handle=>$hOut);
#     }
#     if ($hOutTab = &GetWriteHandle($FileOut,-filestm=>'coverage data to file')) {
#       print $hOutTab "...\n";
#     }
#
sub GetWriteHandle {
  require FileHandle;
  my ($FileOut, %opt) = @_;

  my $hOut = FileHandle->new($FileOut,$opt{-access}||'w');
  if ($hOut) {
    my $hOutMsg = exists($opt{-HdlOnSucc}) ? $opt{-HdlOnSucc} : \*STDOUT;
    if ($hOutMsg) {
      printf $hOutMsg "writing %s %s\n", $opt{-filestm}||'file', $FileOut;
    }
  } else {
    my $hOutMsg = exists($opt{-HdlOnErr}) ? $opt{-HdlOnErr} : \*STDERR;
    if ($hOutMsg) {
      printf $hOutMsg "%sERROR: unable to write %s %s\n",
        $opt{-SubOnErr}?((caller(1))[3].'. '):'',
        $opt{-filestm}||'file', $FileOut;
    }
    if ($opt{-exit}) { exit $opt{-exit} }
  }

  return $hOut;
}


1;
# $Id: Cmdline.pm,v 1.13 2018/06/05 18:02:56 szafrans Exp $
