#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Write data in tabular text format
# Philip R Brenan at gmail dot com, Appa Apps Ltd Inc, 2016-2018
#-------------------------------------------------------------------------------
# podDocumentation
# to escape an open parenthesis in a re use \x28, close is \x29

package Data::Table::Text;
use v5.8.0;
our $VERSION = '20180929';
use warnings FATAL => qw(all);
use strict;
use Carp qw(confess carp cluck);
use Cwd;
use File::Path qw(make_path);
use File::Glob qw(:bsd_glob);
use File::Temp qw(tempfile tempdir);
use POSIX qw(strftime);                                                         # http://www.cplusplus.com/reference/ctime/strftime/
use Data::Dump qw(dump);
use JSON;
use MIME::Base64;
use Storable qw(store retrieve);
use String::Numeric qw(is_float);
use Time::HiRes qw(gettimeofday);
use utf8;
sub ˢ(&);                                                                       # Immediately executed inline sub to allow a code block before B<if>.

#D1 Time stamps                                                                 # Date and timestamps as used in logs of long running commands.

sub dateTimeStamp                                                               # Year-monthNumber-day at hours:minute:seconds
 {strftime('%Y-%m-%d at %H:%M:%S', localtime)
 }

sub dateStamp                                                                   # Year-monthName-day
 {strftime('%Y-%b-%d', localtime)
 }

sub versionCode                                                                 # YYYYmmdd-HHMMSS
 {strftime('%Y%m%d-%H%M%S', localtime)
 }

sub versionCodeDashed                                                           # YYYY-mm-dd-HH:MM:SS
 {strftime('%Y-%m-%d-%H:%M:%S', localtime)
 }

sub timeStamp                                                                   # hours:minute:seconds
 {strftime('%H:%M:%S', localtime)
 }

sub microSecondsSinceEpoch                                                      # Micro seconds since unix epoch.
 {my ($s, $u) = gettimeofday();
  $s*1e6 + $u
 }

#D1 Command execution                                                           # Various ways of processing commands.

sub xxx(@)                                                                      # Execute a shell command. The command to execute is specified as one or more strings which are joined together after removing any new lines. Optionally the last string can be a regular expression that is used to test the output generated by the execution the command: if the regular expression fails the command output is printed, else it is suppressed as being uninteresting.
 {my (@cmd) = @_;                                                               # Command to execute followed by an optional regular expression to test the results
  @cmd or confess "No command\n";                                               # Check that there is a command to execute
  $_ or confess "Missing command component\n" for @cmd;                         # Check that there are no undefined command components
  my $success = $cmd[-1];                                                       # Error check if present
  my $check = ref($success) =~ /RegExp/i;                                       # Check for error check
  pop @cmd if $check;                                                           # Remove check from command
  my $cmd = join ' ', @cmd;                                                     # Command to execute
  say STDERR timeStamp, " ", $cmd unless $check;                                # Print the command unless there is a check in place
  my $response = qx($cmd 2>&1);                                                 # Execute command
  $response =~ s/\s+\Z//s;                                                      # Remove trailing white space from response
  say STDERR $response if $response and !$check;                                # Print non blank error message
  confess $response if $response and $check and $response !~ m/$success/;       # Error check if an error checking regular expression has been supplied
  $response
 }

