#!/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 regular expression use: \x28, for close use: \x29
# perl Build.PL && perl Build test && sudo perl Build install

package Data::Table::Text;
use v5.20;
our $VERSION = 20181101;                                                        # Version
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 Scalar::Util qw(blessed reftype looks_like_number);
use Storable qw(store retrieve);
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                                                               #I Year-monthNumber-day at hours:minute:seconds
 {strftime('%Y-%m-%d at %H:%M:%S', localtime)
 }

sub dateTimeStampName                                                           # Date time stamp without white space.
 {strftime('_on_%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(@)                                                                      #I Execute a shell command optionally checking its response. 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 any non blank output generated by the execution of the command: if the regular expression fails the command and the command output are printed, else it is suppressed as being uninteresting. If such a regular expression is not supplied then the command and its non blank output lines are always printed.
 {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 = eval {qx($cmd 2>&1)} // "No such command";                     # 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
 } # xxx

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 '';
   }
 } # yyy

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
 } # zzz

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})
 } # parseCommandLineArguments

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
    my $r = $@;                                                                 # Save result
    unlink $_ for @file;                                                        # Remove transfer files
    confess "$r\n$save\n" if $r;                                                # Confess to any errors
   }
 } # call

#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 fileMd5Sum($)                                                               # Get the Md5 sum for a file
 {my ($file) = @_;                                                              # File
  my $s = qx(md5sum "$file");
  (split /\s+/, $s)[0];
 }

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
 } # fileOutOfDate

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
 } # firstFileThatExists

#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(@)                                                              #I 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($)                                                                       #I 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
  $file or confess "Undefined file to quote";
  $file =~ s(") (\\\")gs;
  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 swapFilePrefix($$$)                                                         # Swaps the start of a file name from a known name to a new one,
 {my ($file, $known, $new) = @_;                                                # File name, existing prefix, new prefix

  my $l = length($known);
  if (length($file) >= $l)
   {if (substr($file, 0, $l) eq $known)
     {return $new.substr($file, $l);
     }
   }
  confess "Known longer than file name";
 } # swapFilePrefix

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

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)
 } # currentDirectory

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);
 } # currentDirectoryAbove

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)
     }
   }
 } # parseFileName

sub fullFileName                                                                # Full name of a file.
 {my ($file) = @_;                                                              # File name
  return $file if $file =~ m(\A/)s;                                             # Already a full file name
  absFromAbsPlusRel(currentDirectory, $file);                                   # Relative to current folder
 } # fullFileName

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'"
 } # printFullFileName

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); confess unless defined $ap;
  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(/)
 } # absFromAbsPlusRel

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 @A = my ($ap, $af, $ax) = parseFileName($a);
  my @F = 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;
 } # relFromAbsAgainstAbs

sub sumAbsAndRel(@)                                                             #I Combine zero or more absolute and relative file names
 {my (@f) = @_;                                                                 # Absolute and relative file names
  return undef unless @f;
  return $f[0] unless @f > 1;

  my ($ap, $af, $ax) = parseFileName(shift @f);                                 # Parse first file
  while(@f)                                                                     # Each following file
   {my ($fp, $ff, $fx) = parseFileName(shift @f);                               # Parse following file

    if     ($fp =~ m(\A\s*\Z)s) {}                                              # Blank file path
    elsif  ($fp =~ m(\A/)s)                                                     # Absolute file path
     {$ap = $fp;
     }
    else                                                                        # Relative file path
     {my @a = split m(/), $ap;
      my @f = split m(/), $fp;
      shift @a while @a and $a[0] eq q(.);                                      # Remove leading ./
      shift @f while @f and $f[0] eq q(.);
      while(@a and @f and $f[0] eq q(..)) {pop @a; shift @f};                   # Move up through ../
      $ap =  join "/", @a, @f;
     }
    $af = $ff;                                                                  # Latest file name and extension
    $ax = $fx;
   }
  return fpe($ap, $af, $ax) if $ax;                                             # Summed file name with extension
  fpf($ap, $af)             if $af;
  fpf($ap)
 } # sumAbsAndRel

#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
 }# temporaryFile

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

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
 } # findFiles

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
 } # findDirs

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

sub searchDirectoryTreesForMatchingFiles(@)                                     #I 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
   {next unless -d $dir;
    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($$;$)                                                           #I 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. Sometimes the folder can be emptied but not removed - perhaps because it a  link, in this case a message is produced unless suppressed by the optional B<$nomsg> parameter.
 {my ($folder, $limitCount, $noMsg) = @_;                                       # Folder, maximum number of files to remove to limit damage, no message if the folder cannot be completely removed.
  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
  unless($noMsg)
   {-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($)                                                                 #I 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";
  reloadHashes($res);
  $res
 } # evalFile

sub evalGZipFile($)                                                             # Read a file containing compressed utf8, evaluate it, confess to any errors or return any result. This is much slower than using L<Storable> but does use much smaller files, see also: L<dumpGZipFile|/dumpGZipFile>.
 {my ($file) = @_;                                                              # File to read
  my $string = readGZipFile($file);
  my $res = eval $string;
  $@ and confess "$@\n";
  reloadHashes($res);
 } # evalGZipFile

sub retrieveFile($)                                                             # Retrieve a file created via L<Storable>.  This is much faster than L<evalFile|/evalFile> but the stored data is not easily modified.
 {my ($file) = @_;                                                              # File to read
  -e $file or confess "No such file: $file\n";                                  # Check file exists
  my $res = retrieve $file;                                                     # Retrieve file
  reloadHashes($res);                                                           # Reload access methods
 } # evalFile

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($$)                                                               #I 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 overWriteBinaryFile($$)                                                     # Write a binary 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 binary write to file:\n$file\n";
  makePath($file);
  open my $F, ">$file" or
    confess "Cannot open file for binary write because:\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
 }

sub writeBinaryFile($$)                                                         # Write a binary 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 "Binary file already exists:\n$file\n";
   }
  &overWriteBinaryFile(@_);
 }

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));
 } # dumpFile

sub storeFile($$)                                                               # Store a data structure to a file via L<Storable>.  This is much faster than L<dumpFile|/dumpFile> but the stored results are not easily modified.
 {my ($file, $struct) = @_;                                                     # File to write to or B<undef> for a temporary file,  address of data structure to write
  if (!$file)                                                                   # Use a temporary file or create a path to the named file
   {$file //= temporaryFile;
   }
  else
   {makePath($file);
   }
  ref($struct) or confess "storeFile requires a reference for the struct parameter";
  store $struct, $file;
  $file
 } # 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. This technique produces files that are a lot more compact files than those produced by L<Storable>, but the execution time is much longer. See also: L<evalGZipFile|/evalGZipFile>.
 {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 readFiles($)                                                                # Read all the files in a folder into a hash
 {my ($folder) = @_;                                                            # Folder to read
  my %h;
  for my $file(searchDirectoryTreesForMatchingFiles($folder))                   # Files
   {eval {$h{$file} = readFile($file)};
   }
  \%h
 } # readFiles

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 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

#D2 Copy                                                                        # Copy files and folders

sub copyFile($$)                                                                # Copy a file encoded in utf8
 {my ($source, $target) = @_;                                                   # Source file, target file
  owf($target, readFile($source));
 }

sub copyBinaryFile($$)                                                          # Copy a binary file
 {my ($source, $target) = @_;                                                   # Source file, target file
  overWriteBinaryFile($target, readBinaryFile($source));
 }

sub copyFolder($$)                                                              # Copy a folder
 {my ($source, $target) = @_;                                                   # Source file, target file
  -d $source or confess "No such folder:\n$source\n";
  makePath($target);
  xxx(qq(rsync -r $source $target), qr(\A\s*\Z));                               # Suppress command printing by supplying a regular expression to test the command output
 }

#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
 }

#sub decodeBase64Image($$)                                                       # Decode an image from Base64 and write the decoded image to a file with the appropriate extension.
# {my ($source, $file) = @_;                                                     # Base 64 string, image file name minus extension
#  my $i = $source =~ s/\s+//g;                                                  # Remove spaces
#  my ($ext) =                                                                   # Decide on image type
#    $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";
#
#  my $I = decodeBase64($i);                                                     # Decode image
#  my $f = fpf($file, $ext);                                                     # Output file
#  writeBinaryFile($f, $I);                                                      # Write image
# }

#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 mergeHashesBySummingValues(@)                                               # Merge the specified hashes by summing their values
 {my (@h) = @_;                                                                 # List of hashes to be summed
  my %h;
  for my $h(@h)
   {$h{$_} += $$h{$_} for sort keys %$h;
   }
  \%h
 }

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 (looks_like_number($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($;$%)                                                           #I 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.),
     zero=>q(Write the report even if the table is empty.),
    });

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

  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 || $zero;                 # 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($%)                                                                 #I Return a B<$bless>ed hash with the specified B<$attributes> accessible via L<lvalueMethod> method calls. 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 reloadHashes2($$)                                                           #P Ensures that all the hashes within a tower of data structures have LValue methods to get and set their current keys.
 {my ($d, $progress) = @_;                                                      # Data structure, progress
  return unless my $r = reftype($d);
  return if $$progress{$d};
  if ($d =~ m(array)is)
   {$$progress{$d}++;
    &reloadHashes2($_, $progress) for @$d;
   }
  elsif ($d =~ m(hash)is)
   {$$progress{$d}++;
    &reloadHashes2($_, $progress) for values %$d;
    if (my $b = blessed($d))
     {genHash($b, %$d);
     }
   }
 }

sub reloadHashes($)                                                             # Ensures that all the hashes within a tower of data structures have LValue methods to get and set their current keys.
 {my ($d) = @_;                                                                 # Data structure
  reloadHashes2($d, {});
  $d
 }

sub showHashes2($$$)                                                            #P Create a map of all the keys within all the hashes within a tower of data structures.
 {my ($d, $keys, $progress) = @_;                                               # Data structure, keys found, progress
  return unless my $r = reftype($d);
  return if $$progress{$d};
  if ($d =~ m(array)is)
   {$$progress{$d}++;
    &showHashes2($_, $keys, $progress) for @$d;
   }
  elsif ($d =~ m(hash)is)
   {$$progress{$d}++;
    &showHashes2($_, $keys, $progress) for values %$d;
    if (my $b = blessed($d))
     {for my $k(keys %$d)
       {$keys->{$b}{$k}++
       }
     }
   }
 }

sub showHashes($)                                                               #P Create a map of all the keys within all the hashes within a tower of data structures.
 {my ($d) = @_;                                                                 # Data structure
  showHashes2($d, my $keys = {}, {});
  $keys
 }

my %packageSearchOrder;                                                         # Method to package map

sub setPackageSearchOrder($@)                                                   # Set a package search order for methods requested in the current package via AUTOLOAD.
 {my ($set, @search) = @_;                                                      # Package to set, package names in search order.
  %packageSearchOrder = ();                                                     # Reset method to package map

  my $c  = <<'END';
if (1)
 {package $set;
  our $AUTOLOAD;                                                                # Method requested
  BEGIN{undef &AUTOLOAD};                                                       # Replace autoload
  sub AUTOLOAD
   {my $s = $AUTOLOAD;
    return if $s =~ m(Destroy)is;
    if (my $t = $packageSearchOrder{$s})                                        # Reuse a cached method if possible
     {goto &$t;
     }
    else                                                                        # Search for the first package that can provide the requested method
     {for my $package(@search)
       {my $t = $s =~ s(\A.+::) (${package}::)grs;
        if (defined &$t)
         {$packageSearchOrder{$s} = $t;
          goto &$t;
         }
       }
      confess "Cannot find a method implementing $s";                           # No package supports the requested method
     }
   }
 }
END
  my $search = q/qw(/.join(' ', @search).q/)/;                                  # Set search order
  $c =~ s(\$set)    ($set)gs;
  $c =~ s(\@search) ($search)gs;
  eval $c;
  confess "$c\n$@\n" if $@;
 }

sub isSubInPackage($$)                                                          # Test whether a subroutine is present in a package.
 {my ($package, $sub) = @_;                                                     # Package name, subroutine name
  my $r = eval qq(defined(&${package}::${sub}));
  $@ and confess $@;
  $r
 }

sub overrideMethods($$@)                                                        # For each method, if it exists in package B<$from> then export it to package B<$to> replacing any existing method in B<$to>, otherwise export the method from package B<$to> to package B<$from> in order to merge the behavior of the B<$from> and B<$to> packages with respect to the named methods with duplicates resolved if favour of package B<$from>.
 {my ($from, $to, @methods) = @_;                                               # Name of package from which to import methods, package into which to import the methods, list of methods to try importing.
  my @s;
  for my $method(@methods)                                                      # Replaceable methods
   {push @s, <<"END";
if (isSubInPackage(q($from), q($method)))
 {undef &${to}::$method;
  *${to}::$method = *${from}::$method;
 }
else
 {undef &${from}::$method;
  *${from}::$method = *${to}::$method;
 }
END
   }
  my $s = join "\n", @s;                                                        # Replace methods
  eval $s;
  confess $@ if $@;
 }

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.
 }

