################################################################################
#
#  kPerl Core Library Group
#  Library for Main Purposes
#
#  copyright (c)
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 2000-2002, 2004
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - individual description of functions at the beginning of the code blocks
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @EXPORT
#
# - program architecture, functions, process attributes
#   &MySub
#   &MyMem
#   &CallExtClosure
#
# - direction encoding
#   %SyntaxTranslDrc
#
#
#  STD OPTIONS
#
#   -debug      print debug protocol to STDERR
#
################################################################################

package MainLib::Misc;

# includes
use strict; #use warnings;  # OK 20050512
use FileHandle;
# we cannot use MainLib::Data here - it would cause cross-include!
#   MainLib::Data requires &MySub

# symbol export
use Exporter qw(import);
our @EXPORT = qw (
  &MySub &MyMem &CallExtClosure
  %SyntaxTranslDrc
  );


################################################################################
# program architecture, functions, process attributes
################################################################################


# package plus function name where this function was actually called
sub MySub { return (caller(1))[3] }


# runtime memory usage via system's ps
#
# INTERFACE
# - argument 1*: process ID, default $$
# - return val:  memory usage, scaled in kByte
#
sub MyMem {
  my $pid = shift(@_) || $$;
  my ($hInProc, $line);
  $hInProc = FileHandle->new("ps -p $pid -o vsz |");
  while (<$hInProc>) { $line = $_ }
  return int ($line);
}


# return reference to a closure to use it in an encapsulated system call
#
# INTERFACE
# - argument 1+: like for function 'system'
# - return val:  - reference to closure, arguments:
#                  - argument 1: none (for call)
#                                'WhatRUCalling' (to return command)
#                                'WhatWasRet' (to return exit code)
#                  - return val: success status (boolean)
#                - undef if an error occurs (no input arguments)
#
sub CallExtClosure {
  my $call = join (' ',@_) or return undef;
  my $ret;

  return sub {
    if ($_[0]) {
      if ($_[0] eq 'WhatRUCalling') { return $call }
      if ($_[0] eq 'WhatWasRet') { return $ret }
    }
    return ! ($ret = int (system($call)/256));
  };
}


################################################################################
# direction encoding
################################################################################

# standard direction encoding
our (%SyntaxTranslDrc);
$SyntaxTranslDrc{num2word} = {
  '-1' => 'left',
   '0' => 'straight',
   '1' => 'right',
  '+1' => 'right',
  };


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