sub yyy($)                                                                      # Execute a block of shell commands line by line after removing comments - stop if there is a non zero return code from any command.
 {my ($cmd) = @_;                                                               # Commands to execute separated by new lines
  for(split /\n/, $cmd)                                                         # Split commands on new lines
   {s(#.*\Z)()gs;                                                               # Remove comments
    next if !$_ or m(\A\s*\Z);                                                  # Skip blank lines
    say   STDERR timeStamp, " ", $_;                                            # Say command
    print STDERR $_ for qx($_);                                                 # Execute command
    say STDERR '';
   }
 }

sub zzz($;$$$)                                                                  # Execute lines of commands after replacing new lines with && then check that the pipeline execution results in a return code of zero and that the execution results match the optional regular expression if one has been supplied; confess() to an error if either check fails.
 {my ($cmd, $success, $returnCode, $message) = @_;                              # Commands to execute - one per line with no trailing &&, optional regular expression to check for acceptable results, optional regular expression to check the acceptable return codes, message of explanation if any of the checks fail
  $cmd or confess "No command\n";                                               # Check that there is a command to execute
  my @c;                                                                        # Commands
  for(split /\n/, $cmd)                                                         # Split commands on new lines
   {s(#.*\Z)()gs;                                                               # Remove comments
    next unless m(\S);                                                          # Skip blank lines
    push @c, $_;                                                                # Save command
   }
  my $c = join ' && ', @c;                                                      # Command string to execute
  my $r = qx($c 2>&1);                                                          # Execute command
  my $R = $?;
  $r =~ s/\s+\Z//s;                                                             # Remove trailing white space from response

  confess "Error:\n".                                                           # Check the error code and results
    ($message ? "$message\n" : '').                                             # Explanation if supplied
    "$cmd\n".                                                                   # Commands being executed
    "Return code: $R\n".                                                        # Return code
    "Result:\n$r\n" if                                                          # Output from commands so far
    $R && (!$returnCode or $R !~ /$returnCode/) or                              # Return code not zero and either no return code check or the return code checker failed
    $success && $r !~ m/$success/s;                                             # Results check failed
  $r
 }

sub parseCommandLineArguments(&$;$)                                             # Classify the specified array of words referred to by B<$args> into positional and keyword parameters, call the specified B<sub> with a reference to an array of positional parameters followed by a reference to a hash of keywords and their values then return the value returned by this sub. The keywords names will be validated if  B<$valid> is either a reference to an array of valid keywords names or a hash of valid keyword names => textual descriptions. Confess with a table of valid keywords definitions if the B<$valid> keywords are specified and an invalid one is presented.
 {my ($sub, $args, $valid) = @_;                                                # Sub to call, list of arguments to parse, optional list of valid parameters else all parameters will be accepted
  my %valid =                                                                   # Valid keywords
   ˢ{return () unless $valid;                                                   # No keywords definitions
     return map {lc($_)=>0} @$valid if ref($valid) =~ m(array)is;               # Keyword names as an array but with no explanation
     %$valid                                                                    # Hash of keyword name=>explanation
    };
 my %hash;
  my @array;
  for my $arg(@$args)                                                           # Each arg
   {if ($arg =~ m/\A-+(\S+?)(=(.+))?\Z/)                                        # Keyword parameter
     {if ($valid and !defined($valid{lc($1)}))                                  # Validate keyword name
       {my @s;
        for my $k(sort keys %valid)                                             # Create a table of valid keywords
         {if (my $v = $valid{$k})
           {push @s, [$k, $v];
           }
          else
           {push @s, [$k];
           }
         }
        if (@s)                                                                 # Format error message
         {my $s = formatTable(\@s, [qw(Keyword Description)]);
          confess "Invalid parameter: $arg\nValid keyword parameters are:\n$s\n";
         }
        else
         {confess "Invalid parameter: $arg\n";
         }
       }
      $hash{lc($1)} = $3;                                                       # Save valid keyword parameter
     }
    else                                                                        # Positional parameter
     {push @array, $arg;
     }
   }
  $sub->([@array], {%hash})
 }

sub call(&@)                                                                    # Call the specified sub in a separate process, wait for it to complete, copy back the named L<our> variables, free the memory used.
 {my ($sub, @our) = @_;                                                         # Sub to call, our variable names with preceding sigils to copy back
  my ($package)   = caller;                                                     # Caller's package
  unless(my $pid  = fork)                                                       # Fork - child
   {&$sub;                                                                      # Execute the sub
    my @save = '';                                                              # Code to copy back our variables
    for my $our(@our)                                                           # Each variable
     {my ($sigil, $var) = $our =~ m(\A(.)(.+)\Z)s;                              # Sigil, variable name
      my $our  = $sigil.$package.q(::).$var;                                    # Add caller's package to variable name
      my $char = ord($sigil);                                                   # Differentiate between variables with the same type but different sigils
      my $file = qq(${$}$var$char.data);
      push @save, <<END                                                         # Save each our variable in a file
store \\$our, q($file);
END
     }
    my $save = join "\n", @save;                                                # Perl code to store our variables
    eval $save;                                                                 # Evaluate code to store our variables
    confess $@ if $@;                                                           # Confess any errors
    exit;                                                                       # End of child process
   }
  else                                                                          # Fork - parent
   {waitpid $pid,0;                                                             # Wait for child
    my @save = '';                                                              # Code to retrieve our variables
    my @file;                                                                   # Transfer files
    for my $our(@our)
     {my ($sigil, $var) = $our =~ m(\A(.)(.+)\Z)s;                              # Sigil, variable name
      my $our  = $sigil.$package.q(::).$var;                                    # Add caller's package to variable name
      my $char = ord($sigil);                                                   # Differentiate between variables with the same type but different sigils
      my $file = qq($pid$var$char.data);                                        # Save file
      push @save, <<END;                                                        # Perl code to retrieve our variables
$our = ${sigil}{retrieve q($file)};
END
      push @file, $file;                                                        # Remove transfer files
     }
    my $save = join "\n", @save;
    eval $save;                                                                 # Evaluate perl code
    unlink $_ for @file;                                                        # Remove transfer files
    confess "$@\n$save\n" if $@;                                                # Confess to any errors
   }
 }

#D1 Files and paths                                                             # Operations on files and paths.
#D2 Statistics                                                                  # Information about each file.

sub fileSize($)                                                                 # Get the size of a file.
 {my ($file) = @_;                                                              # File name
  return (stat($file))[7] if -e $file;                                          # Size if file exists
  undef                                                                         # File does not exist
 }

sub fileModTime($)                                                              # Get the modified time of a file in seconds since the epoch.
 {my ($file) = @_;                                                              # File name
  (stat($file))[9] // 0
 }

sub fileOutOfDate(&$@)                                                          # Calls the specified sub once for each source file that is missing, then calls the sub for the target if there were any missing files or if the target is older than any of the non missing source files or if the target does not exist. The file name is passed to the sub each time in $_. Returns the files to be remade in the order they should be made.
 {my ($make, $target, @source) = @_;                                            # Make with this sub, target file, source files
  my $exists = -e $target;                                                      # Existence of target
  my @missing = grep {!-e $_} @source;                                          # Missing files that do not exist will need to be remade
  push @missing, $target unless $exists and !@missing;                          # Add the target if there were missing files
  if (!@missing)                                                                # If there were no missing files that forced a remake, then check for a source file younger than the target that would force a remake of the target
   {my $t = fileModTime($target);                                               # Time of target
    if (grep {-e $$_[0] and $$_[0] ne $target and $$_[1] > $t}                  # Target will have to be remade if there are younger source files
        map {[$_, fileModTime($_)]}
        @source)
     {@missing = $target;
     }
   }
  my %remade;                                                                   # Files that have been remade
  my @order;                                                                    # Files that have been remade in make order
  for(@missing)
   {&$make, push @order, $_ unless $remade{$_}++;                               # Make each missing file once and then the target file
   }
  @order                                                                        # Return a list of the files that were remade
 }

sub firstFileThatExists(@)                                                      # Returns the name of the first file that exists or B<undef> if none of the named files exist.
 {my (@files) = @_;                                                             # Files to check
  for(@files)
   {return $_ if -e $_;
   }
  undef                                                                         # No such file
 }

#D2 Components                                                                  # File names and components.

#D3 Fusion                                                                      # Create file names from file name components.

sub denormalizeFolderName($)                                                    #P Remove any trailing folder separator from a folder name component.
 {my ($name) = @_;                                                              # Name
  $name =~ s([\/\\]+\Z) ()gsr;
 }

sub renormalizeFolderName($)                                                    #P Normalize a folder name component by adding a trailing separator.
 {my ($name) = @_;                                                              # Name
  ($name =~ s([\/\\]+\Z) ()gsr).'/';                                            # Put a trailing / on the folder name
 }

sub filePath(@)                                                                 # Create a file name from an array of file name components. If all the components are blank then a blank file name is returned.  Identical to L<fpf|/fpf>.
 {my (@file) = @_;                                                              # File name components
  defined($_) or confess "Missing file component\n" for @file;                  # Check that there are no undefined file components
  my @components = grep {$_} map {denormalizeFolderName($_)} @file;             # Skip blank components
  return '' unless @components;                                                 # No components resolves to '' rather than '/'
  join '/', @components;                                                        # Join separate components
 }

sub filePathDir(@)                                                              # Create a directory name from an array of file name components. If all the components are blank then a blank file name is returned.   Identical to L<fpd|/fpd>.
 {my (@file) = @_;                                                              # Directory name components
  my $file = filePath(@_);
  return '' unless $file;                                                       # No components resolves to '' rather than '/'
  renormalizeFolderName($file)                                                  # Normalize with trailing separator
 }

sub filePathExt(@)                                                              # Create a file name from an array of file name components the last of which is an extension. Identical to L<fpe|/fpe>.
 {my (@File) = @_;                                                              # File name components and extension
  my @file = grep{defined and /\S/} @_;                                         # Remove undefined and blank components
  @file > 1 or confess "At least two non blank file name components required\n";
  my $x = pop @file;
  my $n = pop @file;
  my $f = "$n.$x";
  return $f unless @file;
  filePath(@file, $f)
 }

BEGIN{*fpd=*filePathDir}
BEGIN{*fpe=*filePathExt}
BEGIN{*fpf=*filePath}

#D3 Fission                                                                     # Get file name components from file names.

sub fp($)                                                                       # Get path from file name.
 {my ($file) = @_;                                                              # File name
  return '' unless $file =~ m(\/);                                              # Must have a / in it else no path
  $file =~ s([^/]*+\Z) ()gsr
 }

sub fpn($)                                                                      # Remove extension from file name.
 {my ($file) = @_;                                                              # File name
  return '' unless $file =~ m(/);                                               # Must have a / in it else no path
  $file =~ s(\.[^.]+?\Z) ()gsr
 }

sub fn($)                                                                       # Remove path and extension from file name.
 {my ($file) = @_;                                                              # File name
  $file =~ s(\A.*/) ()gsr =~ s(\.[^.]+?\Z) ()gsr
 }

sub fne($)                                                                      # Remove path from file name.
 {my ($file) = @_;                                                              # File name
  $file =~ s(\A.*/) ()gsr;
 }

sub fe($)                                                                       # Get extension of file name.
 {my ($file) = @_;                                                              # File name
  return '' unless $file =~ m(\.)s;                                             # Must have a period
  my $f = $file =~ s(\.[^.]*?\Z) ()gsr;
  substr($file, length($f)+1)
 }

sub checkFile($)                                                                # Return the name of the specified file if it exists, else confess the maximum extent of the path that does exist.
 {my ($file) = @_;                                                              # File to check
  unless(-e $file)
   {confess "Can only find the prefix (below) of the file (further below):\n".
      matchPath($file)."\n$file\n";
   }
  $file
 }

sub quoteFile($)                                                                # Quote a file name.
 {my ($file) = @_;                                                              # File name
  qq(\"$file\")
 }

sub removeFilePrefix($@)                                                        # Removes a file prefix from an array of files.
 {my ($prefix, @files) = @_;                                                    # File prefix, array of file names
  my @f = map {s(\A$prefix) ()r} @files;
  return $f[0] if @f == 1 and !wantarray;                                       # Special case of wanting one file in scalar context
  @f
 }

sub trackFiles($@)                                                              #P Track the existence of files.
 {my ($label, @files) = @_;                                                     # Label, files
  say STDERR "$label ", dump([map{[fileSize($_), $_]} @files]);
 }

sub titleToUniqueFileName($$$$)                                                 # Create a file name from a title that is unique within the set %uniqueNames.
 {my ($uniqueFileNames, $title, $suffix, $ext) = @_;                            # Unique file names hash {} which will be updated by this method, title, file name suffix, file extension
  my $t = $title;                                                               # Title
     $t =~ s/[^a-z0-9_-]//igs;                                                  # Edit out characters that would produce annoying file names

  my $n = 1 + keys %$uniqueFileNames;                                           # Make the file name unique
  my $f = $t =~ m(\S) ?                                                         # File name without unique number if possible
        fpe(qq(${t}_${suffix}), $ext):
        fpe(        ${suffix},  $ext);

     $f = $t =~ m(\S) ?                                                         # Otherwise file name with unique number
      fpe(qq(${t}_${suffix}_${n}), $ext):
      fpe(     qq(${suffix}_${n}), $ext)
        if $$uniqueFileNames{$f};

  $$uniqueFileNames{$f}++;
  $f
 } # titleToUniqueFileName

#D2 Position                                                                    # Position in the file system.

sub currentDirectory                                                            # Get the current working directory.
 {renormalizeFolderName(getcwd)
 }

sub currentDirectoryAbove                                                       # The path to the folder above the current working folder.
 {my $path = currentDirectory;
  my @path = split m(/)s, $path;
  shift @path if @path and $path[0] =~ m/\A\s*\Z/;
  @path or confess "No directory above\n:".currentDirectory, "\n";
  pop @path;
  my $r = shift @path;
  filePathDir("/$r", @path);
 }

sub parseFileName($)                                                            # Parse a file name into (path, name, extension).
 {my ($file) = @_;                                                              # File name to parse
  return ($file) if $file =~ m{\/\Z}s or $file =~ m/\.\.\Z/s;                   # Its a folder
  if ($file =~ m/\.[^\/]+?\Z/s)                                                 # The file name has an extension
   {if ($file =~ m/\A.+[\/]/s)                                                  # The file name has a preceding path
     {my @f = $file =~ m/(\A.+[\/])([^\/]+)\.([^\/]+?)\Z/s;                     # File components
      return @f;
     }
    else                                                                        # There is no preceding path
     {my @f = $file =~ m/(\A.+)\.([^\/]+?)\Z/s;                                 # File components
      return (undef, @f)
     }
   }
  else                                                                          # The file name has no extension
   {if ($file =~ m/\A.+[\/]/s)                                                  # The file name has a preceding path
     {my @f = $file =~ m/(\A.+\/)([^\/]+?)\Z/s;                                 # File components
      return @f;
     }
    elsif ($file =~ m/\A[\/]./s)                                                # The file name has a single preceding /
     {return (q(/), substr($file, 1));
     }
    elsif ($file =~ m/\A[\/]\Z/s)                                               # The file name is a single /
     {return (q(/));
     }
    else                                                                        # There is no preceding path
     {return (undef, $file)
     }
   }
 }

sub fullFileName                                                                # Full name of a file.
 {my ($file) = @_;                                                              # File name
  filePath(currentDirectory, $file)                                             # Full file name
 }

sub printFullFileName                                                           #P Print a file name on a separate line with escaping so it can be used easily from the command line.
 {my ($file) = @_;                                                              # File name
  "\n\'".dump(fullFileName($file))."\'\n'"
 }

sub absFromAbsPlusRel($$)                                                       # Create an absolute file from an absolute file and a relative file.
 {my ($a, $f) = @_;                                                             # Absolute file name, relative file name
  my $m = "file name for the";
  defined $a or confess "Specify an absolute $m first parameter\n";
  defined $f or confess "Specify a relative $m second parameter\n";

  $a =~ m(\A/)s or confess "$a is not an absolute file name\n";

  my ($ap, $af, $ax) = parseFileName($a);
  my ($fp, $ff, $fx) = parseFileName($f);

  return $ap if defined($f) and $f eq q();                                      # Blank file name relative to
  return fpf($ap, $f) if defined($ap) and !defined($fp);                        # Short file name relative to

  my @a = split m(/), $ap;
  my @f = split m(/), $fp;
  shift @f while @f and $f[0] eq q(.);                                          # Remove leading ./
  while(@a and @f and $f[0] eq q(..)) {pop @a; shift @f};                       # Remove leading ../
  @f && $f[0] eq q(..) and confess "$f has too many leading ../\n";
  return q(/).fpe(grep {$_ and m/\S/} @a, @f, $ff, $fx) if defined $fx;

  my @A = grep {$_ and m/\S/} @a, @f, $ff, $fx;                                 # Components of new file
  return q(/).fpe(@A)    if @A >  1 and  defined($fx);
  return q(/).fpf(@A)    if @A >  1 and !defined($fx) and  defined($ff);
  return q(/).fpd(@A)    if @A >  1 and !defined($fx) and !defined($ff);
  return q(/).$A[0].q(/) if @A == 1 and !defined($ff);
  return q(/).$A[0]      if @A == 1 and  defined($ff);
  q(/)
 }

sub relFromAbsAgainstAbs($$)                                                    # Derive a relative file name for the first absolute file name relative to the second absolute file name.
 {my ($f, $a) = @_;                                                             # Absolute file to be made relative, absolute file name to make relative to.
  my $m = q(Specify an absolute file name for the);
  defined $f or confess "$m first parameter\n";
  defined $a or confess "$m second parameter\n";
  $f =~ m(\A/)s or confess "$f is not an absolute file name\n";
  $a =~ m(\A/)s or confess "$a is not an absolute file name\n";

  my ($ap, $af, $ax) = parseFileName($a);
  my ($fp, $ff, $fx) = parseFileName($f);

  my @a = $ap ? split m(/), $ap : q(/);
  my @f = $fp ? split m(/), $fp : q(/);

  while(@a and @f and $a[0] eq $f[0]) {shift @a; shift @f};
  my @l = (q(..)) x scalar(@a);
  pop @l if $fp && $fp eq "/";
  push @l, q(..) if $ap && $ap eq "/" and defined $af;
  return fpe(@l, @f, grep{$_ and m/\S/} $ff, $fx) if  defined($fx);
  return fpf(@l, @f, grep{$_ and m/\S/} $ff) if !defined($fx) and defined($ff);
  my $s = fpd(@l, @f, grep{$_ and m/\S/} $ff);
  return "./" unless $s;
  $s;
 }

#D2 Temporary                                                                   # Temporary files and folders

sub temporaryFile                                                               # Create a temporary file that will automatically be L<unlinked|/unlink> during END processing.
 {my ($fh, $filename) = tempfile;
  $filename
 }

sub temporaryFolder                                                             # Create a temporary folder that will automatically be L<rmdired|/rmdir> during END processing.
 {my $d = tempdir();
     $d =~ s/[\/\\]+\Z//s;
  $d.'/';
 }

BEGIN{*temporaryDirectory=*temporaryFolder}

#D2 Find                                                                        # Find files and folders below a folder.

sub findFiles($;$)                                                              # Find all the files under a folder and optionally filter the selected files with a regular expression.
 {my ($dir, $filter) = @_;                                                      # Folder to start the search with, optional regular expression to filter files
  my @files;                                                                    # Files
  my $res = qx(find $dir -print0);                                              # Execute find command
  utf8::decode($res);                                                           # Decode unicode file names
  for(split /\0/, $res)                                                         # Split out file names on \0
   {next if -d $_;                                                              # Do not include folder names
    next if $filter and $filter and !m($filter)s;                               # Filter out files that do not match the regular expression
    push @files, $_;
   }
  @files
 }

sub findDirs($;$)                                                               # Find all the folders under a folder and optionally filter the selected folders with a regular expression.
 {my ($dir, $filter) = @_;                                                      # Folder to start the search with, optional regular expression to filter files
  my @dir;                                                                      # Directories
  my $res = qx(find $dir -print0);                                              # Execute find command
  utf8::decode($res);                                                           # Decode unicode file names
  for(split /\0/, $res)                                                         # Split out file names on \0
   {next unless -d $_;                                                          # Include only folders
    next if $filter and $filter and !m($filter)s;                               # Filter out directories that do not match the regular expression
    push @dir, fpd($_);
   }
  @dir
 }

sub fileList($)                                                                 # Files that match a given search pattern handed to bsd_glob.
 {my ($pattern) = @_;                                                           # Search pattern
  bsd_glob($pattern, GLOB_MARK | GLOB_TILDE)
 }

sub searchDirectoryTreesForMatchingFiles(@)                                     # Search the specified directory trees for the files (not folders) that match the specified extensions. The argument list should include at least one path name to be useful. If no file extension is supplied then all the files below the specified paths are returned.
 {my (@foldersandExtensions) = @_;                                              # Mixture of folder names and extensions
  my @folder     = grep { -d $_ } @_;                                           # Folders
  my @extensions = grep {!-d $_ } @_;                                           # Extensions
  for(@extensions)                                                              # Prefix period to extension of not all ready there - however this can lead to errors if there happens to be a folder with the same name as an undotted extension.
   {$_ = qq(\.$_) unless m(\A\.)s
   }
  my $ext = join '|', @extensions;                                              # Extensions
  my @file;                                                                     # Files
  for my $dir(@folder)                                                          # Directories
   {for my $d(split /\0/, qx(find $dir -print0))
     {next if -d $d;                                                            # Do not include folder names
      push @file, $d if $d =~ m(($ext)\Z)is;
     }
   }
  sort @file
 } # searchDirectoryTreesForMatchingFiles

sub matchPath($)                                                                # Given an absolute path find out how much of the path actually exists.
 {my ($file) = @_;                                                              # File name
  return $file if -e $file;                                                     # File exists so nothing more to match
  my @path = split /[\/\\]/, $file;                                             # Split path into components
  while(@path)                                                                  # Remove components one by one
   {pop @path;                                                                  # Remove deepest component and try again
    my $path = join '/', @path, '';                                             # Containing folder
    return $path if -d $path;                                                   # Containing folder exists
   }
  ''                                                                            # Nothing matches
 } # matchPath

sub findFileWithExtension($@)                                                   # Find the first extension from the specified extensions that produces a file that exists when appended to the specified file.
 {my ($file, @ext) = @_;                                                        # File name minus extensions, possible extensions
  for my $ext(@ext)                                                             # Each extension
   {my $f = fpe($file, $ext);                                                   # Possible file
    return $ext if -e $f;                                                       # First matching file
   }
  undef                                                                         # No matching file
 } # findFileWithExtension

sub clearFolder($$)                                                             # Remove all the files and folders under and including the specified folder as long as the number of files to be removed is less than the specified limit.
 {my ($folder, $limitCount) = @_;                                               # Folder, maximum number of files to remove to limit damage
  return unless -d $folder;                                                     # Only works on a folder that exists
  my @files = findFiles($folder);                                               # Find files to be removed
  if (@files > $limitCount)                                                     # Limit the number of files that can be deleted to limit potential opportunity for damage
   {my $f = @files;
    confess "Limit is $limitCount, but $f files under folder:\n$folder\n";
   }
  my @dirs = findDirs($folder);                                                 # These directories should be empty and thus removable after removing the files
  unlink $_ for @files;                                                         # Remove files
  rmdir $_  for reverse @dirs;                                                  # Remove empty folders
  -e $folder and carp "Unable to completely remove folder:\n$folder\n";         # Complain if the folder still exists
 } # clearFolder

#D2 Read and write files                                                        # Read and write strings from and to files creating paths as needed.

sub readFile($)                                                                 # Read a file containing unicode in utf8.
 {my ($file) = @_;                                                              # Name of file to read
  defined($file) or
    confess "Cannot read undefined file\n";
  $file =~ m(\n) and
    confess "File name contains a new line:\n=$file=\n";
  -e $file or
    confess "Cannot read file because it does not exist, file:\n$file\n";
  open(my $F, "<:encoding(UTF-8)", $file) or
    confess "Cannot open file for unicode input, file:\n$file\n$!\n";
  local $/ = undef;
  my $string = eval {<$F>};
  $@ and confess $@;
  $string
 } # readFile

sub evalFile($)                                                                 # Read a file containing unicode in utf8, evaluate it, confess to any errors and then return any result - an improvement on B<do> which silently ignores any problems.
 {my ($file) = @_;                                                              # File to read
  my $string = readFile($file);
  my $res = eval $string;
  $@ and confess "$@\nin file:\n$file\n";
  $res
 } # evalFile

sub evalGZipFile($)                                                             # Read a file containing compressed utf8, evaluate it, confess to any errors or return any result.
 {my ($file) = @_;                                                              # File to read
  my $string = readGZipFile($file);
  my $res = eval $string;
  $@ and confess "$@\n";
  $res
 } # evalGZipFile

sub readUtf16File($)                                                            #P Read a file containing unicode in utf-16 format.
 {my ($file) = @_;                                                              # Name of file to read
  defined($file) or
    confess "Cannot read undefined file\n";
  $file =~ m(\n) and
    confess "File name contains a new line:\n=$file=\n";
  -e $file or
    confess "Cannot read file because it does not exist, file:\n$file\n";
  open(my $F, "<:encoding(UTF-16)", $file) or confess
    "Cannot open file for utf16 input, file:\n$file\n$!\n";
  local $/ = undef;
  my $s = eval {<$F>};
  $@ and confess $@;
  $s
 }

sub readBinaryFile($)                                                           # Read binary file - a file whose contents are not to be interpreted as unicode.
 {my ($file) = @_;                                                              # File to read
  -e $file or
    confess "Cannot read binary file because it does not exist:\n$file\n";
  open my $F, "<$file" or
    confess "Cannot open binary file for input:\n$file\n$!\n";
  binmode $F;
  local $/ = undef;
  <$F>;
 } # readBinaryFile

sub readGZipFile($)                                                             # Read the specified B<$file>, containing compressed utf8, through gzip
 {my ($file) = @_;                                                              # File to read.
  defined($file) or
    confess "Cannot read undefined file\n";
  $file =~ m(\n) and
    confess "File name contains a new line:\n=$file=\n";
  -e $file or
    confess "Cannot read file because it does not exist, file:\n$file\n";
  open(my $F, "gunzip < $file|") or                                             # Unzip input file
    confess "Cannot open file for input, file:\n$file\n$!\n$?\n";
  binmode($F, "encoding(UTF-8)");
  local $/ = undef;
  my $string = <$F>;
  $string                                                                       # Resulting string
 } # readGZipFile

sub makePath($)                                                                 # Make the path for the specified file name or folder.
 {my ($file) = @_;                                                              # File
  my @path = split /[\\\/]+/, $file;
  return 1 unless @path > 1;
  pop @path unless $file =~ /[\\\/]\Z/;
  my $path = join '/', @path;
  return 2 if -d $path;
  eval {make_path($path)};
  -d $path or confess "Cannot make path:\n$path\n";
  0
 } # makePath

sub overWriteFile($$)                                                           # Write a unicode utf8 string to a file after creating a path to the file if necessary and return the name of the file on success else confess. If the file already exists it is overwritten.
 {my ($file, $string) = @_;                                                     # File to write to or B<undef> for a temporary file, unicode string to write
  $file //= temporaryFile;
  $string or carp "No string for file:\n$file\n";
  makePath($file);
  open my $F, ">$file" or
    confess "Cannot open file for write because:\n$file\n$!\n";
  binmode($F, ":utf8");
  print  {$F} $string;
  close  ($F);
  -e $file or confess "Failed to write to file:\n$file\n";
  $file
 } # overWriteFile

BEGIN{*owf=*overWriteFile}

sub writeFile($$)                                                               # Write a unicode utf8 string to a new file that does not already exist after creating a path to the file if necessary and return the name of the file on success else confess if a problem occurred or the file does already exist.
 {my ($file, $string) = @_;                                                     # New file to write to or B<undef> for a temporary file,  string to write
  if (defined $file)
   {-e $file and confess "File already exists:\n$file\n";
   }
  &overWriteFile(@_);
 } # writeFile

sub dumpFile($$)                                                                # Dump a data structure to a file
 {my ($file, $struct) = @_;                                                     # File to write to or B<undef> for a temporary file,  address of data structure to write
  overWriteFile($file, dump($struct));
 } # writeFile

sub writeGZipFile($$)                                                           # Write a unicode utf8 string through gzip to a file.
 {my ($file, $string) = @_;                                                     # File to write to, string to write
  makePath($file);
  open my $F, "| gzip>$file" or                                                 # Compress via gzip
    confess "Cannot open file for write because:\n$file\n$!\n";
  binmode($F, ":utf8");                                                         # Input to gzip encoded as utf8
  print  {$F} $string;
  close  ($F);
  -e $file or confess "Failed to write to file:\n$file\n";
  $file
 } # writeGZipFile

sub dumpGZipFile($$)                                                            # Write a data structure through B<gzip> to a file.
 {my ($file, $data) = @_;                                                       # File to write, reference to data
  ref($data) or confess "\$data must contain a reference to data, not a scalar";
  writeGZipFile($file, dump($data));
 } # dumpGZipFile

sub writeFiles($;$)                                                             # Write the values of a hash into files identified by the key of each value using L<overWriteFile|/overWriteFile>
 {my ($hash, $folder) = @_;                                                     # Hash of key value pairs representing files and data, optional folder to contain files else the current folder
  for my $file(sort keys %$hash)                                                # Write file data for each hash key
   {writeFile(fpf($folder ? $folder : '.', $file), $hash->{$file})
   }
 } # writeFiles

sub appendFile($$)                                                              # Append a unicode utf8 string to a file, possibly creating the file and the path to the file if necessary and return the name of the file on success else confess.
 {my ($file, $string) = @_;                                                     # File to append to, string to append
  $file or confess "No file name supplied\n";
  $string or carp "No string for file:\n$file\n";
  makePath($file);
  open my $F, ">>$file" or confess "Cannot open for write file:\n$file\n$!\n";
  binmode($F, ":utf8");
  print  {$F} $string;
  close  ($F);
  -e $file or confess "Failed to write to file:\n$file\n";
  $file
 } # appendFile

sub writeBinaryFile($$)                                                         # Write a non unicode string to a file in after creating a path to the file if necessary and return the name of the file on success else confess.
 {my ($file, $string) = @_;                                                     # File to write to or B<undef> for a temporary file, non unicode string to write
  $file //= temporaryFile;
  $string or confess "No string for file:\n$file\n";
  makePath($file);
  open my $F, ">$file" or confess "Cannot open file for binary write:\n".
               "$file\n$!\n";
  binmode($F);
  print  {$F} $string;
  close  ($F);
  -e $file or confess "Failed to write in binary to file:\n$file\n";
  $file
 } # writeBinaryFile

sub createEmptyFile($)                                                          # Create an empty file - L<writeFile|/writeFile> complains if no data is written to the file -  and return the name of the file on success else confess.
 {my ($file) = @_;                                                              # File to create or B<undef> for a temporary file
  $file //= temporaryFile;
  return $file if -e $file;                                                     # Return file name as proxy for success if file already exists
  makePath($file);
  open my $F, ">$file" or confess "Cannot create empty file:\n$file\n$!\n";
  binmode($F);
  print  {$F} '';
  close  ($F);
  -e $file or confess "Failed to create empty file:\n$file\n";
  $file                                                                         # Return file name on success
 } # createEmptyFile

sub binModeAllUtf8                                                              #P Set STDOUT and STDERR to accept utf8 without complaint.
 {binmode $_, ":utf8" for *STDOUT, *STDERR;
 }

sub numberOfLinesInFile($)                                                      # The number of lines in a file
 {my ($file) = @_;                                                              # File
  scalar split /\n/, readFile($file);
 } # numberOfLinesInFile

#D1 Images                                                                      # Image operations.

sub imageSize($)                                                                # Return (width, height) of an image obtained via L<Imagemagick>.
 {my ($image) = @_;                                                             # File containing image
  -e $image or confess
    "Cannot get size of image as file does not exist:\n$image\n";
  my $s = qx(identify -verbose "$image");
  if ($s =~ /Geometry: (\d+)x(\d+)/s)
   {return ($1, $2);
   }
  else
   {confess "Cannot get image size for file:\n$image\nfrom:\n$s\n";
   }
 }

sub convertImageToJpx690($$;$)                                                  #P Convert an image to jpx format using versions of L<Imagemagick> version 6.9.0 and above.
 {my ($source, $target, $Size) = @_;                                            # Source file, target folder (as multiple files will be created),  optional size of each tile - defaults to 256
  my $size = $Size // 256;                                                      # Size of each tile
  my $N    = 4;                                                                 # Power of ten representing the maximum number of tiles
  -e $source or confess "Image file does not exist:\n$source\n";                # Check source
  $target  = fpd($target);                                                      # Make sure the target is a folder
  makePath($target);                                                            # Make target folder
  my ($w, $h) = imageSize($source);                                             # Image size
  my $W = int($w/$size); ++$W if $w % $size;                                    # Image size in tiles
  my $H = int($h/$size); ++$H if $h % $size;
  writeFile(filePath($target, "jpx.data"), <<END);                              # Write jpx header
version 1
type    jpx
size    $size
source  $source
width   $w
height  $h
END

  if (1)                                                                        # Create tiles
   {my $s = quoteFile($source);
    my $t = quoteFile($target."%0${N}d.jpg");
    my $c = qq(convert $s -crop ${size}x${size} $t);
    say STDERR $c;
    say STDERR $_ for qx($c 2>&1);
   }

  if (1)                                                                        # Rename tiles in two dimensions
   {my $W = int($w/$size); ++$W if $w % $size;
    my $H = int($h/$size); ++$H if $h % $size;
    my $k = 0;
    for   my $Y(1..$H)
     {for my $X(1..$W)
       {my $s = sprintf("${target}%0${N}d.jpg", $k++);
        my $t = "${target}/${Y}_${X}.jpg";
        rename $s, $t or confess "Cannot rename file:\n$s\nto:\n$t\n";
        -e $t or confess "Cannot create file:\n$t\n";
       }
     }
   }
 }

sub convertImageToJpx($$;$)                                                     # Convert an image to jpx format using L<Imagemagick>.
 {my ($source, $target, $Size) = @_;                                            # Source file, target folder (as multiple files will be created),  optional size of each tile - defaults to 256

  if (1)
   {my $r = qx(convert --version);
    if ($r =~ m(\AVersion: ImageMagick ((\d|\.)+)))
     {my $version = join '', map {sprintf("%04d", $_)} split /\./, $1;
      return &convertImageToJpx690(@_) if $version >= 600090000;
     }
    else {confess "Please install Imagemagick:\nsudo apt install imagemagick\n"}
   }

  -e $source or confess "Image file does not exist:\n$source\n";
  my $size = $Size // 256;

  makePath($target);

  my ($w, $h) = imageSize($source);                                             # Write Jpx header
  writeFile(filePath($target, "jpx.data"), <<END);
version 1
type    jpx
size    $size
source  $source
width   $w
height  $h
END

  if (1)                                                                        # Create tiles
   {my $s = quoteFile($source);
    my $t = quoteFile($target);
    my $c = qq(convert $s -crop ${size}x${size} $t);
    say STDERR $c;
    say STDERR $_ for qx($c 2>&1);
   }

  if (1)                                                                        # Rename tiles in two dimensions
   {my $W = int($w/$size); ++$W if $w % $size;
    my $H = int($h/$size); ++$H if $h % $size;
    my $k = 0;
    for   my $Y(1..$H)
     {for my $X(1..$W)
       {my $s = "${target}-$k";
        my $t = "${target}/${Y}_${X}.jpg";
        rename $s, $t or confess "Cannot rename file:\n$s\nto:\n$t\n";
        -e $t or confess "Cannot create file:\n$t\n";
        ++$k;
       }
     }
   }
 }

sub convertDocxToFodt($$)                                                       # Convert a B<docx> file to B<fodt> using B<unoconv> which must not be running elsewhere at the time.  L<Unoconv|/https://github.com/dagwieers/unoconv> can be installed via:\m  sudo apt install sharutils unoconv\mParameters:
 {my ($inputFile, $outputFile) = @_;                                            # Input file, output file
  my $r = qx(unoconv -f fodt -o "$outputFile" "$inputFile");                    # Perform conversion
  !$r or confess "unoconv failed, try closing libreoffice if it is open\n". $r;
 }

# Tests in: /home/phil/perl/z/unoconv/testCutOutImagesInFodtFile.pl
sub cutOutImagesInFodtFile($$$)                                                 # Cut out the images embedded in a B<fodt> file, perhaps produced via L<convertDocxToFodt|/convertDocxToFodt>, placing them in the specified folder and replacing them in the source file with:\m  <image href="$imageFile" outputclass="imageType">\mThis conversion requires that you have both L<Imagemagick> and L<unoconv|/https://github.com/dagwieers/unoconv> installed on your system:\m    sudo apt install sharutils  imagemagick unoconv\mParameters:
 {my ($inputFile, $outputFolder, $imagePrefix) = @_;                            # Input file,  output folder for images, a prefix to be added to image file names
  my $source = readFile($inputFile);                                            # Read .fodt file
  say STDERR "Start image location in string of ", length($source);

  my @p;
  my $p = 0;
  my ($s1, $s2) = ('<office:binary-data>', '</office:binary-data>');
  for(;;)                                                                       # Locate images
   {my $q = index($source, $s1, $p);  last if $q < 0;
    my $Q = index($source, $s2, $q);  last if $Q < 0;
    push @p, [$q+length($s1), $Q-$q-length($s1)];
    $p = $Q;
   }
  say STDERR "Cutting out ", scalar(@p), " images";                             # Cut out images

  my $imageNumber = @p;                                                         # Number the image files

  for(reverse @p)                                                               # We cut out in reverse to preserve the offsets of the images yet to be cut out
   {my ($p, $l) = @$_;                                                          # Position, length of image

    my $i = substr($source, $p, $l);                                            # Image text uuencoded
       $i =~ s/ //g;                                                            # Remove leading spaces on each line

    my ($ext, $type, $im) =                                                     # Decide on final image type, possibly via an external imagemagick conversion on windows, or an internal imagemagick conversion locally
      $i =~ m/\AiVBOR/    ? ('png')            :
      $i =~ m/\AAQAAAG/   ? ('png', 'emf')     :
      $i =~ m/\AVkNMT/    ? ('png', 'svm')     :
      $i =~ m/\A183G/     ? ('png', '', 'wmf') :
      $i =~ m/\A\/9j/     ? ('jpg')            :
      $i =~ m/\AR0lGODlh/ ? ('gif')            :
      confess "Unknown image type: ". substr($i, 0, 16)."\n";

    say STDERR "$imageNumber cut $ext from $p for $l";

    my $imageBinary = decodeBase64($i);                                         # Decode image
    my $imageFile =                                                             # Image file name
      fpe($outputFolder, join(q(), $imagePrefix, q(_), $imageNumber), $ext);

    if (!$type)
     {writeBinaryFile($imageFile, $imageBinary);
     }

    my $xml = "<image href=\"$imageFile\" outputclass=\"$ext\"\/>";             # Create image command
    substr($source, $p, $l) = $xml;                                             # Replace the image source with an image command
    $imageNumber--;
   }
  $source
 }

#D1 Encoding and Decoding                                                       # Encode and decode using Json and Mime.

sub encodeJson($)                                                               # Encode Perl to Json.
 {my ($string) = @_;                                                            # Data to encode
  encode_json($string)
 }

sub decodeJson($)                                                               # Decode Perl from Json.
 {my ($string) = @_;                                                            # Data to decode
  decode_json($string)
 }

sub encodeBase64($)                                                             # Encode a string in base 64.
 {my ($string) = @_;                                                            # String to encode
  my $s = eval {encode_base64($string, '')};
  confess $@ if $@;                                                             # So we get a trace back
  $s
 }

sub decodeBase64($)                                                             # Decode a string in base 64.
 {my ($string) = @_;                                                            # String to decode
  my $s   = eval {decode_base64($string)};
  confess $@ if $@;                                                             # So we get a trace back
  $s
 }

sub convertUnicodeToXml($)                                                      # Convert a string with unicode points that are not directly representable in ascii into string that replaces these points with their representation on Xml making the string usable in Xml documents.
 {my ($s) = @_;                                                                 # String to convert
  my $t = '';
  for(split //, $s)                                                             # Each letter in the source
   {my $n = ord($_);
    my $c = $n > 127 ? "&#$n;" : $_;                                            # Use xml representation beyond u+127
    $t .= $c;
   }
  $t                                                                            # Return resulting string
 }

#D1 Numbers                                                                     # Numeric operations,

sub powerOfTwo($)                                                               # Test whether a number is a power of two, return the power if it is else B<undef>.
 {my ($n) = @_;                                                                 # Number to check
  for(0..128)
   {return $_  if 1<<$_ == $n;
    last       if 1<<$_ >  $n;
   }
  undef
 }

sub containingPowerOfTwo($)                                                     # Find log two of the lowest power of two greater than or equal to a number.
 {my ($n) = @_;                                                                 # Number to check
  for(0..128)
   {return $_  if $n <= 1<<$_;
   }
  undef
 }

#D1 Sets                                                                        # Set operations.

sub setIntersectionOfTwoArraysOfWords($$)                                       # Intersection of two arrays of words.
 {my ($a, $b) = @_;                                                             # Reference to first array of words, reference to second array of words
  my @a = @$a >  @$b ? @$a : @$b;
  my @b = @$a <= @$b ? @$a : @$b;
  my %a  = map {$_=>1} @a;
  my %b  = map {$_=>1} @b;
  grep {$a{$_}} sort keys %b
 }

sub setUnionOfTwoArraysOfWords($$)                                              # Union of two arrays of words.
 {my ($a, $b) = @_;                                                             # Reference to first array of words, reference to second array of words
  my %a = map {$_=>1} @$a, @$b;
  sort keys %a
 }

sub contains($@)                                                                # Returns the indices at which an item matches elements of the specified array. If the item is a regular expression then it is matched as one, else it is a number it is matched as a number, else as a string.
 {my ($item, @array) = @_;                                                      # Item, array
  my @r;
  if (ref($item) =~ m(Regexp))                                                  # Match via a regular expression
   {for(keys @array)
     {push @r, $_ if $array[$_] =~ m($item)s;
     }
   }
  elsif (is_float($item))                                                       # Match as a number
   {for(keys @array)
     {push @r, $_ if $array[$_]+0 == $item;
     }
   }
  else                                                                          # Match as a string
   {for(keys @array)
     {push @r, $_ if $array[$_] eq $item;
     }
   }
  @r
 }

#D1 Minima and Maxima                                                           # Find the smallest and largest elements of arrays.

sub min(@)                                                                      # Find the minimum number in a list.
 {my (@n) = @_;                                                                 # Numbers
  return undef unless @n;
  return $n[0] if @n == 0;
  my $m = $n[0];
  for(@n)
   {$m = $_ if $_ < $m;
   }
  $m
 }

sub max(@)                                                                      # Find the maximum number in a list.
 {my (@n) = @_;                                                                 # Numbers
  return undef unless @n;
  return $n[0] if @n == 0;
  my $M = $n[0];
  for(@n)
   {$M = $_ if $_ > $M;
   }
  $M
 }

#D1 Format                                                                      # Format data structures as tables.

sub maximumLineLength($)                                                        # Find the longest line in a string
 {my ($string) = @_;                                                            # String of lines of text
  max(map {length($_)} split /\n/, ($string//'')) // 0                          # Length of longest line
 }

sub formatTableMultiLine($;$)                                                   #P Tabularize text that has new lines in it.
 {my ($data, $separator) = @_;                                                  # Reference to an array of arrays of data to be formatted as a table, optional line separator to use instead of new line for each row.
  ref($data) =~ /array/i or
    confess "Array reference required not:\n".dump($data)."\n";

  my @width;                                                                    # Maximum width of each column
  for my $row(@$data)                                                           # Find maximum width of each column
   {ref($row) =~ /array/i or
      confess "Array reference required not:\n".dump($row)."\n";
    for my $col(0..$#$row)                                                      # Each column index
     {my $a = $width[$col] // 0;                                                # Maximum length of data so far
      my $b = maximumLineLength($row->[$col]);                                  # Length of longest line in current item
      $width[$col] = ($a > $b ? $a : $b);                                       # Update maximum length
     }
   }

  my @text;                                                                     # Formatted data
  for   my $row(@$data)                                                         # Each row
   {my @row;                                                                    # Laid out text
    for my $col(0..$#$row)                                                      # Each column
     {my $m = $width[$col];                                                     # Maximum width
      for my $i(split /\n/, $row->[$col]//'')                                   # Each line of item
       {if ($i !~ /\A\s*[-+]?\s*(\d|[,])+(\.\d+)?([Ee]\s*[-+]?\s*\d+)?\s*\Z/)   # Not a number - left justify
         {push @{$row[$col]}, substr($i.(' 'x$m), 0, $m);
         }
        else                                                                    # Number - right justify
         {push @{$row[$col]}, substr((' 'x$m).$i, -$m);
         }
       }
     }

    my $n = max(map {scalar @{$_//[]}} @row)//0;                                # Maximum number of rows

    for my $r(1..$n)                                                            # Each row of the items
     {my $text = '';
      for my $col(0..$#$row)                                                    # Each item
       {$text .= ($row[$col][$r-1] // (q( ) x $width[$col])).q(  );
       }
      $text =~ s(\s*\Z) ()s;                                                    # Strip trailing blanks as they are not needed for padding
      push @text, $text;
     }
   }

  my $s = $separator//"\n";
  join($s, @text).$s
 }

sub formatTableBasic($)                                                         # Tabularize an array of arrays of text.
 {my ($data) = @_;                                                              # Reference to an array of arrays of data to be formatted as a table.
  ref($data) =~ /array/i or                                                     # Must be an array
    confess "Array reference required not:\n".dump($data)."\n";
  my @width;                                                                    # Maximum width of each column

  for   my $row(@$data)                                                         # Each row
   {ref($row) =~ /array/i or                                                    # Each row must be an array
      confess "Array reference required not:\n".dump($row)."\n";
    for my $col(0..$#$row)                                                      # Each column index
     {my $text  = $row->[$col] // '';                                           # Text of current line
      return &formatTableMultiLine(@_) if $text =~ m(\n);                       # Element has a new line in it
      my $a  = $width[$col] // 0;                                               # Maximum length of data so far
      my $b  = length($text);                                                   # Length of longest line in current item
      $width[$col] = ($a > $b ? $a : $b);                                       # Update maximum length
     }
   }

  my @text;                                                                     # Formatted data
  for my $row(@$data)
   {my $text = '';                                                              # Formatted text
    for my $col(0..$#$row)
     {my $m = $width[$col];                                                     # Maximum width
      my $i = $row->[$col]//'';                                                 # Current item
      if ($i !~ /\A\s*[-+]?\s*(\d|[,])+(\.\d+)?([Ee]\s*[-+]?\s*\d+)?\s*\Z/)     # Not a number - left justify
       {$text .= substr($i.(' 'x$m), 0, $m)."  ";
       }
      else                                                                      # Number - right justify
       {$text .= substr((' 'x$m).$i, -$m)."  ";
       }
     }
    $text =~ s(\s*\Z) ()s;                                                      # Strip trailing blanks as they are not needed for padding
    push @text, $text;
   }

  join("\n", @text)."\n"
 }

sub formatTableAA($;$)                                                          #P Tabularize an array of arrays.
 {my ($data, $title) = @_;                                                      # Data to be formatted, optional reference to an array of titles
  return dump($data) unless ref($data) =~ /array/i and @$data;
  my $d;
  push @$d, ['', @$title] if $title;
  push @$d, [$_, @{$data->[$_-1]}] for 1..@$data;
  formatTableBasic($d);
 }

sub formatTableHA($;$)                                                          #P Tabularize a hash of arrays.
 {my ($data, $title) = @_;                                                      # Data to be formatted, optional titles
  return dump($data) unless ref($data) =~ /hash/i and keys %$data;
  my $d;
  push @$d, $title if $title;
  push @$d, [$_, @{$data->{$_}}] for sort keys %$data;
  formatTableBasic($d);
 }

sub formatTableAH($)                                                            #P Tabularize an array of hashes.
 {my ($data) = @_;                                                              # Data to be formatted
  return dump($data) unless ref($data) =~ /array/i and @$data;

  my %k; @k{keys %$_}++ for @$data;                                             # Column headers
  my @k = sort keys %k;
  $k{$k[$_-1]} = $_ for 1..@k;

  my $d = [['', @k]];
  for(1..@$data)
   {push @$d, [$_];
    my %h = %{$data->[$_-1]};
    $d->[-1][$k{$_}] = $h{$_} for keys %h;
   }
  formatTableBasic($d);
 }

sub formatTableHH($)                                                            #P Tabularize a hash of hashes.
 {my ($data) = @_;                                                              # Data to be formatted
  return dump($data) unless ref($data) =~ /hash/i and keys %$data;

  my %k; @k{keys %$_}++ for values %$data;                                      # Column headers
  my @k = sort keys %k;
  $k{$k[$_-1]} = $_ for 1..@k;

  my $d = [['', @k]];
  for(sort keys %$data)
   {push @$d, [$_];
    my %h = %{$data->{$_}};
    $d->[-1][$k{$_}] = $h{$_} for keys %h;
   }
  formatTableBasic($d);
 }

sub formatTableA($;$)                                                           #P Tabularize an array.
 {my ($data, $title) = @_;                                                      # Data to be formatted, optional title
  return dump($data) unless ref($data) =~ /array/i and @$data;

  my $d;
  push @$d, $title if $title;
  for(keys @$data)
   {push @$d, @$data > 1 ? [$_, $data->[$_]] : [$data->[$_]];                   # Skip line number if the array is degenerate
   }
  formatTableBasic($d);
 }

sub formatTableH($;$)                                                           #P Tabularize a hash.
 {my ($data, $title) = @_;                                                      # Data to be formatted, optional title

  return dump($data) unless ref($data) =~ /hash/i and keys %$data;

  my $d;
  push @$d, $title if $title;
  for(sort keys %$data)
   {push @$d, [$_, $data->{$_}];
   }
  formatTableBasic($d);
 }

sub formatTable($;$%)                                                           # Format various data structures as a table. Optionally create a report from the table using the following optional report options:\mB<file=E<gt>$file> the name of a file to write the report to.\mB<head=E<gt>$head> a header line in which DDDD will be replaced with the data and time and NNNN will be replaced with the number of rows in the table.\mB<zero=E<gt>$zero> if true the report will be written to the specified file even if empty.\mParameters:
 {my ($data, $title, %options) = @_;                                            # Data to be formatted, optional reference to an array of titles, options

  my ($a, $h, $o) = (0, 0, 0);                                                  # Check structure of input data
  my $checkStructure = sub
   {for(@_)
     {my $r = ref($_[0]);
      if ($r =~ /array/i) {++$a} elsif ($r =~ /hash/i) {++$h} else {++$o}
     }
   };

  my $formattedTable = sub                                                      # Format table
   {if    (ref($data) =~ /array/i)
     {$checkStructure->(       @$data);
      return formatTableAA($data, $title) if  $a and !$h and !$o;
      return formatTableAH($data)         if !$a and  $h and !$o;
      return formatTableA ($data, $title);
     }
    elsif (ref($data) =~ /hash/i)
     {$checkStructure->(values %$data);
      return formatTableHA($data, $title) if  $a and !$h and !$o;
      return formatTableHH($data)         if !$a and  $h and !$o;
      return formatTableH ($data, $title);
     }
   }->();

  return $formattedTable unless keys %options;                                  # Return table as is unless report requested

  checkKeys(\%options,                                                          # Check report options
    {head=><<'END',
A header line which will preceed the formatted table.
DDDD in this line will be replaced with the current date and time.
NNNN in this line will be replaced with the number of rows in the table.
END
     file=>q(The name of a file to which to write the formatted table.),
    });

  my ($head, $file, $rows) = map{$options{$_}} qw(head file rows);

  my @report;
  my $date = dateTimeStamp;
  my $N    = keyCount(1, $data);
  push @report, ($head =~ s(DDDD) ($date)gr =~ s(NNNN) ($N)gr), q() if $head;
  push @report, qq(This file: $file),                           q() if $file;
  push @report, $formattedTable;
  my $report = join "\n", @report;
  overWriteFile($file, $report) if $file and $a+$h+$o;                          # Only write the report if there is some data in it or the zero option has been specified to write it regardless.

  $report
 }

sub keyCount($$)                                                                # Count keys down to the specified level.
 {my ($maxDepth, $ref) = @_;                                                    # Maximum depth to count to, reference to an array or a hash
  my $n = 0;
  my $count;
  $count = sub
   {my ($ref, $currentDepth) = @_;
    if (ref($ref) =~ /array/i)
     {if ($maxDepth == $currentDepth) {$n += scalar(@$ref)}
      else {$count->($_, ++$currentDepth)       for @$ref}
     }
    elsif (ref($ref) =~ /hash/i)
     {if ($maxDepth == $currentDepth)   {$n += scalar(keys %$ref)}
      else {$count->($ref->{$_}, ++$currentDepth) for keys %$ref}
     }
    else {++$n}
   };
  $count->($ref, 1);
  $n
 }

#D1 Lines                                                                       # Load data structures from lines.

sub loadArrayFromLines($)                                                       # Load an array from lines of text in a string.
 {my ($string) = @_;                                                            # The string of lines from which to create an array
  [split "\n", $string]
 }

sub loadHashFromLines($)                                                        # Load a hash: first word of each line is the key and the rest is the value.
 {my ($string) = @_;                                                            # The string of lines from which to create a hash
  +{map{split /\s+/, $_, 2} split "\n", $string}
 }

sub loadArrayArrayFromLines($)                                                  # Load an array of arrays from lines of text: each line is an array of words.
 {my ($string) = @_;                                                            # The string of lines from which to create an array of arrays
  [map{[split /\s+/]} split "\n", $string]
 }

sub loadHashArrayFromLines($)                                                   # Load a hash of arrays from lines of text: the first word of each line is the key, the remaining words are the array contents.
 {my ($string) = @_;                                                            # The string of lines from which to create a hash of arrays
  +{map{my @a = split /\s+/; (shift @a, [@a])} split "\n", $string}
 }

sub loadArrayHashFromLines($)                                                   # Load an array of hashes from lines of text: each line is an hash of words.
 {my ($string) = @_;                                                            # The string of lines from which to create an array of arrays
  [map {+{split /\s+/}} split /\n/, $string]
 }

sub loadHashHashFromLines($)                                                    # Load a hash of hashes from lines of text: the first word of each line is the key, the remaining words are the sub hash contents.
 {my ($string) = @_;                                                            # The string of lines from which to create a hash of arrays
  +{map{my ($a, @a) = split /\s+/; ($a=>{@a})} split "\n", $string}
 }

sub checkKeys($$)                                                               # Check the keys in a hash.
 {my ($test, $permitted) = @_;                                                  # The hash to test, a hash of the permitted keys and their meanings

  ref($test)      =~ /hash/igs or                                               # Check parameters
    confess "Hash reference required for first parameter\n";
  ref($permitted) =~ /hash/igs or
    confess "Hash reference required for second parameter\n";

  my %parms = %$test;                                                           # Copy keys supplied
  delete $parms{$_} for keys %$permitted;                                       # Remove permitted keys
  return '' unless keys %parms;                                                 # Success - all the keys in the test hash are permitted

  confess join "\n",                                                            # Failure - explain what went wrong
   "Invalid options chosen:",
    indentString(formatTable([sort keys %parms]), '  '),
   "",
   "Permitted options are:",
    indentString(formatTable($permitted),         '  '),
   "";
 }

#D1 LVALUE methods                                                              # Replace $a->{B<value>} = $b with $a->B<value> = $b which reduces the amount of typing required, is easier to read and provides a hard check that {B<value>} is spelled correctly.

sub genLValueScalarMethods(@)                                                   # Generate L<lvalueMethod> scalar methods in the current package, A method whose value has not yet been set will return a new scalar with value B<undef>. Suffixing B<X> to the scalar name will confess if a value has not been set.
 {my (@names) = @_;                                                             # List of method names
  my ($package) = caller;                                                       # Package
  for my $m(@_)                                                                 # Name each method
   {my $s;
    if ($m =~ m(::)s)                                                           # Package name supplied in name
     {my $M = $m =~ s(\A.*:) ()r;                                               # Remove package
      $s =
       'sub '.$m. ':lvalue {$_[0]{"'.$M.'"}}'.                                  # LValue version for get and set
       'sub '.$m.'X        {$_[0]{"'.$M.'"} // q()}';                           # Non lvalue version for get only returning q() instead of B<undef>
     }
    else                                                                        # Use package of caller
     {$s =
       'sub '.$package.'::'.$m. ':lvalue {$_[0]{"'.$m.'"}}'.                    # LValue version for get and set
       'sub '.$package.'::'.$m.'X        {$_[0]{"'.$m.'"} // q()}';             # Non lvalue version for get only returning q() instead of undef
     }
 #   'sub '.$package.'::'.$_. ':lvalue {my $v;       $_[0]{"'.$_.'"} //= $v}'.
 #   'sub '.$package.'::'.$_.'X:lvalue {my $v = q(); $_[0]{"'.$_.'"} //= $v}';
 #   'sub '.$package.'::'.$_.'X:lvalue {my $v =      $_[0]{"'.$_.'"}; confess q(No value supplied for "'.$_.'") unless defined($v); $v}';
    eval $s;
    confess "Unable to create LValue scalar method for: '$m' because\n$@\n" if $@;
   }
 }

sub addLValueScalarMethods(@)                                                   # Generate L<lvalueMethod> scalar methods in the current package if they do not already exist. A method whose value has not yet been set will return a new scalar with value B<undef>. Suffixing B<X> to the scalar name will confess if a value has not been set.
 {my (@names) = @_;                                                             # List of method names
  my ($package) = caller;                                                       # Package
  for my $m(@_)                                                                 # Name each method
   {my $M = $m =~ m(::)s ? $m : $package.'::'.$m;
    next if defined &$M;
    genLValueScalarMethods($M);
   }
 }

sub genLValueScalarMethodsWithDefaultValues(@)                                  # Generate L<lvalueMethod> scalar methods with default values in the current package. A reference to a method whose value has not yet been set will return a scalar whose value is the name of the method.
 {my (@names) = @_;                                                             # List of method names
  my ($package) = caller;                                                       # Package
  for(@_)                                                                       # Name each method
   {my $s = 'sub '.$package.'::'.$_.':lvalue {my $v = "'.$_.'"; $_[0]{"'.$_.'"} //= $v}';
    eval $s;
    confess "Unable to create LValue scalar method for: '$_' because\n$@\n" if $@;
   }
 }

sub genLValueArrayMethods(@)                                                    # Generate L<lvalueMethod> array methods in the current package. A reference to a method that has no yet been set will return a reference to an empty array.
 {my (@names) = @_;                                                             # List of method names
  my ($package) = caller;                                                       # Package
  for(@_)                                                                       # Name each method
   {my $s = 'sub '.$package.'::'.$_.':lvalue {$_[0]{"'.$_.'"} //= []}';
    eval $s;
    confess "Unable to create LValue array method for: '$_' because\n$@\n" if $@;
   }
 }

sub genLValueHashMethods(@)                                                     # Generate L<lvalueMethod> hash methods in the current package. A reference to a method that has no yet been set will return a reference to an empty hash.
 {my (@names) = @_;                                                             # Method names
  my ($package) = caller;                                                       # Package
  for(@_)                                                                       # Name each method
   {my $s = 'sub '.$package.'::'.$_.':lvalue {$_[0]{"'.$_.'"} //= {}}';
    eval $s;
    confess "Unable to create LValue hash method for: '$_' because\n$@\n" if $@;
   }
 }

sub genHash($%)                                                                 # Return a B<$bless>ed hash with the specified B<$attributes>. L<updateDocumentation|/updateDocumentation> will generate documentation at L<Hash Definitions> for the hash defined by the call to L<genHash|/genHash> if the call is laid out as in the example below.
 {my ($bless, %attributes) = @_;                                                # Package name, hash of attribute names and values
  my $h = \%attributes;
  bless $h, $bless;
  my $s;
  for my $m(sort keys %attributes)                                              # Add any attributes not already present
   {next if $h->can($m);
    $s .= 'sub '.$bless.'::'.$m. ':lvalue {$_[0]{"'.$m.'"}}';                   # LValue version for get and set
    $s .= 'sub '.$bless.'::'.$m. 'X       {$_[0]{"'.$m.'"}//q()}';              # Default to blank for get
   }
  if ($s)                                                                       # Add any new methods needed
   {eval $s;
    confess $@ if $@;
   }
  $h
 }

sub loadHash($%)                                                                # Load the specified B<$hash> generated with L<genHash|/genHash> with B<%attributes>. Confess to any unknown attribute names.
 {my ($hash, %attributes) = @_;                                                 # Hash, hash of attribute names and values to be loaded
  for my $m(sort keys %attributes)                                              # Add any attributes not already present
   {$hash->can($m) or confess "Cannot load attribute: $m\n";                    # Unknown attribute
    $hash->{$m} = $attributes{$m};                                              # Load known attribute
   }
  $hash                                                                         # Return loaded hash
 }

sub assertPackageRefs($@)                                                       # Confirm that the specified references are to the specified package
 {my ($package, @refs) = @_;                                                    # Package, references
  for(@refs)                                                                    # Check each reference
   {my $r = ref($_);
    $r && $r eq $package or confess "Wanted reference to $package, but got $r\n";
   }
  1
 }

sub assertRef(@)                                                                # Confirm that the specified references are to the package into which this routine has been exported.
 {my (@refs) = @_;                                                              # References
  my ($package) = caller;                                                       # Package
  for(@_)                                                                       # Check each reference
   {my $r = ref($_);
    $r && $r eq $package or confess "Wanted reference to $package, but got $r\n";
   }
  1
 }

sub ˢ(&)                                                                        # Immediately executed inline sub to allow a code block before B<if>.
 {my ($sub) = @_;                                                               # Sub enclosed in {} without the word "sub"
  &$sub                                                                         # Note: due to a collision with perl statement syntax: method package parameters as in say STDERR ... this method can be used before this line in this module as I tried unsuccessfully to do in formatTable.
 }

#D1 Strings                                                                     # Actions on strings.

sub indentString($$)                                                            # Indent lines contained in a string or formatted table by the specified string.
 {my ($string, $indent) = @_;                                                   # The string of lines to indent, the indenting string
  join "\n", map {$indent.$_} split "\n", (ref($string) ? $$string  : $string)
 }

sub isBlank($)                                                                  # Test whether a string is blank.
 {my ($string) = @_;                                                            # String
  $string =~ m/\A\s*\Z/
 }

sub trim($)                                                                     # Remove any white space from the front and end of a string.
 {my ($string) = @_;                                                            # String
  $string =~ s/\A\s+//r =~ s/\s+\Z//r
 }

sub pad($$;$)                                                                   # Pad a string with blanks or the specified padding character  to a multiple of a specified length.
 {my ($string, $length, $pad) = @_;                                             # String, tab width, padding char
  $string =~ s/\s+\Z//;
  $pad //= q( );
  my $l = length($string);
  return $string if $l % $length == 0;
  my $p = $length - $l % $length;
  $string .= $pad x $p;
 }

sub firstNChars($$)                                                             # First N characters of a string.
 {my ($string, $length) = @_;                                                   # String, length
  return $string if !$length or length($string) < $length;
  substr($string, 0, $length);
 }

sub nws($;$)                                                                    # Normalize white space in a string to make comparisons easier. Leading and trailing white space is removed; blocks of white space in the interior are reduced to a single space.  In effect: this puts everything on one long line with never more than one space at a time. Optionally a maximum length is applied to the normalized string.
 {my ($string, $length) = @_;                                                   # String to normalize, maximum length of result
  my $s = $string =~ s/\A\s+//r =~ s/\s+\Z//r =~ s/\s+/ /gr;
  firstNChars($s, $length)                                                      # Apply maximum length if requested
 }

sub stringsAreNotEqual($$)                                                      # Return the two non equal tails of non equal strings or an empty list if the strings are equal.
 {my ($a, $b) = @_;                                                             # First string, second string
  my @a = split //, $a;
  my @b = split //, $b;
  while(@a and @b and $a[0] eq $b[0])
   {shift @a; shift @b;
   }
  (join(q(), @a), join(q(), @b))
 }

sub javaPackage($)                                                              # Extract the package name from a java string or file.
 {my ($java) = @_;                                                              # Java file if it exists else the string of java

  my $s = sub
   {return readFile($java) if $java !~ m/\n/s and -e $java;                     # Read file of java
    $java                                                                       # Java string
   }->();

  my ($package) = $s =~ m(package\s+(\S+)\s*;);
  $package
 }

sub javaPackageAsFileName($)                                                    # Extract the package name from a java string or file and convert it to a file name.
 {my ($java) = @_;                                                              # Java file if it exists else the string of java

  if (my $package = javaPackage($java))
   {return $package =~ s/\./\//gr;
   }
  undef
 }

sub perlPackage($)                                                              # Extract the package name from a perl string or file.
 {my ($perl) = @_;                                                              # Perl file if it exists else the string of perl
  javaPackage($perl);                                                           # Use same technique as Java
 }

sub printQw(@)                                                                  # Print an array of words in qw() format.
 {my (@words) = @_;                                                             # Array of words
  'qw('.join(' ', @words).')'
 }

sub numberOfLinesInString($)                                                    # The number of lines in a string.
 {my ($string) = @_;                                                            # String
  scalar split /\n/, $string;
 }


#D1 Unicode                                                                     # Translate ascii alphanumerics in strings to various Unicode blocks.

my $normalString = join '', 'A'..'Z', 'a'..'z', '0'..'9';
my $boldString   = q(𝗔𝗕𝗖𝗗𝗘𝗙𝗚𝗛𝗜𝗝𝗞𝗟𝗠𝗡𝗢𝗣𝗤𝗥𝗦𝗧𝗨𝗩𝗪𝗫𝗬𝗭𝗮𝗯𝗰𝗱𝗲𝗳𝗴𝗵𝗶𝗷𝗸𝗹𝗺𝗻𝗼𝗽𝗾𝗿𝘀𝘁𝘂𝘃𝘄𝘅𝘆𝘇𝟬𝟭𝟮𝟯𝟰𝟱𝟲𝟳𝟴𝟵);
my $circleString = q(ⒶⒷⒸⒹⒺⒻⒼⒽⒾⒿⓀⓁⓂⓃⓄⓅⓆⓇⓈⓉⓊⓋⓌⓍⓎⓏⓐⓑⓒⓓⓔⓕⓖⓗⓘⓙⓚⓛⓜⓝⓞⓟⓠⓡⓢⓣⓤⓥⓦⓧⓨⓩ⓪①②③④⑤⑥⑦⑧⑨);
my $darkString   = q(🅐🅑🅒🅓🅔🅕🅖🅗🅘🅙🅚🅛🅜🅝🅞🅟🅠🅡🅢🅣🅤🅥🅦🅧🅨🅩🅐🅑🅒🅓🅔🅕🅖🅗🅘🅙🅚🅛🅜🅝🅞🅟🅠🅡🅢🅣🅤🅥🅦🅧🅨🅩⓿➊➋➌➍➎➏➐➑➒);
my $superString  = q(ᴬᴮCᴰᴱFᴳᴴᴵᴶᴷᴸᴹᴺᴼᴾQᴿSᵀᵁⱽᵂXYZᵃᵇᶜᵈᵉᶠᵍʰⁱʲᵏˡᵐⁿᵒᵖqʳˢᵗᵘᵛʷˣʸᶻ⁰¹²³⁴⁵⁶⁷⁸⁹);
my $lowsubString = q(ₐbcdₑfgₕᵢⱼₖₗₘₙₒₚqᵣₛₜᵤᵥwₓyz₀₁₂₃₄₅₆₇₈₉);
my $lowerString  = join '', 'a'..'z', '0'..'9';

sub boldString($)                                                               # Convert alphanumerics in a string to bold.
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($normalString) ($boldString));                         # Some Perls cannot do this and complain but wI want to avoid excluding all the other methods in this file just because some perls cannot do this one operation.
  $string
 }

sub boldStringUndo($)                                                           # Undo alphanumerics in a string to bold.
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($boldString) ($normalString));
  $string
 }

sub enclosedString($)                                                           # Convert alphanumerics in a string to enclosed alphanumerics.
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($normalString) ($circleString));
  $string
 }

sub enclosedStringUndo($)                                                       # Undo alphanumerics in a string to enclosed alphanumerics.
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($circleString) ($normalString));
  $string
 }

sub enclosedReversedString($)                                                   # Convert alphanumerics in a string to enclosed reversed alphanumerics.
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($normalString) ($darkString));
  $string
 }

sub enclosedReversedStringUndo($)                                               # Undo alphanumerics in a string to enclosed reversed alphanumerics.
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($darkString)   ($normalString));
  $string
 }

sub superScriptString($)                                                        # Convert alphanumerics in a string to super scripts
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($normalString) ($superString));
  $string
 }

sub superScriptStringUndo($)                                                    # Undo alphanumerics in a string to super scripts
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($superString)  ($normalString));
  $string
 }