sub arrayToHash(@)                                                              # Create a hash from an array
 {my (@array) = @_;                                                             # Array
 +{map{$_=>1} @array}
 }

#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 common start followed by the two non equal tails of two 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;
  my @c;
  while(@a and @b and $a[0] eq $b[0])
   {shift @a; push @c, shift @b;
   }
  (join(q(), @c), 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 I 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 wwwDecode($)                                                                # Replace %20 in a string with a space.
 {my ($string) = @_;                                                            # String
  $string =~ 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 newProcessStarter($;$)                                                      #I Create a new L<process starter|/Data::Table::Text::Starter Definition> with which to start parallel processes up to a specified B<$maximumNumberOfProcesses> maximum number of parallel processes at a time, wait for all the started processes to finish and then optionally retrieve their saved results as an array from the folder named by B<$transferArea>.
 {my ($maximumNumberOfProcesses, $transferArea) = @_;                           # Maximum number of processes to start, optional folder to be used to save and retrieve results.
  genHash(q(Data::Table::Text::Starter),                                        # Process starter definition.
    transferArea             => $transferArea,                                  # The name of the folder in which files transferring results from the child to the parent process will be stored.
    maximumNumberOfProcesses => $maximumNumberOfProcesses,                      # The maximum number of processes to start in parallel at one time. If this limit is exceeded, the start of subsequent processes will be delayed until processes started earlier have finished.
    pids                     => {},                                             #P A hash of pids representing processes started but not yet completed.
    resultsArray             => [],                                             #P Consolidated array of results
   );
 }

sub Data::Table::Text::Starter::start($$)                                       # Start a new process to run the specified B<$sub>.
 {my ($starter, $sub) = @_;                                                     # Starter, sub to be run.
  $^O =~ m(MSWin32)i and confess "Not available on windows";

  while(keys(%{$starter->pids}) >= $starter->maximumNumberOfProcesses)          # Wait for enough processes to terminate to bring us below the maximum number of processes allowed.
   {$starter->waitOne;
   }

  if (my $pid = fork)                                                           # Create new process
   {$starter->pids->{$pid}++                                                    # Update pids
   }
  else                                                                          # Run sub in new process
   {my $results = &$sub;                                                        # Execute sub and address results
    if (my $t = $starter->transferArea)                                         # Transfer folder
     {my $f = fpe($t, $$, q(data));                                             # Transfer file in transfer folder
      makePath($f);
      my $e = qq(store [\$results], \$f);                                       # Store data
      eval $e;                                                                  # Execute
      $@ and confess "$@\n$e\n";                                                # Confess to any errors
     }
    exit;
   }
 }

sub Data::Table::Text::Starter::waitOne($)                                      #P Wait for one process to finish and consolidate its results.
 {my ($starter) = @_;                                                           # Starter

  while(keys(%{$starter->pids}) and my $p = waitpid 0,0)                        # Wait for a process to finish
   {if ($starter->pids->{$p})                                                   # One of ours and it has data to transfer
     {if (my $t = $starter->transferArea)                                       # Transfer folder
       {my $f = fpe($t, $p, q(data));                                           # Transfer file in transfer folder
        my $d = retrieve $f;                                                    # Retrieve data
        my $s = q(@);                                                           # At sign
        my $e = qq(push ${s}{\$starter->resultsArray}, $s\$d);                  # Save data in parent
        eval $e;                                                                # Execute
        $@ and confess "$@\n$e\n";                                              # Confess to any errors
       }
      delete $starter->pids->{$p};
      last;
     }
   }
 }

sub Data::Table::Text::Starter::finish($)                                       # Wait for all started processes to finish and return their results as an array.
 {my ($starter) = @_;                                                           # Starter

  while(keys(%{$starter->pids}) > 0)                                            # Wait for all started processes to terminate
   {$starter->waitOne;
   }

  @{$starter->resultsArray}                                                     # Return results
 }

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 for a Perl module from the comments in its source code. 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 %attributes;                                                               # Attributes defined in this package, the values of this hash are the flags for the attribute
  my %attributeDescription;                                                     # Description of each attribute
  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 $version;                                                                  # Version of package being documented

  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 = $version = $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
   }

  if (1)                                                                        # Document description
   {my $v = $version ? "\n\nVersion $version.\n" : "";
    push @doc, <<"END";
`head1 Description
$oneLineDescription$v

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
          my $L = $l + 1;
          $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
        my $L = $l + 1;
        $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 generated lvalue * method = sub name comment
     /\Asub\s*(\w+)\s*{.*}\s*#(\w*)\s+(.*)\Z/)
     {my ($name, $flags, $description) = ($1, $2, $3);                          # Name of attribute, flags, description from comment
      $attributes{$name}           = $flags;
      $attributeDescription{$name} = $description;
     }
    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
       "\nB<Example:>\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, '\nB<Example:>\m', map {"  $_"} @examples;
         }
       }

      push @method, <<END if $replace;                                          # Optionally replaceable

You can provide you own implementation of this method in your calling package
via:

  sub $name {...}

if you wish to override the default processing supplied by this method.

END


      push @method, <<END if $Replace;                                          # Required replaceable

You must supply an implementation of this method in your package via:

  sub $name {...}

END

      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 (my @a = sort keys %attributes)
   {push my @d, qq(\n), qq(=head1 Attributes\n\n);
    push @d, <<"END";
The following is a list of all the attributes in this package.  A method coded
with the same name in your package will over ride the method of the same name
in this package and thus provide your value for the attribute in place of the
default value supplied for this attribute by this package.

`head2 Replaceable Attribute List

END
    push @d, join ' ', @a, "\n\n";
    for my $name(@a)
     {my $d = $attributeDescription{$name};
      push @d, qq(=head2 $name\n\n$d\n\n);
     }
    push @doc, @d;
   }

  if (my @r = sort keys %replace)
   {push @doc, qq(\n), <<END;
`head1 Optional Replace Methods

The following is a list of all the optionally replaceable methods in this
package.  A method coded with the same name in your package will over ride the
method of the same name in this package providing your preferred processing for
the replaced method in place of the default processing supplied by this
package. If you do not supply such an over riding method, the existing method
in this package will be used instead.

`head2 Replaceable Method List

END
    push @doc, join ' ', @r, "\n\n";
   }

  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 adopt appendFile
arrayToHash assertRef assertPackageRefs
binModeAllUtf8 boldString boldStringUndo
call checkFile checkFilePath checkFilePathExt checkFilePathDir
checkKeys clearFolder contains containingPowerOfTwo
convertDocxToFodt convertImageToJpx convertUnicodeToXml
copyBinaryFile copyFile copyFolder
createEmptyFile currentDirectory currentDirectoryAbove cutOutImagesInFodtFile
dateStamp dateTimeStamp dateTimeStampName decodeJson decodeBase64 dumpFile dumpGZipFile
enclosedString enclosedStringUndo enclosedReversedString enclosedReversedStringUndo
encodeJson encodeBase64 evalFile evalGZipFile
fileList fileMd5Sum 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 isSubInPackage overrideMethods indentString ipAddressViaArp isBlank
javaPackage javaPackageAsFileName
keyCount
loadArrayArrayFromLines loadArrayFromLines loadArrayHashFromLines
loadHash loadHashArrayFromLines loadHashFromLines loadHashHashFromLines
makeDieConfess
makePath matchPath max microSecondsSinceEpoch min
newServiceIncarnation newProcessStarter numberOfLinesInFile numberOfLinesInString
nws
overWriteBinaryFile overWriteFile owf
pad parseFileName parseCommandLineArguments powerOfTwo printFullFileName printQw
quoteFile
readBinaryFile readFile readGZipFile readUtf16File relFromAbsAgainstAbs reloadHashes removeBOM removeFilePrefix
retrieveFile
saveCodeToS3 saveSourceToS3 searchDirectoryTreesForMatchingFiles
setIntersectionOfTwoArraysOfWords setPackageSearchOrder
setUnionOfTwoArraysOfWords startProcess
storeFile stringsAreNotEqual
superScriptString superScriptStringUndo subScriptString subScriptStringUndo
swapFilePrefix
temporaryDirectory temporaryFile temporaryFolder timeStamp trackFiles trim
updateDocumentation updatePerlModuleDocumentation userId
versionCode versionCodeDashed
waitForAllStartedProcessesToFinish wwwDecode 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.


Version 20181101.


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 Immediately useful methods

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


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. Sometimes the folder can be emptied but not removed - perhaps because it a  link, in this case a message is produced unless suppressed by the optional B<$nomsg> parameter.

L<dateTimeStamp|/dateTimeStamp>

Year-monthNumber-day at hours:minute:seconds

L<filePathExt|/filePathExt>

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

L<fn|/fn>

Remove path and extension from file name.

L<formatTable|/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:

L<genHash|/genHash>

Return a B<$bless>ed hash with the specified B<$attributes> accessible via L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> method calls. 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.

L<newProcessStarter|/newProcessStarter>

Create a new L<process starter|/Data::Table::Text::Starter Definition> with which to start parallel processes up to a specified B<$maximumNumberOfProcesses> maximum number of parallel processes at a time, wait for all the started processes to finish and then optionally retrieve their saved results as an array from the folder named by B<$transferArea>.

L<readFile|/readFile>

Read a file containing unicode in utf8.

L<searchDirectoryTreesForMatchingFiles|/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.

L<sumAbsAndRel|/sumAbsAndRel>

Combine zero or more absolute and relative file names

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.

L<xxx|/xxx>

Execute a shell command optionally checking its response. 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 any non blank output generated by the execution of the command: if the regular expression fails the command and the command output are printed, else it is suppressed as being uninteresting. If such a regular expression is not supplied then the command and its non blank output lines are always printed.




=head1 Time stamps

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

=head2 dateTimeStamp()

Year-monthNumber-day at hours:minute:seconds


B<Example:>


  ok 𝗱𝗮𝘁𝗲𝗧𝗶𝗺𝗲𝗦𝘁𝗮𝗺𝗽     =~ m(\A\d{4}-\d\d-\d\d at \d\d:\d\d:\d\d\Z);               
  

=head2 dateTimeStampName()

Date time stamp without white space.


B<Example:>


  ok 𝗱𝗮𝘁𝗲𝗧𝗶𝗺𝗲𝗦𝘁𝗮𝗺𝗽𝗡𝗮𝗺𝗲 =~ m(\A_on_\d{4}_\d\d_\d\d_at_\d\d_\d\d_\d\d\Z);           
  

=head2 dateStamp()

Year-monthName-day


B<Example:>


  ok 𝗱𝗮𝘁𝗲𝗦𝘁𝗮𝗺𝗽         =~ m(\A\d{4}-\w{3}-\d\d\Z);                                
  

=head2 versionCode()

YYYYmmdd-HHMMSS


B<Example:>


  ok 𝘃𝗲𝗿𝘀𝗶𝗼𝗻𝗖𝗼𝗱𝗲       =~ m(\A\d{8}-\d{6}\Z);                                     
  

=head2 versionCodeDashed()

YYYY-mm-dd-HH:MM:SS


B<Example:>


  ok 𝘃𝗲𝗿𝘀𝗶𝗼𝗻𝗖𝗼𝗱𝗲𝗗𝗮𝘀𝗵𝗲𝗱 =~ m(\A\d{4}-\d\d-\d\d-\d\d:\d\d:\d\d\Z);                  
  

=head2 timeStamp()

hours:minute:seconds


B<Example:>


  ok 𝘁𝗶𝗺𝗲𝗦𝘁𝗮𝗺𝗽         =~ m(\A\d\d:\d\d:\d\d\Z);                                  
  

=head2 microSecondsSinceEpoch()

Micro seconds since unix epoch.


B<Example:>


  ok 𝗺𝗶𝗰𝗿𝗼𝗦𝗲𝗰𝗼𝗻𝗱𝘀𝗦𝗶𝗻𝗰𝗲𝗘𝗽𝗼𝗰𝗵 > 47*365*24*60*60*1e6;                                
  

=head1 Command execution

Various ways of processing commands.

=head2 xxx(@)

Execute a shell command optionally checking its response. 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 any non blank output generated by the execution of the command: if the regular expression fails the command and the command output are printed, else it is suppressed as being uninteresting. If such a regular expression is not supplied then the command and its non blank output lines are always printed.

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

B<Example:>


   {ok 𝘅𝘅𝘅("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

B<Example:>


    ok !𝘆𝘆𝘆 <<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

B<Example:>


  ok 𝘇𝘇𝘇(<<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

B<Example:>


    my $r = 𝗽𝗮𝗿𝘀𝗲𝗖𝗼𝗺𝗺𝗮𝗻𝗱𝗟𝗶𝗻𝗲𝗔𝗿𝗴𝘂𝗺𝗲𝗻𝘁𝘀 {[@_]}                                      
  
     [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

B<Example:>


  ˢ{our $a = q(1);                                                                
    our @a = qw(1);
    our %a = (a=>1);
    our $b = q(1);
    for(2..4) {
      𝗰𝗮𝗹𝗹 {$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

B<Example:>


    my $f = writeFile("zzz.data", "aaa");                                         
  
    ok 𝗳𝗶𝗹𝗲𝗦𝗶𝘇𝗲($f) == 3;                                                         
  

=head3 fileMd5Sum($)

Get the Md5 sum for a file

     Parameter  Description
  1  $file      File

B<Example:>


    𝗳𝗶𝗹𝗲𝗠𝗱𝟱𝗦𝘂𝗺(q(/etc/hosts));                                                    
  

=head3 fileModTime($)

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

     Parameter  Description
  1  $file      File name

B<Example:>


  ok 𝗳𝗶𝗹𝗲𝗠𝗼𝗱𝗧𝗶𝗺𝗲($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

B<Example:>


  if (0) {                                                                        
    my @Files = qw(a b c);
    my @files = (@Files, qw(d));
    writeFile($_, $_), sleep 1 for @Files;
  
    my $a = '';
    my @a = 𝗳𝗶𝗹𝗲𝗢𝘂𝘁𝗢𝗳𝗗𝗮𝘁𝗲 {$a .= $_} q(a), @files;
    ok $a eq 'da';
    is_deeply [@a], [qw(d a)];
  
    my $b = '';
    my @b = 𝗳𝗶𝗹𝗲𝗢𝘂𝘁𝗢𝗳𝗗𝗮𝘁𝗲 {$b .= $_} q(b), @files;
    ok $b eq 'db';
    is_deeply [@b], [qw(d b)];
  
    my $c = '';
    my @c = 𝗳𝗶𝗹𝗲𝗢𝘂𝘁𝗢𝗳𝗗𝗮𝘁𝗲 {$c .= $_} q(c), @files;
    ok $c eq 'dc';
    is_deeply [@c], [qw(d c)];
  
    my $d = '';
    my @d = 𝗳𝗶𝗹𝗲𝗢𝘂𝘁𝗢𝗳𝗗𝗮𝘁𝗲 {$d .= $_} q(d), @files;
    ok $d eq 'd';
    is_deeply [@d], [qw(d)];
  
    my @A = 𝗳𝗶𝗹𝗲𝗢𝘂𝘁𝗢𝗳𝗗𝗮𝘁𝗲 {} q(a), @Files;
    my @B = 𝗳𝗶𝗹𝗲𝗢𝘂𝘁𝗢𝗳𝗗𝗮𝘁𝗲 {} q(b), @Files;
    my @C = 𝗳𝗶𝗹𝗲𝗢𝘂𝘁𝗢𝗳𝗗𝗮𝘁𝗲 {} 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

B<Example:>


    my $d = temporaryFolder;                                                      
  
    ok $d eq 𝗳𝗶𝗿𝘀𝘁𝗙𝗶𝗹𝗲𝗧𝗵𝗮𝘁𝗘𝘅𝗶𝘀𝘁𝘀("$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

B<Example:>


  if (1) {                                                                             
    ok 𝗳𝗶𝗹𝗲𝗣𝗮𝘁𝗵   (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

B<Example:>


  if (1) {                                                                             
    ok filePath   (qw(/aaa bbb ccc ddd.eee)) eq "/aaa/bbb/ccc/ddd.eee";
    ok 𝗳𝗶𝗹𝗲𝗣𝗮𝘁𝗵𝗗𝗶𝗿(qw(/aaa bbb ccc ddd))     eq "/aaa/bbb/ccc/ddd/";
    ok 𝗳𝗶𝗹𝗲𝗣𝗮𝘁𝗵𝗗𝗶𝗿('', qw(aaa))              eq "aaa/";
    ok 𝗳𝗶𝗹𝗲𝗣𝗮𝘁𝗵𝗗𝗶𝗿('')                       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

B<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 𝗳𝗶𝗹𝗲𝗣𝗮𝘁𝗵𝗘𝘅𝘁(qw(aaa xxx))              eq "aaa.xxx";
    ok 𝗳𝗶𝗹𝗲𝗣𝗮𝘁𝗵𝗘𝘅𝘁(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

B<Example:>


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

=head4 fpn($)

Remove extension from file name.

     Parameter  Description
  1  $file      File name

B<Example:>


  ok 𝗳𝗽𝗻(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

B<Example:>


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

=head4 fne($)

Remove path from file name.

     Parameter  Description
  1  $file      File name

B<Example:>


  ok 𝗳𝗻𝗲(q(a/b/c.d.e))  eq q(c.d.e);                                              
  

=head4 fe($)

Get extension of file name.

     Parameter  Description
  1  $file      File name

B<Example:>


  ok 𝗳𝗲 (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

B<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 𝗰𝗵𝗲𝗰𝗸𝗙𝗶𝗹𝗲($d);                                                             
  
    ok 𝗰𝗵𝗲𝗰𝗸𝗙𝗶𝗹𝗲($f);                                                             
  

=head4 quoteFile($)

Quote a file name.

     Parameter  Description
  1  $file      File name

B<Example:>


  ok 𝗾𝘂𝗼𝘁𝗲𝗙𝗶𝗹𝗲(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

B<Example:>


  is_deeply [qw(a b)], [&𝗿𝗲𝗺𝗼𝘃𝗲𝗙𝗶𝗹𝗲𝗣𝗿𝗲𝗳𝗶𝘅(qw(a/ a/a a/b))];                       
  
  is_deeply [qw(b)],   [&𝗿𝗲𝗺𝗼𝘃𝗲𝗙𝗶𝗹𝗲𝗣𝗿𝗲𝗳𝗶𝘅("a/", "a/b")];                          
  

=head4 swapFilePrefix($$$)

Swaps the start of a file name from a known name to a new one,

     Parameter  Description
  1  $file      File name
  2  $known     Existing prefix
  3  $new       New prefix

B<Example:>


  ok 𝘀𝘄𝗮𝗽𝗙𝗶𝗹𝗲𝗣𝗿𝗲𝗳𝗶𝘅(q(/aaa/bbb.txt), q(/aaa/), q(/AAA/)) eq q(/AAA/bbb.txt);      
  

=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

B<Example:>


  ˢ{my $f = {};                                                                   
    ok q(a_p.txt)   eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a p txt));                   
    ok q(a_p_2.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a p txt));                   
    ok q(a_p_3.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a p txt));                   
    ok q(a_q.txt)   eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a q txt));                   
    ok q(a_q_5.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a q txt));                   
    ok q(a_q_6.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a q txt));                   
   };
  
    ok q(a_p.txt)   eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a p txt));                   
  
    ok q(a_p_2.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a p txt));                   
  
    ok q(a_p_3.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a p txt));                   
  
    ok q(a_q.txt)   eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a q txt));                   
  
    ok q(a_q_5.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a q txt));                   
  
    ok q(a_q_6.txt) eq &𝘁𝗶𝘁𝗹𝗲𝗧𝗼𝗨𝗻𝗶𝗾𝘂𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($f, qw(a q txt));                   
  

=head2 Position

Position in the file system.

=head3 currentDirectory()

Get the current working directory.


B<Example:>


    𝗰𝘂𝗿𝗿𝗲𝗻𝘁𝗗𝗶𝗿𝗲𝗰𝘁𝗼𝗿𝘆;                                                             
  

=head3 currentDirectoryAbove()

The path to the folder above the current working folder.


B<Example:>


    𝗰𝘂𝗿𝗿𝗲𝗻𝘁𝗗𝗶𝗿𝗲𝗰𝘁𝗼𝗿𝘆𝗔𝗯𝗼𝘃𝗲;                                                        
  

=head3 parseFileName($)

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

     Parameter  Description
  1  $file      File name to parse

B<Example:>


  if (1)                                                                          
   {is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "/home/phil/test.data"], ["/home/phil/", "test", "data"];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "/home/phil/test"],      ["/home/phil/", "test"];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "phil/test.data"],       ["phil/",       "test", "data"];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "phil/test"],            ["phil/",       "test"];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "test.data"],            [undef,         "test", "data"];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "phil/"],                [qw(phil/)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "/phil"],                [qw(/ phil)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "/"],                    [qw(/)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "/var/www/html/translations/"], [qw(/var/www/html/translations/)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "a.b/c.d.e"],            [qw(a.b/ c.d e)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "./a.b"],                [qw(./ a b)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲 "./../../a.b"],          [qw(./../../ a b)];
   }
  

