#!/usr/bin/perl

#
# This Perl program displays the uptime, the number of processes,
# number of threads and the amount of physical memory, swap and
# virtual memory in a nicely organized chart on the screen.
# Written for TinyPerl 5.8 under Windows XP and tested on XP/Win7,
# Perl 5.004 under DOS/Windows, and Perl 5.10 on Ubuntu Linux.
# It was also tested on a MacBook with iOS 10,
# but it did not work on the MacOS at all.
# Written by Zsolt Nagy-Perge (zsnp@juno.com)
# in August 2022, Pensacola, Fla.
#
#################################################################

use strict;
use warnings;

$| = 1;
my @MEMDATA;
my $OS = DetectOS();
if ($OS == 1) { system('MEM'); exit; }
if ($OS > 3) { @MEMDATA = LinuxResources(); }
        else { @MEMDATA = WindowsResources(); }
PrintReport(@MEMDATA);
print CENTER('- - -  PRESS ENTER TO EXIT  - - -');
$a = <STDIN>;
print "\n";
exit;

##################################################
sub PrintReport
{
  my ($OSNAME, $UPTIME, $PROCESSES, $THREADS, $RAMINSTALLED, $PHYSTOTAL, $PHYSUSED, $PHYSFREE, $PHYSPERCENT,
      $SWAPTOTAL, $SWAPUSED, $SWAPFREE, $SWAPPERCENT, $VMTOTAL, $VMUSED, $VMFREE, $VMPERCENT) = @_;

  my $DAYS = int($UPTIME / 86400);
  $UPTIME -= ($DAYS * 86400);
  my $HOURS = int($UPTIME / 3600); 
  $UPTIME -= ($HOURS * 3600);
  my $MIN = int($UPTIME / 60); 
  $UPTIME -= ($MIN * 60);
  my $SEC = $UPTIME;
  $DAYS = $DAYS ? "$DAYS days " : '';
  $HOURS = $HOURS ? sprintf('%0.2d', $HOURS) : '00';
  $MIN = $MIN ? sprintf('%0.2d', $MIN) : '00';
  $SEC = $SEC ? sprintf('%0.2d', $SEC) : '00';
  $UPTIME = "$DAYS$HOURS:$MIN:$SEC";

  my $REPORT = "\n" . CENTER($OSNAME) . CENTER("UPTIME: $UPTIME  PROCESSES: $PROCESSES  THREADS: $THREADS") .
  "\n   PHYSICAL MEMORY" .
  "\n     Total Installed...................................RR MB" .
  "\n     Total Accessible..................................P1 MB" .
  "\n     Used..............................................P2 MB" .
  "\n     Free..............................................P3 MB     P4% used.\n" .
  "\n   SWAP SPACE" .
  "\n     Total.............................................S1 MB" .
  "\n     Used..............................................S2 MB" .
  "\n     Free..............................................S3 MB     S4% used.\n" .
  "\n   VIRTUAL MEMORY"                                            .
  "\n     Total............................................ V1 MB" .
  "\n     Used............................................. V2 MB" .
  "\n     Free............................................. V3 MB     V4% used.\n\n";
  OverwriteFromRight($REPORT, 'RR', $RAMINSTALLED >> 10);
  OverwriteFromRight($REPORT, 'P1', $PHYSTOTAL >> 10);
  OverwriteFromRight($REPORT, 'P2', $PHYSUSED >> 10);
  OverwriteFromRight($REPORT, 'P3', $PHYSFREE >> 10);
  OverwriteFromRight($REPORT, 'P4', $PHYSPERCENT);
  OverwriteFromRight($REPORT, 'S1', $SWAPTOTAL >> 10);
  OverwriteFromRight($REPORT, 'S2', $SWAPUSED >> 10);
  OverwriteFromRight($REPORT, 'S3', $SWAPFREE >> 10);
  OverwriteFromRight($REPORT, 'S4', $SWAPPERCENT);
  OverwriteFromRight($REPORT, 'V1', $VMTOTAL >> 10);
  OverwriteFromRight($REPORT, 'V2', $VMUSED >> 10);
  OverwriteFromRight($REPORT, 'V3', $VMFREE >> 10);
  OverwriteFromRight($REPORT, 'V4', $VMPERCENT);
  CLS();
  print $REPORT;
}
##################################################
#                                       v2022.8.10
# This function returns important memory-related
# system resource counters from a Windows OS.
# Minimum OS requirements: Windows XP
# Returns the following values:
#
#   ARRAY[0] = Operating system name and version
#   ARRAY[1] = System uptime in seconds
#   ARRAY[2] = Number of current processes
#   ARRAY[3] = Number of current threads
#   ARRAY[4] = KB of total physical memory installed in the computer
#   ARRAY[5] = KB of total physical memory accessible to the operating system
#   ARRAY[6] = KB of physical memory used
#   ARRAY[7] = KB of physical memory free
#   ARRAY[8] = Percentage of physical memory used
#   ARRAY[9] = KB of total swap space
#   ARRAY[10] = KB of used swap space
#   ARRAY[11] = KB of free swap space
#   ARRAY[12] = Percentage of swap space used
#   ARRAY[13] = KB of total virtual memory available to the system
#   ARRAY[14] = KB of used virtual memory
#   ARRAY[15] = KB of free virtual memory
#   ARRAY[16] = Percentage of virtual memory used
#
# Usage: ARRAY = WindowsResources()
#
sub WindowsResources
{
  print "\n  Collecting memory use information...";
  $^O =~ /MSWIN/i or return (0) x 16;

  my $OSNAME = `VER`;
  $OSNAME = Trim($OSNAME);
  my $TEMPDIR = 'C:\\TEMP';

  # To get these values in Windows, we run a small Javascript
  # program that collects these values and prints them to stdout.
  # Then we just capture stdout...

  -d $TEMPDIR or CreatePath($TEMPDIR);
  my $JSFILE = "$TEMPDIR\\MEM.JS";
  $JSFILE =~ tr|\\||s;  # Remove double backslash characters
  my $JSCODE = "DATA = '0|0|0|0|0|0|0'; try { WMI = GetObject('winmgmts:{impersonationLevel=impersonate}!\\\\\\\\.\\\\root\\\\cimv2'); M = WMI.ExecQuery('select * from Win32_PerfFormattedData_PerfOS_System'); e = new Enumerator(M); UPTIME = e.item().SystemUpTime; PROCESSES = e.item().Processes; THREADS = e.item().Threads; M = WMI.ExecQuery('select * from Win32_PhysicalMemory'); e = new Enumerator(M); PHYSTOTAL = Math.round(e.item().Capacity / 1024); M = WMI.ExecQuery('select * from Win32_PerfFormattedData_PerfOS_Memory'); e = new Enumerator(M); PHYSFREE = e.item().AvailableKBytes; SWAPTOTAL = Math.round(e.item().CommitLimit/1024); SWAPUSED = Math.round(e.item().CommittedBytes/1024); DATA = [UPTIME, PROCESSES, THREADS, PHYSTOTAL, PHYSFREE, SWAPTOTAL, SWAPUSED].join('|'); } catch (e) {} WScript.StdOut.WriteLine(DATA);";
  my ($RETRY, $RAW, $UPTIME, $PROCESSES, $THREADS, $RAMINSTALLED, $PHYSFREE, $SWAPTOTAL, $SWAPUSED) = (4);
  while ($RETRY--)
  {
    # Tested on Windows XP: I am not sure why, but on a rare occasion the
    # JavaScript program fails to get the values, so we do a retry up to 4 times.
    CreateFile($JSFILE, $JSCODE);
    $RAW = Trim(`C:\\WINDOWS\\SYSTEM32\\CSCRIPT.EXE //Nologo $JSFILE`);
    ($UPTIME, $PROCESSES, $THREADS, $RAMINSTALLED, $PHYSFREE, $SWAPTOTAL, $SWAPUSED) = split(/\|/, $RAW);
    if (length($PROCESSES) > 0 && $PROCESSES ne '0') { last; }
    if (length($PHYSFREE) > 0 && $PHYSFREE ne '0') { last; }
    if (length($THREADS) > 0 && $THREADS ne '0') { last; }
    if (length($UPTIME) > 0 && $UPTIME ne '0') { last; }
  }
  print " DONE.\n\n  Collecting uptime data...";

  if ($UPTIME == 0)  # If this method didn't work, then we try another way.
  {
    my $LASTBOOT = `WMIC OS GET LastBootupTime`;
    $LASTBOOT =~ tr|0-9||cd;                # Leave digits only.
    my $YR = substr($LASTBOOT, 0, 4);
    my $MONTH = substr($LASTBOOT, 4, 2);
    my $DAY = substr($LASTBOOT, 6, 2);
    my $HR = substr($LASTBOOT, 8, 2);
    my $MIN = substr($LASTBOOT, 10, 2);
    my $SEC = substr($LASTBOOT, 12, 2);
    my ($CURSEC, $CURMIN, $CURHR, $CURDAY, $CURMONTH, $CURYR) = localtime();
    $CURYR += 1900;
    $CURMONTH++;
    $UPTIME = ($CURSEC - $SEC) + ($CURMIN - $MIN) * 60 + ($CURHR - $HR) * 3600 + ($CURDAY - $DAY) * 86400 + ($CURMONTH - $MONTH) * 2635200 + ($CURYR - $YR) * 31536000;
  }
  print " DONE.\n\n  Requesting amount of total physical memory...";

  # To get the total memory available, we use the WMIC command,
  # which unfortunately is not very efficient, but it gets the job done.
  my $PHYSTOTAL = `WMIC COMPUTERSYSTEM GET TotalPhysicalMemory`;

  # NOTE: This whole process requires at least 15 MB of memory.
  # CSCRIPT.EXE which runs the JavaScript code takes about 5 MB.
  # Issuing the WMIC command takes about 5-6 MB.
  # And during this process, WMIPRVSE.EXE starts up, which again requires about 6 MB.
  # And of course, all this takes at least 1000ms if not more, so it's not a
  # good idea to call this function many times repeatedly.

  $PHYSTOTAL =~ tr|0-9||cd;                   # Get rid of letters; leave numbers only.
  $PHYSTOTAL = int($PHYSTOTAL / 1024 + 0.5);  # Total physical memory that Windows can access
  my $PHYSUSED = $PHYSTOTAL - $PHYSFREE;
  my $SWAPFREE = $SWAPTOTAL - $SWAPUSED;
  my $VMTOTAL = $PHYSTOTAL + $SWAPTOTAL;
  my $VMUSED = $PHYSUSED + $SWAPUSED;
  my $VMFREE = $VMTOTAL - $VMUSED;
  my   $VMPERCENT = int((  $VMUSED / (  $VMTOTAL + 0.00001)) * 100 + 0.5);
  my $PHYSPERCENT = int(($PHYSUSED / ($PHYSTOTAL + 0.00001)) * 100 + 0.5);
  my $SWAPPERCENT = int(($SWAPUSED / ($SWAPTOTAL + 0.00001)) * 100 + 0.5);
  print " DONE.\n\n";
  sleep(1);
  return ($OSNAME, $UPTIME, $PROCESSES, $THREADS, $RAMINSTALLED, $PHYSTOTAL, $PHYSUSED, $PHYSFREE, $PHYSPERCENT, $SWAPTOTAL, $SWAPUSED, $SWAPFREE, $SWAPPERCENT, $VMTOTAL, $VMUSED, $VMFREE, $VMPERCENT);
}
##################################################
#                                       v2022.8.11
# This function is the same as WindowsResources()
# and returns the same numbers in the same format
# but this function is designed to collect
# the data on a Linux system.
#
# Usage: ARRAY = LinuxResources()
#
sub LinuxResources
{
  print "\n  Reading OS name...";
  my $OSNAME = `hostnamectl`;
  $OSNAME = cut($OSNAME, 'Operating System: ', 0x001);
  $OSNAME = cut($OSNAME, "\n", 0x110);

  print " DONE.\n\n  Reading uptime...";

  # /proc/uptime is a file that contains two numbers such as "1381.20 2101.47"
  # The first number is the uptime in seconds.
  my $UPTIME = ReadFile('/proc/uptime');
  $UPTIME = (GetNumbers("$UPTIME 0"))[0];

  print " DONE.\n\n  Collecting information about threads and processes...";

  # The ps command lists all the processes, so we just count
  # the number of lines that are returned.
  my $PROCESSES = `ps -e --no-header`;
  my @LINES = split(/\n/, $PROCESSES);
  $PROCESSES = 0;
  foreach (@LINES) { ($_ =~ m/[a-zA-Z0-9]+/) and $PROCESSES++; }

  # We get the total number of threads by
  # counting all the directories under /proc/*/task/
  # Source: https://www.tutorialspoint.com/count-the-number-of-threads-in-a-process-on-linux
  # These directories all start with a number, so we just check if the first character
  # of the line begins with a digit, and if so, we increment the thread counter.
  my $THREADS = `ls /proc/*/task`;
  @LINES = split(/\n/, $THREADS);
  $THREADS = 0;
  foreach (@LINES) { ($_ =~ m/^[0-9]+/) and $THREADS++; }

  print " DONE.\n\n  Checking memory usage...";

  # Now we check our memory.
  my ($COL_FREE, $COL_TOTAL);
  my $MEM = `free -m`;     # Give us the values in megabytes, please!

# This command yields us a list that looks like this:
#
#              total        used        free      shared  buff/cache   available
#Mem:        1643600      221152      446540       33368      975908     1356912
#Swap:             0           0           0
#

# Our assumption is that the columns and rows might vary on this chart
# however the labels such as 'total' and 'free' and 'mem' and 'swap' will
# still be on there somewhere. So, our job is to read the chart and
# store the numbers in the right place.

  @LINES = split(/\n/, uc($MEM));
  my @FREE = (0, 0, 0);
  my @TOTAL = (0, 0, 0);
  my $SEL = 0;
  foreach (@LINES)
  {
    my @WORDS = SplitWords($_);
    for (my $i = 0; $i < @WORDS; $i++)
    {
         if ($WORDS[$i] eq 'FREE')  { $COL_FREE  = $i+1; }
      elsif ($WORDS[$i] eq 'TOTAL') { $COL_TOTAL = $i+1; }
      elsif ($i == 0 && index($WORDS[0], 'MEM') >= 0) { $SEL = 1; }
      elsif ($i == 0 && index($WORDS[0], 'SWAP') >= 0) { $SEL = 2; }
      elsif ($i == $COL_TOTAL) { $TOTAL[$SEL] .= ' ' . $WORDS[$i]; }
      elsif ($i == $COL_FREE)  { $FREE[$SEL]  .= ' ' . $WORDS[$i]; }
    }
  }
  my $PHYSTOTAL = $TOTAL[1]; my $PHYSFREE = $FREE[1]; my $PHYSUSED = $PHYSTOTAL - $PHYSFREE;
  my $SWAPTOTAL = $TOTAL[2]; my $SWAPFREE = $FREE[2]; my $SWAPUSED = $SWAPTOTAL - $SWAPFREE;

  my $VMTOTAL = $PHYSTOTAL + $SWAPTOTAL;
  my $VMUSED = $PHYSUSED + $SWAPUSED;
  my $VMFREE = $VMTOTAL - $VMUSED;
  my   $VMPERCENT = int((  $VMUSED / (  $VMTOTAL + 0.00001)) * 100 + 0.5);
  my $PHYSPERCENT = int(($PHYSUSED / ($PHYSTOTAL + 0.00001)) * 100 + 0.5);
  my $SWAPPERCENT = int(($SWAPUSED / ($SWAPTOTAL + 0.00001)) * 100 + 0.5);

  # Unfortunately, I don't know how to find the total RAM
  # installed in the computer, so we'll just try to guess it:
  # If the OS reports, let's say, 782MB total physical memory,
  # then probably the computer has a 1GB RAM stick in the motherboard.
  # So, we will report 1GB as the installed RAM.  
  my $RAMINSTALLED = $PHYSTOTAL;
  foreach (2, 4, 8, 16, 32, 64, 128, 256, 512, 768, 1024, 1536, 2048, 3072, 2560, 4096, 6144, 8192, 10240, 12288, 16384, 32768, 65536, 131072, 262144, 524288, 1048576, 2097152, 4194304)
  {
    if ($RAMINSTALLED == $_) { last; }
    if ($RAMINSTALLED < $_) { $RAMINSTALLED = $_; last; }
  }
  print " DONE.\n\n";
  sleep(1);
  return ($OSNAME, $UPTIME, $PROCESSES, $THREADS, $RAMINSTALLED, $PHYSTOTAL, $PHYSUSED, $PHYSFREE, $PHYSPERCENT, $SWAPTOTAL, $SWAPUSED, $SWAPFREE, $SWAPPERCENT, $VMTOTAL, $VMUSED, $VMFREE, $VMPERCENT);
}
##################################################
#                                       v2022.8.11
# Returns a number indicating what type of
# OS environment is used:
#
#   1 = Perl designed for DOS is running in DOS mode
#   2 = Perl designed for DOS is running in Windows
#   3 = Perl compiled for Windows is running under Windows
#   4 = Perl compiled for Linux is running in Linux
#   5 = Perl compiled for iOS is running
#   6 = something else
#
# Usage: INTEGER = DetectOS()
# 
sub DetectOS
{
  my $OS = uc($^O);
  if (index($OS, 'MSWIN') >= 0) { return 3; }
  if (index($OS, 'LINUX') >= 0) { return 4; }
  if (index($OS, 'DARWIN') >= 0) { return 5; }
  if (index($OS, 'DOS') >= 0) {
    return (exists($ENV{WINDIR}) || exists($ENV{PROCESSOR_ARCHITECTURE}) ||
      exists($ENV{ALLUSERSPROFILE}) || exists($ENV{PROGRAMFILES}) ||
      exists($ENV{HOMEPATH}) || exists($ENV{APPDATA})) ? 2 : 1;
  }
  return 6;
}
##################################################
#
# This function inserts commas into a number at
# every 3 digits and returns a string.
# Usage: STRING = Commify(INTEGER)
# Copied from www.PerlMonks.org/?node_id=157725
#
sub Commify
{
  my $N = reverse $_[0];
  $N =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  return scalar reverse $N;
}
##################################################
#                                       v2021.1.17
# This function extracts digits from a string and
# returns them in an array.
#   Example:
# GetNumbers("34DX5g") -> ["34", "5"]
# GetNumbers("-x39.4") -> ["39", "4"]
# Usage: ARRAY = GetNumbers(STRING)
#
sub GetNumbers
{
  my @N;
  defined $_[0] or return @N;
  my ($L, $p, $i, $c) = (length($_[0]), -1);
  for ($i = 0; $i <= $L; $i++)
  {
    $c = vec($_[0], $i, 8);
    if ($c < 48 || $c > 57)
    {
      if ($p >= 0) { push(@N, substr($_[0], $p, $i - $p)); }
      $p = -1;
    }
    elsif ($p < 0) { $p = $i; }
  }
  return @N;
}
##################################################
#                                       v2022.8.11
# This function splits a string along whitespace,
# newline characters, vertical tab, null, bel, esc, etc.
# and returns the words in an array. Any character
# whose ASCII value is less than 33 is treated as
# a separator. No empty elements are returned!!
# Example:
#   SplitWords('   5 apples    1/2  watermelon') => ('5', 'apples', '1/2', 'watermelon')
#
# Usage: ARRAY = SplitWords(STRING)
#
sub SplitWords
{
  my @A;
  defined $_[0] or return @A;
  my ($START, $LAST, $N, $L) = (0, 0, 0, length($_[0]));
  for (my $i = 0; $i <= $L; $i++)
  {
    if (vec($_[0], $i, 8) > 32)
    {
      $LAST or $START = $i;
      $LAST = $i + 1;
    }
    elsif ($LAST)
    {
      $A[$N++] = substr($_[0], $START, $LAST - $START);
      $LAST = 0;
    }
  }
  return @A;
}
##################################################
#                                       v2022.8.10
# This function allows you to create nice reports
# in memory where the numbers must be aligned to
# the right.
#
# This function looks for the first occurrence of string B
# which we call a "MARKER" within string A which is the
# report input string. If the marker is found, it will
# be overwritten with string C starting from the right,
# so the output will look like the value is aligned right.
#
#  Here is an example:
#    String A = '...........X lbs. '  <= original string
#    String B = 'X'                   <= marker
#    String C = '3,587.42'            <= paste
#    Output   = '....3,587.42 lbs. '  <= result
#
# As you can see, the number was placed
# where the X was using right alignment.
#
# Usage: STRING = OverwriteFromRight(STRING_A, STRING_B, STRING_C)
#
sub OverwriteFromRight
{
  my ($A, $MARKER, $B) = @_;
  $B = ' ' . Commify($B);
  my $FOUND = index($A, $MARKER);
  $FOUND >= 0 or return;
  my $POS = $FOUND + length($MARKER) - length($B);
  if ($POS < 0) { $B = substr($B, $FOUND, ); }     # FINISH THIS LATER
  return substr($_[0], $POS, length($B)) = $B;
}
##################################################
#                                       v2022.8.11
# Returns 1 in Windows if the specified drive
# letter exists, otherwise returns zero.
# Usage: INTEGER = DriveExists(STRING)
#
sub DriveExists
{
  $^O =~ /MSWIN/i or return 0;
  my $TEST = defined $_[0] ? substr($_[0], 0, 1) : '';
  length($TEST) == 1 || return 0;
  $TEST = `CD $TEST:`;
  return ($TEST =~ /CANNOT FIND THE DRIVE/i) ? 0 : 1;
}
##################################################
#                                        v2021.1.7
# This function searches for a substring and
# returns either the string following or preceding
# the match depending on the value of CMD.
# CMD is a hexadecimal number that tells the function
# how to match and which part of the string to return.
#  0x00001 : Return the string AFTER the substring.
#  0x00010 : Return the string BEFORE the substring.
#  0x00100 : If the match isn't found, return the whole string.
#  0x01000 : Convert string to uppercase before matching.
#  0x10000 : Start searching from the end of string.
# These values can be combined with OR.
# In addition, this function also works like the
# split() method. It splits string along substring
# and returns the first part in $a and the second
# part in $b. If substring is not found,
# $a and $b will be empty strings.
#
# Usage: STRING = cut(STRING, SUBSTR, [CMD])
#
sub cut
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $SUB = defined $_[1] ? $_[1] : '';
  my $CMD = defined $_[2] ? $_[2] : 0x111;
  my $P = ($CMD & 0x1000)  ?
    (($CMD & 0x10000) ? rindex(uc($STR), $SUB) : index(uc($STR), $SUB))
   :
    (($CMD & 0x10000) ? rindex($STR, $SUB) : index($STR, $SUB));
  $a = $b = '';
  $P < 0 and return ($CMD & 256) ? $STR : '';
  $a = substr($STR, 0, $P);
  $b = substr($STR, $P + length($SUB));
  return ($CMD & 16 ? $a : '') . ($CMD & 1 ? $b : '');
}
##################################################
#                                       v2022.8.16
# Prints some text in the center of the screen.
# Usage: CENTER(STRING)
#
sub CENTER
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $LEN = length($STR);
  if ($LEN >= 78) { print ' ', substr($STR, 0, 78), " \n"; return; }
  my $PADDING = ' ' x int(40 - $LEN / 2);
  return $PADDING . $STR . $PADDING . (' ' x (length($STR) & 1)) . " \n";
}
##################################################
#                                       v2022.8.28
# Assembles two or more strings to form a path.
# Removes duplicate slashes and resolves . and ..
# directory references. On Linux and MacOS systems,
# it returns a path string separated by forward slashes,
# and on Windows and DOS, it returns a path separated
# by backslash characters.
#
# Usage: STRING = MergePath(STRINGs)
#
sub MergePath { return FixPath(join('/', @_)); }