sub subScriptString($)                                                          # Convert alphanumerics in a string to sub scripts
 {my ($string) = @_;                                                           # String to convert
  eval qq(\$string =~ tr($lowerString)  ($lowsubString));
  $string
 }

sub subScriptStringUndo($)                                                      # Undo alphanumerics in a string to sub scripts
 {my ($string) = @_;                                                            # String to convert
  eval qq(\$string =~ tr($lowsubString) ($lowerString));
  $string
 }

#D1 Cloud Cover                                                                 # Useful for operating across the cloud.

sub makeDieConfess                                                              # Force die to confess where the death occurred
 {$SIG{__DIE__} = sub
   {confess shift;
   };
 }

sub ipAddressViaArp($)                                                          # Get the ip address of a server on the local network by hostname via arp
 {my ($hostName) = @_;                                                          # Host name
  my ($line) = grep {/$hostName/i} qx(arp -a 2>&1);                             # Search for host name in arp output
  return undef unless $line;                                                    # No such host
  my (undef, $ip) = split / /, $line;                                           # Get ip address
  $ip =~ s(\x28|\x29) ()gs;                                                     # Remove brackets around ip address
  $ip                                                                           # Return ip address
 }

sub saveCodeToS3($$$;$)                                                         # Save source code files.
 {my ($saveCodeEvery, $zipFileName, $bucket, $S3Parms) = @_;                    # Save every seconds, zip file name, bucket/key, additional S3 parameters like profile or region as a string
  my $saveTimeFile = q(.codeSaveTimes);                                         # Get last save time if any
  my $s3Parms = $S3Parms // '';
  my $lastSaveTime = -e $saveTimeFile ? retrieve($saveTimeFile) : undef;        # Get last save time
  return if $lastSaveTime and $lastSaveTime->[0] > time - $saveCodeEvery;       # Too soon

  return if fork;                                                               # Fork zip and upload
  say STDERR &timeStamp." Saving latest version of code to S3";

  my $z = filePathExt($zipFileName, q(zip));                                    # Zip file
  unlink $z;                                                                    # Remove old zip file

  if (my $c = <<END =~ s/\n/ /gsr)                                              # Zip command
zip -qr $z *
END
   {my $r = qx($c);
    confess "$c\n$r\n" if $r =~ m(\S);                                          # Confirm zip
   }

  if (my $c = "aws s3 cp $z s3://$bucket/$zipFileName.zip $s3Parms")            # Upload zip
   {my $r = qx($c);
    confess "$c\n$r\n" if $r =~ m(\S);                                          # Confirm upload
   }

  store([time], $saveTimeFile);                                                 # Save last save time
  unlink $z;                                                                    # Remove old zip file
  say STDERR &timeStamp." Saved latest version of code to S3";
  exit;
 }

sub saveSourceToS3($;$)                                                         #P Save source code.
 {my ($aws, $saveIntervalInSeconds) = @_;                                       # Aws target file and keywords, save internal
  $saveIntervalInSeconds //= 1200;                                              # Default save time
  cluck "saveSourceToS3 is deprecated, please use saveCodeToS3 instead";
  unless(fork())
   {my $saveTime = "/tmp/saveTime/$0";                                          # Get last save time if any
    makePath($saveTime);

    if (my $lastSaveTime = fileModTime($saveTime))                              # Get last save time
     {return if $lastSaveTime > time - $saveIntervalInSeconds;                  # Already saved
     }

    say STDERR &timeStamp." Saving latest version of code to S3";
    unlink my $z = qq(/tmp/DataTableText/save/$0.zip);                          # Zip file
    makePath($z);                                                               # Zip file folder
    my $c = qq(zip -r $z $0);                                                   # Zip command
    print STDERR $_ for qx($c);                                                 # Zip file to be saved
    my $a = qq(aws s3 cp $z $aws);                                              # Aws command
    my $r = qx($a);                                                             # Copy zip to S3
    #!$r or confess $r;
    writeFile($saveTime, time);                                                 # Save last save time
    say STDERR &timeStamp." Saved latest version of code to S3";
    exit;
   }
 }

sub addCertificate($)                                                           # Add a certificate to the current ssh session.
 {my ($file) = @_;                                                              # File containing certificate
  qx(ssh-add -t 100000000 $file 2>/dev/null);
 }

my $hostName;                                                                   # Host name cache.
sub hostName                                                                    # The name of the host we are running on.
 {$hostName //= trim(qx(hostname))
 }

my $userid;                                                                     # User name cache.
sub userId                                                                      # The userid we are currently running under.
 {$userid //= trim(qx(whoami))
 }

sub wwwEncode($)                                                                # Replace spaces in a string with %20 .
 {my ($string) = @_;                                                            # String
  $string =~ s(\s) (%20)gsr;
 }

sub startProcess(&\%$)                                                          # Start new processes while the number of child processes recorded in B<%$pids> is less than the specified B<$maximum>.  Use L<waitForAllStartedProcessesToFinish|/waitForAllStartedProcessesToFinish> to wait for all these processes to finish.
 {my ($sub, $pids, $maximum) = @_;                                              # Sub to start, hash in which to record the process ids, maximum number of processes to run at a time
  while(keys(%$pids) >= $maximum)                                               # Wait for enough processes to terminate to bring us below the maximum number of processes allowed.
   {my $p = waitpid 0,0;
    $$pids{$p} or confess "Pid $p not defined in ".dump($pids)."\n";
    delete $$pids{$p}
   }
  if (my $pid = fork)                                                           # Create new process
   {$$pids{$pid}++                                                              # Update pids
   }
  else                                                                          # Run sub in new process
   {&$sub;
    exit;
   }
 }

sub waitForAllStartedProcessesToFinish(\%)                                      # Wait until all the processes started by L<startProcess|/startProcess> have finished.
 {my ($pids) = @_;                                                              # Hash of started process ids
  while(keys %$pids)                                                            # Remaining processes
   {my $p = waitpid 0,0;
    $$pids{$p} or cluck "Pid $p not defined in ".dump($pids)."\n";
    delete $$pids{$p}
   }
 }

sub newServiceIncarnation($;$)                                                  # Create a new service incarnation to record the start up of a new instance of a service and return the description as a L<Data::Exchange::Service Definition hash|/Data::Exchange::Service Definition>.
 {my ($service, $file) = @_;                                                    # Service name, optional details file
  $file ||= fpe($ENV{HOME},                                                     # File to log service details in
    qw(.config com.appaapps services), $service, q(txt));                       # Service specification file
  my $t = genHash(q(Data::Exchange::Service),                                   # Service details.
    service=> $service,                                                         # The name of the service.
    start  => time + (-e $file ? 1 : 0),                                        # The time this service was started time plus a minor hack to simplify testing.
    file   => $file,                                                            # The file in which the service start details is being recorded.
   );
  dumpFile($file, $t);                                                          # Write details
  $t                                                                            # Return service details
 }

sub Data::Exchange::Service::check($$)                                          # Check that we are the current incarnation of the named service with details obtained from L<newServiceIncarnation|/newServiceIncarnation>. If the optional B<$continue> flag has been set then return the service details if this is the current service incarnation else B<undef>. Otherwise if the B<$continue> flag is false confess unless this is the current service incarnation thus bringing the earlier version of this service to an abrupt end.
 {my ($s, $continue) = @_;                                                      # Current service details, return result if B<$continue> is true else confess if the service has been replaced
  my $t = evalFile($s->file);                                                   # Latest service details
  return $t if $t->start   == $s->start   and                                   # Check service details match
               $t->service eq $s->service and
               $t->file    eq $t->file;
  confess $t->service. " replaced by a newer version\n" unless $continue;       # Replaced by a newer incarnation
  undef                                                                         # Not the current incarnation but continue specified
 }

#D1 Documentation                                                               # Extract, format and update documentation for a perl module.

sub htmlToc($@)                                                                 # Generate a table of contents for some html.
 {my ($replace, $html) = @_;                                                    # Sub-string within the html to be replaced with the toc, string of html
  my @toc;
  my %toc;

  for(split /\n/, $html)
   {next unless  /\A\s*<h(\d)\s+id="(.+?)"\s*>(.+?)<\/h\d>\s*\Z/;
    confess "Duplicate id $2\n" if $toc{$2}++;
    push @toc, [$1, $2, $3];
   }

  my @h;
  for my $head(keys @toc)
   {my ($level, $id, $title) = @{$toc[$head]};
    my $spacer = '&nbsp;' x (4*$level);
    push @h, <<END if $level < 2;
<tr><td>&nbsp;
END
    my $n = $head+1;
    push @h, <<END;
<tr><td align=right>$n<td>$spacer<a href="#$id">$title</a>
END
   }

  my $h = <<END.join "\n", @h, <<END;
<table cellspacing=10 border=0>
END
</table>
END

  $html =~ s($replace) ($h)gsr;
 }