=head3 fullFileName()

Full name of a file.


B<Example:>


    𝗳𝘂𝗹𝗹𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲(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

B<Example:>


  ok "/home/la/perl/aaa.pl"   eq 𝗮𝗯𝘀𝗙𝗿𝗼𝗺𝗔𝗯𝘀𝗣𝗹𝘂𝘀𝗥𝗲𝗹("/home/la/perl/bbb",      "aaa.pl");                 
  
  ok "/home/la/perl/aaa.pl"   eq 𝗮𝗯𝘀𝗙𝗿𝗼𝗺𝗔𝗯𝘀𝗣𝗹𝘂𝘀𝗥𝗲𝗹("/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.

B<Example:>


  ok "bbb.pl"                 eq 𝗿𝗲𝗹𝗙𝗿𝗼𝗺𝗔𝗯𝘀𝗔𝗴𝗮𝗶𝗻𝘀𝘁𝗔𝗯𝘀("/home/la/perl/bbb.pl", "/home/la/perl/aaa.pl");  
  
  ok "../perl/bbb.pl"         eq 𝗿𝗲𝗹𝗙𝗿𝗼𝗺𝗔𝗯𝘀𝗔𝗴𝗮𝗶𝗻𝘀𝘁𝗔𝗯𝘀("/home/la/perl/bbb.pl", "/home/la/java/aaa.jv");  
  

=head3 sumAbsAndRel(@)

Combine zero or more absolute and relative file names

     Parameter  Description
  1  @f         Absolute and relative file names

B<Example:>


  ok "aaa/bbb/ccc/ddd.txt"    eq 𝘀𝘂𝗺𝗔𝗯𝘀𝗔𝗻𝗱𝗥𝗲𝗹(qw(aaa/AAA/ ../bbb/bbb/BBB/ ../../ccc/ddd.txt)); 
  

=head2 Temporary

Temporary files and folders

=head3 temporaryFile()

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


B<Example:>


    my $f = 𝘁𝗲𝗺𝗽𝗼𝗿𝗮𝗿𝘆𝗙𝗶𝗹𝗲;                                                        
  

=head3 temporaryFolder()

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


B<Example:>


    my $D = 𝘁𝗲𝗺𝗽𝗼𝗿𝗮𝗿𝘆𝗙𝗼𝗹𝗱𝗲𝗿;                                                            
  

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

B<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 $_} 𝗳𝗶𝗻𝗱𝗙𝗶𝗹𝗲𝘀($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

B<Example:>


    my $D = temporaryFolder;                                                            
  
    my $d = fpd($D, q(ddd));                                                                             
  
    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);                                       
  
    is_deeply [𝗳𝗶𝗻𝗱𝗗𝗶𝗿𝘀($D)], [$D, $d];                                                                                                                                                           
  

=head3 fileList($)

Files that match a given search pattern handed to bsd_glob.

     Parameter  Description
  1  $pattern   Search pattern

B<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 $_} 𝗳𝗶𝗹𝗲𝗟𝗶𝘀𝘁("$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

B<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 $_} 𝘀𝗲𝗮𝗿𝗰𝗵𝗗𝗶𝗿𝗲𝗰𝘁𝗼𝗿𝘆𝗧𝗿𝗲𝗲𝘀𝗙𝗼𝗿𝗠𝗮𝘁𝗰𝗵𝗶𝗻𝗴𝗙𝗶𝗹𝗲𝘀($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

B<Example:>


    my $d = filePath   (my @d = qw(a b c d));                                      
  
    ok 𝗺𝗮𝘁𝗰𝗵𝗣𝗮𝘁𝗵($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

B<Example:>


    my $f = createEmptyFile(fpe(my $d = temporaryFolder, qw(a jpg)));             
  
    my $F = 𝗳𝗶𝗻𝗱𝗙𝗶𝗹𝗲𝗪𝗶𝘁𝗵𝗘𝘅𝘁𝗲𝗻𝘀𝗶𝗼𝗻(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. Sometimes the folder can be emptied but not removed - perhaps because it a  link, in this case a message is produced unless suppressed by the optional B<$nomsg> parameter.

     Parameter    Description
  1  $folder      Folder
  2  $limitCount  Maximum number of files to remove to limit damage
  3  $noMsg       No message if the folder cannot be completely removed.

B<Example:>


    my $D = temporaryFolder;                                                            
  
    my $d = fpd($D, q(ddd));                                                                             
  
    my @f = map {createEmptyFile(fpe($d, $_, qw(txt)))} qw(a b c);                                       
  
    𝗰𝗹𝗲𝗮𝗿𝗙𝗼𝗹𝗱𝗲𝗿($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

B<Example:>


    my $f = writeFile(undef, "aaa");                                                
  
    my $s = 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲($f);                                                           
  
    ok $s eq "aaa";                                                                 
  
    appendFile($f, "bbb");                                                          
  
    my $S = 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲($f);                                                           
  
    ok $S eq "aaabbb";                                                              
  
  if (1) {                                                                          
    my $f =  writeFile(undef, q(aaaa));
    ok 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲($f) eq q(aaaa);
    eval{writeFile($f, q(bbbb))};
    ok $@ =~ m(\AFile already exists)s;
    ok 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲($f) eq q(aaaa);
    overWriteFile($f,  q(bbbb));
    ok 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲($f) eq q(bbbb);
    unlink $f;
   }
  

=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

B<Example:>


  if (1) {                                                                         
    my $f = dumpFile(undef, my $d = [qw(aaa bbb ccc)]);
    my $s = 𝗲𝘃𝗮𝗹𝗙𝗶𝗹𝗲($f);
    is_deeply $s, $d;
    unlink $f;
   }
  

=head3 evalGZipFile($)

Read a file containing compressed utf8, evaluate it, confess to any errors or return any result. This is much slower than using L<Storable> but does use much smaller files, see also: L<dumpGZipFile|/dumpGZipFile>.

     Parameter  Description
  1  $file      File to read

B<Example:>


  if (1) {                                                                         
    my $d = [1, 2, 3=>{a=>4, b=>5}];
    my $file = dumpGZipFile(q(zzz.zip), $d);
    ok -e $file;
    my $D = 𝗲𝘃𝗮𝗹𝗚𝗭𝗶𝗽𝗙𝗶𝗹𝗲($file);
    is_deeply $d, $D;
    unlink $file;
   }
  

=head3 retrieveFile($)

Retrieve a file created via L<Storable>.  This is much faster than L<evalFile|/evalFile> but the stored data is not easily modified.

     Parameter  Description
  1  $file      File to read

B<Example:>


  if (1) {                                                                         
    my $f = storeFile(undef, my $d = [qw(aaa bbb ccc)]);
    my $s = 𝗿𝗲𝘁𝗿𝗶𝗲𝘃𝗲𝗙𝗶𝗹𝗲($f);
    is_deeply $s, $d;
    unlink $f;
   }
  

=head3 readBinaryFile($)

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

     Parameter  Description
  1  $file      File to read

B<Example:>


    my $f = writeBinaryFile(undef, 0xff x 8);                                      
  
    my $s = 𝗿𝗲𝗮𝗱𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲($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.

B<Example:>


  if (1) {                                                                         
    my $s = '𝝰'x1e3;
    my $file = writeGZipFile(q(zzz.zip), $s);
    ok -e $file;
    my $S = 𝗿𝗲𝗮𝗱𝗚𝗭𝗶𝗽𝗙𝗶𝗹𝗲($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

B<Example:>


    my $d = fpd(my $D = temporaryDirectory, qw(a));                                
  
    my $f = fpe($d, qw(bbb txt));                                                 
  
    ok !-d $d;                                                                    
  
    𝗺𝗮𝗸𝗲𝗣𝗮𝘁𝗵($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

B<Example:>


  if (1) {                                                                          
    my $f =  writeFile(undef, q(aaaa));
    ok readFile($f) eq q(aaaa);
    eval{writeFile($f, q(bbbb))};
    ok $@ =~ m(\AFile already exists)s;
    ok readFile($f) eq q(aaaa);
    𝗼𝘃𝗲𝗿𝗪𝗿𝗶𝘁𝗲𝗙𝗶𝗹𝗲($f,  q(bbbb));
    ok readFile($f) eq q(bbbb);
    unlink $f;
   }
  

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

B<Example:>


    my $f = 𝘄𝗿𝗶𝘁𝗲𝗙𝗶𝗹𝗲(undef, "aaa");                                                
  
    my $s = readFile($f);                                                           
  
    ok $s eq "aaa";                                                                 
  
    appendFile($f, "bbb");                                                          
  
    my $S = readFile($f);                                                           
  
    ok $S eq "aaabbb";                                                              
  
  if (1) {                                                                          
    my $f =  𝘄𝗿𝗶𝘁𝗲𝗙𝗶𝗹𝗲(undef, q(aaaa));
    ok readFile($f) eq q(aaaa);
    eval{𝘄𝗿𝗶𝘁𝗲𝗙𝗶𝗹𝗲($f, q(bbbb))};
    ok $@ =~ m(\AFile already exists)s;
    ok readFile($f) eq q(aaaa);
    overWriteFile($f,  q(bbbb));
    ok readFile($f) eq q(bbbb);
    unlink $f;
   }
  

=head3 overWriteBinaryFile($$)

Write a binary 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

B<Example:>


  if (1)                                                                            
   {vec(my $a, 0, 8) = 254;
    vec(my $b, 0, 8) = 255;
    ok dump($a) eq dump("FE");
    ok dump($b) eq dump("FF");
    ok length($a) == 1;
    ok length($b) == 1;
  
    my $s = $a.$a.$b.$b;
    ok length($s) == 4;
  
    my $f = eval {writeFile(undef, $s)};
    ok fileSize($f) == 8;
  
    eval {writeBinaryFile($f, $s)};
    ok $@ =~ m(Binary file already exists:)s;
  
    eval {𝗼𝘃𝗲𝗿𝗪𝗿𝗶𝘁𝗲𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲($f, $s)};
    ok !$@;
    ok fileSize($f) == 4;
  
    eval {readFile($f)};
    ok $@, "readFile";
  
    ok $s eq eval {readBinaryFile($f)};
  
    copyBinaryFile($f, my $F = temporaryFile);
    ok $s eq readBinaryFile($F);
    unlink $f, $F;
   }
  

=head3 writeBinaryFile($$)

Write a binary 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

B<Example:>


    my $f = 𝘄𝗿𝗶𝘁𝗲𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲(undef, 0xff x 8);                                      
  
    my $s = readBinaryFile($f);                                                    
  
    ok $s eq 0xff x 8;                                                             
  
  if (1)                                                                            
   {vec(my $a, 0, 8) = 254;
    vec(my $b, 0, 8) = 255;
    ok dump($a) eq dump("FE");
    ok dump($b) eq dump("FF");
    ok length($a) == 1;
    ok length($b) == 1;
  
    my $s = $a.$a.$b.$b;
    ok length($s) == 4;
  
    my $f = eval {writeFile(undef, $s)};
    ok fileSize($f) == 8;
  
    eval {𝘄𝗿𝗶𝘁𝗲𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲($f, $s)};
    ok $@ =~ m(Binary file already exists:)s;
  
    eval {overWriteBinaryFile($f, $s)};
    ok !$@;
    ok fileSize($f) == 4;
  
    eval {readFile($f)};
    ok $@, "readFile";
  
    ok $s eq eval {readBinaryFile($f)};
  
    copyBinaryFile($f, my $F = temporaryFile);
    ok $s eq readBinaryFile($F);
    unlink $f, $F;
   }
  

=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

B<Example:>


  if (1) {                                                                         
    my $f = 𝗱𝘂𝗺𝗽𝗙𝗶𝗹𝗲(undef, my $d = [qw(aaa bbb ccc)]);
    my $s = evalFile($f);
    is_deeply $s, $d;
    unlink $f;
   }
  

=head3 storeFile($$)

Store a data structure to a file via L<Storable>.  This is much faster than L<dumpFile|/dumpFile> but the stored results are not easily modified.

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

B<Example:>


  if (1) {                                                                         
    my $f = 𝘀𝘁𝗼𝗿𝗲𝗙𝗶𝗹𝗲(undef, my $d = [qw(aaa bbb ccc)]);
    my $s = retrieveFile($f);
    is_deeply $s, $d;
    unlink $f;
   }
  

=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

B<Example:>


  if (1) {                                                                         
    my $s = '𝝰'x1e3;
    my $file = 𝘄𝗿𝗶𝘁𝗲𝗚𝗭𝗶𝗽𝗙𝗶𝗹𝗲(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. This technique produces files that are a lot more compact files than those produced by L<Storable>, but the execution time is much longer. See also: L<evalGZipFile|/evalGZipFile>.

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

B<Example:>


  if (1) {                                                                         
    my $d = [1, 2, 3=>{a=>4, b=>5}];
    my $file = 𝗱𝘂𝗺𝗽𝗚𝗭𝗶𝗽𝗙𝗶𝗹𝗲(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

B<Example:>


  if (1) {                                                                           
    my $h =
     {"aaa/1.txt"=>"1111",
      "aaa/2.txt"=>"2222",
     };
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
    𝘄𝗿𝗶𝘁𝗲𝗙𝗶𝗹𝗲𝘀($h);
    my $a = readFiles(q(aaa));
    is_deeply $h, $a;
    copyFolder(q(aaa), q(bbb));
    my $b = readFiles(q(bbb));
    is_deeply [sort values %$a],[sort values %$b];
  
    copyFile(q(aaa/1.txt), q(aaa/2.txt));
    my $A = readFiles(q(aaa));
    is_deeply(values %$A);
  
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
   }
  

=head3 readFiles($)

Read all the files in a folder into a hash

     Parameter  Description
  1  $folder    Folder to read

B<Example:>


  if (1) {                                                                           
    my $h =
     {"aaa/1.txt"=>"1111",
      "aaa/2.txt"=>"2222",
     };
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
    writeFiles($h);
    my $a = 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲𝘀(q(aaa));
    is_deeply $h, $a;
    copyFolder(q(aaa), q(bbb));
    my $b = 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲𝘀(q(bbb));
    is_deeply [sort values %$a],[sort values %$b];
  
    copyFile(q(aaa/1.txt), q(aaa/2.txt));
    my $A = 𝗿𝗲𝗮𝗱𝗙𝗶𝗹𝗲𝘀(q(aaa));
    is_deeply(values %$A);
  
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
   }
  

=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

B<Example:>


    my $f = writeFile(undef, "aaa");                                                
  
    my $s = readFile($f);                                                           
  
    ok $s eq "aaa";                                                                 
  
    𝗮𝗽𝗽𝗲𝗻𝗱𝗙𝗶𝗹𝗲($f, "bbb");                                                          
  
    my $S = readFile($f);                                                           
  
    ok $S eq "aaabbb";                                                              
  

=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

B<Example:>


    my $D = temporaryFolder;                                                            
  
    my $d = fpd($D, q(ddd));                                                                             
  
    my @f = map {𝗰𝗿𝗲𝗮𝘁𝗲𝗘𝗺𝗽𝘁𝘆𝗙𝗶𝗹𝗲(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

B<Example:>


    my $f = writeFile(undef, "a
b
");                                           
  
    ok 𝗻𝘂𝗺𝗯𝗲𝗿𝗢𝗳𝗟𝗶𝗻𝗲𝘀𝗜𝗻𝗙𝗶𝗹𝗲($f) == 2;                                              
  

=head2 Copy

Copy files and folders

=head3 copyFile($$)

Copy a file encoded in utf8

     Parameter  Description
  1  $source    Source file
  2  $target    Target file

B<Example:>


  if (1) {                                                                           
    my $h =
     {"aaa/1.txt"=>"1111",
      "aaa/2.txt"=>"2222",
     };
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
    writeFiles($h);
    my $a = readFiles(q(aaa));
    is_deeply $h, $a;
    copyFolder(q(aaa), q(bbb));
    my $b = readFiles(q(bbb));
    is_deeply [sort values %$a],[sort values %$b];
  
    𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲(q(aaa/1.txt), q(aaa/2.txt));
    my $A = readFiles(q(aaa));
    is_deeply(values %$A);
  
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
   }
  

=head3 copyBinaryFile($$)

Copy a binary file

     Parameter  Description
  1  $source    Source file
  2  $target    Target file

B<Example:>


  if (1)                                                                            
   {vec(my $a, 0, 8) = 254;
    vec(my $b, 0, 8) = 255;
    ok dump($a) eq dump("FE");
    ok dump($b) eq dump("FF");
    ok length($a) == 1;
    ok length($b) == 1;
  
    my $s = $a.$a.$b.$b;
    ok length($s) == 4;
  
    my $f = eval {writeFile(undef, $s)};
    ok fileSize($f) == 8;
  
    eval {writeBinaryFile($f, $s)};
    ok $@ =~ m(Binary file already exists:)s;
  
    eval {overWriteBinaryFile($f, $s)};
    ok !$@;
    ok fileSize($f) == 4;
  
    eval {readFile($f)};
    ok $@, "readFile";
  
    ok $s eq eval {readBinaryFile($f)};
  
    𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲($f, my $F = temporaryFile);
    ok $s eq readBinaryFile($F);
    unlink $f, $F;
   }
  

=head3 copyFolder($$)

Copy a folder

     Parameter  Description
  1  $source    Source file
  2  $target    Target file

B<Example:>


  if (1) {                                                                           
    my $h =
     {"aaa/1.txt"=>"1111",
      "aaa/2.txt"=>"2222",
     };
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
    writeFiles($h);
    my $a = readFiles(q(aaa));
    is_deeply $h, $a;
    𝗰𝗼𝗽𝘆𝗙𝗼𝗹𝗱𝗲𝗿(q(aaa), q(bbb));
    my $b = readFiles(q(bbb));
    is_deeply [sort values %$a],[sort values %$b];
  
    copyFile(q(aaa/1.txt), q(aaa/2.txt));
    my $A = readFiles(q(aaa));
    is_deeply(values %$A);
  
    clearFolder(q(aaa), 3);
    clearFolder(q(bbb), 3);
   }
  

=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

B<Example:>


    my ($width, $height) = 𝗶𝗺𝗮𝗴𝗲𝗦𝗶𝘇𝗲(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

B<Example:>


    𝗰𝗼𝗻𝘃𝗲𝗿𝘁𝗜𝗺𝗮𝗴𝗲𝗧𝗼𝗝𝗽𝘅(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

B<Example:>


    𝗰𝗼𝗻𝘃𝗲𝗿𝘁𝗗𝗼𝗰𝘅𝗧𝗼𝗙𝗼𝗱𝘁(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

B<Example:>


    𝗰𝘂𝘁𝗢𝘂𝘁𝗜𝗺𝗮𝗴𝗲𝘀𝗜𝗻𝗙𝗼𝗱𝘁𝗙𝗶𝗹𝗲(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

B<Example:>


    my $A = 𝗲𝗻𝗰𝗼𝗱𝗲𝗝𝘀𝗼𝗻(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

B<Example:>


    my $A = encodeJson(my $a = {a=>1,b=>2, c=>[1..2]});                            
  
    my $b = 𝗱𝗲𝗰𝗼𝗱𝗲𝗝𝘀𝗼𝗻($A);                                                        
  
    is_deeply $a, $b;                                                              
  

=head2 encodeBase64($)

Encode a string in base 64.

     Parameter  Description
  1  $string    String to encode

B<Example:>


    my $A = 𝗲𝗻𝗰𝗼𝗱𝗲𝗕𝗮𝘀𝗲𝟲𝟰(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

B<Example:>


    my $A = encodeBase64(my $a = "Hello World" x 10);                              
  
    my $b = 𝗱𝗲𝗰𝗼𝗱𝗲𝗕𝗮𝘀𝗲𝟲𝟰($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

B<Example:>


  ok 𝗰𝗼𝗻𝘃𝗲𝗿𝘁𝗨𝗻𝗶𝗰𝗼𝗱𝗲𝗧𝗼𝗫𝗺𝗹('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

B<Example:>


  ok  𝗽𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(1) == 0;                                                         
  
  ok  𝗽𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(2) == 1;                                                         
  
  ok !𝗽𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(3);                                                              
  
  ok  𝗽𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(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

B<Example:>


  ok  𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝗶𝗻𝗴𝗣𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(1) == 0;                                               
  
  ok  𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝗶𝗻𝗴𝗣𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(2) == 1;                                               
  
  ok  𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝗶𝗻𝗴𝗣𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(3) == 2;                                               
  
  ok  𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝗶𝗻𝗴𝗣𝗼𝘄𝗲𝗿𝗢𝗳𝗧𝘄𝗼(4) == 2;                                               
  

=head1 Sets

Set operations.

=head2 mergeHashesBySummingValues(@)

Merge the specified hashes by summing their values

     Parameter  Description
  1  @h         List of hashes to be summed

B<Example:>


  if (1) {                                                                        
    is_deeply +{a=>1, b=>2, c=>3},
      𝗺𝗲𝗿𝗴𝗲𝗛𝗮𝘀𝗵𝗲𝘀𝗕𝘆𝗦𝘂𝗺𝗺𝗶𝗻𝗴𝗩𝗮𝗹𝘂𝗲𝘀
        +{a=>1,b=>1, c=>1}, +{b=>1,c=>1}, +{c=>1};
   }
  

=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

B<Example:>


  is_deeply [qw(a b c)],                                                          
  
    [𝘀𝗲𝘁𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻𝗢𝗳𝗧𝘄𝗼𝗔𝗿𝗿𝗮𝘆𝘀𝗢𝗳𝗪𝗼𝗿𝗱𝘀([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

B<Example:>


  is_deeply [qw(a b c)],                                                          
  
    [𝘀𝗲𝘁𝗨𝗻𝗶𝗼𝗻𝗢𝗳𝗧𝘄𝗼𝗔𝗿𝗿𝗮𝘆𝘀𝗢𝗳𝗪𝗼𝗿𝗱𝘀([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

B<Example:>


  is_deeply [1],       [𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝘀(1,0..1)];                                        
  
  is_deeply [1,3],     [𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝘀(1, qw(0 1 0 1 0 0))];                            
  
  is_deeply [0, 5],    [𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝘀('a', qw(a b c d e a b c d e))];                  
  
  is_deeply [0, 1, 5], [𝗰𝗼𝗻𝘁𝗮𝗶𝗻𝘀(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

B<Example:>


  ok 𝗺𝗶𝗻(1) == 1;                                                                 
  
  ok 𝗺𝗶𝗻(5,4,2,3) == 2;                                                           
  

=head2 max(@)

Find the maximum number in a list.

     Parameter  Description
  1  @n         Numbers

B<Example:>


  ok !𝗺𝗮𝘅;                                                                        
  
  ok 𝗺𝗮𝘅(1) == 1;                                                                 
  
  ok 𝗺𝗮𝘅(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

B<Example:>


  ok 3 == 𝗺𝗮𝘅𝗶𝗺𝘂𝗺𝗟𝗶𝗻𝗲𝗟𝗲𝗻𝗴𝘁𝗵(<<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.

B<Example:>


    my $d = [[qw(a 1)], [qw(bb 22)], [qw(ccc 333)], [qw(dddd 4444)]];             
  
    ok 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲𝗕𝗮𝘀𝗶𝗰($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

B<Example:>


  ok 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲                                                                  
  
   ([[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 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲                                                                  
  
   ([[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 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲                                                                  
  
   ([{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 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲                                                                  
  
   ({''=>[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 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲                                                                  
  
   ({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 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲({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 = 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲
     ([["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

B<Example:>


    my $a = [[1..3],       {map{$_=>1} 1..3}];                                    
  
    my $h = {a=>[1..3], b=>{map{$_=>1} 1..3}};                                    
  
    ok 𝗸𝗲𝘆𝗖𝗼𝘂𝗻𝘁(2, $a) == 6;                                                      
  
    ok 𝗸𝗲𝘆𝗖𝗼𝘂𝗻𝘁(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

B<Example:>


    my $s = 𝗹𝗼𝗮𝗱𝗔𝗿𝗿𝗮𝘆𝗙𝗿𝗼𝗺𝗟𝗶𝗻𝗲𝘀 <<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

B<Example:>


    my $s = 𝗹𝗼𝗮𝗱𝗛𝗮𝘀𝗵𝗙𝗿𝗼𝗺𝗟𝗶𝗻𝗲𝘀 <<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

B<Example:>


    my $s = 𝗹𝗼𝗮𝗱𝗔𝗿𝗿𝗮𝘆𝗔𝗿𝗿𝗮𝘆𝗙𝗿𝗼𝗺𝗟𝗶𝗻𝗲𝘀 <<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

B<Example:>


    my $s = 𝗹𝗼𝗮𝗱𝗛𝗮𝘀𝗵𝗔𝗿𝗿𝗮𝘆𝗙𝗿𝗼𝗺𝗟𝗶𝗻𝗲𝘀 <<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

B<Example:>


    my $s = 𝗹𝗼𝗮𝗱𝗔𝗿𝗿𝗮𝘆𝗛𝗮𝘀𝗵𝗙𝗿𝗼𝗺𝗟𝗶𝗻𝗲𝘀 <<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

B<Example:>


    my $s = 𝗹𝗼𝗮𝗱𝗛𝗮𝘀𝗵𝗛𝗮𝘀𝗵𝗙𝗿𝗼𝗺𝗟𝗶𝗻𝗲𝘀 <<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

B<Example:>


    eval q{𝗰𝗵𝗲𝗰𝗸𝗞𝗲𝘆𝘀({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

B<Example:>


    package Scalars;                                                              
  
    my $a = bless{};                                                              
  
    Data::Table::Text::𝗴𝗲𝗻𝗟𝗩𝗮𝗹𝘂𝗲𝗦𝗰𝗮𝗹𝗮𝗿𝗠𝗲𝘁𝗵𝗼𝗱𝘀(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

B<Example:>


    my $class = "Data::Table::Text::Test";                                        
  
    my $a = bless{}, $class;                                                      
  
    𝗮𝗱𝗱𝗟𝗩𝗮𝗹𝘂𝗲𝗦𝗰𝗮𝗹𝗮𝗿𝗠𝗲𝘁𝗵𝗼𝗱𝘀(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

B<Example:>


    package ScalarsWithDefaults;                                                  
  
    my $a = bless{};                                                              
  
    Data::Table::Text::𝗴𝗲𝗻𝗟𝗩𝗮𝗹𝘂𝗲𝗦𝗰𝗮𝗹𝗮𝗿𝗠𝗲𝘁𝗵𝗼𝗱𝘀𝗪𝗶𝘁𝗵𝗗𝗲𝗳𝗮𝘂𝗹𝘁𝗩𝗮𝗹𝘂𝗲𝘀(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

B<Example:>


    package Arrays;                                                               
  
    my $a = bless{};                                                              
  
    Data::Table::Text::𝗴𝗲𝗻𝗟𝗩𝗮𝗹𝘂𝗲𝗔𝗿𝗿𝗮𝘆𝗠𝗲𝘁𝗵𝗼𝗱𝘀(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

B<Example:>


    package Hashes;                                                               
  
    my $a = bless{};                                                              
  
    Data::Table::Text::𝗴𝗲𝗻𝗟𝗩𝗮𝗹𝘂𝗲𝗛𝗮𝘀𝗵𝗠𝗲𝘁𝗵𝗼𝗱𝘀(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> accessible via L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> method calls. 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

B<Example:>


  if (1) {                                                                         
    my $o = 𝗴𝗲𝗻𝗛𝗮𝘀𝗵(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 = 𝗴𝗲𝗻𝗛𝗮𝘀𝗵(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

B<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"};
  
    𝗹𝗼𝗮𝗱𝗛𝗮𝘀𝗵($p, a=>11, b=>22);                                                   # Load the hash
    is_deeply $p, {a=>11, b=>22, c=>"cc"};
  
    my $r = eval {𝗹𝗼𝗮𝗱𝗛𝗮𝘀𝗵($p, d=>44)};                                           # Try to load the hash
    ok $@ =~ m(Cannot load attribute: d);
   }
  

=head2 reloadHashes($)

Ensures that all the hashes within a tower of data structures have LValue methods to get and set their current keys.

     Parameter  Description
  1  $d         Data structure

B<Example:>


  if (1)                                                                          
   {my $a = bless [bless {aaa=>42}, "AAAA"], "BBBB";
    eval {$a->[0]->aaa};
    ok $@ =~ m(\ACan.t locate object method .aaa. via package .AAAA.);
    𝗿𝗲𝗹𝗼𝗮𝗱𝗛𝗮𝘀𝗵𝗲𝘀($a);
    ok $a->[0]->aaa == 42;
   }
  
  if (1)                                                                          
   {my $a = bless [bless {ccc=>42}, "CCCC"], "DDDD";
    eval {$a->[0]->ccc};
    ok $@ =~ m(\ACan.t locate object method .ccc. via package .CCCC.);
    𝗿𝗲𝗹𝗼𝗮𝗱𝗛𝗮𝘀𝗵𝗲𝘀($a);
    ok $a->[0]->ccc == 42;
   }
  

=head2 setPackageSearchOrder($@)

Set a package search order for methods requested in the current package via AUTOLOAD.

     Parameter  Description
  1  $set       Package to set
  2  @search    Package names in search order.

B<Example:>


  if (1)                                                                          
   {if (1)
     {package AAAA;
  
      sub aaaa{q(AAAAaaaa)}
      sub bbbb{q(AAAAbbbb)}
      sub cccc{q(AAAAcccc)}
     }
    if (1)
     {package BBBB;
  
      sub aaaa{q(BBBBaaaa)}
      sub bbbb{q(BBBBbbbb)}
      sub dddd{q(BBBBdddd)}
     }
    if (1)
     {package CCCC;
  
      sub aaaa{q(CCCCaaaa)}
      sub dddd{q(CCCCdddd)}
      sub eeee{q(CCCCeeee)}
     }
  
    𝘀𝗲𝘁𝗣𝗮𝗰𝗸𝗮𝗴𝗲𝗦𝗲𝗮𝗿𝗰𝗵𝗢𝗿𝗱𝗲𝗿(__PACKAGE__, qw(CCCC BBBB AAAA));
  
    ok &aaaa eq q(CCCCaaaa);
    ok &bbbb eq q(BBBBbbbb);
    ok &cccc eq q(AAAAcccc);
  
    ok &aaaa eq q(CCCCaaaa);
    ok &bbbb eq q(BBBBbbbb);
    ok &cccc eq q(AAAAcccc);
  
    ok &dddd eq q(CCCCdddd);
    ok &eeee eq q(CCCCeeee);
  
    𝘀𝗲𝘁𝗣𝗮𝗰𝗸𝗮𝗴𝗲𝗦𝗲𝗮𝗿𝗰𝗵𝗢𝗿𝗱𝗲𝗿(__PACKAGE__, qw(AAAA BBBB CCCC));
  
    ok &aaaa eq q(AAAAaaaa);
    ok &bbbb eq q(AAAAbbbb);
    ok &cccc eq q(AAAAcccc);
  
    ok &aaaa eq q(AAAAaaaa);
    ok &bbbb eq q(AAAAbbbb);
    ok &cccc eq q(AAAAcccc);
  
    ok &dddd eq q(BBBBdddd);
    ok &eeee eq q(CCCCeeee);
   }
  

=head2 isSubInPackage($$)

Test whether a subroutine is present in a package.

     Parameter  Description
  1  $package   Package name
  2  $sub       Subroutine name

B<Example:>


  if (1)                                                                           
   {sub AAAA::Call {q(AAAA)}
  
    sub BBBB::Call {q(BBBB)}
    sub BBBB::call {q(bbbb)}
  
    if (1)
     {package BBBB;
      use Test::More;
      *ok = *Test::More::ok;
      *𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲 = *Data::Table::Text::𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲;
      ok  𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(AAAA), q(Call));
      ok !𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(AAAA), q(call));
      ok  𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(BBBB), q(Call));
      ok  𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(BBBB), q(call));
      ok Call eq q(BBBB);
      ok call eq q(bbbb);
      &Data::Table::Text::overrideMethods(qw(AAAA BBBB Call call));
      *𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲 = *Data::Table::Text::𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲;
      ok  𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(AAAA), q(Call));
      ok  𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(AAAA), q(call));
      ok  𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(BBBB), q(Call));
      ok  𝗶𝘀𝗦𝘂𝗯𝗜𝗻𝗣𝗮𝗰𝗸𝗮𝗴𝗲(q(BBBB), q(call));
      ok Call eq q(AAAA);
      ok call eq q(bbbb);
      package AAAA;
      use Test::More;
      *ok = *Test::More::ok;
      ok  Call eq q(AAAA);
      ok &call eq q(bbbb);
     }
   }
  

=head2 overrideMethods($$@)

For each method, if it exists in package B<$from> then export it to package B<$to> replacing any existing method in B<$to>, otherwise export the method from package B<$to> to package B<$from> in order to merge the behavior of the B<$from> and B<$to> packages with respect to the named methods with duplicates resolved if favour of package B<$from>.

     Parameter  Description
  1  $from      Name of package from which to import methods
  2  $to        Package into which to import the methods
  3  @methods   List of methods to try importing.

B<Example:>


  if (1)                                                                           
   {sub AAAA::Call {q(AAAA)}
  
    sub BBBB::Call {q(BBBB)}
    sub BBBB::call {q(bbbb)}
  
    if (1)
     {package BBBB;
      use Test::More;
      *ok = *Test::More::ok;
      *isSubInPackage = *Data::Table::Text::isSubInPackage;
      ok  isSubInPackage(q(AAAA), q(Call));
      ok !isSubInPackage(q(AAAA), q(call));
      ok  isSubInPackage(q(BBBB), q(Call));
      ok  isSubInPackage(q(BBBB), q(call));
      ok Call eq q(BBBB);
      ok call eq q(bbbb);
      &Data::Table::Text::𝗼𝘃𝗲𝗿𝗿𝗶𝗱𝗲𝗠𝗲𝘁𝗵𝗼𝗱𝘀(qw(AAAA BBBB Call call));
      *isSubInPackage = *Data::Table::Text::isSubInPackage;
      ok  isSubInPackage(q(AAAA), q(Call));
      ok  isSubInPackage(q(AAAA), q(call));
      ok  isSubInPackage(q(BBBB), q(Call));
      ok  isSubInPackage(q(BBBB), q(call));
      ok Call eq q(AAAA);
      ok call eq q(bbbb);
      package AAAA;
      use Test::More;
      *ok = *Test::More::ok;
      ok  Call eq q(AAAA);
      ok &call eq q(bbbb);
     }
   }
  

=head2 assertPackageRefs($@)

Confirm that the specified references are to the specified package

     Parameter  Description
  1  $package   Package
  2  @refs      References

B<Example:>


  if (1) {                                                                        
    eval q{𝗮𝘀𝘀𝗲𝗿𝘁𝗣𝗮𝗰𝗸𝗮𝗴𝗲𝗥𝗲𝗳𝘀(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

B<Example:>


  if (1) {                                                                        
    eval q{𝗮𝘀𝘀𝗲𝗿𝘁𝗥𝗲𝗳(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"

B<Example:>


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

=head2 arrayToHash(@)

Create a hash from an array

     Parameter  Description
  1  @array     Array

B<Example:>


  is_deeply 𝗮𝗿𝗿𝗮𝘆𝗧𝗼𝗛𝗮𝘀𝗵(qw(a b c)), {a=>1, b=>1, c=>1};                           
  

=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

B<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

B<Example:>


  ok 𝗶𝘀𝗕𝗹𝗮𝗻𝗸("");                                                                 
  
  ok 𝗶𝘀𝗕𝗹𝗮𝗻𝗸(" 
 ");                                                             
  

=head2 trim($)

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

     Parameter  Description
  1  $string    String

B<Example:>


  ok 𝘁𝗿𝗶𝗺(" 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

B<Example:>


  ok  𝗽𝗮𝗱('abc  ', 2).'='       eq "abc =";                                       
  
  ok  𝗽𝗮𝗱('abc  ', 3).'='       eq "abc=";                                        
  
  ok  𝗽𝗮𝗱('abc  ', 4, q(.)).'=' eq "abc.=";                                       
  

=head2 firstNChars($$)

First N characters of a string.

     Parameter  Description
  1  $string    String
  2  $length    Length

B<Example:>


  ok 𝗳𝗶𝗿𝘀𝘁𝗡𝗖𝗵𝗮𝗿𝘀(q(abc), 2) eq q(ab);                                             
  
  ok 𝗳𝗶𝗿𝘀𝘁𝗡𝗖𝗵𝗮𝗿𝘀(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

B<Example:>


  ok 𝗻𝘄𝘀(qq(a  b    c)) eq q(a b c);                                              
  

=head2 stringsAreNotEqual($$)

Return the common start followed by the two non equal tails of two non equal strings or an empty list if the strings are equal.

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

B<Example:>


  if (1) {                                                                        
    ok        !𝘀𝘁𝗿𝗶𝗻𝗴𝘀𝗔𝗿𝗲𝗡𝗼𝘁𝗘𝗾𝘂𝗮𝗹(q(abc), q(abc));
    ok         𝘀𝘁𝗿𝗶𝗻𝗴𝘀𝗔𝗿𝗲𝗡𝗼𝘁𝗘𝗾𝘂𝗮𝗹(q(abc), q(abd));
    is_deeply [𝘀𝘁𝗿𝗶𝗻𝗴𝘀𝗔𝗿𝗲𝗡𝗼𝘁𝗘𝗾𝘂𝗮𝗹(q(abc), q(abd))], [qw(ab c d)];
    is_deeply [𝘀𝘁𝗿𝗶𝗻𝗴𝘀𝗔𝗿𝗲𝗡𝗼𝘁𝗘𝗾𝘂𝗮𝗹(q(ab),  q(abd))], [q(ab), '', 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

B<Example:>


    overWriteFile($f, <<END);                                                      
  // Test
  package com.xyz;
  END
  
    ok 𝗷𝗮𝘃𝗮𝗣𝗮𝗰𝗸𝗮𝗴𝗲($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

B<Example:>


    overWriteFile($f, <<END);                                                      
  // Test
  package com.xyz;
  END
  
    ok 𝗷𝗮𝘃𝗮𝗣𝗮𝗰𝗸𝗮𝗴𝗲𝗔𝘀𝗙𝗶𝗹𝗲𝗡𝗮𝗺𝗲($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

B<Example:>


    overWriteFile($f, <<END);                                                     
  package a::b;
  END
  
    ok 𝗽𝗲𝗿𝗹𝗣𝗮𝗰𝗸𝗮𝗴𝗲($f)           eq "a::b";                                       
  

=head2 printQw(@)

Print an array of words in qw() format.

     Parameter  Description
  1  @words     Array of words

B<Example:>


  ok 𝗽𝗿𝗶𝗻𝘁𝗤𝘄(qw(a b c)) eq q(qw(a b c));                                          
  

=head2 numberOfLinesInString($)

The number of lines in a string.

     Parameter  Description
  1  $string    String

B<Example:>


    ok 𝗻𝘂𝗺𝗯𝗲𝗿𝗢𝗳𝗟𝗶𝗻𝗲𝘀𝗜𝗻𝗦𝘁𝗿𝗶𝗻𝗴("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

B<Example:>


  ok 𝗯𝗼𝗹𝗱𝗦𝘁𝗿𝗶𝗻𝗴(q(zZ)) eq q(𝘇𝗭);                                                  
  

=head2 boldStringUndo($)

Undo alphanumerics in a string to bold.

     Parameter  Description
  1  $string    String to convert

B<Example:>


  if (1)                                                                              
   {my $n = 1234567890;
    ok 𝗯𝗼𝗹𝗱𝗦𝘁𝗿𝗶𝗻𝗴𝗨𝗻𝗱𝗼            (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

B<Example:>


  ok 𝗲𝗻𝗰𝗹𝗼𝘀𝗲𝗱𝗦𝘁𝗿𝗶𝗻𝗴(q(hello world 1234)) eq q(ⓗⓔⓛⓛⓞ ⓦⓞⓡⓛⓓ ①②③④);         
  

=head2 enclosedStringUndo($)

Undo alphanumerics in a string to enclosed alphanumerics.

     Parameter  Description
  1  $string    String to convert

B<Example:>


  if (1)                                                                              
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok 𝗲𝗻𝗰𝗹𝗼𝘀𝗲𝗱𝗦𝘁𝗿𝗶𝗻𝗴𝗨𝗻𝗱𝗼        (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

B<Example:>


  ok 𝗲𝗻𝗰𝗹𝗼𝘀𝗲𝗱𝗥𝗲𝘃𝗲𝗿𝘀𝗲𝗱𝗦𝘁𝗿𝗶𝗻𝗴(q(hello world 1234)) eq q(🅗🅔🅛🅛🅞 🅦🅞🅡🅛🅓 ➊➋➌➍);   
  

=head2 enclosedReversedStringUndo($)

Undo alphanumerics in a string to enclosed reversed alphanumerics.

     Parameter  Description
  1  $string    String to convert

B<Example:>


  if (1)                                                                              
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok enclosedStringUndo        (enclosedString($n))         == $n;
    ok 𝗲𝗻𝗰𝗹𝗼𝘀𝗲𝗱𝗥𝗲𝘃𝗲𝗿𝘀𝗲𝗱𝗦𝘁𝗿𝗶𝗻𝗴𝗨𝗻𝗱𝗼(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

B<Example:>


  ok 𝘀𝘂𝗽𝗲𝗿𝗦𝗰𝗿𝗶𝗽𝘁𝗦𝘁𝗿𝗶𝗻𝗴(1234567890) eq q(¹²³⁴⁵⁶⁷⁸⁹⁰);                              
  

=head2 superScriptStringUndo($)

Undo alphanumerics in a string to super scripts

     Parameter  Description
  1  $string    String to convert

B<Example:>


  if (1)                                                                              
   {my $n = 1234567890;
    ok boldStringUndo            (boldString($n))             == $n;
    ok enclosedStringUndo        (enclosedString($n))         == $n;
    ok enclosedReversedStringUndo(enclosedReversedString($n)) == $n;
    ok 𝘀𝘂𝗽𝗲𝗿𝗦𝗰𝗿𝗶𝗽𝘁𝗦𝘁𝗿𝗶𝗻𝗴𝗨𝗻𝗱𝗼     (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

B<Example:>


  ok 𝘀𝘂𝗯𝗦𝗰𝗿𝗶𝗽𝘁𝗦𝘁𝗿𝗶𝗻𝗴(1234567890)   eq q(₁₂₃₄₅₆₇₈₉₀);                              
  

=head2 subScriptStringUndo($)

Undo alphanumerics in a string to sub scripts

     Parameter  Description
  1  $string    String to convert

B<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 𝘀𝘂𝗯𝗦𝗰𝗿𝗶𝗽𝘁𝗦𝘁𝗿𝗶𝗻𝗴𝗨𝗻𝗱𝗼       (subScriptString($n))        == $n;
   }
  

=head1 Cloud Cover

Useful for operating across the cloud.

=head2 makeDieConfess()

Force die to confess where the death occurred.


B<Example:>


    𝗺𝗮𝗸𝗲𝗗𝗶𝗲𝗖𝗼𝗻𝗳𝗲𝘀𝘀                                                                
  

=head2 ipAddressViaArp($)

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

     Parameter  Description
  1  $hostName  Host name

B<Example:>


    𝗶𝗽𝗔𝗱𝗱𝗿𝗲𝘀𝘀𝗩𝗶𝗮𝗔𝗿𝗽(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

B<Example:>


    𝘀𝗮𝘃𝗲𝗖𝗼𝗱𝗲𝗧𝗼𝗦𝟯(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

B<Example:>


    𝗮𝗱𝗱𝗖𝗲𝗿𝘁𝗶𝗳𝗶𝗰𝗮𝘁𝗲(fpf(qw(.ssh cert)));                                           
  

=head2 hostName()

The name of the host we are running on.


B<Example:>


    𝗵𝗼𝘀𝘁𝗡𝗮𝗺𝗲;                                                                     
  

=head2 userId()

The userid we are currently running under.


B<Example:>


    𝘂𝘀𝗲𝗿𝗜𝗱;                                                                       
  

=head2 wwwEncode($)

Replace spaces in a string with %20 .

     Parameter  Description
  1  $string    String

B<Example:>


  ok 𝘄𝘄𝘄𝗘𝗻𝗰𝗼𝗱𝗲(q(a  b c)) eq q(a%20%20b%20c);                                     
  

=head2 wwwDecode($)

Replace %20 in a string with a space.

     Parameter  Description
  1  $string    String

B<Example:>


  ok 𝘄𝘄𝘄𝗗𝗲𝗰𝗼𝗱𝗲(wwwEncode q(a  b c)) eq q(a  b c);                                 
  

=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

B<Example:>


  if (0) {                                                                         
    my %pids;
    ˢ{𝘀𝘁𝗮𝗿𝘁𝗣𝗿𝗼𝗰𝗲𝘀𝘀 {} %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

B<Example:>


  if (0) {                                                                         
    my %pids;
    ˢ{startProcess {} %pids, 1; ok 1 >= keys %pids} for 1..8;
    𝘄𝗮𝗶𝘁𝗙𝗼𝗿𝗔𝗹𝗹𝗦𝘁𝗮𝗿𝘁𝗲𝗱𝗣𝗿𝗼𝗰𝗲𝘀𝘀𝗲𝘀𝗧𝗼𝗙𝗶𝗻𝗶𝘀𝗵(%pids);
    ok !keys(%pids)
   }
  

=head2 newProcessStarter($$)

Create a new L<process starter|/Data::Table::Text::Starter Definition> with which to start parallel processes up to a specified B<$maximumNumberOfProcesses> maximum number of parallel processes at a time, wait for all the started processes to finish and then optionally retrieve their saved results as an array from the folder named by B<$transferArea>.

     Parameter                  Description
  1  $maximumNumberOfProcesses  Maximum number of processes to start
  2  $transferArea              Optional folder to be used to save and retrieve results.

B<Example:>


  if (!$windows)                                                                    
  

=head2 Data::Table::Text::Starter::start($$)

Start a new process to run the specified B<$sub>.

     Parameter  Description
  1  $starter   Starter
  2  $sub       Sub to be run.

B<Example:>


  if (!$windows)                                                                    
  

=head2 Data::Table::Text::Starter::finish($)

Wait for all started processes to finish and return their results as an array.

     Parameter  Description
  1  $starter   Starter

B<Example:>


  if (!$windows)                                                                    
  

=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

B<Example:>


  if (1)                                                                           
   {my $s = 𝗻𝗲𝘄𝗦𝗲𝗿𝘃𝗶𝗰𝗲𝗜𝗻𝗰𝗮𝗿𝗻𝗮𝘁𝗶𝗼𝗻("aaa", q(bbb.txt));
    is_deeply $s->check, $s;
    my $t = 𝗻𝗲𝘄𝗦𝗲𝗿𝘃𝗶𝗰𝗲𝗜𝗻𝗰𝗮𝗿𝗻𝗮𝘁𝗶𝗼𝗻("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

B<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

B<Example:>


  ok nws(𝗵𝘁𝗺𝗹𝗧𝗼𝗰("XXXX", <<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>
  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 for a Perl module from the comments in its source code. 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

B<Example:>


   {my $s = 𝘂𝗽𝗱𝗮𝘁𝗲𝗗𝗼𝗰𝘂𝗺𝗲𝗻𝘁𝗮𝘁𝗶𝗼𝗻(<<'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 Data::Table::Text::Starter Definition


Process starter definition.


B<maximumNumberOfProcesses> - The maximum number of processes to start in parallel at one time. If this limit is exceeded, the start of subsequent processes will be delayed until processes started earlier have finished.

B<transferArea> - The name of the folder in which files transferring results from the child to the parent process will be stored.



=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.


B<Example:>


    𝗯𝗶𝗻𝗠𝗼𝗱𝗲𝗔𝗹𝗹𝗨𝘁𝗳𝟴;                                                               
  

=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 reloadHashes2($$)

Ensures that all the hashes within a tower of data structures have LValue methods to get and set their current keys.

     Parameter  Description
  1  $d         Data structure
  2  $progress  Progress

=head2 showHashes2($$$)

Create a map of all the keys within all the hashes within a tower of data structures.

     Parameter  Description
  1  $d         Data structure
  2  $keys      Keys found
  3  $progress  Progress

=head2 showHashes($)

Create a map of all the keys within all the hashes within a tower of data structures.

     Parameter  Description
  1  $d         Data structure

=head2 saveSourceToS3($$)

Save source code.

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

=head2 Data::Table::Text::Starter::waitOne($)

Wait for one process to finish and consolidate its results.

     Parameter  Description
  1  $starter   Starter

=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<arrayToHash|/arrayToHash> - Create a hash from an array

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

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

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

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

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

11 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.

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

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

14 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.

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

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

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

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

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

20 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.

21 L<copyBinaryFile|/copyBinaryFile> - Copy a binary file

22 L<copyFile|/copyFile> - Copy a file encoded in utf8

23 L<copyFolder|/copyFolder> - Copy a folder

24 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.

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

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

27 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">.

28 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>.

29 L<Data::Table::Text::Starter::finish|/Data::Table::Text::Starter::finish> - Wait for all started processes to finish and return their results as an array.

30 L<Data::Table::Text::Starter::start|/Data::Table::Text::Starter::start> - Start a new process to run the specified B<$sub>.

31 L<Data::Table::Text::Starter::waitOne|/Data::Table::Text::Starter::waitOne> - Wait for one process to finish and consolidate its results.

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

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

34 L<dateTimeStampName|/dateTimeStampName> - Date time stamp without white space.

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

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

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

38 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.

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

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

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

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

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

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

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

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

47 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.

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

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

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

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

52 L<fileMd5Sum|/fileMd5Sum> - Get the Md5 sum for a file

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

54 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.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

78 L<genHash|/genHash> - Return a B<$bless>ed hash with the specified B<$attributes> accessible via L<lvalue|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> method calls.

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

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

81 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>.

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

83 L<hostName|/hostName> - The name of the host we are running on.

84 L<htmlToc|/htmlToc> - Generate a table of contents for some html.

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

86 L<indentString|/indentString> - Indent lines contained in a string or formatted table by the specified string.

87 L<ipAddressViaArp|/ipAddressViaArp> - Get the ip address of a server on the local network by hostname via arp

88 L<isBlank|/isBlank> - Test whether a string is blank.

89 L<isSubInPackage|/isSubInPackage> - Test whether a subroutine is present in a package.

90 L<javaPackage|/javaPackage> - Extract the package name from a java string or file.

91 L<javaPackageAsFileName|/javaPackageAsFileName> - Extract the package name from a java string or file and convert it to a file name.

92 L<keyCount|/keyCount> - Count keys down to the specified level.

93 L<loadArrayArrayFromLines|/loadArrayArrayFromLines> - Load an array of arrays from lines of text: each line is an array of words.

94 L<loadArrayFromLines|/loadArrayFromLines> - Load an array from lines of text in a string.

95 L<loadArrayHashFromLines|/loadArrayHashFromLines> - Load an array of hashes from lines of text: each line is an hash of words.

96 L<loadHash|/loadHash> - Load the specified B<$hash> generated with L<genHash|/genHash> with B<%attributes>.

97 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.

98 L<loadHashFromLines|/loadHashFromLines> - Load a hash: first word of each line is the key and the rest is the value.

99 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.

100 L<makeDieConfess|/makeDieConfess> - Force die to confess where the death occurred.

101 L<makePath|/makePath> - Make the path for the specified file name or folder.

102 L<matchPath|/matchPath> - Given an absolute path find out how much of the path actually exists.

103 L<max|/max> - Find the maximum number in a list.

104 L<maximumLineLength|/maximumLineLength> - Find the longest line in a string

105 L<mergeHashesBySummingValues|/mergeHashesBySummingValues> - Merge the specified hashes by summing their values

106 L<microSecondsSinceEpoch|/microSecondsSinceEpoch> - Micro seconds since unix epoch.

107 L<min|/min> - Find the minimum number in a list.

108 L<newProcessStarter|/newProcessStarter> - Create a new L<process starter|/Data::Table::Text::Starter Definition> with which to start parallel processes up to a specified B<$maximumNumberOfProcesses> maximum number of parallel processes at a time, wait for all the started processes to finish and then optionally retrieve their saved results as an array from the folder named by B<$transferArea>.

109 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>.

110 L<numberOfLinesInFile|/numberOfLinesInFile> - The number of lines in a file

111 L<numberOfLinesInString|/numberOfLinesInString> - The number of lines in a string.

112 L<nws|/nws> - Normalize white space in a string to make comparisons easier.

113 L<overrideMethods|/overrideMethods> - For each method, if it exists in package B<$from> then export it to package B<$to> replacing any existing method in B<$to>, otherwise export the method from package B<$to> to package B<$from> in order to merge the behavior of the B<$from> and B<$to> packages with respect to the named methods with duplicates resolved if favour of package B<$from>.

114 L<overWriteBinaryFile|/overWriteBinaryFile> - Write a binary string to a file after creating a path to the file if necessary and return the name of the file on success else confess.

115 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.

116 L<pad|/pad> - Pad a string with blanks or the specified padding character  to a multiple of a specified length.

117 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.

118 L<parseFileName|/parseFileName> - Parse a file name into (path, name, extension).

119 L<perlPackage|/perlPackage> - Extract the package name from a perl string or file.

120 L<powerOfTwo|/powerOfTwo> - Test whether a number is a power of two, return the power if it is else B<undef>.

121 L<printFullFileName|/printFullFileName> - Print a file name on a separate line with escaping so it can be used easily from the command line.

122 L<printQw|/printQw> - Print an array of words in qw() format.

123 L<quoteFile|/quoteFile> - Quote a file name.

124 L<readBinaryFile|/readBinaryFile> - Read binary file - a file whose contents are not to be interpreted as unicode.

125 L<readFile|/readFile> - Read a file containing unicode in utf8.

126 L<readFiles|/readFiles> - Read all the files in a folder into a hash

127 L<readGZipFile|/readGZipFile> - Read the specified B<$file>, containing compressed utf8, through gzip

128 L<readUtf16File|/readUtf16File> - Read a file containing unicode in utf-16 format.

129 L<relFromAbsAgainstAbs|/relFromAbsAgainstAbs> - Derive a relative file name for the first absolute file name relative to the second absolute file name.

130 L<reloadHashes|/reloadHashes> - Ensures that all the hashes within a tower of data structures have LValue methods to get and set their current keys.

131 L<reloadHashes2|/reloadHashes2> - Ensures that all the hashes within a tower of data structures have LValue methods to get and set their current keys.

132 L<removeFilePrefix|/removeFilePrefix> - Removes a file prefix from an array of files.

133 L<renormalizeFolderName|/renormalizeFolderName> - Normalize a folder name component by adding a trailing separator.

134 L<retrieveFile|/retrieveFile> - Retrieve a file created via L<Storable>.

135 L<saveCodeToS3|/saveCodeToS3> - Save source code files.

136 L<saveSourceToS3|/saveSourceToS3> - Save source code.

137 L<searchDirectoryTreesForMatchingFiles|/searchDirectoryTreesForMatchingFiles> - Search the specified directory trees for the files (not folders) that match the specified extensions.

138 L<setIntersectionOfTwoArraysOfWords|/setIntersectionOfTwoArraysOfWords> - Intersection of two arrays of words.

139 L<setPackageSearchOrder|/setPackageSearchOrder> - Set a package search order for methods requested in the current package via AUTOLOAD.

140 L<setUnionOfTwoArraysOfWords|/setUnionOfTwoArraysOfWords> - Union of two arrays of words.

141 L<showHashes|/showHashes> - Create a map of all the keys within all the hashes within a tower of data structures.

142 L<showHashes2|/showHashes2> - Create a map of all the keys within all the hashes within a tower of data structures.

143 L<startProcess|/startProcess> - Start new processes while the number of child processes recorded in B<%$pids> is less than the specified B<$maximum>.

144 L<storeFile|/storeFile> - Store a data structure to a file via L<Storable>.

145 L<stringsAreNotEqual|/stringsAreNotEqual> - Return the common start followed by the two non equal tails of two non equal strings or an empty list if the strings are equal.

146 L<subScriptString|/subScriptString> - Convert alphanumerics in a string to sub scripts

147 L<subScriptStringUndo|/subScriptStringUndo> - Undo alphanumerics in a string to sub scripts

148 L<sumAbsAndRel|/sumAbsAndRel> - Combine zero or more absolute and relative file names

149 L<superScriptString|/superScriptString> - Convert alphanumerics in a string to super scripts

150 L<superScriptStringUndo|/superScriptStringUndo> - Undo alphanumerics in a string to super scripts

151 L<swapFilePrefix|/swapFilePrefix> - Swaps the start of a file name from a known name to a new one,

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

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

154 L<timeStamp|/timeStamp> - hours:minute:seconds

155 L<titleToUniqueFileName|/titleToUniqueFileName> - Create a file name from a title that is unique within the set %uniqueNames.

156 L<trackFiles|/trackFiles> - Track the existence of files.

157 L<trim|/trim> - Remove any white space from the front and end of a string.

158 L<updateDocumentation|/updateDocumentation> - Update documentation for a Perl module from the comments in its source code.

159 L<updatePerlModuleDocumentation|/updatePerlModuleDocumentation> - Update the documentation in a perl file and show said documentation in a web browser.

160 L<userId|/userId> - The userid we are currently running under.

161 L<versionCode|/versionCode> - YYYYmmdd-HHMMSS

162 L<versionCodeDashed|/versionCodeDashed> - YYYY-mm-dd-HH:MM:SS

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

164 L<writeBinaryFile|/writeBinaryFile> - Write a binary 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.

165 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.

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

167 L<writeGZipFile|/writeGZipFile> - Write a unicode utf8 string through gzip to a file.

168 L<wwwDecode|/wwwDecode> - Replace %20 in a string with a space.

169 L<wwwEncode|/wwwEncode> - Replace spaces in a string with %20 .

170 L<xxx|/xxx> - Execute a shell command optionally checking its response.

171 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.

172 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.

173 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 => 430;
my $windows   = $^O =~ m(MSWin32)i;
my $mac       = $^O =~ m(darwin)i;
my $freeBsd   = $^O =~ m(freebsd)i;
my $dragonFly = $^O =~ m(dragonfly)i;

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)                                                                          #TparseFileName
 {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 "/phil"],                [qw(/ phil)];
  is_deeply [parseFileName "/"],                    [qw(/)];
  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)];
  is_deeply [parseFileName "./a.b"],                [qw(./ a b)];
  is_deeply [parseFileName "./../../a.b"],          [qw(./../../ a b)];
 }

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/");

ok "aaa/bbb/ccc/ddd.txt"    eq sumAbsAndRel(qw(aaa/AAA/ ../bbb/bbb/BBB/ ../../ccc/ddd.txt)); #TsumAbsAndRel

ˢ{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 wwwDecode(wwwEncode q(a  b c)) eq q(a  b c);                                 #TwwwDecode

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 dateTimeStampName =~ m(\A_on_\d{4}_\d\d_\d\d_at_\d\d_\d\d_\d\d\Z);           #TdateTimeStampName
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..7;
 }

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
  fileMd5Sum(q(/etc/hosts));                                                    #TfileMd5Sum
 }

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) {                                                                        #TdumpFile #TevalFile
  my $f = dumpFile(undef, my $d = [qw(aaa bbb ccc)]);
  my $s = evalFile($f);
  is_deeply $s, $d;
  unlink $f;
 }

if (1) {                                                                        #TstoreFile #TretrieveFile
  my $f = storeFile(undef, my $d = [qw(aaa bbb ccc)]);
  my $s = retrieveFile($f);
  is_deeply $s, $d;
  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 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 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(ab c d)];
  is_deeply [stringsAreNotEqual(q(ab),  q(abd))], [q(ab), '', 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);
 }

if (!$windows)                                                                  #TnewProcessStarter #TData::Table::Text::Starter::start #TData::Table::Text::Starter::finish
 {my $N = 100;
  my $s = newProcessStarter(4, q(processes));
  for my $i(1..$N)
   {Data::Table::Text::Starter::start($s, sub{$i*$i});
   }
  is_deeply
   [sort {$a <=> $b} Data::Table::Text::Starter::finish($s)],
   [map {$_**2} 1..$N];
  clearFolder($s->transferArea, 1e2);
 }
else
 {ok 1
 }

is_deeply arrayToHash(qw(a b c)), {a=>1, b=>1, c=>1};                           #TarrayToHash

if (1)                                                                          #TreloadHashes
 {my $a = bless [bless {aaa=>42}, "AAAA"], "BBBB";
  eval {$a->[0]->aaa};
  ok $@ =~ m(\ACan.t locate object method .aaa. via package .AAAA.);
  reloadHashes($a);
  ok $a->[0]->aaa == 42;
 }

if (1)                                                                          #TreloadHashes
 {my $a = bless [bless {ccc=>42}, "CCCC"], "DDDD";
  eval {$a->[0]->ccc};
  ok $@ =~ m(\ACan.t locate object method .ccc. via package .CCCC.);
  reloadHashes($a);
  ok $a->[0]->ccc == 42;
 }

if (1) {                                                                        #TreadFile #TwriteFile #ToverWriteFile
  my $f =  writeFile(undef, q(aaaa));
  ok readFile($f) eq q(aaaa);
  eval{writeFile($f, q(bbbb))};
  ok $@ =~ m(\AFile already exists)s;
  ok readFile($f) eq q(aaaa);
  overWriteFile($f,  q(bbbb));
  ok readFile($f) eq q(bbbb);
  unlink $f;
 }

if ($freeBsd or $windows or $dragonFly) {ok 1 for 1..3} else {
if (1) {                                                                        #TwriteFiles #TreadFiles #TcopyFile #TcopyFolder
  my $h =
   {"aaa/1.txt"=>"1111",
    "aaa/2.txt"=>"2222",
   };
  clearFolder(q(aaa), 3);
  clearFolder(q(bbb), 3);
  writeFiles($h);
  my $a = readFiles(q(aaa));
  is_deeply $h, $a;
  copyFolder(q(aaa), q(bbb));
  my $b = readFiles(q(bbb));
  is_deeply [sort values %$a],[sort values %$b];

  copyFile(q(aaa/1.txt), q(aaa/2.txt));
  my $A = readFiles(q(aaa));
  is_deeply(values %$A);

  clearFolder(q(aaa), 3);
  clearFolder(q(bbb), 3);
 }
 }

if (1)                                                                          #TsetPackageSearchOrder
 {if (1)
   {package AAAA;

    sub aaaa{q(AAAAaaaa)}
    sub bbbb{q(AAAAbbbb)}
    sub cccc{q(AAAAcccc)}
   }
  if (1)
   {package BBBB;

    sub aaaa{q(BBBBaaaa)}
    sub bbbb{q(BBBBbbbb)}
    sub dddd{q(BBBBdddd)}
   }
  if (1)
   {package CCCC;

    sub aaaa{q(CCCCaaaa)}
    sub dddd{q(CCCCdddd)}
    sub eeee{q(CCCCeeee)}
   }

  setPackageSearchOrder(__PACKAGE__, qw(CCCC BBBB AAAA));

  ok &aaaa eq q(CCCCaaaa);
  ok &bbbb eq q(BBBBbbbb);
  ok &cccc eq q(AAAAcccc);

  ok &aaaa eq q(CCCCaaaa);
  ok &bbbb eq q(BBBBbbbb);
  ok &cccc eq q(AAAAcccc);

  ok &dddd eq q(CCCCdddd);
  ok &eeee eq q(CCCCeeee);

  setPackageSearchOrder(__PACKAGE__, qw(AAAA BBBB CCCC));

  ok &aaaa eq q(AAAAaaaa);
  ok &bbbb eq q(AAAAbbbb);
  ok &cccc eq q(AAAAcccc);

  ok &aaaa eq q(AAAAaaaa);
  ok &bbbb eq q(AAAAbbbb);
  ok &cccc eq q(AAAAcccc);

  ok &dddd eq q(BBBBdddd);
  ok &eeee eq q(CCCCeeee);
 }

if (1)
 {my $d = bless
   {a=>1,
    b=>
     [bless({A=>1, B=>2, C=>3}, q(BBBB)),
      bless({A=>5, B=>6, C=>7}, q(BBBB)),
     ],
    c=>bless({A=>1, B=>2, C=>3}, q(CCCC)),
   }, q(AAAA);

  is_deeply showHashes($d),
   {AAAA => { a => 1, b => 1, c => 1 },
    BBBB => { A => 2, B => 2, C => 2 },
    CCCC => { A => 1, B => 1, C => 1 },
   };

  reloadHashes($d);
  ok $d->c->C == 3;
 }

ok swapFilePrefix(q(/aaa/bbb.txt), q(/aaa/), q(/AAA/)) eq q(/AAA/bbb.txt);      #TswapFilePrefix

if (1)                                                                          #ToverrideMethods #TisSubInPackage
 {sub AAAA::Call {q(AAAA)}

  sub BBBB::Call {q(BBBB)}
  sub BBBB::call {q(bbbb)}

  if (1)
   {package BBBB;
    use Test::More;
    *ok = *Test::More::ok;
    *isSubInPackage = *Data::Table::Text::isSubInPackage;
    ok  isSubInPackage(q(AAAA), q(Call));
    ok !isSubInPackage(q(AAAA), q(call));
    ok  isSubInPackage(q(BBBB), q(Call));
    ok  isSubInPackage(q(BBBB), q(call));
    ok Call eq q(BBBB);
    ok call eq q(bbbb);
    &Data::Table::Text::overrideMethods(qw(AAAA BBBB Call call));
    *isSubInPackage = *Data::Table::Text::isSubInPackage;
    ok  isSubInPackage(q(AAAA), q(Call));
    ok  isSubInPackage(q(AAAA), q(call));
    ok  isSubInPackage(q(BBBB), q(Call));
    ok  isSubInPackage(q(BBBB), q(call));
    ok Call eq q(AAAA);
    ok call eq q(bbbb);
    package AAAA;
    use Test::More;
    *ok = *Test::More::ok;
    ok  Call eq q(AAAA);
    ok &call eq q(bbbb);
   }
 }

if (1)                                                                          #ToverWriteBinaryFile #TwriteBinaryFile #TcopyBinaryFile
 {vec(my $a, 0, 8) = 254;
  vec(my $b, 0, 8) = 255;
  ok dump($a) eq dump("\xFE");
  ok dump($b) eq dump("\xFF");
  ok length($a) == 1;
  ok length($b) == 1;

  my $s = $a.$a.$b.$b;
  ok length($s) == 4;

  my $f = eval {writeFile(undef, $s)};
  ok fileSize($f) == 8;

  eval {writeBinaryFile($f, $s)};
  ok $@ =~ m(Binary file already exists:)s;

  eval {overWriteBinaryFile($f, $s)};
  ok !$@;
  ok fileSize($f) == 4;

  eval {readFile($f)};
  ok $@, "readFile";

  ok $s eq eval {readBinaryFile($f)};

  copyBinaryFile($f, my $F = temporaryFile);
  ok $s eq readBinaryFile($F);
  unlink $f, $F;
 }

is_deeply [parseFileName(q(/home/phil/r/aci2/out/.ditamap))],
          ["/home/phil/r/aci2/out/", "", "ditamap"];

ok relFromAbsAgainstAbs
 ("/home/phil/r/aci2/out/audit_events.xml",
  "/home/phil/r/aci2/out/.ditamap") eq "audit_events.xml";


if (1) {                                                                        #TmergeHashesBySummingValues
  is_deeply +{a=>1, b=>2, c=>3},
    mergeHashesBySummingValues
      +{a=>1,b=>1, c=>1}, +{b=>1,c=>1}, +{c=>1};
 }

#tttt

1