##################################################
#                                       v2022.8.27
# Changes the file name separator to forward slash
# or backslash depending on the current OS.
# Resolves . and .. in path strings.
# Eliminates duplicate slashes.
#
# Examples:
#     ../..               => ../..
#     a/b/././../../..    => ..
#     /a/b/c/./../x.txt   => /a/b/x.txt
#     a/../../../x.txt    => ../../x.txt
#     /a/b/../../../x.txt => /x.txt
#
# Paths can contain too many .. which point to nowhere.
# In that, case the function ignores the error and
# tries to resolve it as much as possible:
#
#     /../                => /
#     /../../a/b/c        => /a/b/c
#
# Usage: STRING = FixPath(PATH)
#
sub FixPath
{
  my $P = defined $_[0] ? $_[0] : '';

  $P =~ tr`\x00-\x1F\"\|<>``d;  # Remove illegal characters: < > | " \t \r \n \0
  $P =~ tr`\\`/`;  # Change all backslash to forward slash.
  $P =~ tr|\/||s;   # Remove duplicate slashes.

  my $DRV = '';
  if (vec($P, 1, 8) == 58) { $DRV = substr($P, 0, 2); $P = substr($P, 2); }

  my $ABS = '';
  if (vec($P, 0, 8) == 47) { $ABS = 1; $P = substr($P, 1); }

  # Split the path string along '/' characters
  my @D = split(/\//, $P);
  my $i = @D;

  # First, let's eliminate '.' from the path string.
  while ($i--)
  {
    $D[$i] = Trim($D[$i]);
    if (length($D[$i]) == 0 || $D[$i] eq '.') { splice(@D, $i, 1); }
  }

  # Next, we resolve '..' in the path string.
  for ($i = 0; $i < @D; $i++)
  {
    if ($D[$i] eq '..')
    {
      if ($i == 0)
      {
        # If the path string begins with ..
        # then we can do one of two things: either eliminate
        # it or leave it. We eliminate it if the path is an absolute path,
        # because you can't go one level higher than /
        # If the path looks like ../a.txt then it's a relative path,
        # and we have to leave it like it is. But if it looks like
        # /../a.txt then we eliminate those, because /../a.txt
        # makes no sense. This is an invalid path.
        if ($ABS) { splice(@D, $i--, 1); }
        next;
      }

      # If we encounter a '..' but the previous string was also '..'
      # then we can't resolve it. Two '..' separated by '/' don't
      # cancel each other out. We skip this and move on...
      if ($D[$i - 1] eq '..') { next; }

      # Okay, if we can cancel out the previous string, then we use
      # the splice() function to erase the current '..' and the string before it.
      splice(@D, $i - 1, 2);
      $i -= 2;
    }
  }

  # Here we rebuild the original path string.
  $P = $DRV . ($ABS ? '/' : '') . join('/', @D);

  $P =~ tr`/``s;   # Remove duplicate slashes just in case. -- THIS LINE MAY BE UNNECESSARY. WILL HAVE TO REVIEW...

  # Change all forward slashes to backslash on DOS/Windows.
  if ($^O =~ m/DOS|MSWIN/i) { $P =~ tr`/`\\`; }
  # And we're done!

  return $P;
}
##################################################
#                                        v2022.9.2
# This function creates a bunch of subdirectories
# if they don't exist yet. If everything goes well,
# it returns the number of subdirectories created
# PLUS ONE. Returns zero if something went wrong.
#
# CAUTION: Do not mistype the path name!!!
# Also, if a file name exists that matches the
# directory name you want to create, the file will
# be renamed first (if the rename is unsuccessful,
# the file will be deleted) and the directory
# will be created in its place.
#
# For example, let's say you have a file called
# /tmp/mynotes and you call CreatePath('/tmp/mynotes/2022/March')
# In this case, the mynotes file will be renamed
# to mynotes.BAK, and the directory structure
# is then created. The return value is 4.
#
# Usage: INTEGER = CreatePath(PATH)
#
sub CreatePath
{
  my $PATH = MergePath($_[0], '.');   # Resolve . and .. references
  $PATH =~ tr`\\`/`;   # Change all backslash to forward slash for now.

  my $PREV = 0;
  my $CREATED = 0;
  for (my $i = 0; $i < length($PATH); $i++)
  {
    my $c = vec($PATH, $i, 8);
    if ($c == 47)             # Forward slash?
    {
      # Skip root. Don't test whether / or drive C:\ exists or not.
      next if ($i == 0 || $PREV == 58);

      my $F = substr($PATH, 0, $i - 1);
      if (-e $F)              # Is this name taken already?
      {
        if (-d $F) { next; }  # Yes, but it's a directory. Okay, perfect!
        rename $F, "$F.BAK";
        unlink $F;            # If the rename was unsuccessful, we delete it.
      }
      mkdir($F, 0664);        # And create a directory.
      $CREATED++;
    }
    $PREV = $c;
  }
  return (-d $PATH) ? $CREATED + 1 : 0;
}
##################################################
#                                       v2022.8.28
# Removes whitespace from before and after a string.
#          
# Usage: STRING = Trim(STRING)
#
sub Trim
{
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';   # String length is zero?
  my $P = 0;
  while ($P <= $L && vec($_[0], $P++, 8) < 33) {}       # Find first non-whitespace
  for ($P--; $P <= $L && vec($_[0], $L--, 8) < 33;) {}  # Find last non-whitespace
  return substr($_[0], $P, $L - $P + 2);
}
##################################################
#                                       v2022.8.26
# Reads an entire binary file or part of a file
# using the sysopen(), sysseek() and sysread()
# functions. Returns the file's content as a string.
#
# An optional second argument will move the file
# pointer before reading, and an optional third
# argument can limit the number of bytes to read.
#
# IMPORTANT: This function should NOT be used to read
# very large files, because it's inefficient for
# that purpose!
#
# Usage: CONTENT = ReadFile(FILENAME, [START, [LENGTH]])
#
sub ReadFile
{
  my $FILE = defined $_[0] ? $_[0] : '';  # File name
  my $PTR = defined $_[1] ? $_[1] : 0;    # File pointer
  my $N = defined $_[2] ? $_[2] : 0;      # Bytes to read

  # First, we will remove double quotes, $ sign, null * ? < > | and
  # various other illegal characters from the file name.
  $FILE =~ tr#<>*%$?\x00-\x1F\"\|##d;

  -e $FILE || return '';  # Let's check if the file exists.
  -f $FILE || return '';  # Check if it's a plain file.
  my $SIZE = -s $FILE;    # Get file size.
  $SIZE || return '';     # File size is zero?

  # Make sure all parameters are valid.
  if ($N < 0 || $PTR < 0 || $PTR >= $SIZE) { return ''; }

  # The sysread() function will reserve EXACTLY as many bytes of memory
  # as specified in its third argument even if the file size is much smaller.
  # So, it is a good idea to check and make sure that the LENGTH argument
  # does not hold a value that is far greater than necessary.
  $SIZE -= $PTR;  # Calculate the maximum value for the LENGTH argument.
  if ($N == 0 || $N > $SIZE) { $N = $SIZE; }
  
  local *H;
  sysopen(H, $FILE, 0) || return '';   # Try to open file for read only.
  $PTR && sysseek(H, $PTR, 0);         # Move the file pointer if necessary.
  my $DATA = '';
  sysread(H, $DATA, $N);               # Read $N number of bytes from file into $DATA.
  close H;
  return $DATA;
}
##################################################
#                                      v2022.08.26
# Creates and overwrites a file in binary mode.
# Returns 1 on success or 0 if something went wrong.
#
# The second argument that holds the content to be
# written can be either a scalar or scalar reference.
#
# Usage: STATUS = CreateFile(FILENAME, CONTENT)
#
sub CreateFile
{
  my $FILE = defined $_[0] ? $_[0] : '';  # Get file name.
  my $DATA = defined $_[1] ? $_[1] : '';  # Get content.

  # The content to be written can be type scalar or scalar reference.
  # Here we figure out which one it is.
  my $REF = length(ref($DATA));
  $REF == 0 || $REF == 6 || return 0;   # 'SCALAR' has 6 letters
  if ($REF == 0) { $REF = 6; $DATA = \$_[1]; }

  # Get content length.
  my $LEN = ($REF) ? length($$DATA) : length($DATA);

  # Remove double quotes, $ sign, null * ? < > | and
  # various other illegal characters from the file name.
  $FILE =~ tr#<>*%$?\x00-\x1F\"\|##d;

  local *H;
  open(H, ">$FILE") or return 0;
  binmode H;
  if ($LEN) { print H $REF ? $$DATA : $DATA; }
  close H;
  -e $FILE or return 0;               # File exists?
  -f $FILE or return 0;               # It's a plain file?
  return (-s $FILE == $LEN) ? 1 : 0;  # Double check file size.
}
##################################################
# Usage: CLS() - Clears the terminal window.
#
sub CLS
{
  if ($OS == 1) { system('CLS'); }
  elsif ($OS == 2 || $OS == 3) { system('COMMAND.COM /C CLS'); }
  elsif ($OS == 5) { print "\x1Bc\x1B[0m\x1B[3J\x1B[H\x1B[2J"; }
  else { print "\x1B[3J"; }
}
##################################################