sub extractTest($)                                                              #P Remove example markers from test code.
 {my ($string) = @_;                                                            # String containing test line
 #$string =~ s/\A\s*{?(.+?)\s*#.*\Z/$1/;                                        # Remove any initial white space and possible { and any trailing white space and comments
  $string =~ s(#T(\w|:)+) ()gs;                                                 # Remove test tags from line
  $string
 }

sub updateDocumentation(;$)                                                     # Update documentation from the comments in a perl script. Comments between the lines marked with:\m  #Dn title # description\mand:\m  #D\mwhere n is either 1, 2 or 3 indicating the heading level of the section and the # is in column 1.\mMethods are formatted as:\m  sub name(signature)      #FLAGS comment describing method\n   {my ($parameters) = @_; # comments for each parameter separated by commas.\mFLAGS can be chosen from:\m=over\m=item I\mmethod of interest to new users\m=item P\mprivate method\m=item r\moptionally replaceable method\m=item R\mrequired replaceable method\m=item S\mstatic method\m=item X\mdie rather than received a returned B<undef> result\m=back\mOther flags will be handed to the method extractDocumentationFlags(flags to process, method name) found in the file being documented, this method should return [the additional documentation for the method, the code to implement the flag].\mText following 'E\xxample:' in the comment (if present) will be placed after the parameters list as an example. Lines containing comments consisting of '#T'.methodName will also be aggregated and displayed as examples for that method.\mLines formatted as:\m  BEGIN{*source=*target}\mstarting in column 1 will define a synonym for a method.\mLines formatted as:\m  #C emailAddress text\mwill be aggregated in the acknowledgments section at the end of the documentation.\mThe character sequence B<\\xn> in the comment will be expanded to one new line, B<\\xm> to two new lines and B<L>B<<$_>>,B<L>B<<confess>>,B<L>B<<die>>,B<L>B<<eval>>,B<L>B<<lvalueMethod>> to links to the perl documentation.\mSearch for '#D1': in L<https://metacpan.org/source/PRBRENAN/Data-Table-Text-20180810/lib/Data/Table/Text.pm> to see  more examples of such documentation in action - although it is quite difficult to see as it looks just like normal comments placed in the code.\mParameters:\n
 {my ($perlModule) = @_;                                                        # Optional file name with caller's file being the default
  $perlModule //= $0;                                                           # Extract documentation from the caller if no perl module is supplied
  my $package = perlPackage($perlModule);                                       # Package name
  my $maxLinesInExample = 100;                                                  # Maximum number of lines in an example
  my %collaborators;                                                            # Collaborators #C pause-id  comment
  my %comment;                                                                  # The line comment associated with a method
  my %examples;                                                                 # Examples for each method
  my %genHashs;                                                                 # Attributes in objects defined by genHash
  my %genHash;                                                                  # Attributes in objects defined by genHash
  my %genHashPackage;                                                           # Packages defined by genHash
  my %iUseful;                                                                  # Immediately useful methods
  my %methods;                                                                  # Methods that have been coded as opposed to being generated
  my %methodParms;                                                              # Method names including parameters
  my %methodX;                                                                  # Method names for methods that have an version suffixed with X that die rather than returning B<undef>
  my %private;                                                                  # Private methods
  my %replace;                                                                  # Optional replaceable methods
  my %Replace;                                                                  # Required replaceable methods
  my %static;                                                                   # Static methods
  my %synonymTargetSource;                                                      # Synonyms from source to target - {$source}{$target} = 1 - can be several
  my %synonymTarget;                                                            # Synonym target - confess is more than one
  my %exported;                                                                 # Exported methods
  my %userFlags;                                                                # User flags
  my $oneLineDescription = qq(\n);                                              # One line description from =head1 Name
  my $install = '';                                                             # Additional installation notes
  my @doc;                                                                      # Documentation
  my @private;                                                                  # Documentation of private methods
  my $level = 0; my $off = 0;                                                   # Header levels

  my $sourceIsString = $perlModule =~ m(\n)s;                                   # Source of documentation is a string not a file
  my $Source = my $source = $sourceIsString ? $perlModule:readFile($perlModule);# Read the perl module from a file unless it is a string not a file

  if ($source =~ m(our\s+\$VERSION\s*=\s*(\S+)\s*;)s)                           # Update references to examples so we can include html and images etc. in the module
   {my $V = $1;                                                                 # Quoted version
    if (my $v = eval $V)                                                        # Remove any quotes
     {my $s = $source;
      $source =~                                                                # Replace example references in source
        s((https://metacpan\.org/source/\S+?-)(\d+)(/examples/))
         ($1$v$3)gs;
     }
   }

  if ($source =~ m(\n=head1\s+Name\s+(?:\w|:)+\s+(.+?)\n)s)                     # Extract one line description from =head1 Name ... Module name ... one line description
   {my $s = $1;
    $s =~ s(\A\s*-\s*) ();                                                      # Remove optional leading -
    $s =~ s(\s+\Z)     ();                                                      # Remove any trailing spaces
    $oneLineDescription = "\n$s\n";                                             # Save description
   }

  push @doc, <<"END";                                                           # Documentation
`head1 Description
$oneLineDescription
The following sections describe the methods in each functional area of this
module.  For an alphabetic listing of all methods by name see L<Index|/Index>.

END

  my @lines = split /\n/, $source;                                              # Split source into lines

  for my $l(keys @lines)                                                        # Tests associated with each method
   {my $line = $lines[$l];
    if (my @tags = $line =~ m/(?:\s#T((?:\w|:)+))/g)
     {my %tags; $tags{$_}++ for @tags;

      for(grep {$tags{$_} > 1} sort keys %tags)                                 # Check for duplicate example names on the same line
       {warn "Duplicate example name $_ on line $l";
       }

      my @testLines = (extractTest($line));

      if ($line =~ m/<<(END|'END'|"END")/)                                      # Process here documents
       {for(my $L = $l + 1; $L < @lines; ++$L)
         {my $nextLine = $lines[$L];
          push @testLines, extractTest($nextLine);
          last if $nextLine =~ m/\AEND/;                                        # Finish on END
         }
       }

      if ($line =~ m(\A(if\s*\x28\d+\x29|ˢ\{)))                                 # Process "if (\d+)" and ˢ{
       {my $M = $maxLinesInExample;
        for(my ($L, $N) = ($l + 1, 0); $L < @lines; ++$L, ++$N)
         {my $nextLine = $lines[$L];
          push @testLines, extractTest($nextLine);
          last if $nextLine =~ m/\A }/;                                         # Finish on closing brace in column 2
          $N < $M or confess "More than $M line example at line $l\n";          # Prevent overruns
         }
       }

      push @testLines, '';                                                      # Blank line between each test line

      for my $testLine(@testLines)                                              # Save test lines
       {for my $t(sort keys %tags)
         {$testLine =~ s(!) (#)g if $t =~ m(\AupdateDocumentation\Z)s;          # To prevent the example documentation using this method showing up for real.
          push @{$examples{$t}}, $testLine;
         }
       }
     }
   }

  for my $l(keys @lines)                                                        # Tests associated with replaceable methods
   {my $M = $maxLinesInExample;
    my $line = $lines[$l];
    if ($line =~ m(\Asub\s+((\w|:)+).*#(\w*)[rR]))
     {my $sub = $1;
      my @testLines = ($line =~ s(\s#.*\Z) ()r);
      for(my ($L, $N) = ($l + 1, 0); $L < @lines; ++$L, ++$N)
       {my $nextLine = $lines[$L];
        push @testLines, extractTest($nextLine);
        last if $nextLine =~ m/\A }/;                                           # Finish on closing brace in column 2
        $N < $M or confess "More than $M line example at line $l\n";            # Prevent overruns
       }
      push @testLines, '';                                                      # Blank line between each test line

      for my $testLine(@testLines)                                              # Save test lines
       {push @{$examples{$sub}}, $testLine;
       }
     }
   }

  for my $l(keys @lines)                                                        # Generated objects
   {my $M = $maxLinesInExample;
    my $line = $lines[$l];
    if ($line =~ m(genHash\s*\x28\s*(q\x28.+\x29|__PACKAGE__).+?# (.+)\Z))
     {my $p = $1; my $c = $2;
         $p = $p =~ s(q[qw]?\x28|\x29) ()gsr =~ s(__PACKAGE__) ($package)gsr;
      $genHashPackage{$p} = $c;
      for(my ($L, $N) = ($l + 1, 0); $L < @lines; ++$L, ++$N)
       {my $nextLine = $lines[$L];
        if ($nextLine =~ m(\A\s+(\w+)\s*=>\s*.+?# (.*)\Z))
         {$genHashs{$p}{$1} = $2;
         }
        last if $nextLine =~ m/\A\s*\);/;                                       # Finish on closing bracket
        $N < $M or confess                                                      # Prevent overruns
          "More than $M line genHash definition at line $l\n";
       }
     }
   }

  if (1)                                                                        # Bold method name in examples to make it easier to pick out with the slight disadvantage that the exampels can no longer be cut and paste without modification.
   {for my $m(sort keys %examples)
     {my $M = boldString($m);
      s(\b$m\b) ($M)g for @{$examples{$m}};
     }
   }

  for my $l(keys @lines)                                                        # Extract synonyms
   {my $line = $lines[$l];
    if ($line =~ m(\ABEGIN\{\*(\w+)=\*(\w+)\}))
     {my ($source, $target) = ($1, $2);
      $synonymTargetSource{$target}{$source} = 1;
      confess "Multiple targets for synonym: $source\n"
        if $synonymTarget{$target} and $synonymTarget{$target} ne $source;
      $synonymTarget{$source} = $target;
     }
   }

  unless($perlModule =~ m(\A(Text.pm|Doc.pm)\Z)s)                               # Load the module being documented so that we can call its extractDocumentationFlags method if needed to process user flags, we do not need to load these modules as they are already loaded
   {do "./$perlModule";
    confess $@ if $@;
   }

  for my $l(keys @lines)                                                        # Extract documentation from comments
   {my $line     = $lines[$l];                                                  # This line
    my $nextLine = $lines[$l+1];                                                # The next line
    if ($line =~ /\A#D(\d)\s+(.*?)\s*(#\s*(.+)\s*)?\Z/)                         # Sections are marked with #Dn in column 1-3 followed by title followed by optional text
     {$level = $1;
      my $headLevel = $level+$off;
      push @doc, "\n=head$headLevel $2" if $level;                              # Heading
      push @doc, "\n$4"                 if $level and $4;                       # Text of section
     }
    elsif ($line =~ /\A#C(?:ollaborators)?\s+(\S+)\s+(.+?)\s*\Z/)               # Collaborators
     {$collaborators{$1} = $2;
     }
    elsif ($line =~ /\A#I(?:nstall(?:ation)?)?\s+(.+)\Z/)                       # Extra install instructions
     {$install = "\\m$1\\m";
     }
    elsif ($line =~ /\A#D/)                                                     # Switch documentation off
     {$level = 0;
     }
    elsif ($level and $line =~                                                  # Documentation for a method
     /\Asub\b\s*(.*?)?(\s*:lvalue)?\s*#(\w*)\s+(.+?)\s*\Z/)
     {my ($sub, $lvalue, $flags, $comment, $example, $produces) =               # Name from sub, flags, description
         ($1, $2, $3, $4);
      $flags //= '';                                                            # No flags found

      if ($comment =~ m/\A(.*)Example:(.+?)\Z/is)                               # Extract example
       {$comment = $1;
       ($example, $produces) = split /:/, $2, 2;
       }

      my $signature = $sub =~ s/\A\s*(\w|:)+//gsr =~                            # Signature
                              s/\A\x28//gsr     =~
                              s/\x29\s*(:lvalue\s*)?\Z//gsr =~
                              s/;//gsr;                                         # Remove optional parameters marker from signature
      my $name      = $sub =~ s/\x28.*?\x29//r;                                 # Method name after removing parameters

      my $methodX   = $flags =~ m/X/;                                           # Die rather than return undef
      my $private   = $flags =~ m/P/;                                           # Private
      my $static    = $flags =~ m/S/;                                           # Static
      my $iUseful   = $flags =~ m/I/;                                           # Immediately useful
      my $exported  = $flags =~ m/E/;                                           # Exported
      my $replace   = $flags =~ m/r/;                                           # Optionally replaceable
      my $Replace   = $flags =~ m/R/;                                           # Required replaceable
      my $userFlags = $flags =~ s/[EIPrRSX]//gsr;                               # User flags == all flags minus the known flags

      confess "(P)rivate and (rR)eplacable are incompatible on method $name\n"
        if $private and $replace || $Replace;
      confess "(S)tatic and (rR)eplacable are incompatible on method $name\n"
        if $static and $replace || $Replace;
      confess "(E)xported and (rR)eplacable are incompatible on method $name\n"
        if $exported and $replace || $Replace;
      confess "(E)xported and (S)tatic are incompatible on method $name\n"
        if $exported and $static;

      $methodX   {$name} = $methodX     if $methodX;                            # MethodX
      $private   {$name} = $private     if $private;                            # Private
      $replace   {$name} = $replace     if $replace;                            # Optionally replace
      $Replace   {$name} = $Replace     if $Replace;                            # Required replace
      $static    {$name} = $static      if $static;                             # Static
      $iUseful   {$name} = $comment     if $iUseful;                            # Immediately useful
      $exported  {$name} = $exported    if $exported;                           # Exported
      $comment   {$name} = $comment;                                            # Comment describing method

      $userFlags{$name} =                                                       # Process user flags
        &docUserFlags($userFlags, $perlModule, $package, $name)
        if $userFlags;

      my ($parmNames, $parmDescriptions);
      if ($signature)                                                           # Parameters, parameter descriptions from comment
       {($parmNames, $parmDescriptions) =
         $nextLine =~ /\A\s*(.+?)\s*#\s*(.+?)\s*\Z/;
       }
      $parmNames //= ''; $parmDescriptions //= '';                              # No parameters

      my @parameters = split /,\s*/,                                            # Parameter names
        $parmNames =~ s/\A\s*\{my\s*\x28//r =~ s/\x29\s*=\s*\@_;//r;

      my $signatureLength = length($signature =~ s(\\) ()gsr);                  # Number of parameters in signature
      @parameters == $signatureLength or                                        # Check signature length
        confess "Wrong number of parameter descriptions for method: ".
          "$name($signature)\n";

      my @parmDescriptions = map {ucfirst()} split /,\s*/, $parmDescriptions;   # Parameter descriptions with first letter uppercased

      if (1)                                                                    # Check parameters comment
       {my $p = @parmDescriptions;
        my $l = $signatureLength;
        $p == $l or confess <<"END";
Method: $name($signature). The comment describing the parameters for this
method has descriptions for $p parameters but the signature suggests that there
are $l parameters.

The comment is split on /,/ to divide the comment into descriptions of each
parameter.

The comment supplied is:
$parmDescriptions
END
       }

      my $parametersAsString = join ', ', @parameters;                          # Parameters as a comma separated string
      my $headLevel = $level+$off+1;                                            # Heading level
      my $methodSignature = "$name($parametersAsString)";                       # Method(signature)

      $methods{$name}++;                                                        # Methods that have been coded as opposed to being generated
      $methodParms{$name} = $name;                                              # Method names not including parameters
      $methodParms{$name.'X'} = $name if $methodX;                              # Method names not including parameters
      $methodX{$name}++ if $methodX;                                            # Method names that have an X version
      if (my $u = $userFlags{$name})                                            # Add names of any generated methods
       {$methodParms{$_} = $name for @{$u->[2]};                                # Generated names array
       }

      my @method;                                                               # Accumulate method documentation

      if (1)                                                                    # Section title
       {my $h = $private ? 2 : $headLevel;
        push @method, "\n=head$h $name($signature)\n\n$comment\n";              # Method description
       }

      push @method, indentString(formatTable
       ([map{[$parameters[$_], $parmDescriptions[$_]]} keys @parameters],
        [qw(Parameter Description)]), '  ')
        if $parmNames and $parmDescriptions and $parmDescriptions !~ /\A#/;     # Add parameter description if present

      push @method,                                                             # Add user documentation
       "\n".$userFlags{$name}[0]."\n"          if $userFlags{$name}[0];

      push @method,                                                             # Add example
       "\nExample:\n\n  $example"              if $example;

      push @method,                                                             # Produces
       "\n$produces"                           if $produces;

      if (my $examples = $examples{$name})                                      # Format examples
       {if (my @examples = @$examples)
         {push @method, '\nExample:\m', map {"  $_"} @examples;
         }
       }

      push @method,                                                             # Optionally replaceable
       "\nYou can provide an implementation of this method as ".
       "B<${package}::$name> if you wish to override the default processing."
        if $replace;

      push @method,                                                             # Required replaceable
       "\nYou must supply an implementation of this method as ".
       "B<${package}::$name>."
        if $Replace;

      push @method,                                                             # Add a note about the availability of an X method
       "\nUse B<${name}X> to execute L<$name|/$name> but B<die> '$name'".
       " instead of returning B<undef>"        if $methodX;

      push @method,                                                             # Static method
       "\nThis is a static method and so should be invoked as:\n\n".
       "  $package\:\:$name\n"                 if $static;

      push @method,                                                             # Exported
       "\nThis method can be imported via:\n\n".
       "  use $package qw($name)\n"            if $exported;

      if (my $s = $synonymTargetSource{$name})                                  # Synonym
       {if (keys %$s)
         {for my $source(sort keys %$s)
           {push @method, "\nB<$source> is a synonym for L<$name|/$name>.\n";
           }
         }
       }

      push @{$private ? \@private : \@doc}, @method;                            # Save method documentation in correct section
     }
    elsif ($level and $line =~                                                  # Documentation for a generated lvalue * method = sub name comment
     /\A\s*genLValue(?:\w+?)Methods\s*\x28q(?:w|q)?\x28(\w+)\x29\x29;\s*#\s*(.+?)\s*\Z/)
     {my ($name, $description) = ($1, $2);                                      # Name from sub, description from comment
      next if $description =~ /\A#/;                                            # Private method if #P
      my $headLevel = $level+$off+1;                                            # Heading level
      $methodParms{$name} = $name;                                              # Method names not including parameters
      $comment    {$name} = $description =~ s(\A#) ()gsr;                       # Description of method
      push @doc, "\n=head$headLevel $name :lvalue\n\n$description\n";           # Method description
     }
   }

  if (keys %genHashs)                                                           # Document generated objects
   {push my @d, qq(\n), qq(=head1 Hash Definitions), qq(\n);
    for   my $package  (sort keys % genHashs)
     {push @d, qq(\n), qq(=head2 $package Definition), qq(\n),
                 $genHashPackage{$package}, qq(\n);
      for my $attribute(sort keys %{$genHashs{$package}})
       {my $comment = $genHashs{$package}{$attribute};
        push @d, "B<$attribute> - $comment\n";
       }
     }
    push @doc, @d;
   }

  if (1)                                                                        # Alphabetic listing of methods that still need examples
   {my %m = %methods;
    delete @m{$_, "$_ :lvalue"} for keys %examples;
    delete @m{$_, "$_ :lvalue"} for keys %private;
    my $n = keys %m;
    my $N = keys %methods;
    say STDERR formatTable(\%m), "\n$n of $N methods still need tests" if $n;
   }

  if (keys %iUseful)                                                            # Alphabetic listing of immediately useful methods
    {my @d;
     push @d, <<END;

`head1 Immediately useful methods

These methods are the ones most likely to be of immediate use to anyone using
this module for the first time:

END
    for my $m(sort {lc($a) cmp lc($b)} keys %iUseful)
     {my $c = $iUseful{$m};
       push @d, "L<$m|/$m>\n\n$c\n"
     }
    push @d, <<END;

END
    unshift @doc, (shift @doc, @d)                                              # Put first after title
   }

  push @doc, qq(\n\n=head1 Private Methods), @private if @private;              # Private methods in a separate section if there are any

  if (keys %synonymTarget)                                                      # Synonyms
   {my @s;
    my $line;
    for my $source(sort keys %synonymTarget)
     {my $target  = $synonymTarget{$source};
      my $comment = $comment{$target} // confess "No comment for $target\n";
         $comment =~ s(\..*\Z) (\.)s;
      push @s, qq(B<$source> is a synonym for L<$target|/$target> - $comment);
     }
    my $s = join q(\n\n), @s;
    push @doc, qq(\n\n=head1 Synonyms\n\n$s\n);
   }

  push @doc, qq(\n\n=head1 Index\n\n);
  if (1)
   {my $n = 0;
    for my $s(sort {lc($a) cmp lc($b)} keys %methodParms)                       # Alphabetic listing of methods
     {my $t = $methodParms{$s};
      my $c = $comment{$s};
      if ($c and $t)
       {$c =~ s(\..*\Z) (\.)s;
        push @doc, ++$n.qq( L<$s|/$t> - $c\n);
       }
     }
   }

  if (keys %exported)                                                           # Exported methods available
   {push @doc, <<"END";


`head1 Exports

All of the following methods can be imported via:

  use $package qw(:all);

Or individually via:

  use $package qw(<method>);


END

    my $n = 0;
    for my $s(sort {lc($a) cmp lc($b)} keys %exported)                          # Alphabetic listing of exported methods
     {push @doc, ++$n." L<$s|/$s>\n"
     }
   }

  push @doc, <<END;                                                             # Standard stuff
`head1 Installation

This module is written in 100% Pure Perl and, thus, it is easy to read,
comprehend, use, modify and install via B<cpan>:

  sudo cpan install $package

`head1 Author

L<philiprbrenan\@gmail.com|mailto:philiprbrenan\@gmail.com>

L<http://www.appaapps.com|http://www.appaapps.com>

`head1 Copyright

Copyright (c) 2016-2018 Philip R Brenan.

This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.
END

  if (keys %collaborators)                                                      # Acknowledge any collaborators
   {push @doc,
     '\n=head1 Acknowledgements\m'.
     'Thanks to the following people for their help with this module:\m'.
     '=over\m';
    for(sort keys %collaborators)
     {my $p = "L<$_|mailto:$_>";
      my $r = $collaborators{$_};
      push @doc, "=item $p\n\n$r\n\n";
     }
    push @doc, '=back\m';
   }

  push @doc, '=cut\m';                                                          # Finish documentation

  if (keys %methodX)                                                            # Insert X method definitions
   {my @x;
    for my $x(sort keys %methodX)
     {push @x, ["sub ${x}X", "{&$x", "(\@_) || die '$x'}"];
     }
    push @doc, formatTableBasic(\@x);
   }

  for my $name(sort keys %userFlags)                                            # Insert generated method definitions
   {if (my $doc = $userFlags{$name})
     {push @doc, $doc->[1] if $doc->[1];
     }
   }

  push @doc, <<'END';                                                           # Standard test sequence

# Tests and documentation

sub test
 {my $p = __PACKAGE__;
  binmode($_, ":utf8") for *STDOUT, *STDERR;
  return if eval "eof(${p}::DATA)";
  my $s = eval "join('', <${p}::DATA>)";
  $@ and die $@;
  eval $s;
  $@ and die $@;
  1
 }

test unless caller;
END


  for(@doc)                                                                     # Expand snippets in documentation
   {s/\\m/\n\n/gs;                                                              # Double new line
    s/\\n/\n/gs;                                                                # Single new line
    s/\\x//gs;                                                                  # Break
    s/`/=/gs;
    s(L<lvalueMethod>) (L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines>);
    s(L<confess>)      (L<confess|http://perldoc.perl.org/Carp.html#SYNOPSIS/>);
    s(L<die>)          (L<die|http://perldoc.perl.org/functions/die.html>);
    s(L<eval>)         (L<eval|http://perldoc.perl.org/functions/eval.html>);
    s(L<\$_>)          (L<\$_|http://perldoc.perl.org/perlvar.html#General-Variables>);
    s(L<our>)          (L<our|https://perldoc.perl.org/functions/our.html>);
    s(L<Imagemagick>)  (L<Imagemagick|/https://www.imagemagick.org/script/index.php>);
    s(L<Dita>)         (L<Dita|http://docs.oasis-open.org/dita/dita/v1.3/os/part2-tech-content/dita-v1.3-os-part2-tech-content.html>);
    s(L<Xml parser>)   (L<Xml parser|https://metacpan.org/pod/XML::Parser/>);
    s(L<html table>)   (L<html table|https://www.w3.org/TR/html52/tabular-data.html#the-table-element>);
   }

  my $doc = join "\n", @doc;                                                    # Documentation

  #say STDERR "Documentation\n$doc", dump(\%examples); return $doc;             # Testing

  unless($sourceIsString)                                                       # Update source file
   {$source =~ s/\n+=head1 Description.+?\n+1;\n+/\n\n$doc\n1;\n/gs;            # Edit module source from =head1 description to final 1;

    if ($source ne $Source)                                                     # Save source only if it has changed and came from a file
     {overWriteFile(filePathExt($perlModule, qq(backup)), $source);             # Backup module source
      overWriteFile($perlModule, $source);                                      # Write updated module source
     }
   }

  $doc
 } # updateDocumentation

sub docUserFlags($$$$)                                                          #P Generate documentation for a method by calling the extractDocumentationFlags method in the package being documented, passing it the flags for a method and the name of the method. The called method should return the documentation to be inserted for the named method.
 {my ($flags, $perlModule, $package, $name) = @_;                               # Flags, file containing documentation, package containing documentation, name of method to be processed
  my $s = <<END;
${package}::extractDocumentationFlags("$flags", "$name");
END

  use Data::Dump qw(dump);
  my $r = eval $s;
  confess "$s\n". dump($@, $!) if $@;
  $r
 }

sub updatePerlModuleDocumentation($)                                            #P Update the documentation in a perl file and show said documentation in a web browser.
 {my ($perlModule) = @_;                                                        # File containing the code of the perl module
  -e $perlModule or confess "No such file:\n$perlModule\n";
  updateDocumentation($perlModule);                                             # Update documentation

  zzz("pod2html --infile=$perlModule --outfile=zzz.html && ".                   # View documentation
      " firefox file:zzz.html && ".
      " (sleep 5 && rm zzz.html pod2htmd.tmp) &");
 }

#-------------------------------------------------------------------------------
# Export - eeee
#-------------------------------------------------------------------------------

use Exporter qw(import);

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

# containingFolder

@ISA          = qw(Exporter);
@EXPORT       = qw(formatTable);
@EXPORT_OK    = qw(
absFromAbsPlusRel addCertificate addLValueScalarMethods appendFile assertRef assertPackageRefs
binModeAllUtf8 boldString boldStringUndo
call checkFile checkFilePath checkFilePathExt checkFilePathDir
checkKeys clearFolder contains containingPowerOfTwo
convertDocxToFodt convertImageToJpx convertUnicodeToXml
createEmptyFile currentDirectory currentDirectoryAbove cutOutImagesInFodtFile
dateStamp dateTimeStamp decodeJson decodeBase64 dumpFile dumpGZipFile
enclosedString enclosedStringUndo enclosedReversedString enclosedReversedStringUndo
encodeJson encodeBase64 evalFile evalGZipFile
fileList fileModTime fileOutOfDate
filePath filePathDir filePathExt fileSize findDirs findFiles
findFileWithExtension
firstFileThatExists firstNChars
formatTableBasic fpd fpe fpf fp fe fn fpn fne fullFileName
genClass genHash
genLValueArrayMethods genLValueHashMethods
genLValueScalarMethods genLValueScalarMethodsWithDefaultValues
hostName htmlToc
imageSize indentString ipAddressViaArp isBlank
javaPackage javaPackageAsFileName
keyCount
loadArrayArrayFromLines loadArrayFromLines loadArrayHashFromLines
loadHash loadHashArrayFromLines loadHashFromLines loadHashHashFromLines
makeDieConfess
makePath matchPath max microSecondsSinceEpoch min
newServiceIncarnation numberOfLinesInFile numberOfLinesInString
nws
overWriteFile owf
pad parseFileName parseCommandLineArguments powerOfTwo printFullFileName printQw
quoteFile
readBinaryFile readFile readGZipFile readUtf16File relFromAbsAgainstAbs removeBOM removeFilePrefix
saveCodeToS3 saveSourceToS3 searchDirectoryTreesForMatchingFiles
setIntersectionOfTwoArraysOfWords setUnionOfTwoArraysOfWords startProcess
superScriptString superScriptStringUndo subScriptString subScriptStringUndo
temporaryDirectory temporaryFile temporaryFolder timeStamp trackFiles trim
updateDocumentation updatePerlModuleDocumentation userId
versionCode versionCodeDashed
waitForAllStartedProcessesToFinish wwwEncode writeBinaryFile writeFile writeFiles writeGZipFile
xxx XXX
zzz
ˢ
);
%EXPORT_TAGS  = (all=>[@EXPORT, @EXPORT_OK]);

#D
# podDocumentation
#C mim@cpan.org Testing on windows

=pod

=encoding utf-8

=head1 Name

Data::Table::Text - Write data in tabular text format.

=head1 Synopsis

  use Data::Table::Text;

# Print a table:

  my $d =
   [[qq(a), qq(b\nbb), qq(c\ncc\nccc\n)],
    [qq(1), qq(1\n22), qq(1\n22\n333\n)],
   ];

  my $t = formatTable($d, [qw(A BB CCC)]);

  ok $t eq <<END;
     A  BB  CCC
  1  a  b   c
        bb  cc
            ccc
  2  1   1    1
        22   22
            333
  END

# Print a table containing tables and make it into a report:

  my $D = [[qq(See the\ntable\nopposite), $t],
           [qq(Or\nthis\none),            $t],
          ];


  my $T = formatTable($D, [qw(Description Table)], head=><<END);
  Table of Tables.

  Table has NNNN rows each of which contains a table.
  END

  ok $T eq <<END;
  Table of Tables.

  Table has 2 rows each of which contains a table.


     Description  Table
  1  See the         A  BB  CCC
     table        1  a  b   c
     opposite           bb  cc
                            ccc
                  2  1   1    1
                        22   22
                            333
  2  Or              A  BB  CCC
     this         1  a  b   c
     one                bb  cc
                            ccc
                  2  1   1    1
                        22   22
                            333
  END

# Print an array of arrays:

  my $aa = formatTable
   ([[qw(A   B   C  )],
     [qw(AA  BB  CC )],
     [qw(AAA BBB CCC)],
     [qw(1   22  333)]],
     [qw (aa  bb  cc)]);

  ok $aa eq <<END;
     aa   bb   cc
  1  A    B    C
  2  AA   BB   CC
  3  AAA  BBB  CCC
  4    1   22  333
  END

# Print an array of hashes:

  my $ah = formatTable
   ([{aa=> "A",   bb => "B",   cc => "C" },
     {aa=> "AA",  bb => "BB",  cc => "CC" },
     {aa=> "AAA", bb => "BBB", cc => "CCC" },
     {aa=> 1,     bb => 22,    cc => 333 }]);

  ok $ah eq <<END;
     aa   bb   cc
  1  A    B    C
  2  AA   BB   CC
  3  AAA  BBB  CCC
  4    1   22  333
  END

# Print a hash of arrays:

  my $ha = formatTable
   ({""     => ["aa",  "bb",  "cc"],
     "1"    => ["A",   "B",   "C"],
     "22"   => ["AA",  "BB",  "CC"],
     "333"  => ["AAA", "BBB", "CCC"],
     "4444" => [1,      22,    333]},
     [qw(Key A B C)]
     );

  ok $ha eq <<END;
  Key   A    B    C
        aa   bb   cc
     1  A    B    C
    22  AA   BB   CC
   333  AAA  BBB  CCC
  4444    1   22  333
  END

# Print a hash of hashes:

  my $hh = formatTable
   ({a    => {aa=>"A",   bb=>"B",   cc=>"C" },
     aa   => {aa=>"AA",  bb=>"BB",  cc=>"CC" },
     aaa  => {aa=>"AAA", bb=>"BBB", cc=>"CCC" },
     aaaa => {aa=>1,     bb=>22,    cc=>333 }});

  ok $hh eq <<END;
        aa   bb   cc
  a     A    B    C
  aa    AA   BB   CC
  aaa   AAA  BBB  CCC
  aaaa    1   22  333
  END

# Print an array of scalars:

  my $a = formatTable(["a", "bb", "ccc", 4], [q(#), q(Col)]);

  ok $a eq <<END;
  #  Col
  0  a
  1  bb
  2  ccc
  3    4
  END

# Print a hash of scalars:

  my $h = formatTable({aa=>"AAAA", bb=>"BBBB", cc=>"333"}, [qw(Key Title)]);

  ok $h eq <<END;
  Key  Title
  aa   AAAA
  bb   BBBB
  cc     333
  END

=head1 Description

Write data in tabular text format.

The following sections describe the methods in each functional area of this
module.  For an alphabetic listing of all methods by name see L<Index|/Index>.



=head1 Time stamps

Date and timestamps as used in logs of long running commands.

=head2 dateTimeStamp()

Year-monthNumber-day at hours:minute:seconds


Example:


  ok dateTimeStamp     =~ m(\A\d{4}-\d\d-\d\d at \d\d:\d\d:\d\d\Z);


=head2 dateStamp()

Year-monthName-day


Example:


  ok dateStamp         =~ m(\A\d{4}-\w{3}-\d\d\Z);


=head2 versionCode()

YYYYmmdd-HHMMSS


Example:


  ok versionCode       =~ m(\A\d{8}-\d{6}\Z);


=head2 versionCodeDashed()

YYYY-mm-dd-HH:MM:SS


Example:


  ok versionCodeDashed =~ m(\A\d{4}-\d\d-\d\d-\d\d:\d\d:\d\d\Z);


=head2 timeStamp()

hours:minute:seconds


Example:


  ok timeStamp         =~ m(\A\d\d:\d\d:\d\d\Z);


=head2 microSecondsSinceEpoch()

Micro seconds since unix epoch.


Example:


  ok microSecondsSinceEpoch > 47*365*24*60*60*1e6;


=head1 Command execution

Various ways of processing commands.

=head2 xxx(@)

Execute a shell command. The command to execute is specified as one or more strings which are joined together after removing any new lines. Optionally the last string can be a regular expression that is used to test the output generated by the execution the command: if the regular expression fails the command output is printed, else it is suppressed as being uninteresting.

     Parameter  Description
  1  @cmd       Command to execute followed by an optional regular expression to test the results

Example:


   {ok xxx("echo aaa")       =~ /aaa/;


=head2 yyy($)

Execute a block of shell commands line by line after removing comments - stop if there is a non zero return code from any command.

     Parameter  Description
  1  $cmd       Commands to execute separated by new lines

Example:


    ok !yyy <<END;
  echo aaa
  echo bbb
  END


=head2 zzz($$$$)

Execute lines of commands after replacing new lines with && then check that the pipeline execution results in a return code of zero and that the execution results match the optional regular expression if one has been supplied; confess() to an error if either check fails.

     Parameter    Description
  1  $cmd         Commands to execute - one per line with no trailing &&
  2  $success     Optional regular expression to check for acceptable results
  3  $returnCode  Optional regular expression to check the acceptable return codes
  4  $message     Message of explanation if any of the checks fail

Example:


  ok zzz(<<END, qr(aaa\s*bbb)s);
  echo aaa
  echo bbb
  END


=head2 parseCommandLineArguments(&$$)

Classify the specified array of words referred to by B<$args> into positional and keyword parameters, call the specified B<sub> with a reference to an array of positional parameters followed by a reference to a hash of keywords and their values then return the value returned by this sub. The keywords names will be validated if  B<$valid> is either a reference to an array of valid keywords names or a hash of valid keyword names => textual descriptions. Confess with a table of valid keywords definitions if the B<$valid> keywords are specified and an invalid one is presented.

     Parameter  Description
  1  $sub       Sub to call
  2  $args      List of arguments to parse
  3  $valid     Optional list of valid parameters else all parameters will be accepted

Example:


    my $r = parseCommandLineArguments {[@_]}

     [qw( aaa bbb -c --dd --eee=EEEE -f=F), q(--gg=g g), q(--hh=h h)];

    is_deeply $r,

      [["aaa", "bbb"],

       {c=>undef, dd=>undef, eee=>"EEEE", f=>"F", gg=>"g g", hh=>"h h"},

      ];


=head2 call(&@)

Call the specified sub in a separate process, wait for it to complete, copy back the named L<our|https://perldoc.perl.org/functions/our.html> variables, free the memory used.

     Parameter  Description
  1  $sub       Sub to call
  2  @our       Our variable names with preceding sigils to copy back

Example:


  ˢ{our $a = q(1);
    our @a = qw(1);
    our %a = (a=>1);
    our $b = q(1);
    for(2..4) {
      call {$a = $_  x 1000; $a[0] = $_; $a{a} = $_; $b = 2;} qw($a @a %a);
      ok $a    == $_ x 1000;
      ok $a[0] == $_;
      ok $a{a} == $_;
      ok $b    == 1;
     }
   };


=head1 Files and paths

Operations on files and paths.

=head2 Statistics

Information about each file.

=head3 fileSize($)

Get the size of a file.

     Parameter  Description
  1  $file      File name

Example:


    my $f = writeFile("zzz.data", "aaa");

    ok fileSize($f) == 3;


=head3 fileModTime($)

Get the modified time of a file in seconds since the epoch.

     Parameter  Description
  1  $file      File name

Example:


  ok fileModTime($0) =~ m(\A\d+\Z)s;


=head3 fileOutOfDate(&$@)

Calls the specified sub once for each source file that is missing, then calls the sub for the target if there were any missing files or if the target is older than any of the non missing source files or if the target does not exist. The file name is passed to the sub each time in $_. Returns the files to be remade in the order they should be made.

     Parameter  Description
  1  $make      Make with this sub
  2  $target    Target file
  3  @source    Source files

Example:


  if (0) {
    my @Files = qw(a b c);
    my @files = (@Files, qw(d));
    writeFile($_, $_), sleep 1 for @Files;

    my $a = '';
    my @a = fileOutOfDate {$a .= $_} q(a), @files;
    ok $a eq 'da';
    is_deeply [@a], [qw(d a)];

    my $b = '';
    my @b = fileOutOfDate {$b .= $_} q(b), @files;
    ok $b eq 'db';
    is_deeply [@b], [qw(d b)];

    my $c = '';
    my @c = fileOutOfDate {$c .= $_} q(c), @files;
    ok $c eq 'dc';
    is_deeply [@c], [qw(d c)];

    my $d = '';
    my @d = fileOutOfDate {$d .= $_} q(d), @files;
    ok $d eq 'd';
    is_deeply [@d], [qw(d)];

    my @A = fileOutOfDate {} q(a), @Files;
    my @B = fileOutOfDate {} q(b), @Files;
    my @C = fileOutOfDate {} q(c), @Files;
    is_deeply [@A], [qw(a)];
    is_deeply [@B], [qw(b)];
    is_deeply [@C], [];
    unlink for @Files;
   }


=head3 firstFileThatExists(@)

Returns the name of the first file that exists or B<undef> if none of the named files exist.

     Parameter  Description
  1  @files     Files to check

Example:


    my $d = temporaryFolder;

    ok $d eq firstFileThatExists("$d/$d", $d);


=head2 Components

File names and components.

=head3 Fusion

Create file names from file name components.

=head4 filePath(@)

Create a file name from an array of file name components. If all the components are blank then a blank file name is returned.  Identical to L<fpf|/fpf>.

     Parameter  Description
  1  @file      File name components

Example:


  if (1) {
    ok filePath   (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
    ok filePathDir(qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
    ok filePathDir('', qw(aaa))              eq "aaa/";
    ok filePathDir('')                       eq "";
    ok filePathExt(qw(aaa xxx))              eq "aaa.xxx";
    ok filePathExt(qw(aaa bbb xxx))          eq "aaa/bbb.xxx";

    ok fpd        (qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
    ok fpf        (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
    ok fpe        (qw(aaa bbb xxx))          eq "aaa/bbb.xxx";
   }


B<fpf> is a synonym for L<filePath|/filePath>.


=head4 filePathDir(@)

Create a directory name from an array of file name components. If all the components are blank then a blank file name is returned.   Identical to L<fpd|/fpd>.

     Parameter  Description
  1  @file      Directory name components

Example:


  if (1) {
    ok filePath   (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
    ok filePathDir(qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
    ok filePathDir('', qw(aaa))              eq "aaa/";
    ok filePathDir('')                       eq "";
    ok filePathExt(qw(aaa xxx))              eq "aaa.xxx";
    ok filePathExt(qw(aaa bbb xxx))          eq "aaa/bbb.xxx";

    ok fpd        (qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
    ok fpf        (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
    ok fpe        (qw(aaa bbb xxx))          eq "aaa/bbb.xxx";
   }


B<fpd> is a synonym for L<filePathDir|/filePathDir>.


=head4 filePathExt(@)

Create a file name from an array of file name components the last of which is an extension. Identical to L<fpe|/fpe>.

     Parameter  Description
  1  @File      File name components and extension

Example:


  if (1) {
    ok filePath   (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
    ok filePathDir(qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
    ok filePathDir('', qw(aaa))              eq "aaa/";
    ok filePathDir('')                       eq "";
    ok filePathExt(qw(aaa xxx))              eq "aaa.xxx";
    ok filePathExt(qw(aaa bbb xxx))          eq "aaa/bbb.xxx";

    ok fpd        (qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
    ok fpf        (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
    ok fpe        (qw(aaa bbb xxx))          eq "aaa/bbb.xxx";
   }


B<fpe> is a synonym for L<filePathExt|/filePathExt>.


=head3 Fission

Get file name components from file names.

=head4 fp($)

Get path from file name.

     Parameter  Description
  1  $file      File name

Example:


  ok fp (q(a/b/c.d.e))  eq q(a/b/);


=head4 fpn($)

Remove extension from file name.

     Parameter  Description
  1  $file      File name

Example:


  ok fpn(q(a/b/c.d.e))  eq q(a/b/c.d);


=head4 fn($)

Remove path and extension from file name.

     Parameter  Description
  1  $file      File name

Example:


  ok fn (q(a/b/c.d.e))  eq q(c.d);


=head4 fne($)

Remove path from file name.

     Parameter  Description
  1  $file      File name

Example:


  ok fne(q(a/b/c.d.e))  eq q(c.d.e);


=head4 fe($)

Get extension of file name.

     Parameter  Description
  1  $file      File name

Example:


  ok fe (q(a/b/c.d.e))  eq q(e);


=head4 checkFile($)

Return the name of the specified file if it exists, else confess the maximum extent of the path that does exist.

     Parameter  Description
  1  $file      File to check

Example:


    my $d = filePath   (my @d = qw(a b c d));

    my $f = filePathExt(qw(a b c d e x));

    my $F = filePathExt(qw(a b c e d));

    createEmptyFile($f);

    ok checkFile($d);

    ok checkFile($f);


=head4 quoteFile($)

Quote a file name.

     Parameter  Description
  1  $file      File name

Example:


  ok quoteFile(fpe(qw(a b c))) eq q("a/b.c");


=head4 removeFilePrefix($@)

Removes a file prefix from an array of files.

     Parameter  Description
  1  $prefix    File prefix
  2  @files     Array of file names

Example:


  is_deeply [qw(a b)], [&removeFilePrefix(qw(a/ a/a a/b))];

  is_deeply [qw(b)],   [&removeFilePrefix("a/", "a/b")];


=head4 titleToUniqueFileName($$$$)

Create a file name from a title that is unique within the set %uniqueNames.

     Parameter         Description
  1  $uniqueFileNames  Unique file names hash {} which will be updated by this method
  2  $title            Title
  3  $suffix           File name suffix
  4  $ext              File extension

Example:


  ˢ{my $f = {};
    ok q(a_p.txt)   eq &titleToUniqueFileName($f, qw(a p txt));
    ok q(a_p_2.txt) eq &titleToUniqueFileName($f, qw(a p txt));
    ok q(a_p_3.txt) eq &titleToUniqueFileName($f, qw(a p txt));
    ok q(a_q.txt)   eq &titleToUniqueFileName($f, qw(a q txt));
    ok q(a_q_5.txt) eq &titleToUniqueFileName($f, qw(a q txt));
    ok q(a_q_6.txt) eq &titleToUniqueFileName($f, qw(a q txt));
   };

    ok q(a_p.txt)   eq &titleToUniqueFileName($f, qw(a p txt));

    ok q(a_p_2.txt) eq &titleToUniqueFileName($f, qw(a p txt));

    ok q(a_p_3.txt) eq &titleToUniqueFileName($f, qw(a p txt));

    ok q(a_q.txt)   eq &titleToUniqueFileName($f, qw(a q txt));

    ok q(a_q_5.txt) eq &titleToUniqueFileName($f, qw(a q txt));

    ok q(a_q_6.txt) eq &titleToUniqueFileName($f, qw(a q txt));


=head2 Position

Position in the file system.

=head3 currentDirectory()

Get the current working directory.


Example:


    currentDirectory;


=head3 currentDirectoryAbove()

The path to the folder above the current working folder.


Example:


    currentDirectoryAbove;


=head3 parseFileName($)

Parse a file name into (path, name, extension).

     Parameter  Description
  1  $file      File name to parse

Example:


    is_deeply [parseFileName "a.b/c.d.e"],            [qw(a.b/ c.d e)];


=head3 fullFileName()

Full name of a file.


Example:


    fullFileName(fpe(qw(a txt)));


=head3 absFromAbsPlusRel($$)

Create an absolute file from an absolute file and a relative file.

     Parameter  Description
  1  $a         Absolute file name
  2  $f         Relative file name

Example:


  ok "/home/la/perl/aaa.pl"   eq absFromAbsPlusRel("/home/la/perl/bbb",      "aaa.pl");

  ok "/home/la/perl/aaa.pl"   eq absFromAbsPlusRel("/home/il/perl/bbb.pl",   "../../la/perl/aaa.pl");


=head3 relFromAbsAgainstAbs($$)

Derive a relative file name for the first absolute file name relative to the second absolute file name.

     Parameter  Description
  1  $f         Absolute file to be made relative
  2  $a         Absolute file name to make relative to.

Example:


  ok "bbb.pl"                 eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/perl/aaa.pl");

  ok "../perl/bbb.pl"         eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/java/aaa.jv");


=head2 Temporary

Temporary files and folders

=head3 temporaryFile()

Create a temporary file that will automatically be L<unlinked|/unlink> during END processing.


Example:


    my $f = temporaryFile;


=head3 temporaryFolder()

Create a temporary folder that will automatically be L<rmdired|/rmdir> during END processing.


Example:


    my $D = temporaryFolder;


B<temporaryDirectory> is a synonym for L<temporaryFolder|/temporaryFolder>.


=head2 Find

Find files and folders below a folder.

=head3 findFiles($$)

Find all the files under a folder and optionally filter the selected files with a regular expression.

     Parameter  Description
  1  $dir       Folder to start the search with
  2  $filter    Optional regular expression to filter files

Example:


    my $D = temporaryFolder;

    my $d = fpd($D, q(ddd));

    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);

    is_deeply [sort map {fne $_} findFiles($d, qr(txt\Z))], [qw(a.txt b.txt c.txt)];


=head3 findDirs($$)

Find all the folders under a folder and optionally filter the selected folders with a regular expression.

     Parameter  Description
  1  $dir       Folder to start the search with
  2  $filter    Optional regular expression to filter files

Example:


    my $D = temporaryFolder;

    my $d = fpd($D, q(ddd));

    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);

    is_deeply [findDirs($D)], [$D, $d];


=head3 fileList($)

Files that match a given search pattern handed to bsd_glob.

     Parameter  Description
  1  $pattern   Search pattern

Example:


    my $D = temporaryFolder;

    my $d = fpd($D, q(ddd));

    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);

    is_deeply [sort map {fne $_} fileList("$d/*.txt")],

              ["a.txt", "b.txt", "c.txt"];


=head3 searchDirectoryTreesForMatchingFiles(@)

Search the specified directory trees for the files (not folders) that match the specified extensions. The argument list should include at least one path name to be useful. If no file extension is supplied then all the files below the specified paths are returned.

     Parameter              Description
  1  @foldersandExtensions  Mixture of folder names and extensions

Example:


    my $D = temporaryFolder;

    my $d = fpd($D, q(ddd));

    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);

    is_deeply [sort map {fne $_} searchDirectoryTreesForMatchingFiles($d)],

              ["a.txt", "b.txt", "c.txt"];


=head3 matchPath($)

Given an absolute path find out how much of the path actually exists.

     Parameter  Description
  1  $file      File name

Example:


    my $d = filePath   (my @d = qw(a b c d));

    ok matchPath($d) eq $d;


=head3 findFileWithExtension($@)

Find the first extension from the specified extensions that produces a file that exists when appended to the specified file.

     Parameter  Description
  1  $file      File name minus extensions
  2  @ext       Possible extensions

Example:


    my $f = createEmptyFile(fpe(my $d = temporaryFolder, qw(a jpg)));

    my $F = findFileWithExtension(fpf($d, q(a)), qw(txt data jpg));

    ok $F eq "jpg";


=head3 clearFolder($$)

Remove all the files and folders under and including the specified folder as long as the number of files to be removed is less than the specified limit.

     Parameter    Description
  1  $folder      Folder
  2  $limitCount  Maximum number of files to remove to limit damage

Example:


    my $D = temporaryFolder;

    my $d = fpd($D, q(ddd));

    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);

    clearFolder($D, 5);

    ok !-e $_ for @f;

    ok !-d $D;


=head2 Read and write files

Read and write strings from and to files creating paths as needed.

=head3 readFile($)

Read a file containing unicode in utf8.

     Parameter  Description
  1  $file      Name of file to read

Example:


    my $f = writeFile(undef, "aaa");

    my $s = readFile($f);

    ok $s eq "aaa";

    appendFile($f, "bbb");

    my $S = readFile($f);

    ok $S eq "aaabbb";


=head3 evalFile($)

Read a file containing unicode in utf8, evaluate it, confess to any errors and then return any result - an improvement on B<do> which silently ignores any problems.

     Parameter  Description
  1  $file      File to read

Example:


    my $f = dumpFile(undef, [qw(aaa bbb ccc)]);

    my $s = evalFile($f);

    is_deeply $s, [qw(aaa bbb ccc)];


=head3 evalGZipFile($)

Read a file containing compressed utf8, evaluate it, confess to any errors or return any result.

     Parameter  Description
  1  $file      File to read

Example:


  if (1) {
    my $d = [1, 2, 3=>{a=>4, b=>5}];
    my $file = dumpGZipFile(q(zzz.zip), $d);
    ok -e $file;
    my $D = evalGZipFile($file);
    is_deeply $d, $D;
    unlink $file;
   }


=head3 readBinaryFile($)

Read binary file - a file whose contents are not to be interpreted as unicode.

     Parameter  Description
  1  $file      File to read

Example:


    my $f = writeBinaryFile(undef, 0xff x 8);

    my $s = readBinaryFile($f);

    ok $s eq 0xff x 8;


=head3 readGZipFile($)

Read the specified B<$file>, containing compressed utf8, through gzip

     Parameter  Description
  1  $file      File to read.

Example:


  if (1) {
    my $s = '𝝰'x1e3;
    my $file = writeGZipFile(q(zzz.zip), $s);
    ok -e $file;
    my $S = readGZipFile($file);
    ok $s eq $S;
    ok length($s) == length($S);
    unlink $file;
   }


=head3 makePath($)

Make the path for the specified file name or folder.

     Parameter  Description
  1  $file      File

Example:


    my $d = fpd(my $D = temporaryDirectory, qw(a));

    my $f = fpe($d, qw(bbb txt));

    ok !-d $d;

    makePath($f);

    ok -d $d;


=head3 overWriteFile($$)

Write a unicode utf8 string to a file after creating a path to the file if necessary and return the name of the file on success else confess. If the file already exists it is overwritten.

     Parameter  Description
  1  $file      File to write to or B<undef> for a temporary file
  2  $string    Unicode string to write

Example:


    my $f = dumpFile(undef, [qw(aaa bbb ccc)]);

    ok overWriteFile($f, q({qw(aaa bbb ccc)]));


B<owf> is a synonym for L<overWriteFile|/overWriteFile>.


=head3 writeFile($$)

Write a unicode utf8 string to a new file that does not already exist after creating a path to the file if necessary and return the name of the file on success else confess if a problem occurred or the file does already exist.

     Parameter  Description
  1  $file      New file to write to or B<undef> for a temporary file
  2  $string    String to write

Example:


    my $f = writeFile(undef, "aaa");

    my $s = readFile($f);

    ok $s eq "aaa";

    appendFile($f, "bbb");

    my $S = readFile($f);

    ok $S eq "aaabbb";


=head3 dumpFile($$)

Dump a data structure to a file

     Parameter  Description
  1  $file      File to write to or B<undef> for a temporary file
  2  $struct    Address of data structure to write

Example:


    my $f = dumpFile(undef, [qw(aaa bbb ccc)]);

    my $s = evalFile($f);

    is_deeply $s, [qw(aaa bbb ccc)];


=head3 writeGZipFile($$)

Write a unicode utf8 string through gzip to a file.

     Parameter  Description
  1  $file      File to write to
  2  $string    String to write

Example:


  if (1) {
    my $s = '𝝰'x1e3;
    my $file = writeGZipFile(q(zzz.zip), $s);
    ok -e $file;
    my $S = readGZipFile($file);
    ok $s eq $S;
    ok length($s) == length($S);
    unlink $file;
   }


=head3 dumpGZipFile($$)

Write a data structure through B<gzip> to a file.

     Parameter  Description
  1  $file      File to write
  2  $data      Reference to data

Example:


  if (1) {
    my $d = [1, 2, 3=>{a=>4, b=>5}];
    my $file = dumpGZipFile(q(zzz.zip), $d);
    ok -e $file;
    my $D = evalGZipFile($file);
    is_deeply $d, $D;
    unlink $file;
   }


=head3 writeFiles($$)

Write the values of a hash into files identified by the key of each value using L<overWriteFile|/overWriteFile>

     Parameter  Description
  1  $hash      Hash of key value pairs representing files and data
  2  $folder    Optional folder to contain files else the current folder

Example:


    my $h =

     {"aaa/1.txt"=>"1111",

      "aaa/2.txt"=>"2222",

     };

    writeFiles($h);

    for(sort keys %$h)

     {ok -e $_;

      ok readFile($_) eq $h->{$_};

     }


=head3 appendFile($$)

Append a unicode utf8 string to a file, possibly creating the file and the path to the file if necessary and return the name of the file on success else confess.

     Parameter  Description
  1  $file      File to append to
  2  $string    String to append

Example:


    my $f = writeFile(undef, "aaa");

    my $s = readFile($f);

    ok $s eq "aaa";

    appendFile($f, "bbb");

    my $S = readFile($f);

    ok $S eq "aaabbb";


=head3 writeBinaryFile($$)

Write a non unicode string to a file in after creating a path to the file if necessary and return the name of the file on success else confess.

     Parameter  Description
  1  $file      File to write to or B<undef> for a temporary file
  2  $string    Non unicode string to write

Example:


    my $f = writeBinaryFile(undef, 0xff x 8);

    my $s = readBinaryFile($f);

    ok $s eq 0xff x 8;


=head3 createEmptyFile($)

Create an empty file - L<writeFile|/writeFile> complains if no data is written to the file -  and return the name of the file on success else confess.

     Parameter  Description
  1  $file      File to create or B<undef> for a temporary file

Example:


    my $D = temporaryFolder;

    my $d = fpd($D, q(ddd));

    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);

    is_deeply [sort map {fne $_} findFiles($d, qr(txt\Z))], [qw(a.txt b.txt c.txt)];


=head3 numberOfLinesInFile($)

The number of lines in a file

     Parameter  Description
  1  $file      File

Example:


    my $f = writeFile(undef, "a
b
");

    ok numberOfLinesInFile($f) == 2;


=head1 Images

Image operations.

=head2 imageSize($)

Return (width, height) of an image obtained via L<Imagemagick|/https://www.imagemagick.org/script/index.php>.

     Parameter  Description
  1  $image     File containing image

Example:


    my ($width, $height) = imageSize(fpe(qw(a image jpg)));


=head2 convertImageToJpx($$$)

Convert an image to jpx format using L<Imagemagick|/https://www.imagemagick.org/script/index.php>.

     Parameter  Description
  1  $source    Source file
  2  $target    Target folder (as multiple files will be created)
  3  $Size      Optional size of each tile - defaults to 256

Example:


    convertImageToJpx(fpe(qw(a image jpg)), fpe(qw(a image jpg)), 256);


=head2 convertDocxToFodt($$)

Convert a B<docx> file to B<fodt> using B<unoconv> which must not be running elsewhere at the time.  L<Unoconv|/https://github.com/dagwieers/unoconv> can be installed via:

  sudo apt install sharutils unoconv

Parameters:

     Parameter    Description
  1  $inputFile   Input file
  2  $outputFile  Output file

Example:


    convertDocxToFodt(fpe(qw(a docx)), fpe(qw(a fodt)));


=head2 cutOutImagesInFodtFile($$$)

Cut out the images embedded in a B<fodt> file, perhaps produced via L<convertDocxToFodt|/convertDocxToFodt>, placing them in the specified folder and replacing them in the source file with:

  <image href="$imageFile" outputclass="imageType">

This conversion requires that you have both L<Imagemagick|/https://www.imagemagick.org/script/index.php> and L<unoconv|/https://github.com/dagwieers/unoconv> installed on your system:

    sudo apt install sharutils  imagemagick unoconv

Parameters:

     Parameter      Description
  1  $inputFile     Input file
  2  $outputFolder  Output folder for images
  3  $imagePrefix   A prefix to be added to image file names

Example:


    cutOutImagesInFodtFile(fpe(qw(source fodt)), fpd(qw(images)), q(image));


=head1 Encoding and Decoding

Encode and decode using Json and Mime.

=head2 encodeJson($)

Encode Perl to Json.

     Parameter  Description
  1  $string    Data to encode

Example:


    my $A = encodeJson(my $a = {a=>1,b=>2, c=>[1..2]});

    my $b = decodeJson($A);

    is_deeply $a, $b;


=head2 decodeJson($)

Decode Perl from Json.

     Parameter  Description
  1  $string    Data to decode

Example:


    my $A = encodeJson(my $a = {a=>1,b=>2, c=>[1..2]});

    my $b = decodeJson($A);

    is_deeply $a, $b;


=head2 encodeBase64($)

Encode a string in base 64.

     Parameter  Description
  1  $string    String to encode

Example:


    my $A = encodeBase64(my $a = "Hello World" x 10);

    my $b = decodeBase64($A);

    ok $a eq $b;


=head2 decodeBase64($)

Decode a string in base 64.

     Parameter  Description
  1  $string    String to decode

Example:


    my $A = encodeBase64(my $a = "Hello World" x 10);

    my $b = decodeBase64($A);

    ok $a eq $b;


=head2 convertUnicodeToXml($)

Convert a string with unicode points that are not directly representable in ascii into string that replaces these points with their representation on Xml making the string usable in Xml documents.

     Parameter  Description
  1  $s         String to convert

Example:


  ok convertUnicodeToXml('setenta e três') eq q(setenta e tr&#234;s);


=head1 Numbers

Numeric operations,

=head2 powerOfTwo($)

Test whether a number is a power of two, return the power if it is else B<undef>.

     Parameter  Description
  1  $n         Number to check

Example:


  ok  powerOfTwo(1) == 0;

  ok  powerOfTwo(2) == 1;

  ok !powerOfTwo(3);

  ok  powerOfTwo(4) == 2;


=head2 containingPowerOfTwo($)

Find log two of the lowest power of two greater than or equal to a number.

     Parameter  Description
  1  $n         Number to check

Example:


  ok  containingPowerOfTwo(1) == 0;

  ok  containingPowerOfTwo(2) == 1;

  ok  containingPowerOfTwo(3) == 2;

  ok  containingPowerOfTwo(4) == 2;


=head1 Sets

Set operations.

=head2 setIntersectionOfTwoArraysOfWords($$)

Intersection of two arrays of words.

     Parameter  Description
  1  $a         Reference to first array of words
  2  $b         Reference to second array of words

Example:


  is_deeply [qw(a b c)],

    [setIntersectionOfTwoArraysOfWords([qw(e f g a b c )], [qw(a A b B c C)])];


=head2 setUnionOfTwoArraysOfWords($$)

Union of two arrays of words.

     Parameter  Description
  1  $a         Reference to first array of words
  2  $b         Reference to second array of words

Example:


  is_deeply [qw(a b c)],

    [setUnionOfTwoArraysOfWords([qw(a b c )], [qw(a b)])];


=head2 contains($@)

Returns the indices at which an item matches elements of the specified array. If the item is a regular expression then it is matched as one, else it is a number it is matched as a number, else as a string.

     Parameter  Description
  1  $item      Item
  2  @array     Array

Example:


  is_deeply [1],       [contains(1,0..1)];

  is_deeply [1,3],     [contains(1, qw(0 1 0 1 0 0))];

  is_deeply [0, 5],    [contains('a', qw(a b c d e a b c d e))];

  is_deeply [0, 1, 5], [contains(qr(a+), qw(a baa c d e aa b c d e))];


=head1 Minima and Maxima

Find the smallest and largest elements of arrays.

=head2 min(@)

Find the minimum number in a list.

     Parameter  Description
  1  @n         Numbers

Example:


  ok min(1) == 1;

  ok min(5,4,2,3) == 2;


=head2 max(@)

Find the maximum number in a list.

     Parameter  Description
  1  @n         Numbers

Example:


  ok !max;

  ok max(1) == 1;

  ok max(1,4,2,3) == 4;


=head1 Format

Format data structures as tables.

=head2 maximumLineLength($)

Find the longest line in a string

     Parameter  Description
  1  $string    String of lines of text

Example:


  ok 3 == maximumLineLength(<<END);
  a
  bb
  ccc
  END


=head2 formatTableBasic($)

Tabularize an array of arrays of text.

     Parameter  Description
  1  $data      Reference to an array of arrays of data to be formatted as a table.

Example:


    my $d = [[qw(a 1)], [qw(bb 22)], [qw(ccc 333)], [qw(dddd 4444)]];

    ok formatTableBasic($d) eq <<END;
  a        1
  bb      22
  ccc    333
  dddd  4444
  END


=head2 formatTable($$%)

Format various data structures as a table. Optionally create a report from the table using the following optional report options:

B<file=E<gt>$file> the name of a file to write the report to.

B<head=E<gt>$head> a header line in which DDDD will be replaced with the data and time and NNNN will be replaced with the number of rows in the table.

B<zero=E<gt>$zero> if true the report will be written to the specified file even if empty.

Parameters:

     Parameter  Description
  1  $data      Data to be formatted
  2  $title     Optional reference to an array of titles
  3  %options   Options

Example:


  ok formatTable

   ([[qw(A    B    C    D   )],

     [qw(AA   BB   CC   DD  )],

     [qw(AAA  BBB  CCC  DDD )],

     [qw(AAAA BBBB CCCC DDDD)],

     [qw(1    22   333  4444)]], [qw(aa bb cc)]) eq <<END;
     aa    bb    cc
  1  A     B     C     D
  2  AA    BB    CC    DD
  3  AAA   BBB   CCC   DDD
  4  AAAA  BBBB  CCCC  DDDD
  5     1    22   333  4444
  END

  ok formatTable

   ([[qw(1     B   C)],

     [qw(22    BB  CC)],

     [qw(333   BBB CCC)],

     [qw(4444  22  333)]], [qw(aa bb cc)]) eq <<END;
     aa    bb   cc
  1     1  B    C
  2    22  BB   CC
  3   333  BBB  CCC
  4  4444   22  333
  END

  ok formatTable

   ([{aa=>'A',   bb=>'B',   cc=>'C'},

     {aa=>'AA',  bb=>'BB',  cc=>'CC'},

     {aa=>'AAA', bb=>'BBB', cc=>'CCC'},

     {aa=>'1',   bb=>'22',  cc=>'333'}

     ]) eq <<END;
     aa   bb   cc
  1  A    B    C
  2  AA   BB   CC
  3  AAA  BBB  CCC
  4    1   22  333
  END

  ok formatTable

   ({''=>[qw(aa bb cc)],

      1=>[qw(A B C)],

      22=>[qw(AA BB CC)],

      333=>[qw(AAA BBB CCC)],

      4444=>[qw(1 22 333)]}) eq <<END;
        aa   bb   cc
     1  A    B    C
    22  AA   BB   CC
   333  AAA  BBB  CCC
  4444    1   22  333
  END

  ok formatTable

   ({1=>{aa=>'A', bb=>'B', cc=>'C'},

     22=>{aa=>'AA', bb=>'BB', cc=>'CC'},

     333=>{aa=>'AAA', bb=>'BBB', cc=>'CCC'},

     4444=>{aa=>'1', bb=>'22', cc=>'333'}}) eq <<END;
        aa   bb   cc
     1  A    B    C
    22  AA   BB   CC
   333  AAA  BBB  CCC
  4444    1   22  333
  END

  ok formatTable({aa=>'A', bb=>'B', cc=>'C'}, [qw(aaaa bbbb)]) eq <<END;
  aaaa  bbbb
  aa    A
  bb    B
  cc    C
  END

  if (1) {
    my $file = fpe(qw(report txt));                                               # Create a report
    my $t = formatTable
     ([["a",undef], [undef, "b0ac"]],                                           # Data - please replace 0a with a new line
      [undef, "BC"],                                                              # Column titles
      file=>$file,                                                                # Output file
      head=><<END);                                                               # Header
  Sample report.

  Table has NNNN rows.
  END
    ok -e $file;
    ok readFile($file) eq $t;
    unlink $file;
    ok $t eq <<END;
  Sample report.

  Table has 2 rows.


  This file: report.txt

        BC
  1  a
  2     b
        c
  END
   }


=head2 keyCount($$)

Count keys down to the specified level.

     Parameter  Description
  1  $maxDepth  Maximum depth to count to
  2  $ref       Reference to an array or a hash

Example:


    my $a = [[1..3],       {map{$_=>1} 1..3}];

    my $h = {a=>[1..3], b=>{map{$_=>1} 1..3}};

    ok keyCount(2, $a) == 6;

    ok keyCount(2, $h) == 6;


=head1 Lines

Load data structures from lines.

=head2 loadArrayFromLines($)

Load an array from lines of text in a string.

     Parameter  Description
  1  $string    The string of lines from which to create an array

Example:


    my $s = loadArrayFromLines <<END;
  a a
  b b
  END

    is_deeply $s, [q(a a), q(b b)];

    ok formatTable($s) eq <<END;
  0  a a
  1  b b
  END


=head2 loadHashFromLines($)

Load a hash: first word of each line is the key and the rest is the value.

     Parameter  Description
  1  $string    The string of lines from which to create a hash

Example:


    my $s = loadHashFromLines <<END;
  a 10 11 12
  b 20 21 22
  END

    is_deeply $s, {a => q(10 11 12), b =>q(20 21 22)};

    ok formatTable($s) eq <<END;
  a  10 11 12
  b  20 21 22
  END


=head2 loadArrayArrayFromLines($)

Load an array of arrays from lines of text: each line is an array of words.

     Parameter  Description
  1  $string    The string of lines from which to create an array of arrays

Example:


    my $s = loadArrayArrayFromLines <<END;
  A B C
  AA BB CC
  END

    is_deeply $s, [[qw(A B C)], [qw(AA BB CC)]];

    ok formatTable($s) eq <<END;
  1  A   B   C
  2  AA  BB  CC
  END


=head2 loadHashArrayFromLines($)

Load a hash of arrays from lines of text: the first word of each line is the key, the remaining words are the array contents.

     Parameter  Description
  1  $string    The string of lines from which to create a hash of arrays

Example:


    my $s = loadHashArrayFromLines <<END;
  a A B C
  b AA BB CC
  END

    is_deeply $s, {a =>[qw(A B C)], b => [qw(AA BB CC)] };

    ok formatTable($s) eq <<END;
  a  A   B   C
  b  AA  BB  CC
  END


=head2 loadArrayHashFromLines($)

Load an array of hashes from lines of text: each line is an hash of words.

     Parameter  Description
  1  $string    The string of lines from which to create an array of arrays

Example:


    my $s = loadArrayHashFromLines <<END;
  A 1 B 2
  AA 11 BB 22
  END

    is_deeply $s, [{A=>1, B=>2}, {AA=>11, BB=>22}];

    ok formatTable($s) eq <<END;
     A  AA  B  BB
  1  1      2
  2     11     22
  END


=head2 loadHashHashFromLines($)

Load a hash of hashes from lines of text: the first word of each line is the key, the remaining words are the sub hash contents.

     Parameter  Description
  1  $string    The string of lines from which to create a hash of arrays

Example:


    my $s = loadHashHashFromLines <<END;
  a A 1 B 2
  b AA 11 BB 22
  END

    is_deeply $s, {a=>{A=>1, B=>2}, b=>{AA=>11, BB=>22}};

    ok formatTable($s) eq <<END;
     A  AA  B  BB
  a  1      2
  b     11     22
  END


=head2 checkKeys($$)

Check the keys in a hash.

     Parameter   Description
  1  $test       The hash to test
  2  $permitted  A hash of the permitted keys and their meanings

Example:


    eval q{checkKeys({a=>1, b=>2, d=>3}, {a=>1, b=>2, c=>3})};

    ok nws($@) =~ m(\AInvalid options chosen: d Permitted.+?: a 1 b 2 c 3);


=head1 LVALUE methods

Replace $a->{B<value>} = $b with $a->B<value> = $b which reduces the amount of typing required, is easier to read and provides a hard check that {B<value>} is spelled correctly.

=head2 genLValueScalarMethods(@)

Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> scalar methods in the current package, A method whose value has not yet been set will return a new scalar with value B<undef>. Suffixing B<X> to the scalar name will confess if a value has not been set.

     Parameter  Description
  1  @names     List of method names

Example:


    package Scalars;

    my $a = bless{};

    Data::Table::Text::genLValueScalarMethods(qw(aa bb cc));

    $a->aa = 'aa';

    Test::More::ok  $a->aa eq 'aa';

    Test::More::ok !$a->bb;

    Test::More::ok  $a->bbX eq q();

    $a->aa = undef;

    Test::More::ok !$a->aa;


=head2 addLValueScalarMethods(@)

Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> scalar methods in the current package if they do not already exist. A method whose value has not yet been set will return a new scalar with value B<undef>. Suffixing B<X> to the scalar name will confess if a value has not been set.

     Parameter  Description
  1  @names     List of method names

Example:


    my $class = "Data::Table::Text::Test";

    my $a = bless{}, $class;

    addLValueScalarMethods(qq(${class}::$_)) for qw(aa bb aa bb);

    $a->aa = 'aa';

    ok  $a->aa eq 'aa';

    ok !$a->bb;

    ok  $a->bbX eq q();

    $a->aa = undef;

    ok !$a->aa;


=head2 genLValueScalarMethodsWithDefaultValues(@)

Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> scalar methods with default values in the current package. A reference to a method whose value has not yet been set will return a scalar whose value is the name of the method.

     Parameter  Description
  1  @names     List of method names

Example:


    package ScalarsWithDefaults;

    my $a = bless{};

    Data::Table::Text::genLValueScalarMethodsWithDefaultValues(qw(aa bb cc));

    Test::More::ok $a->aa eq 'aa';


=head2 genLValueArrayMethods(@)

Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> array methods in the current package. A reference to a method that has no yet been set will return a reference to an empty array.

     Parameter  Description
  1  @names     List of method names

Example:


    package Arrays;

    my $a = bless{};

    Data::Table::Text::genLValueArrayMethods(qw(aa bb cc));

    $a->aa->[1] = 'aa';

    Test::More::ok $a->aa->[1] eq 'aa';


=head2 genLValueHashMethods(@)

Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> hash methods in the current package. A reference to a method that has no yet been set will return a reference to an empty hash.

     Parameter  Description
  1  @names     Method names

Example:


    package Hashes;

    my $a = bless{};

    Data::Table::Text::genLValueHashMethods(qw(aa bb cc));

    $a->aa->{a} = 'aa';

    Test::More::ok $a->aa->{a} eq 'aa';


=head2 genHash($%)

Return a B<$bless>ed hash with the specified B<$attributes>. L<updateDocumentation|/updateDocumentation> will generate documentation at L<Hash Definitions> for the hash defined by the call to L<genHash|/genHash> if the call is laid out as in the example below.

     Parameter    Description
  1  $bless       Package name
  2  %attributes  Hash of attribute names and values

Example:


  if (1) {
    my $o = genHash(q(TestHash),                                                  # Definition of a blessed hash.
        a=>q(aa),                                                                 # Definition of attribute aa.
        b=>q(bb),                                                                 # Definition of attribute bb.
       );
    ok $o->a eq q(aa);
    is_deeply $o, {a=>"aa", b=>"bb"};
    my $p = genHash(q(TestHash),
      c=>q(cc),                                                                   # Definition of attribute cc.
     );
    ok $p->c eq q(cc);
    ok $p->a =  q(aa);
    ok $p->a eq q(aa);
    is_deeply $p, {a=>"aa", c=>"cc"};

    loadHash($p, a=>11, b=>22);                                                   # Load the hash
    is_deeply $p, {a=>11, b=>22, c=>"cc"};

    my $r = eval {loadHash($p, d=>44)};                                           # Try to load the hash
    ok $@ =~ m(Cannot load attribute: d);
   }


=head2 loadHash($%)

Load the specified B<$hash> generated with L<genHash|/genHash> with B<%attributes>. Confess to any unknown attribute names.

     Parameter    Description
  1  $hash        Hash
  2  %attributes  Hash of attribute names and values to be loaded

Example:


  if (1) {
    my $o = genHash(q(TestHash),                                                  # Definition of a blessed hash.
        a=>q(aa),                                                                 # Definition of attribute aa.
        b=>q(bb),                                                                 # Definition of attribute bb.
       );
    ok $o->a eq q(aa);
    is_deeply $o, {a=>"aa", b=>"bb"};
    my $p = genHash(q(TestHash),
      c=>q(cc),                                                                   # Definition of attribute cc.
     );
    ok $p->c eq q(cc);
    ok $p->a =  q(aa);
    ok $p->a eq q(aa);
    is_deeply $p, {a=>"aa", c=>"cc"};

    loadHash($p, a=>11, b=>22);                                                   # Load the hash
    is_deeply $p, {a=>11, b=>22, c=>"cc"};

    my $r = eval {loadHash($p, d=>44)};                                           # Try to load the hash
    ok $@ =~ m(Cannot load attribute: d);
   }


=head2 assertPackageRefs($@)

Confirm that the specified references are to the specified package

     Parameter  Description
  1  $package   Package
  2  @refs      References

Example:


  if (1) {
    eval q{assertPackageRefs(q(bbb), bless {}, q(aaa))};
    ok $@ =~ m(\AWanted reference to bbb, but got aaa);
   }


=head2 assertRef(@)

Confirm that the specified references are to the package into which this routine has been exported.

     Parameter  Description
  1  @refs      References

Example:


  if (1) {
    eval q{assertRef(bless {}, q(aaa))};
    ok $@ =~ m(\AWanted reference to Data::Table::Text, but got aaa);
   }


=head2 ˢ(&)

Immediately executed inline sub to allow a code block before B<if>.

     Parameter  Description
  1  $sub       Sub enclosed in {} without the word "sub"

Example:


  ok ˢ{1} == 1;

  ok ˢ{1};

  ˢ{my $s =
    ˢ{if (1)
       {return q(aa) if 1;
        q(bb);
       }
     };

    ok $s eq q(aa);
   };


=head1 Strings

Actions on strings.

=head2 indentString($$)

Indent lines contained in a string or formatted table by the specified string.

     Parameter  Description
  1  $string    The string of lines to indent
  2  $indent    The indenting string

Example:


    my $t = [qw(aa bb cc)];

    my $d = [[qw(A B C)], [qw(AA BB CC)], [qw(AAA BBB CCC)],  [qw(1 22 333)]];

    ok $s eq <<END;
    1  A    B    C
    2  AA   BB   CC
    3  AAA  BBB  CCC
    4    1   22  333
  END


=head2 isBlank($)

Test whether a string is blank.

     Parameter  Description
  1  $string    String

Example:


  ok isBlank("");

  ok isBlank("
 ");


=head2 trim($)

Remove any white space from the front and end of a string.

     Parameter  Description
  1  $string    String

Example:


  ok trim(" a b ") eq join ' ', qw(a b);


=head2 pad($$$)

Pad a string with blanks or the specified padding character  to a multiple of a specified length.

     Parameter  Description
  1  $string    String
  2  $length    Tab width
  3  $pad       Padding char

Example:


  ok  pad('abc  ', 2).'='       eq "abc =";

  ok  pad('abc  ', 3).'='       eq "abc=";

  ok  pad('abc  ', 4, q(.)).'=' eq "abc.=";


=head2 firstNChars($$)

First N characters of a string.

     Parameter  Description
  1  $string    String
  2  $length    Length

Example:


  ok firstNChars(q(abc), 2) eq q(ab);

  ok firstNChars(q(abc), 4) eq q(abc);


=head2 nws($$)

Normalize white space in a string to make comparisons easier. Leading and trailing white space is removed; blocks of white space in the interior are reduced to a single space.  In effect: this puts everything on one long line with never more than one space at a time. Optionally a maximum length is applied to the normalized string.

     Parameter  Description
  1  $string    String to normalize
  2  $length    Maximum length of result

Example:


  ok nws(qq(a  b    c)) eq q(a b c);


=head2 stringsAreNotEqual($$)

Return the two non equal tails of non equal strings or an empty list if the strings are equal.

     Parameter  Description
  1  $a         First string
  2  $b         Second string

Example:


  if (1) {
    ok        !stringsAreNotEqual(q(abc), q(abc));
    ok         stringsAreNotEqual(q(abc), q(abd));
    is_deeply [stringsAreNotEqual(q(abc), q(abd))], [qw(c d)];
    is_deeply [stringsAreNotEqual(q(ab),  q(abd))], ['', q(d)];
   }


=head2 javaPackage($)

Extract the package name from a java string or file.

     Parameter  Description
  1  $java      Java file if it exists else the string of java

Example:


    overWriteFile($f, <<END);
  // Test
  package com.xyz;
  END

    ok javaPackage($f)           eq "com.xyz";


=head2 javaPackageAsFileName($)

Extract the package name from a java string or file and convert it to a file name.

     Parameter  Description
  1  $java      Java file if it exists else the string of java

Example:


    overWriteFile($f, <<END);
  // Test
  package com.xyz;
  END

    ok javaPackageAsFileName($f) eq "com/xyz";


=head2 perlPackage($)

Extract the package name from a perl string or file.

     Parameter  Description
  1  $perl      Perl file if it exists else the string of perl

Example:


    overWriteFile($f, <<END);
  package a::b;
  END

    ok perlPackage($f)           eq "a::b";


=head2 printQw(@)

Print an array of words in qw() format.

     Parameter  Description
  1  @words     Array of words

Example:


  ok printQw(qw(a b c)) eq q(qw(a b c));


=head2 numberOfLinesInString($)

The number of lines in a string.

     Parameter  Description
  1  $string    String

Example:


    ok numberOfLinesInString("a
b
") == 2;


=head1 Unicode

Translate ascii alphanumerics in strings to various Unicode blocks.

=head2 boldString($)

Convert alphanumerics in a string to bold.

     Parameter  Description
  1  $string    String to convert

Example:


  ok boldString(q(zZ)) eq q(𝘇𝗭);


=head2 boldStringUndo($)

Undo alphanumerics in a string to bold.

     Parameter  Description
  1  $string    String to convert

Example:


  if (1)
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok enclosedStringUndo        (enclosedString($n))         == $n;
    ok enclosedReversedStringUndo(enclosedReversedString($n)) == $n;
    ok superScriptStringUndo     (superScriptString($n))      == $n;
    ok subScriptStringUndo       (subScriptString($n))        == $n;
   }


=head2 enclosedString($)

Convert alphanumerics in a string to enclosed alphanumerics.

     Parameter  Description
  1  $string    String to convert

Example:


  ok enclosedString(q(hello world 1234)) eq q(ⓗⓔⓛⓛⓞ ⓦⓞⓡⓛⓓ ①②③④);


=head2 enclosedStringUndo($)

Undo alphanumerics in a string to enclosed alphanumerics.

     Parameter  Description
  1  $string    String to convert

Example:


  if (1)
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok enclosedStringUndo        (enclosedString($n))         == $n;
    ok enclosedReversedStringUndo(enclosedReversedString($n)) == $n;
    ok superScriptStringUndo     (superScriptString($n))      == $n;
    ok subScriptStringUndo       (subScriptString($n))        == $n;
   }


=head2 enclosedReversedString($)

Convert alphanumerics in a string to enclosed reversed alphanumerics.

     Parameter  Description
  1  $string    String to convert

Example:


  ok enclosedReversedString(q(hello world 1234)) eq q(🅗🅔🅛🅛🅞 🅦🅞🅡🅛🅓 ➊➋➌➍);


=head2 enclosedReversedStringUndo($)

Undo alphanumerics in a string to enclosed reversed alphanumerics.

     Parameter  Description
  1  $string    String to convert

Example:


  if (1)
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok enclosedStringUndo        (enclosedString($n))         == $n;
    ok enclosedReversedStringUndo(enclosedReversedString($n)) == $n;
    ok superScriptStringUndo     (superScriptString($n))      == $n;
    ok subScriptStringUndo       (subScriptString($n))        == $n;
   }


=head2 superScriptString($)

Convert alphanumerics in a string to super scripts

     Parameter  Description
  1  $string    String to convert

Example:


  ok superScriptString(1234567890) eq q(¹²³⁴⁵⁶⁷⁸⁹⁰);


=head2 superScriptStringUndo($)

Undo alphanumerics in a string to super scripts

     Parameter  Description
  1  $string    String to convert

Example:


  if (1)
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok enclosedStringUndo        (enclosedString($n))         == $n;
    ok enclosedReversedStringUndo(enclosedReversedString($n)) == $n;
    ok superScriptStringUndo     (superScriptString($n))      == $n;
    ok subScriptStringUndo       (subScriptString($n))        == $n;
   }


=head2 subScriptString($)

Convert alphanumerics in a string to sub scripts

     Parameter  Description
  1  $string    String to convert

Example:


  ok subScriptString(1234567890)   eq q(₁₂₃₄₅₆₇₈₉₀);


=head2 subScriptStringUndo($)

Undo alphanumerics in a string to sub scripts

     Parameter  Description
  1  $string    String to convert

Example:


  if (1)
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok enclosedStringUndo        (enclosedString($n))         == $n;
    ok enclosedReversedStringUndo(enclosedReversedString($n)) == $n;
    ok superScriptStringUndo     (superScriptString($n))      == $n;
    ok subScriptStringUndo       (subScriptString($n))        == $n;
   }


=head1 Cloud Cover

Useful for operating across the cloud.

=head2 makeDieConfess()

Force die to confess where the death occurred


Example:


    makeDieConfess


=head2 ipAddressViaArp($)

Get the ip address of a server on the local network by hostname via arp

     Parameter  Description
  1  $hostName  Host name

Example:


    ipAddressViaArp(q(secarias));


=head2 saveCodeToS3($$$$)

Save source code files.

     Parameter       Description
  1  $saveCodeEvery  Save every seconds
  2  $zipFileName    Zip file name
  3  $bucket         Bucket/key
  4  $S3Parms        Additional S3 parameters like profile or region as a string

Example:


    saveCodeToS3(1200, q(projectName), q(bucket/folder), q(--only-show-errors));


=head2 addCertificate($)

Add a certificate to the current ssh session.

     Parameter  Description
  1  $file      File containing certificate

Example:


    addCertificate(fpf(qw(.ssh cert)));


=head2 hostName()

The name of the host we are running on.


Example:


    hostName;


=head2 userId()

The userid we are currently running under.


Example:


    userId;


=head2 wwwEncode($)

Replace spaces in a string with %20 .

     Parameter  Description
  1  $string    String

Example:


  ok wwwEncode(q(a  b c)) eq q(a%20%20b%20c);


=head2 startProcess(&\%$)

Start new processes while the number of child processes recorded in B<%$pids> is less than the specified B<$maximum>.  Use L<waitForAllStartedProcessesToFinish|/waitForAllStartedProcessesToFinish> to wait for all these processes to finish.

     Parameter  Description
  1  $sub       Sub to start
  2  $pids      Hash in which to record the process ids
  3  $maximum   Maximum number of processes to run at a time

Example:


  if (0) {
    my %pids;
    ˢ{startProcess {} %pids, 1; ok 1 >= keys %pids} for 1..8;
    waitForAllStartedProcessesToFinish(%pids);
    ok !keys(%pids)
   }


=head2 waitForAllStartedProcessesToFinish(\%)

Wait until all the processes started by L<startProcess|/startProcess> have finished.

     Parameter  Description
  1  $pids      Hash of started process ids

Example:


  if (0) {
    my %pids;
    ˢ{startProcess {} %pids, 1; ok 1 >= keys %pids} for 1..8;
    waitForAllStartedProcessesToFinish(%pids);
    ok !keys(%pids)
   }


=head2 newServiceIncarnation($$)

Create a new service incarnation to record the start up of a new instance of a service and return the description as a L<Data::Exchange::Service Definition hash|/Data::Exchange::Service Definition>.

     Parameter  Description
  1  $service   Service name
  2  $file      Optional details file

Example:


  if (1)
   {my $s = newServiceIncarnation("aaa", q(bbb.txt));
    is_deeply $s->check, $s;
    my $t = newServiceIncarnation("aaa", q(bbb.txt));
    is_deeply $t->check, $t;
    ok $t->start >= $s->start+1;
    ok !$s->check(1);
    unlink q(bbb.txt);
   }


=head2 Data::Exchange::Service::check($$)

Check that we are the current incarnation of the named service with details obtained from L<newServiceIncarnation|/newServiceIncarnation>. If the optional B<$continue> flag has been set then return the service details if this is the current service incarnation else B<undef>. Otherwise if the B<$continue> flag is false confess unless this is the current service incarnation thus bringing the earlier version of this service to an abrupt end.

     Parameter  Description
  1  $s         Current service details
  2  $continue  Return result if B<$continue> is true else confess if the service has been replaced

Example:


  if (1)
   {my $s = newServiceIncarnation("aaa", q(bbb.txt));
    is_deeply $s->check, $s;
    my $t = newServiceIncarnation("aaa", q(bbb.txt));
    is_deeply $t->check, $t;
    ok $t->start >= $s->start+1;
    ok !$s->check(1);
    unlink q(bbb.txt);
   }


=head1 Documentation

Extract, format and update documentation for a perl module.

=head2 htmlToc($@)

Generate a table of contents for some html.

     Parameter  Description
  1  $replace   Sub-string within the html to be replaced with the toc
  2  $html      String of html

Example:


  ok nws(htmlToc("XXXX", <<END)), 'htmlToc'
  <h1 id="1" otherprops="1">Chapter 1</h1>
    <h2 id="11" otherprops="11">Section 1</h1>
  <h1 id="2" otherprops="2">Chapter 2</h1>
  XXXX
  END

    eq nws(<<END);
  <h1 id="1" otherprops="1">Chapter 1</h1>
    <h2 id="11" otherprops="11">Section 1</h1>
  <h1 id="2" otherprops="2">Chapter 2</h1>
  <table cellspacing=10 border=0>
  <tr><td>&nbsp;
  <tr><td align=right>1<td>&nbsp;&nbsp;&nbsp;&nbsp;<a href="#1">Chapter 1</a>
  <tr><td align=right>2<td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href="#11">Section 1</a>
  <tr><td>&nbsp;
  <tr><td align=right>3<td>&nbsp;&nbsp;&nbsp;&nbsp;<a href="#2">Chapter 2</a>
  </table>
  END


=head2 updateDocumentation($)

Update documentation from the comments in a perl script. Comments between the lines marked with:

  #Dn title # description

and:

  #D

where n is either 1, 2 or 3 indicating the heading level of the section and the # is in column 1.

Methods are formatted as:

  sub name(signature)      #FLAGS comment describing method
   {my ($parameters) = @_; # comments for each parameter separated by commas.

FLAGS can be chosen from:

=over

=item I

method of interest to new users

=item P

private method

=item r

optionally replaceable method

=item R

required replaceable method

=item S

static method

=item X

die rather than received a returned B<undef> result

=back

Other flags will be handed to the method extractDocumentationFlags(flags to process, method name) found in the file being documented, this method should return [the additional documentation for the method, the code to implement the flag].

Text following 'Example:' in the comment (if present) will be placed after the parameters list as an example. Lines containing comments consisting of '#T'.methodName will also be aggregated and displayed as examples for that method.

Lines formatted as:

  BEGIN{*source=*target}

starting in column 1 will define a synonym for a method.

Lines formatted as:

  #C emailAddress text

will be aggregated in the acknowledgments section at the end of the documentation.

The character sequence B<\n> in the comment will be expanded to one new line, B<\m> to two new lines and B<L>B<<$_>>,B<L>B<<confess>>,B<L>B<<die>>,B<L>B<<eval>>,B<L>B<<lvalueMethod>> to links to the perl documentation.

Search for '#D1': in L<https://metacpan.org/source/PRBRENAN/Data-Table-Text-20180810/lib/Data/Table/Text.pm> to see  more examples of such documentation in action - although it is quite difficult to see as it looks just like normal comments placed in the code.

Parameters:


     Parameter    Description
  1  $perlModule  Optional file name with caller's file being the default

Example:


   {my $s = updateDocumentation(<<'END' =~ s(#) (#)gsr =~ s(~) ()gsr);
  package Sample::Module;

  #D1 Samples                                                                      # Sample methods.

  sub sample($@)                                                                  #R Documentation for the:  sample() method.  See also L<Data::Table::Text::sample2|/Data::Table::Text::sample2>. #Tsample
   {my ($node, @context) = @_;                                                    # Node, optional context
    1
   }

  ~BEGIN{*smpl=*sample}

  sub Data::Table::Text::sample2(\&@)                                             #PS Documentation for the sample2() method.
   {my ($sub, @context) = @_;                                                     # Sub to call, context.
    1
   }

  ok sample(undef, qw(a b c)) == 1;                                               #Tsample

  if (1)                                                                          #Tsample
   {ok sample(q(a), qw(a b c))  == 2;
    ok sample(undef, qw(a b c)) == 1;
   }

  ok sample(<<END2)) == 1;                                                        #Tsample
  sample data
  END2

    ok $s =~ m'=head2 sample28\$\@29';



=head1 Hash Definitions




=head2 Data::Exchange::Service Definition


Service details.


B<file> - The file in which the service start details is being recorded.

B<service> - The name of the service.

B<start> - The time this service was started time plus a minor hack to simplify testing.



=head2 TestHash Definition


Definition of a blessed hash.


B<a> - Definition of attribute aa.

B<b> - Definition of attribute bb.



=head1 Private Methods

=head2 denormalizeFolderName($)

Remove any trailing folder separator from a folder name component.

     Parameter  Description
  1  $name      Name

=head2 renormalizeFolderName($)

Normalize a folder name component by adding a trailing separator.

     Parameter  Description
  1  $name      Name

=head2 trackFiles($@)

Track the existence of files.

     Parameter  Description
  1  $label     Label
  2  @files     Files

=head2 printFullFileName()

Print a file name on a separate line with escaping so it can be used easily from the command line.


=head2 readUtf16File($)

Read a file containing unicode in utf-16 format.

     Parameter  Description
  1  $file      Name of file to read

=head2 binModeAllUtf8()

Set STDOUT and STDERR to accept utf8 without complaint.


Example:


    binModeAllUtf8;


=head2 convertImageToJpx690($$$)

Convert an image to jpx format using versions of L<Imagemagick|/https://www.imagemagick.org/script/index.php> version 6.9.0 and above.

     Parameter  Description
  1  $source    Source file
  2  $target    Target folder (as multiple files will be created)
  3  $Size      Optional size of each tile - defaults to 256

=head2 formatTableMultiLine($$)

Tabularize text that has new lines in it.

     Parameter   Description
  1  $data       Reference to an array of arrays of data to be formatted as a table
  2  $separator  Optional line separator to use instead of new line for each row.

=head2 formatTableAA($$)

Tabularize an array of arrays.

     Parameter  Description
  1  $data      Data to be formatted
  2  $title     Optional reference to an array of titles

=head2 formatTableHA($$)

Tabularize a hash of arrays.

     Parameter  Description
  1  $data      Data to be formatted
  2  $title     Optional titles

=head2 formatTableAH($)

Tabularize an array of hashes.

     Parameter  Description
  1  $data      Data to be formatted

=head2 formatTableHH($)

Tabularize a hash of hashes.

     Parameter  Description
  1  $data      Data to be formatted

=head2 formatTableA($$)

Tabularize an array.

     Parameter  Description
  1  $data      Data to be formatted
  2  $title     Optional title

=head2 formatTableH($$)

Tabularize a hash.

     Parameter  Description
  1  $data      Data to be formatted
  2  $title     Optional title

=head2 saveSourceToS3($$)

Save source code.

     Parameter               Description
  1  $aws                    Aws target file and keywords
  2  $saveIntervalInSeconds  Save internal

=head2 extractTest($)

Remove example markers from test code.

     Parameter  Description
  1  $string    String containing test line

=head2 docUserFlags($$$$)

Generate documentation for a method by calling the extractDocumentationFlags method in the package being documented, passing it the flags for a method and the name of the method. The called method should return the documentation to be inserted for the named method.

     Parameter    Description
  1  $flags       Flags
  2  $perlModule  File containing documentation
  3  $package     Package containing documentation
  4  $name        Name of method to be processed

=head2 updatePerlModuleDocumentation($)

Update the documentation in a perl file and show said documentation in a web browser.

     Parameter    Description
  1  $perlModule  File containing the code of the perl module


=head1 Synonyms

B<fpd> is a synonym for L<filePathDir|/filePathDir> - Create a directory name from an array of file name components.

B<fpe> is a synonym for L<filePathExt|/filePathExt> - Create a file name from an array of file name components the last of which is an extension.

B<fpf> is a synonym for L<filePath|/filePath> - Create a file name from an array of file name components.

B<owf> is a synonym for L<overWriteFile|/overWriteFile> - Write a unicode utf8 string to a file after creating a path to the file if necessary and return the name of the file on success else confess.

B<temporaryDirectory> is a synonym for L<temporaryFolder|/temporaryFolder> - Create a temporary folder that will automatically be L<rmdired|/rmdir> during END processing.



=head1 Index


1 L<absFromAbsPlusRel|/absFromAbsPlusRel> - Create an absolute file from an absolute file and a relative file.

2 L<addCertificate|/addCertificate> - Add a certificate to the current ssh session.

3 L<addLValueScalarMethods|/addLValueScalarMethods> - Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> scalar methods in the current package if they do not already exist.

4 L<appendFile|/appendFile> - Append a unicode utf8 string to a file, possibly creating the file and the path to the file if necessary and return the name of the file on success else confess.

5 L<assertPackageRefs|/assertPackageRefs> - Confirm that the specified references are to the specified package

6 L<assertRef|/assertRef> - Confirm that the specified references are to the package into which this routine has been exported.

7 L<binModeAllUtf8|/binModeAllUtf8> - Set STDOUT and STDERR to accept utf8 without complaint.

8 L<boldString|/boldString> - Convert alphanumerics in a string to bold.

9 L<boldStringUndo|/boldStringUndo> - Undo alphanumerics in a string to bold.

10 L<call|/call> - Call the specified sub in a separate process, wait for it to complete, copy back the named L<our|https://perldoc.perl.org/functions/our.html> variables, free the memory used.

11 L<checkFile|/checkFile> - Return the name of the specified file if it exists, else confess the maximum extent of the path that does exist.

12 L<checkKeys|/checkKeys> - Check the keys in a hash.

13 L<clearFolder|/clearFolder> - Remove all the files and folders under and including the specified folder as long as the number of files to be removed is less than the specified limit.

14 L<containingPowerOfTwo|/containingPowerOfTwo> - Find log two of the lowest power of two greater than or equal to a number.

15 L<contains|/contains> - Returns the indices at which an item matches elements of the specified array.

16 L<convertDocxToFodt|/convertDocxToFodt> - Convert a B<docx> file to B<fodt> using B<unoconv> which must not be running elsewhere at the time.

17 L<convertImageToJpx|/convertImageToJpx> - Convert an image to jpx format using L<Imagemagick|/https://www.imagemagick.org/script/index.php>.

18 L<convertImageToJpx690|/convertImageToJpx690> - Convert an image to jpx format using versions of L<Imagemagick|/https://www.imagemagick.org/script/index.php> version 6.

19 L<convertUnicodeToXml|/convertUnicodeToXml> - Convert a string with unicode points that are not directly representable in ascii into string that replaces these points with their representation on Xml making the string usable in Xml documents.

20 L<createEmptyFile|/createEmptyFile> - Create an empty file - L<writeFile|/writeFile> complains if no data is written to the file -  and return the name of the file on success else confess.

21 L<currentDirectory|/currentDirectory> - Get the current working directory.

22 L<currentDirectoryAbove|/currentDirectoryAbove> - The path to the folder above the current working folder.

23 L<cutOutImagesInFodtFile|/cutOutImagesInFodtFile> - Cut out the images embedded in a B<fodt> file, perhaps produced via L<convertDocxToFodt|/convertDocxToFodt>, placing them in the specified folder and replacing them in the source file with:

  <image href="$imageFile" outputclass="imageType">

This conversion requires that you have both L<Imagemagick|/https://www.imagemagick.org/script/index.php> and L<unoconv|/https://github.

24 L<Data::Exchange::Service::check|/Data::Exchange::Service::check> - Check that we are the current incarnation of the named service with details obtained from L<newServiceIncarnation|/newServiceIncarnation>.

25 L<dateStamp|/dateStamp> - Year-monthName-day

26 L<dateTimeStamp|/dateTimeStamp> - Year-monthNumber-day at hours:minute:seconds

27 L<decodeBase64|/decodeBase64> - Decode a string in base 64.

28 L<decodeJson|/decodeJson> - Decode Perl from Json.

29 L<denormalizeFolderName|/denormalizeFolderName> - Remove any trailing folder separator from a folder name component.

30 L<docUserFlags|/docUserFlags> - Generate documentation for a method by calling the extractDocumentationFlags method in the package being documented, passing it the flags for a method and the name of the method.

31 L<dumpFile|/dumpFile> - Dump a data structure to a file

32 L<dumpGZipFile|/dumpGZipFile> - Write a data structure through B<gzip> to a file.

33 L<enclosedReversedString|/enclosedReversedString> - Convert alphanumerics in a string to enclosed reversed alphanumerics.

34 L<enclosedReversedStringUndo|/enclosedReversedStringUndo> - Undo alphanumerics in a string to enclosed reversed alphanumerics.

35 L<enclosedString|/enclosedString> - Convert alphanumerics in a string to enclosed alphanumerics.

36 L<enclosedStringUndo|/enclosedStringUndo> - Undo alphanumerics in a string to enclosed alphanumerics.

37 L<encodeBase64|/encodeBase64> - Encode a string in base 64.

38 L<encodeJson|/encodeJson> - Encode Perl to Json.

39 L<evalFile|/evalFile> - Read a file containing unicode in utf8, evaluate it, confess to any errors and then return any result - an improvement on B<do> which silently ignores any problems.

40 L<evalGZipFile|/evalGZipFile> - Read a file containing compressed utf8, evaluate it, confess to any errors or return any result.

41 L<extractTest|/extractTest> - Remove example markers from test code.

42 L<fe|/fe> - Get extension of file name.

43 L<fileList|/fileList> - Files that match a given search pattern handed to bsd_glob.

44 L<fileModTime|/fileModTime> - Get the modified time of a file in seconds since the epoch.

45 L<fileOutOfDate|/fileOutOfDate> - Calls the specified sub once for each source file that is missing, then calls the sub for the target if there were any missing files or if the target is older than any of the non missing source files or if the target does not exist.

46 L<filePath|/filePath> - Create a file name from an array of file name components.

47 L<filePathDir|/filePathDir> - Create a directory name from an array of file name components.

48 L<filePathExt|/filePathExt> - Create a file name from an array of file name components the last of which is an extension.

49 L<fileSize|/fileSize> - Get the size of a file.

50 L<findDirs|/findDirs> - Find all the folders under a folder and optionally filter the selected folders with a regular expression.

51 L<findFiles|/findFiles> - Find all the files under a folder and optionally filter the selected files with a regular expression.

52 L<findFileWithExtension|/findFileWithExtension> - Find the first extension from the specified extensions that produces a file that exists when appended to the specified file.

53 L<firstFileThatExists|/firstFileThatExists> - Returns the name of the first file that exists or B<undef> if none of the named files exist.

54 L<firstNChars|/firstNChars> - First N characters of a string.

55 L<fn|/fn> - Remove path and extension from file name.

56 L<fne|/fne> - Remove path from file name.

57 L<formatTable|/formatTable> - Format various data structures as a table.

58 L<formatTableA|/formatTableA> - Tabularize an array.

59 L<formatTableAA|/formatTableAA> - Tabularize an array of arrays.

60 L<formatTableAH|/formatTableAH> - Tabularize an array of hashes.

61 L<formatTableBasic|/formatTableBasic> - Tabularize an array of arrays of text.

62 L<formatTableH|/formatTableH> - Tabularize a hash.

63 L<formatTableHA|/formatTableHA> - Tabularize a hash of arrays.

64 L<formatTableHH|/formatTableHH> - Tabularize a hash of hashes.

65 L<formatTableMultiLine|/formatTableMultiLine> - Tabularize text that has new lines in it.

66 L<fp|/fp> - Get path from file name.

67 L<fpn|/fpn> - Remove extension from file name.

68 L<fullFileName|/fullFileName> - Full name of a file.

69 L<genHash|/genHash> - Return a B<$bless>ed hash with the specified B<$attributes>.

70 L<genLValueArrayMethods|/genLValueArrayMethods> - Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> array methods in the current package.

71 L<genLValueHashMethods|/genLValueHashMethods> - Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> hash methods in the current package.

72 L<genLValueScalarMethods|/genLValueScalarMethods> - Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> scalar methods in the current package, A method whose value has not yet been set will return a new scalar with value B<undef>.

73 L<genLValueScalarMethodsWithDefaultValues|/genLValueScalarMethodsWithDefaultValues> - Generate L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> scalar methods with default values in the current package.

74 L<hostName|/hostName> - The name of the host we are running on.

75 L<htmlToc|/htmlToc> - Generate a table of contents for some html.

76 L<imageSize|/imageSize> - Return (width, height) of an image obtained via L<Imagemagick|/https://www.imagemagick.org/script/index.php>.

77 L<indentString|/indentString> - Indent lines contained in a string or formatted table by the specified string.

78 L<ipAddressViaArp|/ipAddressViaArp> - Get the ip address of a server on the local network by hostname via arp

79 L<isBlank|/isBlank> - Test whether a string is blank.

80 L<javaPackage|/javaPackage> - Extract the package name from a java string or file.

81 L<javaPackageAsFileName|/javaPackageAsFileName> - Extract the package name from a java string or file and convert it to a file name.

82 L<keyCount|/keyCount> - Count keys down to the specified level.

83 L<loadArrayArrayFromLines|/loadArrayArrayFromLines> - Load an array of arrays from lines of text: each line is an array of words.

84 L<loadArrayFromLines|/loadArrayFromLines> - Load an array from lines of text in a string.

85 L<loadArrayHashFromLines|/loadArrayHashFromLines> - Load an array of hashes from lines of text: each line is an hash of words.

86 L<loadHash|/loadHash> - Load the specified B<$hash> generated with L<genHash|/genHash> with B<%attributes>.

87 L<loadHashArrayFromLines|/loadHashArrayFromLines> - Load a hash of arrays from lines of text: the first word of each line is the key, the remaining words are the array contents.

88 L<loadHashFromLines|/loadHashFromLines> - Load a hash: first word of each line is the key and the rest is the value.

89 L<loadHashHashFromLines|/loadHashHashFromLines> - Load a hash of hashes from lines of text: the first word of each line is the key, the remaining words are the sub hash contents.

90 L<makeDieConfess|/makeDieConfess> - Force die to confess where the death occurred

91 L<makePath|/makePath> - Make the path for the specified file name or folder.

92 L<matchPath|/matchPath> - Given an absolute path find out how much of the path actually exists.

93 L<max|/max> - Find the maximum number in a list.

94 L<maximumLineLength|/maximumLineLength> - Find the longest line in a string

95 L<microSecondsSinceEpoch|/microSecondsSinceEpoch> - Micro seconds since unix epoch.

96 L<min|/min> - Find the minimum number in a list.

97 L<newServiceIncarnation|/newServiceIncarnation> - Create a new service incarnation to record the start up of a new instance of a service and return the description as a L<Data::Exchange::Service Definition hash|/Data::Exchange::Service Definition>.

98 L<numberOfLinesInFile|/numberOfLinesInFile> - The number of lines in a file

99 L<numberOfLinesInString|/numberOfLinesInString> - The number of lines in a string.

100 L<nws|/nws> - Normalize white space in a string to make comparisons easier.

101 L<overWriteFile|/overWriteFile> - Write a unicode utf8 string to a file after creating a path to the file if necessary and return the name of the file on success else confess.

102 L<pad|/pad> - Pad a string with blanks or the specified padding character  to a multiple of a specified length.

103 L<parseCommandLineArguments|/parseCommandLineArguments> - Classify the specified array of words referred to by B<$args> into positional and keyword parameters, call the specified B<sub> with a reference to an array of positional parameters followed by a reference to a hash of keywords and their values then return the value returned by this sub.

104 L<parseFileName|/parseFileName> - Parse a file name into (path, name, extension).

105 L<perlPackage|/perlPackage> - Extract the package name from a perl string or file.

106 L<powerOfTwo|/powerOfTwo> - Test whether a number is a power of two, return the power if it is else B<undef>.

107 L<printFullFileName|/printFullFileName> - Print a file name on a separate line with escaping so it can be used easily from the command line.

108 L<printQw|/printQw> - Print an array of words in qw() format.

109 L<quoteFile|/quoteFile> - Quote a file name.

110 L<readBinaryFile|/readBinaryFile> - Read binary file - a file whose contents are not to be interpreted as unicode.

111 L<readFile|/readFile> - Read a file containing unicode in utf8.

112 L<readGZipFile|/readGZipFile> - Read the specified B<$file>, containing compressed utf8, through gzip

113 L<readUtf16File|/readUtf16File> - Read a file containing unicode in utf-16 format.

114 L<relFromAbsAgainstAbs|/relFromAbsAgainstAbs> - Derive a relative file name for the first absolute file name relative to the second absolute file name.

115 L<removeFilePrefix|/removeFilePrefix> - Removes a file prefix from an array of files.

116 L<renormalizeFolderName|/renormalizeFolderName> - Normalize a folder name component by adding a trailing separator.

117 L<saveCodeToS3|/saveCodeToS3> - Save source code files.

118 L<saveSourceToS3|/saveSourceToS3> - Save source code.

119 L<searchDirectoryTreesForMatchingFiles|/searchDirectoryTreesForMatchingFiles> - Search the specified directory trees for the files (not folders) that match the specified extensions.

120 L<setIntersectionOfTwoArraysOfWords|/setIntersectionOfTwoArraysOfWords> - Intersection of two arrays of words.

121 L<setUnionOfTwoArraysOfWords|/setUnionOfTwoArraysOfWords> - Union of two arrays of words.

122 L<startProcess|/startProcess> - Start new processes while the number of child processes recorded in B<%$pids> is less than the specified B<$maximum>.

123 L<stringsAreNotEqual|/stringsAreNotEqual> - Return the two non equal tails of non equal strings or an empty list if the strings are equal.

124 L<subScriptString|/subScriptString> - Convert alphanumerics in a string to sub scripts

125 L<subScriptStringUndo|/subScriptStringUndo> - Undo alphanumerics in a string to sub scripts

126 L<superScriptString|/superScriptString> - Convert alphanumerics in a string to super scripts

127 L<superScriptStringUndo|/superScriptStringUndo> - Undo alphanumerics in a string to super scripts

128 L<temporaryFile|/temporaryFile> - Create a temporary file that will automatically be L<unlinked|/unlink> during END processing.

129 L<temporaryFolder|/temporaryFolder> - Create a temporary folder that will automatically be L<rmdired|/rmdir> during END processing.

130 L<timeStamp|/timeStamp> - hours:minute:seconds

131 L<titleToUniqueFileName|/titleToUniqueFileName> - Create a file name from a title that is unique within the set %uniqueNames.

132 L<trackFiles|/trackFiles> - Track the existence of files.

133 L<trim|/trim> - Remove any white space from the front and end of a string.

134 L<updateDocumentation|/updateDocumentation> - Update documentation from the comments in a perl script.

135 L<updatePerlModuleDocumentation|/updatePerlModuleDocumentation> - Update the documentation in a perl file and show said documentation in a web browser.

136 L<userId|/userId> - The userid we are currently running under.

137 L<versionCode|/versionCode> - YYYYmmdd-HHMMSS

138 L<versionCodeDashed|/versionCodeDashed> - YYYY-mm-dd-HH:MM:SS

139 L<waitForAllStartedProcessesToFinish|/waitForAllStartedProcessesToFinish> - Wait until all the processes started by L<startProcess|/startProcess> have finished.

140 L<writeBinaryFile|/writeBinaryFile> - Write a non unicode string to a file in after creating a path to the file if necessary and return the name of the file on success else confess.

141 L<writeFile|/writeFile> - Write a unicode utf8 string to a new file that does not already exist after creating a path to the file if necessary and return the name of the file on success else confess if a problem occurred or the file does already exist.

142 L<writeFiles|/writeFiles> - Write the values of a hash into files identified by the key of each value using L<overWriteFile|/overWriteFile>

143 L<writeGZipFile|/writeGZipFile> - Write a unicode utf8 string through gzip to a file.

144 L<wwwEncode|/wwwEncode> - Replace spaces in a string with %20 .

145 L<xxx|/xxx> - Execute a shell command.

146 L<yyy|/yyy> - Execute a block of shell commands line by line after removing comments - stop if there is a non zero return code from any command.

147 L<zzz|/zzz> - Execute lines of commands after replacing new lines with && then check that the pipeline execution results in a return code of zero and that the execution results match the optional regular expression if one has been supplied; confess() to an error if either check fails.

148 L<ˢ|/ˢ> - Immediately executed inline sub to allow a code block before B<if>.

=head1 Installation

This module is written in 100% Pure Perl and, thus, it is easy to read,
comprehend, use, modify and install via B<cpan>:

  sudo cpan install Data::Table::Text

=head1 Author

L<philiprbrenan@gmail.com|mailto:philiprbrenan@gmail.com>

L<http://www.appaapps.com|http://www.appaapps.com>

=head1 Copyright

Copyright (c) 2016-2018 Philip R Brenan.

This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.


=head1 Acknowledgements

Thanks to the following people for their help with this module:

=over


=item L<mim@cpan.org|mailto:mim@cpan.org>

Testing on windows


=back


=cut



# Tests and documentation

sub test
 {my $p = __PACKAGE__;
  binmode($_, ":utf8") for *STDOUT, *STDERR;
  return if eval "eof(${p}::DATA)";
  my $s = eval "join('', <${p}::DATA>)";
  $@ and die $@;
  eval $s;
  $@ and die $@;
  1
 }

test unless caller;

1;
# podDocumentation
__DATA__
Test::More->builder->output("/dev/null")                                        # Reduce number of confirmation messages during testing
  if ((caller(1))[0]//'Data::Table::Text') eq "Data::Table::Text";

use Test::More tests => 370;
my $windows = $^O =~ m(MSWin32)is;
my $mac     = $^O =~ m(darwin)is;

if (1)                                                                          # Unicode to local file
 {use utf8;
  my $z = "𝝰 𝝱 𝝲";
  my $t = temporaryFolder;
  my $f = filePathExt($t, $z, qq(data));
  unlink $f if -e $f;
  ok !-e $f;
  writeFile($f, $z);
  ok  -e $f;
  my $s = readFile($f);
  ok $s eq $z;
  ok length($s) == length($z);
  unlink $f;
  ok !-e $f;
  rmdir $t;
  ok !-d $t;
 }

if (1) {                                                                        # Key counts
  my $a = [[1..3],       {map{$_=>1} 1..3}];                                    #TkeyCount
  my $h = {a=>[1..3], b=>{map{$_=>1} 1..3}};                                    #TkeyCount
  ok keyCount(2, $a) == 6;                                                      #TkeyCount
  ok keyCount(2, $h) == 6;                                                      #TkeyCount
 }

if (1) {                                                                        #TfilePath #TfilePathDir #TfilePathExt #Tfpd #Tfpe #Tfpf
  ok filePath   (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
  ok filePathDir(qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
  ok filePathDir('', qw(aaa))              eq "aaa/";
  ok filePathDir('')                       eq "";
  ok filePathExt(qw(aaa xxx))              eq "aaa.xxx";
  ok filePathExt(qw(aaa bbb xxx))          eq "aaa/bbb.xxx";

  ok fpd        (qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
  ok fpf        (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
  ok fpe        (qw(aaa bbb xxx))          eq "aaa/bbb.xxx";
 }

if (1) {                                                                        # File paths
  my $h =                                                                       #TwriteFiles
   {"aaa/1.txt"=>"1111",                                                        #TwriteFiles
    "aaa/2.txt"=>"2222",                                                        #TwriteFiles
   };                                                                           #TwriteFiles
  writeFiles($h);                                                               #TwriteFiles
  for(sort keys %$h)                                                            #TwriteFiles
   {ok -e $_;                                                                   #TwriteFiles
    ok readFile($_) eq $h->{$_};                                                #TwriteFiles
    unlink $_;
    ok !-e $_;
   }                                                                            #TwriteFiles
  rmdir "aaa";
  ok !-d "aaa";
 }

if (1)                                                                          # Parse file names
 {is_deeply [parseFileName "/home/phil/test.data"], ["/home/phil/", "test", "data"];
  is_deeply [parseFileName "/home/phil/test"],      ["/home/phil/", "test"];
  is_deeply [parseFileName "phil/test.data"],       ["phil/",       "test", "data"];
  is_deeply [parseFileName "phil/test"],            ["phil/",       "test"];
  is_deeply [parseFileName "test.data"],            [undef,         "test", "data"];
  is_deeply [parseFileName "phil/"],                [qw(phil/)];
  is_deeply [parseFileName "/var/www/html/translations/"], [qw(/var/www/html/translations/)];
  is_deeply [parseFileName "a.b/c.d.e"],            [qw(a.b/ c.d e)];           #TparseFileName
 }

if (1)                                                                          # Unicode
 {use utf8;
  my $z = "𝝰 𝝱 𝝲";
  my $T = temporaryFolder;
  my $t = filePath($T, $z);
  my $f = filePathExt($t, $z, qq(data));
  unlink $f if -e $f;
  ok !-e $f;
  writeFile($f, $z);
  ok  -e $f;
  my $s = readFile($f);
  ok $s eq $z;
  ok length($s) == length($z);

  if ($windows or $mac) {ok 1}
  else
   {my @f = findFiles($T);
    ok $f[0] eq $f;
   }

  unlink $f;
  ok !-e $f;
  rmdir $t;
  ok !-d $t;
  rmdir $T;
  ok !-d $T;
 }

if (1)                                                                          # Binary
 {my $z = "𝝰 𝝱 𝝲";
  my $Z = join '', map {chr($_)} 0..11;
  my $T = temporaryFolder;
  my $t = filePath($T, $z);
  my $f = filePathExt($t, $z, qq(data));
  unlink $f if -e $f;
  ok !-e $f;
  writeBinaryFile($f, $Z);
  ok  -e $f;
  my $s = readBinaryFile($f);
  ok $s eq $Z;
  ok length($s) == 12;
  unlink $f;
  ok !-e $f;
  rmdir $t;
  ok !-d $t;
  rmdir $T;
  ok !-d $T;
 }

if (!$windows) {                                                                # Check files
  my $d = filePath   (my @d = qw(a b c d));                                     #TcheckFile #TmatchPath
  my $f = filePathExt(qw(a b c d e x));                                         #TcheckFile
  my $F = filePathExt(qw(a b c e d));                                           #TcheckFile
  createEmptyFile($f);                                                          #TcheckFile
  ok matchPath($d) eq $d;                                                       #TmatchPath
  ok checkFile($d);                                                             #TcheckFile
  ok checkFile($f);                                                             #TcheckFile
  eval q{checkFile($F)};
  my @m = split m/\n/, $@;
  ok $m[1] eq  "a/b/c/";
  unlink $f;
  ok !-e $f;
  while(@d)                                                                     # Remove path
   {my $d = filePathDir(@d);
    rmdir $d;
    ok !-d $d;
    pop @d;
   }
 }
else
 {ok 1 for 1..9;
 }

if (1)                                                                          # Clear folder
 {my $d = 'a';
  my @d = qw(a b c d);
  my @D = @d;
  while(@D)
   {my $f = filePathExt(@D, qw(test data));
    overWriteFile($f, '1');
    pop @D;
   }
  if ($windows) {ok 1 for 1..3}
  else
   {ok findFiles($d) == 4;
    eval q{clearFolder($d, 3)};
    ok $@ =~ m(\ALimit is 3, but 4 files under folder:)s;
    clearFolder($d, 4);
    ok !-d $d;
   }
 }

ok formatTable                                                                  #TformatTable
 ([[qw(A    B    C    D   )],                                                   #TformatTable
   [qw(AA   BB   CC   DD  )],                                                   #TformatTable
   [qw(AAA  BBB  CCC  DDD )],                                                   #TformatTable
   [qw(AAAA BBBB CCCC DDDD)],                                                   #TformatTable
   [qw(1    22   333  4444)]], [qw(aa bb cc)]) eq <<END;                        #TformatTable
   aa    bb    cc
1  A     B     C     D
2  AA    BB    CC    DD
3  AAA   BBB   CCC   DDD
4  AAAA  BBBB  CCCC  DDDD
5     1    22   333  4444
END

ok formatTable                                                                  #TformatTable
 ([[qw(1     B   C)],                                                           #TformatTable
   [qw(22    BB  CC)],                                                          #TformatTable
   [qw(333   BBB CCC)],                                                         #TformatTable
   [qw(4444  22  333)]], [qw(aa bb cc)]) eq <<END;                              #TformatTable
   aa    bb   cc
1     1  B    C
2    22  BB   CC
3   333  BBB  CCC
4  4444   22  333
END

ok formatTable                                                                  #TformatTable
 ([{aa=>'A',   bb=>'B',   cc=>'C'},                                             #TformatTable
   {aa=>'AA',  bb=>'BB',  cc=>'CC'},                                            #TformatTable
   {aa=>'AAA', bb=>'BBB', cc=>'CCC'},                                           #TformatTable
   {aa=>'1',   bb=>'22',  cc=>'333'}                                            #TformatTable
   ]) eq <<END;                                                                 #TformatTable
   aa   bb   cc
1  A    B    C
2  AA   BB   CC
3  AAA  BBB  CCC
4    1   22  333
END

ok formatTable                                                                  #TformatTable
 ({''=>[qw(aa bb cc)],                                                          #TformatTable
    1=>[qw(A B C)],                                                             #TformatTable
    22=>[qw(AA BB CC)],                                                         #TformatTable
    333=>[qw(AAA BBB CCC)],                                                     #TformatTable
    4444=>[qw(1 22 333)]}) eq <<END;                                            #TformatTable
      aa   bb   cc
   1  A    B    C
  22  AA   BB   CC
 333  AAA  BBB  CCC
4444    1   22  333
END

ok formatTable                                                                  #TformatTable
 ({1=>{aa=>'A', bb=>'B', cc=>'C'},                                              #TformatTable
   22=>{aa=>'AA', bb=>'BB', cc=>'CC'},                                          #TformatTable
   333=>{aa=>'AAA', bb=>'BBB', cc=>'CCC'},                                      #TformatTable
   4444=>{aa=>'1', bb=>'22', cc=>'333'}}) eq <<END;                             #TformatTable
      aa   bb   cc
   1  A    B    C
  22  AA   BB   CC
 333  AAA  BBB  CCC
4444    1   22  333
END

ok formatTable({aa=>'A', bb=>'B', cc=>'C'}, [qw(aaaa bbbb)]) eq <<END;          #TformatTable
aaaa  bbbb
aa    A
bb    B
cc    C
END

if (1) {                                                                        # AL
  my $s = loadArrayFromLines <<END;                                             #TloadArrayFromLines
a a
b b
END
  is_deeply $s, [q(a a), q(b b)];                                               #TloadArrayFromLines
  ok formatTable($s) eq <<END;                                                  #TloadArrayFromLines
0  a a
1  b b
END
 }

if (1) {                                                                        # HL
  my $s = loadHashFromLines <<END;                                              #TloadHashFromLines
a 10 11 12
b 20 21 22
END
  is_deeply $s, {a => q(10 11 12), b =>q(20 21 22)};                            #TloadHashFromLines
  ok formatTable($s) eq <<END;                                                  #TloadHashFromLines
a  10 11 12
b  20 21 22
END
 }

if (1) {                                                                        # AAL
  my $s = loadArrayArrayFromLines <<END;                                        #TloadArrayArrayFromLines
A B C
AA BB CC
END
  is_deeply $s, [[qw(A B C)], [qw(AA BB CC)]];                                  #TloadArrayArrayFromLines
  ok formatTable($s) eq <<END;                                                  #TloadArrayArrayFromLines
1  A   B   C
2  AA  BB  CC
END
 }

if (1) {                                                                        # HAL
  my $s = loadHashArrayFromLines <<END;                                         #TloadHashArrayFromLines
a A B C
b AA BB CC
END
  is_deeply $s, {a =>[qw(A B C)], b => [qw(AA BB CC)] };                        #TloadHashArrayFromLines
  ok formatTable($s) eq <<END;                                                  #TloadHashArrayFromLines
a  A   B   C
b  AA  BB  CC
END
 }

if (1) {                                                                        # AAL
  my $s = loadArrayHashFromLines <<END;                                         #TloadArrayHashFromLines
A 1 B 2
AA 11 BB 22
END
  is_deeply $s, [{A=>1, B=>2}, {AA=>11, BB=>22}];                               #TloadArrayHashFromLines
  ok formatTable($s) eq <<END;                                                  #TloadArrayHashFromLines
   A  AA  B  BB
1  1      2
2     11     22
END
 }

if (1) {                                                                        # HAL
  my $s = loadHashHashFromLines <<END;                                          #TloadHashHashFromLines
a A 1 B 2
b AA 11 BB 22
END
  is_deeply $s, {a=>{A=>1, B=>2}, b=>{AA=>11, BB=>22}};                         #TloadHashHashFromLines
  ok formatTable($s) eq <<END;                                                  #TloadHashHashFromLines
   A  AA  B  BB
a  1      2
b     11     22
END
}

if (1) {                                                                        # Using a named package
  my $class = "Data::Table::Text::Test";
  my $a = bless{}, $class;
  genLValueScalarMethods(qq(${class}::$_)) for qw(aa bb cc);
  $a->aa = 'aa';
  ok  $a->aa eq 'aa';
  ok !$a->bb;
  ok  $a->bbX eq q();
  $a->aa = undef;
  ok !$a->aa;
 }

if (1) {                                                                        # Conditionally using a named package
  my $class = "Data::Table::Text::Test";                                        #TaddLValueScalarMethods
  my $a = bless{}, $class;                                                      #TaddLValueScalarMethods
  addLValueScalarMethods(qq(${class}::$_)) for qw(aa bb aa bb);                 #TaddLValueScalarMethods
  $a->aa = 'aa';                                                                #TaddLValueScalarMethods
  ok  $a->aa eq 'aa';                                                           #TaddLValueScalarMethods
  ok !$a->bb;                                                                   #TaddLValueScalarMethods
  ok  $a->bbX eq q();                                                           #TaddLValueScalarMethods
  $a->aa = undef;                                                               #TaddLValueScalarMethods
  ok !$a->aa;                                                                   #TaddLValueScalarMethods
 }

if (1) {                                                                        # Using the caller's package
  package Scalars;                                                              #TgenLValueScalarMethods
  my $a = bless{};                                                              #TgenLValueScalarMethods
  Data::Table::Text::genLValueScalarMethods(qw(aa bb cc));                      #TgenLValueScalarMethods
  $a->aa = 'aa';                                                                #TgenLValueScalarMethods
  Test::More::ok  $a->aa eq 'aa';                                               #TgenLValueScalarMethods
  Test::More::ok !$a->bb;                                                       #TgenLValueScalarMethods
  Test::More::ok  $a->bbX eq q();                                               #TgenLValueScalarMethods
  $a->aa = undef;                                                               #TgenLValueScalarMethods
  Test::More::ok !$a->aa;                                                       #TgenLValueScalarMethods
 }

if (1) {                                                                        # SDM
  package ScalarsWithDefaults;                                                  #TgenLValueScalarMethodsWithDefaultValues
  my $a = bless{};                                                              #TgenLValueScalarMethodsWithDefaultValues
  Data::Table::Text::genLValueScalarMethodsWithDefaultValues(qw(aa bb cc));     #TgenLValueScalarMethodsWithDefaultValues
  Test::More::ok $a->aa eq 'aa';                                                #TgenLValueScalarMethodsWithDefaultValues
 }

if (1) {                                                                        # AM
  package Arrays;                                                               #TgenLValueArrayMethods
  my $a = bless{};                                                              #TgenLValueArrayMethods
  Data::Table::Text::genLValueArrayMethods(qw(aa bb cc));                       #TgenLValueArrayMethods
  $a->aa->[1] = 'aa';                                                           #TgenLValueArrayMethods
  Test::More::ok $a->aa->[1] eq 'aa';                                           #TgenLValueArrayMethods
 }                                                                              #
                                                                                #
if (1) {                                                                        ## AM
  package Hashes;                                                               #TgenLValueHashMethods
  my $a = bless{};                                                              #TgenLValueHashMethods
  Data::Table::Text::genLValueHashMethods(qw(aa bb cc));                        #TgenLValueHashMethods
  $a->aa->{a} = 'aa';                                                           #TgenLValueHashMethods
  Test::More::ok $a->aa->{a} eq 'aa';                                           #TgenLValueHashMethods
 }

if (1) {
  my $t = [qw(aa bb cc)];                                                       #TindentString
  my $d = [[qw(A B C)], [qw(AA BB CC)], [qw(AAA BBB CCC)],  [qw(1 22 333)]];    #TindentString
  my $s = indentString(formatTable($d), '  ')."\n";

  ok $s eq <<END;                                                               #TindentString
  1  A    B    C
  2  AA   BB   CC
  3  AAA  BBB  CCC
  4    1   22  333
END
 }

ok trim(" a b ") eq join ' ', qw(a b);                                          #Ttrim
ok isBlank("");                                                                 #TisBlank
ok isBlank(" \n ");                                                             #TisBlank

ok  powerOfTwo(1) == 0;                                                         #TpowerOfTwo
ok  powerOfTwo(2) == 1;                                                         #TpowerOfTwo
ok !powerOfTwo(3);                                                              #TpowerOfTwo
ok  powerOfTwo(4) == 2;                                                         #TpowerOfTwo

ok  containingPowerOfTwo(1) == 0;                                               #TcontainingPowerOfTwo
ok  containingPowerOfTwo(2) == 1;                                               #TcontainingPowerOfTwo
ok  containingPowerOfTwo(3) == 2;                                               #TcontainingPowerOfTwo
ok  containingPowerOfTwo(4) == 2;                                               #TcontainingPowerOfTwo
ok  containingPowerOfTwo(5) == 3;
ok  containingPowerOfTwo(7) == 3;

ok  pad('abc  ', 2).'='       eq "abc =";                                       #Tpad
ok  pad('abc  ', 3).'='       eq "abc=";                                        #Tpad
ok  pad('abc  ', 4, q(.)).'=' eq "abc.=";                                       #Tpad
ok  pad('abc  ', 5).'='       eq "abc  =";
ok  pad('abc  ', 6).'='       eq "abc   =";

#ok containingFolder("/home/phil/test.data") eq "/home/phil/";
#ok containingFolder("phil/test.data")       eq "phil/";
#ok containingFolder("test.data")            eq "./";

if (1) {
  my $f = temporaryFile;                                                        #TtemporaryFile
  overWriteFile($f, <<END);                                                     #TjavaPackage #TjavaPackageAsFileName
// Test
package com.xyz;
END
  ok javaPackage($f)           eq "com.xyz";                                    #TjavaPackage
  ok javaPackageAsFileName($f) eq "com/xyz";                                    #TjavaPackageAsFileName
  unlink $f;
 }
if (1)
 {my $f = temporaryFile;
  overWriteFile($f, <<END);                                                     #TperlPackage
package a::b;
END
  ok perlPackage($f)           eq "a::b";                                       #TperlPackage
  unlink $f;
 }

if (0)                                                                          # Ignore windows for this test
 {ok xxx("echo aaa")       =~ /aaa/;                                            #Txxx
  ok xxx("a=bbb;echo \$a") =~ /bbb/;

  eval q{xxx "echo ccc", qr(ccc)};
  ok !$@;

  eval q{xxx "echo ddd", qr(ccc)};
  ok $@ =~ /ddd/;

  ok !yyy <<END;                                                                #Tyyy
echo aaa
echo bbb
END
 }
else
 {ok 1 for 1..5;
 }

if (1) {
  my $A = encodeJson(my $a = {a=>1,b=>2, c=>[1..2]});                           #TencodeJson #TdecodeJson
  my $b = decodeJson($A);                                                       #TencodeJson #TdecodeJson
  is_deeply $a, $b;                                                             #TencodeJson #TdecodeJson
 }

if (1) {
  my $A = encodeBase64(my $a = "Hello World" x 10);                             #TencodeBase64 #TdecodeBase64
  my $b = decodeBase64($A);                                                     #TencodeBase64 #TdecodeBase64
  ok $a eq $b;                                                                  #TencodeBase64 #TdecodeBase64
 }

ok !max;                                                                        #Tmax
ok max(1) == 1;                                                                 #Tmax
ok max(1,4,2,3) == 4;                                                           #Tmax

ok min(1) == 1;                                                                 #Tmin
ok min(5,4,2,3) == 2;                                                           #Tmin

is_deeply [1],       [contains(1,0..1)];                                        #Tcontains
is_deeply [1,3],     [contains(1, qw(0 1 0 1 0 0))];                            #Tcontains
is_deeply [0, 5],    [contains('a', qw(a b c d e a b c d e))];                  #Tcontains
is_deeply [0, 1, 5], [contains(qr(a+), qw(a baa c d e aa b c d e))];            #Tcontains

is_deeply [qw(a b)], [&removeFilePrefix(qw(a/ a/a a/b))];                       #TremoveFilePrefix
is_deeply [qw(b)],   [&removeFilePrefix("a/", "a/b")];                          #TremoveFilePrefix

if (0) {                                                                        #TfileOutOfDate
  my @Files = qw(a b c);
  my @files = (@Files, qw(d));
  writeFile($_, $_), sleep 1 for @Files;

  my $a = '';
  my @a = fileOutOfDate {$a .= $_} q(a), @files;
  ok $a eq 'da';
  is_deeply [@a], [qw(d a)];

  my $b = '';
  my @b = fileOutOfDate {$b .= $_} q(b), @files;
  ok $b eq 'db';
  is_deeply [@b], [qw(d b)];

  my $c = '';
  my @c = fileOutOfDate {$c .= $_} q(c), @files;
  ok $c eq 'dc';
  is_deeply [@c], [qw(d c)];

  my $d = '';
  my @d = fileOutOfDate {$d .= $_} q(d), @files;
  ok $d eq 'd';
  is_deeply [@d], [qw(d)];

  my @A = fileOutOfDate {} q(a), @Files;
  my @B = fileOutOfDate {} q(b), @Files;
  my @C = fileOutOfDate {} q(c), @Files;
  is_deeply [@A], [qw(a)];
  is_deeply [@B], [qw(b)];
  is_deeply [@C], [];
  unlink for @Files;
 }
else
 { SKIP:
   {skip "Takes too much time", 11;
   }
 }

ok convertUnicodeToXml('setenta e três') eq q(setenta e tr&#234;s);             #TconvertUnicodeToXml

ok zzz(<<END, qr(aaa\s*bbb)s);                                                  #Tzzz
echo aaa
echo bbb
END

if (1)                                                                          # Failure
 {eval q{zzz(qq(echo aaa\necho bbb\n), qr(SUCCESS)s)};
  ok $@ =~ m(Data::Table::Text::zzz)s;
 }

if (1) {
  my $r = parseCommandLineArguments {[@_]}                                      #TparseCommandLineArguments
   [qw( aaa bbb -c --dd --eee=EEEE -f=F), q(--gg=g g), q(--hh=h h)];            #TparseCommandLineArguments
  is_deeply $r,                                                                 #TparseCommandLineArguments
    [["aaa", "bbb"],                                                            #TparseCommandLineArguments
     {c=>undef, dd=>undef, eee=>"EEEE", f=>"F", gg=>"g g", hh=>"h h"},          #TparseCommandLineArguments
    ];                                                                          #TparseCommandLineArguments
 }

if (1)
 {my $r = parseCommandLineArguments
   {ok 1;
    $_[1]
   }
   [qw(--aAa=AAA --bbB=BBB)], [qw(aaa bbb ccc)];
  is_deeply $r, {aaa=>'AAA', bbb=>'BBB'};
 }

if (1)
 {eval
  q{parseCommandLineArguments
     {$_[1]} [qw(aaa bbb ddd --aAa=AAA --dDd=DDD)], [qw(aaa bbb ccc)];
   };
  my $r = $@;
  ok $r =~ m(\AInvalid parameter: --dDd=DDD);
 }

is_deeply [qw(a b c)],                                                          #TsetIntersectionOfTwoArraysOfWords
  [setIntersectionOfTwoArraysOfWords([qw(e f g a b c )], [qw(a A b B c C)])];   #TsetIntersectionOfTwoArraysOfWords

is_deeply [qw(a b c)],                                                          #TsetUnionOfTwoArraysOfWords
  [setUnionOfTwoArraysOfWords([qw(a b c )], [qw(a b)])];                        #TsetUnionOfTwoArraysOfWords

ok printQw(qw(a  b  c)) eq "qw(a b c)";

if (1) {
  my $f = writeFile("zzz.data", "aaa");                                         #TfileSize
  ok -e $f;
  ok fileSize($f) == 3;                                                         #TfileSize
  unlink $f;
  ok !-e $f;
 }

if (1) {
  my $f = createEmptyFile(fpe(my $d = temporaryFolder, qw(a jpg)));             #TfindFileWithExtension
  my $F = findFileWithExtension(fpf($d, q(a)), qw(txt data jpg));               #TfindFileWithExtension
  ok -e $f;
  ok $F eq "jpg";                                                               #TfindFileWithExtension
  unlink $f;
  ok !-e $f;
  rmdir $d;
  ok !-d $d;
 }

if (1) {
  my $d = temporaryFolder;                                                      #TfirstFileThatExists
  ok $d eq firstFileThatExists("$d/$d", $d);                                    #TfirstFileThatExists
 }

if (1) {                                                                        #TassertRef
  eval q{assertRef(bless {}, q(aaa))};
  ok $@ =~ m(\AWanted reference to Data::Table::Text, but got aaa);
 }

if (1) {                                                                        #TassertPackageRefs
  eval q{assertPackageRefs(q(bbb), bless {}, q(aaa))};
  ok $@ =~ m(\AWanted reference to bbb, but got aaa);
 }

# Relative and absolute files
ok "../../../"              eq relFromAbsAgainstAbs("/",                    "/home/la/perl/bbb.pl");
ok "../../../home"          eq relFromAbsAgainstAbs("/home",                "/home/la/perl/bbb.pl");
ok "../../"                 eq relFromAbsAgainstAbs("/home/",               "/home/la/perl/bbb.pl");
ok "aaa.pl"                 eq relFromAbsAgainstAbs("/home/la/perl/aaa.pl", "/home/la/perl/bbb.pl");
ok "aaa"                    eq relFromAbsAgainstAbs("/home/la/perl/aaa",    "/home/la/perl/bbb.pl");
ok "./"                     eq relFromAbsAgainstAbs("/home/la/perl/",       "/home/la/perl/bbb.pl");
ok "aaa.pl"                 eq relFromAbsAgainstAbs("/home/la/perl/aaa.pl", "/home/la/perl/bbb");
ok "aaa"                    eq relFromAbsAgainstAbs("/home/la/perl/aaa",    "/home/la/perl/bbb");
ok "./"                     eq relFromAbsAgainstAbs("/home/la/perl/",       "/home/la/perl/bbb");
ok "../java/aaa.jv"         eq relFromAbsAgainstAbs("/home/la/java/aaa.jv", "/home/la/perl/bbb.pl");
ok "../java/aaa"            eq relFromAbsAgainstAbs("/home/la/java/aaa",    "/home/la/perl/bbb.pl");
ok "../java/"               eq relFromAbsAgainstAbs("/home/la/java/",       "/home/la/perl/bbb.pl");
ok "../../la/perl/aaa.pl"   eq relFromAbsAgainstAbs("/home/la/perl/aaa.pl", "/home/il/perl/bbb.pl");
ok "../../la/perl/aaa"      eq relFromAbsAgainstAbs("/home/la/perl/aaa",    "/home/il/perl/bbb.pl");
ok "../../la/perl/"         eq relFromAbsAgainstAbs("/home/la/perl/",       "/home/il/perl/bbb.pl");
ok "../../la/perl/aaa.pl"   eq relFromAbsAgainstAbs("/home/la/perl/aaa.pl", "/home/il/perl/bbb");
ok "../../la/perl/aaa"      eq relFromAbsAgainstAbs("/home/la/perl/aaa",    "/home/il/perl/bbb");
ok "../../la/perl/"         eq relFromAbsAgainstAbs("/home/la/perl/",       "/home/il/perl/bbb");
ok "../../la/perl/"         eq relFromAbsAgainstAbs("/home/la/perl/",       "/home/il/perl/bbb");
ok "../../la/perl/aaa"      eq relFromAbsAgainstAbs("/home/la/perl/aaa",    "/home/il/perl/");
ok "../../la/perl/"         eq relFromAbsAgainstAbs("/home/la/perl/",       "/home/il/perl/");
ok "../../la/perl/"         eq relFromAbsAgainstAbs("/home/la/perl/",       "/home/il/perl/");
ok "home/la/perl/bbb.pl"    eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/");
ok "../home/la/perl/bbb.pl" eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home");
ok "la/perl/bbb.pl"         eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/");
ok "bbb.pl"                 eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/perl/aaa.pl");  #TrelFromAbsAgainstAbs
ok "bbb.pl"                 eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/perl/aaa");
ok "bbb.pl"                 eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/perl/");
ok "bbb"                    eq relFromAbsAgainstAbs("/home/la/perl/bbb",    "/home/la/perl/aaa.pl");
ok "bbb"                    eq relFromAbsAgainstAbs("/home/la/perl/bbb",    "/home/la/perl/aaa");
ok "bbb"                    eq relFromAbsAgainstAbs("/home/la/perl/bbb",    "/home/la/perl/");
ok "../perl/bbb.pl"         eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/java/aaa.jv");  #TrelFromAbsAgainstAbs
ok "../perl/bbb.pl"         eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/java/aaa");
ok "../perl/bbb.pl"         eq relFromAbsAgainstAbs("/home/la/perl/bbb.pl", "/home/la/java/");
ok "../../il/perl/bbb.pl"   eq relFromAbsAgainstAbs("/home/il/perl/bbb.pl", "/home/la/perl/aaa.pl");
ok "../../il/perl/bbb.pl"   eq relFromAbsAgainstAbs("/home/il/perl/bbb.pl", "/home/la/perl/aaa");
ok "../../il/perl/bbb.pl"   eq relFromAbsAgainstAbs("/home/il/perl/bbb.pl", "/home/la/perl/");
ok "../../il/perl/bbb"      eq relFromAbsAgainstAbs("/home/il/perl/bbb",    "/home/la/perl/aaa.pl");
ok "../../il/perl/bbb"      eq relFromAbsAgainstAbs("/home/il/perl/bbb",    "/home/la/perl/aaa");
ok "../../il/perl/bbb"      eq relFromAbsAgainstAbs("/home/il/perl/bbb",    "/home/la/perl/");
ok "../../il/perl/bbb"      eq relFromAbsAgainstAbs("/home/il/perl/bbb",    "/home/la/perl/");
ok "../../il/perl/"         eq relFromAbsAgainstAbs("/home/il/perl/",       "/home/la/perl/aaa");
ok "../../il/perl/"         eq relFromAbsAgainstAbs("/home/il/perl/",       "/home/la/perl/");
ok "../../il/perl/"         eq relFromAbsAgainstAbs("/home/il/perl/",       "/home/la/perl/");

ok "/"                      eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "../../..");
ok "/home"                  eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "../../../home");
ok "/home/"                 eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "../..");
ok "/home/la/perl/aaa.pl"   eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "aaa.pl");
ok "/home/la/perl/aaa"      eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "aaa");
ok "/home/la/perl/"         eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "");
ok "/home/la/perl/aaa.pl"   eq absFromAbsPlusRel("/home/la/perl/bbb",      "aaa.pl");                 #TabsFromAbsPlusRel
ok "/home/la/perl/aaa"      eq absFromAbsPlusRel("/home/la/perl/bbb",      "aaa");
ok "/home/la/perl/"         eq absFromAbsPlusRel("/home/la/perl/bbb",      "");
ok "/home/la/java/aaa.jv"   eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "../java/aaa.jv");
ok "/home/la/java/aaa"      eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "../java/aaa");
ok "/home/la/java"          eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "../java");
ok "/home/la/java/"         eq absFromAbsPlusRel("/home/la/perl/bbb.pl",   "../java/");
ok "/home/la/perl/aaa.pl"   eq absFromAbsPlusRel("/home/il/perl/bbb.pl",   "../../la/perl/aaa.pl");    #TabsFromAbsPlusRel
ok "/home/la/perl/aaa"      eq absFromAbsPlusRel("/home/il/perl/bbb.pl",   "../../la/perl/aaa");
ok "/home/la/perl"          eq absFromAbsPlusRel("/home/il/perl/bbb.pl",   "../../la/perl");
ok "/home/la/perl/"         eq absFromAbsPlusRel("/home/il/perl/bbb.pl",   "../../la/perl/");
ok "/home/la/perl/aaa.pl"   eq absFromAbsPlusRel("/home/il/perl/bbb",      "../../la/perl/aaa.pl");
ok "/home/la/perl/aaa"      eq absFromAbsPlusRel("/home/il/perl/bbb",      "../../la/perl/aaa");
ok "/home/la/perl"          eq absFromAbsPlusRel("/home/il/perl/bbb",      "../../la/perl");
ok "/home/la/perl/"         eq absFromAbsPlusRel("/home/il/perl/bbb",      "../../la/perl/");
ok "/home/la/perl/aaa"      eq absFromAbsPlusRel("/home/il/perl/",         "../../la/perl/aaa");
ok "/home/la/perl"          eq absFromAbsPlusRel("/home/il/perl/",         "../../la/perl");
ok "/home/la/perl/"         eq absFromAbsPlusRel("/home/il/perl/",         "../../la/perl/");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/",                      "home/la/perl/bbb.pl");
#ok "/home/la/perl/bbb.pl"  eq absFromAbsPlusRel("/home",                  "../home/la/perl/bbb.pl");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/home/",                 "la/perl/bbb.pl");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/perl/aaa.pl",   "bbb.pl");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/perl/aaa",      "bbb.pl");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/perl/",         "bbb.pl");
ok "/home/la/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/aaa.pl",   "bbb");
ok "/home/la/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/aaa",      "bbb");
ok "/home/la/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/aaa",      "bbb");
ok "/home/la/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/",         "bbb");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/java/aaa.jv",   "../perl/bbb.pl");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/java/aaa",      "../perl/bbb.pl");
ok "/home/la/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/java/",         "../perl/bbb.pl");
ok "/home/il/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/perl/aaa.pl",   "../../il/perl/bbb.pl");
ok "/home/il/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/perl/aaa",      "../../il/perl/bbb.pl");
ok "/home/il/perl/bbb.pl"   eq absFromAbsPlusRel("/home/la/perl/",         "../../il/perl/bbb.pl");
ok "/home/il/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/aaa.pl",   "../../il/perl/bbb");
ok "/home/il/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/aaa",      "../../il/perl/bbb");
ok "/home/il/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/",         "../../il/perl/bbb");
ok "/home/il/perl/bbb"      eq absFromAbsPlusRel("/home/la/perl/",         "../../il/perl/bbb");
ok "/home/il/perl"          eq absFromAbsPlusRel("/home/la/perl/aaa",      "../../il/perl");
ok "/home/il/perl/"         eq absFromAbsPlusRel("/home/la/perl/",         "../../il/perl/");

ˢ{my $f = {};                                                                   #TtitleToUniqueFileName
  ok q(a_p.txt)   eq &titleToUniqueFileName($f, qw(a p txt));                   #TtitleToUniqueFileName
  ok q(a_p_2.txt) eq &titleToUniqueFileName($f, qw(a p txt));                   #TtitleToUniqueFileName
  ok q(a_p_3.txt) eq &titleToUniqueFileName($f, qw(a p txt));                   #TtitleToUniqueFileName
  ok q(a_q.txt)   eq &titleToUniqueFileName($f, qw(a q txt));                   #TtitleToUniqueFileName
  ok q(a_q_5.txt) eq &titleToUniqueFileName($f, qw(a q txt));                   #TtitleToUniqueFileName
  ok q(a_q_6.txt) eq &titleToUniqueFileName($f, qw(a q txt));                   #TtitleToUniqueFileName
 };

ok fp (q(a/b/c.d.e))  eq q(a/b/);                                               #Tfp
ok fpn(q(a/b/c.d.e))  eq q(a/b/c.d);                                            #Tfpn
ok fn (q(a/b/c.d.e))  eq q(c.d);                                                #Tfn
ok fne(q(a/b/c.d.e))  eq q(c.d.e);                                              #Tfne
ok fe (q(a/b/c.d.e))  eq q(e);                                                  #Tfe
ok fp (q(/a/b/c.d.e)) eq q(/a/b/);
ok fpn(q(/a/b/c.d.e)) eq q(/a/b/c.d);
ok fn (q(/a/b/c.d.e)) eq q(c.d);
ok fne(q(/a/b/c.d.e)) eq q(c.d.e);
ok fe (q(/a/b/c.d.e)) eq q(e);

if (!$windows) {
ˢ{our $a = q(1);                                                                #Tcall
  our @a = qw(1);
  our %a = (a=>1);
  our $b = q(1);
  for(2..4) {
    call {$a = $_  x 1000; $a[0] = $_; $a{a} = $_; $b = 2;} qw($a @a %a);
    ok $a    == $_ x 1000;
    ok $a[0] == $_;
    ok $a{a} == $_;
    ok $b    == 1;
   }
 };
 }
else
 {ok 1 for 1..12;
 }

ˢ{ok q(../a/) eq fp q(../a/b.c);
  ok q(b)     eq fn q(../a/b.c);
  ok q(c)     eq fe q(../a/b.c);
 };

ok wwwEncode(q(a  b c)) eq q(a%20%20b%20c);                                     #TwwwEncode

ok quoteFile(fpe(qw(a b c))) eq q("a/b.c");                                     #TquoteFile
ok printQw(qw(a b c)) eq q(qw(a b c));                                          #TprintQw

if (!$windows) {
  my $D = temporaryFolder;                                                      #TtemporaryFolder #TcreateEmptyFile #TclearFolder #TfileList #TfindFiles #TsearchDirectoryTreesForMatchingFiles #TfindDirs
  my $d = fpd($D, q(ddd));                                                                        #TcreateEmptyFile #TclearFolder #TfileList #TfindFiles #TsearchDirectoryTreesForMatchingFiles #TfindDirs
  my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);                                  #TcreateEmptyFile #TclearFolder #TfileList #TfindFiles #TsearchDirectoryTreesForMatchingFiles #TfindDirs
  is_deeply [sort map {fne $_} findFiles($d, qr(txt\Z))], [qw(a.txt b.txt c.txt)];                #TcreateEmptyFile                          #TfindFiles
  is_deeply [findDirs($D)], [$D, $d];                                                                                                                                                           #TfindDirs
  is_deeply [sort map {fne $_} searchDirectoryTreesForMatchingFiles($d)],                                                                                     #TsearchDirectoryTreesForMatchingFiles
            ["a.txt", "b.txt", "c.txt"];                                                                                                                 #TsearchDirectoryTreesForMatchingFiles
  is_deeply [sort map {fne $_} fileList("$d/*.txt")],                                                                             #TfileList
            ["a.txt", "b.txt", "c.txt"];                                                                                          #TfileList
  ok -e $_ for @f;
  clearFolder($D, 5);                                                                                               #TclearFolder
  ok !-e $_ for @f;                                                                                                 #TclearFolder
  ok !-d $D;                                                                                                        #TclearFolder
 }
else                                                                            # searchDirectoryTreesForMatchingFiles uses find which does not work identically to Linux on Windows
 {ok 1 for 1..11;
 }

if (1) {
  my $f = writeFile(undef, "aaa");                                              #TwriteFile #TreadFile #TappendFile
  my $s = readFile($f);                                                         #TwriteFile #TreadFile #TappendFile
  ok $s eq "aaa";                                                               #TwriteFile #TreadFile #TappendFile
  appendFile($f, "bbb");                                                        #TwriteFile #TreadFile #TappendFile
  my $S = readFile($f);                                                         #TwriteFile #TreadFile #TappendFile
  ok $S eq "aaabbb";                                                            #TwriteFile #TreadFile #TappendFile
  unlink $f;
 }

if (1) {
  no utf8;
  my $f = writeBinaryFile(undef, 0xff x 8);                                     #TwriteBinaryFile #TreadBinaryFile
  my $s = readBinaryFile($f);                                                   #TwriteBinaryFile #TreadBinaryFile
  ok $s eq 0xff x 8;                                                            #TwriteBinaryFile #TreadBinaryFile
  unlink $f;
 }

if (!$windows) {
  my $d = fpd(my $D = temporaryDirectory, qw(a));                               #TmakePath #TtemporaryDirectory
  my $f = fpe($d, qw(bbb txt));                                                 #TmakePath
  ok !-d $d;                                                                    #TmakePath
  eval q{checkFile($f)};
  my $r = $@;
  my $q = quotemeta($D);
  ok nws($r) =~ m(Can only find.+?: $q)s;
  makePath($f);                                                                 #TmakePath
  ok -d $d;                                                                     #TmakePath
  ok -d $D;
  rmdir $_ for $d, $D;
 }
else {ok 1 for 1..4}

ok nws(qq(a  b    c)) eq q(a b c);                                              #Tnws
ok ˢ{1} == 1;                                                                   #Tˢ

if (0) {                                                                        # Despite eval the confess seems to be killing the process - perhaps the confess is just too big?
  eval q{checkKeys({a=>1, b=>2, d=>3}, {a=>1, b=>2, c=>3})};                    #TcheckKeys
  ok nws($@) =~ m(\AInvalid options chosen: d Permitted.+?: a 1 b 2 c 3);       #TcheckKeys
 }

if (1) {
  my $d = [[qw(a 1)], [qw(bb 22)], [qw(ccc 333)], [qw(dddd 4444)]];             #TformatTableBasic
  ok formatTableBasic($d) eq <<END;                                             #TformatTableBasic
a        1
bb      22
ccc    333
dddd  4444
END
  }

if (0) {                                                                        #TstartProcess #TwaitForAllStartedProcessesToFinish
  my %pids;
  ˢ{startProcess {} %pids, 1; ok 1 >= keys %pids} for 1..8;
  waitForAllStartedProcessesToFinish(%pids);
  ok !keys(%pids)
 }

if (!$windows) {
ok dateTimeStamp     =~ m(\A\d{4}-\d\d-\d\d at \d\d:\d\d:\d\d\Z);               #TdateTimeStamp
ok dateStamp         =~ m(\A\d{4}-\w{3}-\d\d\Z);                                #TdateStamp
ok versionCode       =~ m(\A\d{8}-\d{6}\Z);                                     #TversionCode
ok versionCodeDashed =~ m(\A\d{4}-\d\d-\d\d-\d\d:\d\d:\d\d\Z);                  #TversionCodeDashed
ok timeStamp         =~ m(\A\d\d:\d\d:\d\d\Z);                                  #TtimeStamp
ok microSecondsSinceEpoch > 47*365*24*60*60*1e6;                                #TmicroSecondsSinceEpoch
 }
else
 {ok 1 for 1..6;
 }

if (0) {
  saveCodeToS3(1200, q(projectName), q(bucket/folder), q(--only-show-errors));  #TsaveCodeToS3
  my ($width, $height) = imageSize(fpe(qw(a image jpg)));                       #TimageSize
  addCertificate(fpf(qw(.ssh cert)));                                           #TaddCertificate
  binModeAllUtf8;                                                               #TbinModeAllUtf8
  convertImageToJpx(fpe(qw(a image jpg)), fpe(qw(a image jpg)), 256);           #TconvertImageToJpx
  currentDirectory;                                                             #TcurrentDirectory
  currentDirectoryAbove;                                                        #TcurrentDirectoryAbove
  fullFileName(fpe(qw(a txt)));                                                 #TfullFileName
  convertDocxToFodt(fpe(qw(a docx)), fpe(qw(a fodt)));                          #TconvertDocxToFodt
  cutOutImagesInFodtFile(fpe(qw(source fodt)), fpd(qw(images)), q(image));      #TcutOutImagesInFodtFile
  userId;                                                                       #TuserId
  hostName;                                                                     #ThostName
  makeDieConfess                                                                #TmakeDieConfess
  ipAddressViaArp(q(secarias));                                                 #TipAddressViaArp
 }

ok nws(htmlToc("XXXX", <<END)), 'htmlToc'                                       #ThtmlToc
<h1 id="1" otherprops="1">Chapter 1</h1>
  <h2 id="11" otherprops="11">Section 1</h1>
<h1 id="2" otherprops="2">Chapter 2</h1>
XXXX
END
  eq nws(<<END);                                                                #ThtmlToc
<h1 id="1" otherprops="1">Chapter 1</h1>
  <h2 id="11" otherprops="11">Section 1</h1>
<h1 id="2" otherprops="2">Chapter 2</h1>
<table cellspacing=10 border=0>
<tr><td>&nbsp;
<tr><td align=right>1<td>&nbsp;&nbsp;&nbsp;&nbsp;<a href="#1">Chapter 1</a>
<tr><td align=right>2<td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href="#11">Section 1</a>
<tr><td>&nbsp;
<tr><td align=right>3<td>&nbsp;&nbsp;&nbsp;&nbsp;<a href="#2">Chapter 2</a>
</table>
END

ok fileModTime($0) =~ m(\A\d+\Z)s;                                              #TfileModTime

if (1)
 {my $s = updateDocumentation(<<'END' =~ s(!) (#)gsr =~ s(~) ()gsr);            #TupdateDocumentation
package Sample::Module;

!D1 Samples                                                                      ! Sample methods.

sub sample($@)                                                                  !R Documentation for the:  sample() method.  See also L<Data::Table::Text::sample2|/Data::Table::Text::sample2>. !Tsample
 {my ($node, @context) = @_;                                                    ! Node, optional context
  1
 }

~BEGIN{*smpl=*sample}

sub Data::Table::Text::sample2(\&@)                                             !PS Documentation for the sample2() method.
 {my ($sub, @context) = @_;                                                     ! Sub to call, context.
  1
 }

ok sample(undef, qw(a b c)) == 1;                                               !Tsample

if (1)                                                                          !Tsample
 {ok sample(q(a), qw(a b c))  == 2;
  ok sample(undef, qw(a b c)) == 1;
 }

ok sample(<<END2)) == 1;                                                        !Tsample
sample data
END2

END
  ok $s =~ m'=head2 sample\x28\$\@\x29';                                        #TupdateDocumentation
 }

if (1) {
  my $f = dumpFile(undef, [qw(aaa bbb ccc)]);                                   #TdumpFile #TevalFile #ToverWriteFile
  my $s = evalFile($f);                                                         #TdumpFile #TevalFile
  is_deeply $s, [qw(aaa bbb ccc)];                                              #TdumpFile #TevalFile

  ok overWriteFile($f, q({qw(aaa bbb ccc)]));                                   #ToverWriteFile
  $s = eval q{ evalFile($f) };
  ok $@ =~ m(\Asyntax error);
  unlink $f;
 }

ok 3 == maximumLineLength(<<END);                                               #TmaximumLineLength
a
bb
ccc
END

ok boldString(q(zZ)) eq q(𝘇𝗭);                                                  #TboldString
ok enclosedString(q(hello world 1234)) eq q(ⓗⓔⓛⓛⓞ ⓦⓞⓡⓛⓓ ①②③④);        #TenclosedString
ok enclosedReversedString(q(hello world 1234)) eq q(🅗🅔🅛🅛🅞 🅦🅞🅡🅛🅓 ➊➋➌➍);  #TenclosedReversedString

ok superScriptString(1234567890) eq q(¹²³⁴⁵⁶⁷⁸⁹⁰);                              #TsuperScriptString
ok subScriptString(1234567890)   eq q(₁₂₃₄₅₆₇₈₉₀);                              #TsubScriptString

if (1)                                                                          #TboldStringUndo #TenclosedStringUndo #TenclosedReversedStringUndo #TsuperScriptStringUndo #TsubScriptStringUndo
 {my $n = 1234567890;
  ok boldStringUndo            (boldString($n))             == $n;
  ok enclosedStringUndo        (enclosedString($n))         == $n;
  ok enclosedReversedStringUndo(enclosedReversedString($n)) == $n;
  ok superScriptStringUndo     (superScriptString($n))      == $n;
  ok subScriptStringUndo       (subScriptString($n))        == $n;
 }

if (!$windows) {
if (1) {                                                                        #TwriteGZipFile #TreadGZipFile
  my $s = '𝝰'x1e3;
  my $file = writeGZipFile(q(zzz.zip), $s);
  ok -e $file;
  my $S = readGZipFile($file);
  ok $s eq $S;
  ok length($s) == length($S);
  unlink $file;
 }
 }
else
 {ok 1, "gz$_" for 1..3
 }

if (!$windows) {
if (1) {                                                                        #TdumpGZipFile #TevalGZipFile
  my $d = [1, 2, 3=>{a=>4, b=>5}];
  my $file = dumpGZipFile(q(zzz.zip), $d);
  ok -e $file;
  my $D = evalGZipFile($file);
  is_deeply $d, $D;
  unlink $file;
 }
 }
else
 {ok 1, "egz$_" for 1..2
 }

if (1)
 {my $t = formatTableBasic([["a",undef], [undef, "b\nc"]]);
  ok $t eq <<END;
a
   b
   c
END
 }

ok firstNChars(q(abc), 2) eq q(ab);                                             #TfirstNChars
ok firstNChars(q(abc), 4) eq q(abc);                                            #TfirstNChars

if (1)
 {my $t = formatTable([["a",undef], [undef, "b\nc"]], [undef, undef]);
  ok $t eq <<END;
1  a
2     b
      c
END
 }

if (1) {                                                                        #TformatTable
  my $file = fpe(qw(report txt));                                               # Create a report
  my $t = formatTable
   ([["a",undef], [undef, "b\x0ac"]],                                           # Data - please replace 0a with a new line
    [undef, "BC"],                                                              # Column titles
    file=>$file,                                                                # Output file
    head=><<END);                                                               # Header
Sample report.

Table has NNNN rows.
END
  ok -e $file;
  ok readFile($file) eq $t;
  unlink $file;
  ok $t eq <<END;
Sample report.

Table has 2 rows.


This file: report.txt

      BC
1  a
2     b
      c
END
 }

if (1)
 {my $t = "a\nb\n";
  ok numberOfLinesInString("a\nb\n") == 2;                                      #TnumberOfLinesInString
 }

if (1) {
  my $f = writeFile(undef, "a\nb\n");                                           #TnumberOfLinesInFile
  ok numberOfLinesInFile($f) == 2;                                              #TnumberOfLinesInFile
  unlink $f;
 }

ok ˢ{1};                                                                        #Tˢ

ˢ{my $s =                                                                       #Tˢ
  ˢ{if (1)
     {return q(aa) if 1;
      q(bb);
     }
   };

  ok $s eq q(aa);
 };

if (1) {                                                                        # Synopsis

# Print a table:

my $d =
 [[qq(a), qq(b\nbb), qq(c\ncc\nccc\n)],
  [qq(1), qq(1\n22), qq(1\n22\n333\n)],
 ];

my $t = formatTable($d, [qw(A BB CCC)]);

ok $t eq <<END;
   A  BB  CCC
1  a  b   c
      bb  cc
          ccc
2  1   1    1
      22   22
          333
END

# Print a table containing tables and make it into a report:

my $D = [[qq(See the\ntable\nopposite), $t],
         [qq(Or\nthis\none),            $t],
        ];


my $T = formatTable
 ($D,
 [qw(Description Table)],
  head=><<END);
Table of Tables.

Table has 2 rows each of which contains a table.
END

ok $T eq <<END;
Table of Tables.

Table has 2 rows each of which contains a table.


   Description  Table
1  See the         A  BB  CCC
   table        1  a  b   c
   opposite           bb  cc
                          ccc
                2  1   1    1
                      22   22
                          333
2  Or              A  BB  CCC
   this         1  a  b   c
   one                bb  cc
                          ccc
                2  1   1    1
                      22   22
                          333
END

# Print an array of arrays:

my $aa = formatTable
 ([[qw(A   B   C  )],
   [qw(AA  BB  CC )],
   [qw(AAA BBB CCC)],
   [qw(1   22  333)]],
   [qw (aa  bb  cc)]);

ok $aa eq <<END;
   aa   bb   cc
1  A    B    C
2  AA   BB   CC
3  AAA  BBB  CCC
4    1   22  333
END

# Print an array of hashes:

my $ah = formatTable
 ([{aa=> "A",   bb => "B",   cc => "C" },
   {aa=> "AA",  bb => "BB",  cc => "CC" },
   {aa=> "AAA", bb => "BBB", cc => "CCC" },
   {aa=> 1,     bb => 22,    cc => 333 }]);

ok $ah eq <<END;
   aa   bb   cc
1  A    B    C
2  AA   BB   CC
3  AAA  BBB  CCC
4    1   22  333
END

# Print a hash of arrays:

my $ha = formatTable
 ({""     => ["aa",  "bb",  "cc"],
   "1"    => ["A",   "B",   "C"],
   "22"   => ["AA",  "BB",  "CC"],
   "333"  => ["AAA", "BBB", "CCC"],
   "4444" => [1,      22,    333]},
   [qw(Key A B C)]
   );

ok $ha eq <<END;
Key   A    B    C
      aa   bb   cc
   1  A    B    C
  22  AA   BB   CC
 333  AAA  BBB  CCC
4444    1   22  333
END

# Print a hash of hashes:

my $hh = formatTable
 ({a    => {aa=>"A",   bb=>"B",   cc=>"C" },
   aa   => {aa=>"AA",  bb=>"BB",  cc=>"CC" },
   aaa  => {aa=>"AAA", bb=>"BBB", cc=>"CCC" },
   aaaa => {aa=>1,     bb=>22,    cc=>333 }});

ok $hh eq <<END;
      aa   bb   cc
a     A    B    C
aa    AA   BB   CC
aaa   AAA  BBB  CCC
aaaa    1   22  333
END

# Print an array of scalars:

my $a = formatTable(["a", "bb", "ccc", 4], [q(#), q(Col)]);

ok $a eq <<END;
#  Col
0  a
1  bb
2  ccc
3    4
END

# Print a hash of scalars:

my $h = formatTable({aa=>"AAAA", bb=>"BBBB", cc=>"333"}, [qw(Key Title)]);

ok $h eq <<END;
Key  Title
aa   AAAA
bb   BBBB
cc     333
END
}

if (1) {                                                                        #TstringsAreNotEqual
  ok        !stringsAreNotEqual(q(abc), q(abc));
  ok         stringsAreNotEqual(q(abc), q(abd));
  is_deeply [stringsAreNotEqual(q(abc), q(abd))], [qw(c d)];
  is_deeply [stringsAreNotEqual(q(ab),  q(abd))], ['', q(d)];
 }

if (1) {                                                                        #TgenHash #TloadHash
  my $o = genHash(q(TestHash),                                                  # Definition of a blessed hash.
      a=>q(aa),                                                                 # Definition of attribute aa.
      b=>q(bb),                                                                 # Definition of attribute bb.
     );
  ok $o->a eq q(aa);
  is_deeply $o, {a=>"aa", b=>"bb"};
  my $p = genHash(q(TestHash),
    c=>q(cc),                                                                   # Definition of attribute cc.
   );
  ok $p->c eq q(cc);
  ok $p->a =  q(aa);
  ok $p->a eq q(aa);
  is_deeply $p, {a=>"aa", c=>"cc"};

  loadHash($p, a=>11, b=>22);                                                   # Load the hash
  is_deeply $p, {a=>11, b=>22, c=>"cc"};

  my $r = eval {loadHash($p, d=>44)};                                           # Try to load the hash
  ok $@ =~ m(Cannot load attribute: d);
 }

if (1)                                                                          #TnewServiceIncarnation #TData::Exchange::Service::check
 {my $s = newServiceIncarnation("aaa", q(bbb.txt));
  is_deeply $s->check, $s;
  my $t = newServiceIncarnation("aaa", q(bbb.txt));
  is_deeply $t->check, $t;
  ok $t->start >= $s->start+1;
  ok !$s->check(1);
  unlink q(bbb.txt);
 }

#tttt

1
