#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Write data in tabular text format.
# Philip R Brenan at gmail dot com, Appa Apps Ltd Inc, 2016-2019
#-------------------------------------------------------------------------------
# podDocumentation
# perl Build.PL && perl Build test && sudo perl Build install
# To escape an open parenthesis in a regular expression use: \x28, for close use: \x29
# document and test foot option for format table
# E for exportable methods
# write binary data without complaints about wide characters
# ddd, eee, lll methods
# formatTableHH hash with sub hash of {} fails to print see svgToDita
# runInParallel - processing statistics
# formatTable should optionally clear left columns identical to previous line

package Data::Table::Text;
use v5.20;
our $VERSION = 20190716;                                                        # Version
use warnings FATAL => qw(all);
use strict;
use Carp qw(confess carp cluck);
use Cwd;
use Digest::MD5 qw(md5_hex);
use File::Path qw(make_path);
use File::Glob qw(:bsd_glob);
use File::Temp qw(tempfile tempdir);
use POSIX qw(:sys_wait_h strftime);                                             # http://www.cplusplus.com/reference/ctime/strftime/
use Data::Dump qw(dump);
use IO::Socket::UNIX;
use JSON;
use MIME::Base64;
use Scalar::Util qw(blessed reftype looks_like_number);
use Storable qw(store retrieve);
use Time::HiRes qw(time gettimeofday);
use utf8;

#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 and writing results.

sub fff($$@)                                                                    # Confess a message with a line position and a file that Geany will jump to if clicked on.
 {my ($line, $file, @m) = @_;                                                   # Line, file, messages
  return unless (join '', @_) =~ m(\S)s;

  my $m = join ' ', @m;                                                         # Time stamp each message
  $m .= " at $file line $line";

  confess "  $m\n";                                                             # Confess
 }

our @lll;                                                                       # Run log
sub lll(@)                                                                      # Log messages including the project name if available. This method is not merged as we need to retain its prototype.
 {my (@m) = @_;                                                                 # Messages
  return unless (join '', @_) =~ m(\S)s;

  my $m = join ' ', timeStamp, @_;                                              # Time stamp each message
  my ($p, $f, $l) = caller();
  $m .= " at $f line $l";

  push @lll, $m;                                                                # Log message
  say STDERR $m;                                                                # Say message
  $m                                                                            # Return message produced
 }

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 $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 xxxr($$)                                                                    #I Execute a bash command B<$cmd> as user b<$user>on the server whose ip address is located in L<awsIp>.
 {my ($cmd, $user) = @_;                                                        # Command string, userid on remote system
  my $ip = &awsIp;                                                              # Ip address
  print STDERR my $r = qx(ssh $user\@$ip $cmd);                                 # Execute command remotely
  $r
 } # 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
    lll $_;                                                                     # 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. To execute remotely, add "ssh ... 'echo start" as the first line and "echo end'" as the last line with the commands to be executed on the lines in between.
 {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 = sub                                                               # 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

  my $pid  = fork;                                                              # Fork
  if (!defined($pid))                                                           # Fork failed
   {confess "Unable to fork!\n";
   }
  elsif ($pid == 0)                                                             # 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 or string
 {my ($file) = @_;                                                              # File or string
  if ($file !~ m((\0|\n))s and -e $file)                                        # From file
   {my $s = readBinaryFile($file);
    return md5_hex($s);
   }
  else                                                                          # From string - convoluted but necessary to avoid utf8 problems
   {my $f = writeFile(undef, $file);
    my $m = &fileMd5Sum($f);
    unlink $f;
    return $m;
   }
 }

sub guidFromMd5($)                                                              # Create a guid from an md5 hash.
 {my ($m) = @_;                                                                 # Md5 hash
  length($m) >= 32 or confess "Not an md5 hash: ". ($m//"undef");
  join '-', q(GUID), substr($m, 0, 8),  substr($m, 8, 4), substr($m, 12, 4),    # Uppercase might be needed to meet the strictest definition of a GUID
                     substr($m, 16, 4), substr($m, 20);
 }

sub md5FromGuid($)                                                              # Recover an md5 sum from a guid.
 {my ($G) = @_;                                                                 # Guid
  length($G) >= 41 or confess "Incorrect length for guid: $G";                  # Check guid
  my $g = substr($G, 0, 41);
  return $g =~ s(guid|-) ()igsr if $g =~ m(\AGUID-[0-9a-f]{8}(-[0-9a-f]{4}){3}-[0-9a-f]{12}\Z)is;
  confess "Incorrect format for guid: $g";
 }

sub guidFromString($)                                                           # Create a guid from a file or string via an md5 hash.
 {my ($string) = @_;                                                            # File name or string
  guidFromMd5 fileMd5Sum $string
 }

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

sub fileInWindowsFormat($)                                                      # Convert a unix file name to windows format
 {my ($file) = @_;                                                              # File
  $file =~ s(\/) (\\)gsr
 }

#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
  $file or confess "File required";
  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
  $file or confess "File required";
  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 or confess "File required";
  $file =~ s(\A.*/) ()gsr =~ s(\.[^.]+?\Z) ()gsr
 }

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

sub fe($)                                                                       # Get extension of file name.
 {my ($file) = @_;                                                              # File name
  $file or confess "File required";
  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;
  $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 B<$known> name to a B<$new> one if the file does in fact start with the B<$known> name otherwise returns the original file name. The B<$new> prefix is optional, if not supplied the B<$known> prefix is removed.
 {my ($file, $known, $new) = @_;                                                # File name, existing prefix, optional new prefix defaults to q()
  my $L = length($file);
  my $l = length($known);
  if ($L >= $l)
   {if (substr($file, 0, $l) eq $known)
     {return ($new//q()).substr($file, $l);
     }
    return $file;
   }
  confess "Known $l longer than file name $L:\n$known\n$file";
 } # swapFilePrefix

sub setFileExtension($;$)                                                       # Set the extension of a file to a specified value. Removes the extension if no extension is specified.
 {my ($file, $extension) = @_;                                                  # File name, optional new extension
  return $file =~ s(\.\w+\Z) ()sr unless defined $extension;                    # Remove extension
  my $ext = $extension =~ s(\A\.+) ()gsr;                                       # Remove leading dots
  return $file                    unless $ext;                                  # No extension after dot removal
  ($file =~ s(\.\w+\Z) ()gsr).q(.).$ext;                                        # Change extension
 } # setFileExtension

sub swapFolderPrefix($$$)                                                       # Swaps a starting folder of a file name from a known name to a new one if the file does in fact start with the known name and the known name and new name are folders else return the file as is.
 {my ($file, $known, $new) = @_;                                                # File name, existing prefix, new prefix
  swapFilePrefix($file, fpd($known), fpd($new));
 } # swapFolderPrefix

sub fullyQualifiedFile($)                                                       # Return whether a file is fully qualified or not
 {my ($file) = @_;                                                              # File name to test
  $file =~ m(\A/)s;
 } # fullyQualifiedFile

sub fullyQualifyFile($)                                                         # Return the fully qualified name of a file
 {my ($file) = @_;                                                              # File name
  return $file if fullyQualifiedFile($file);                                    # File is already fully qualified
  absFromAbsPlusRel(&currentDirectory, $file);                                  # Fully qualify file name
 } # fullyQualifiedFile

sub removeDuplicatePrefixes($)                                                  # Remove duplicated leading path components from a file name.
 {my ($file) = @_;                                                              # File name
  return $file unless $file =~ m(/)s;                                           # No path to deduplicate
  return $file if $file =~ m(\A[/.]);                                           # Later
  my ($p, @p) = split m(/), $file;
  shift @p while @p && $p[0] eq $p;
  join "/", $p, @p;
 } # removeDuplicatePrefixes

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

#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) considering .. to be always part of the path ans using B<undef> to mark missing components.  This differs from (fp, fn, fe) which return q() for missing components and do not interpret . or .. as anything special
 {my ($file) = @_;                                                              # File name to parse
  defined($file) or confess "File required";
  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 absFromAbsPlusRel2($$)                                                      #P 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(/)
 } # absFromAbsPlusRel2

sub absFromAbsPlusRel($$)                                                       # Create an absolute file from an absolute file and a relative file.
 {my ($a, $f) = @_;                                                             # Absolute file name, relative file name
  return $f if &absFile($f);                                                    # Return the relative file name immediately if in fact it is absolute
  my $r = absFromAbsPlusRel2($a, $f);                                           # Sum abs and rel file to make a new abs file
  $r =~ s(/+) (/)gsr                                                            # Remove doubles slashes
 } # 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 absFile($)                                                                  # Return B<undef> if the file is a relative file or b<$file> if the file is an absolute file name
 {my ($file) = @_;                                                              # File to test
  return $file if $file =~ m(\A/);
  undef
 }

sub sumAbsAndRel(@)                                                             #I Combine zero or more absolute and relative file names starting at the current working folder to get an absolute file name.
 {my (@f) = @_;                                                                 # Absolute and relative file names
  unshift @f, currentDirectory;
  while(@f > 1)
   {my $a = shift @f;
    my $b = shift @f;
    unshift @f, absFile($b) ? $b : absFromAbsPlusRel($a, $b);
   }
  $f[0]
 } # 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 findAllFilesAndFolders($)                                                   #P Find all the files and folders under a folder.
 {my ($dir) = @_;                                                               # Folder to start the search with
  my @files;                                                                    # Files
  my $c   = qq(find "$dir" -print0);                                            # Use find command to find files
  my $res = qx($c);                                                             # Execute find command
  defined($res) or confess "No result from find command below\n$c\n";           # Find failed for some reason
  utf8::decode($res);                                                           # Decode unicode file names
  split /\0/, $res                                                              # Split out file names on \0
 } # findFiles

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
  for(findAllFilesAndFolders($dir))                                             # All files and folders
   {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
  for(findAllFilesAndFolders($dir))                                             # All files and folders
   {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)
 } # fileList

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 @extensions = grep {$_ and !-d $_ and !m([\/])} @_;                        # Extensions are not directories
  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 = @extensions ? join '|', @extensions : undef;                        # Extensions
  my @file;                                                                     # Files
  for my $dir(@_)                                                               # Directories
   {next unless $dir && -d $dir;                                                # Do not include folder names

    for my $d(findAllFilesAndFolders($dir))                                     # All files and folders beneath each folder
     {next if -d $d;                                                            # Do not include folder names
      push @file, $d if !$ext or $d =~ m(($ext)\Z)is;                           # Filter by extension if requested.
     }
   }
  my @sorted = sort @file;                                                      # Return sorted file list
  @sorted
 } # searchDirectoryTreesForMatchingFiles

sub countFileExtensions(@)                                                      # Return a hash which counts the file extensions under the specified directories
 {my (@folders) = @_;                                                           # Folders to search
  my %ext;
  for my $dir(@folders)                                                         # Directories
   {next unless -d $dir;
    for my $file(findAllFilesAndFolders($dir))                                  # All files and folders under the current folder
     {next if -d $file;                                                         # Do not include folder names
      $ext{fe $file}++;
     }
   }
  \%ext                                                                         # Return extension counts
 } # countFileExtensions

sub countFileTypes($@)                                                          # Return a hash which counts, in parallel, the results of applying the B<file> command to each file under the specified directories.
 {my ($maximumNumberOfProcesses, @folders) = @_;                                # Maximum number of processes to run in parallel, Folders to search
  my %ext;
  my @files = squareArray(searchDirectoryTreesForMatchingFiles(@folders));      # Find files

  my $p = newProcessStarter($maximumNumberOfProcesses);                         # Process starter
     $p->totalToBeStarted  = scalar @files;

  for my $block(@files)                                                         # Apply file to each file
   {$p->start(sub
     {my @r;
      for my $file(@$block)
       {my $f = quoteFile($file);
        my $r = qx(file $f);
        push @r, trim(swapFilePrefix($r, $file.q(:), q()));
       }
      [@r]
     });
   }

  for my $type(deSquareArray($p->finish))                                       # Consolidate results
   {$ext{$type}++;
   }

  \%ext
 } # countFileTypes

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|\r) 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";
  if (wantarray)                                                                # Read as an array
   {my @string = eval {<$F>};
    $@ and confess "$@ reading file:\n$file\n";
    return @string;
   }
  else                                                                          # Read as a string
   {local $/ = undef;
    my $string = eval {<$F>};
    $@ and confess "$@ reading file:\n$file\n";
    return $string;
   }
 } # readFile

sub evalFile($)                                                                 # Read a file containing unicode in utf8, evaluate it, confess to any errors and then return any result with L<lvalueMethod> methods to access each hash element - an improvement on B<do> which silently ignores any errors.
 {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|\r) 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|\r) 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 undef unless @path > 1;
  pop @path unless $file =~ /[\\\/]\Z/;                                         # Remove file component allowing us to present files as well as folders
  my $path = join '/', @path;
  return undef if -d $path;
  eval {make_path($path)};
  -d $path or confess "Cannot make path:\n$path\n";
  $file                                                                         # Success!  Return the file so we can chain more actions on it
 } # 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
 {my ($file, $string) = @_;                                                     # File to write to or B<undef> for a temporary file, unicode string to write
  $file //= temporaryFile;
  $file =~ m(\n|\r)s and confess "File name contains a new line:\n=$file=\n";
  $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) or confess "Could not close file:\n$file\n$!\n";;
  -e $file or confess "Failed to write to file:\n$file\n";
  $file
 } # overWriteFile

BEGIN{*owf=*overWriteFile}                                                      # Short form of overwrite file

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 already exists.
 {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;
  $file =~ m(\n|\r)s and confess "File name contains a new line:\n=$file=\n";
  $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$!\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> optionally swapping the prefix of each file from B<$old> to B<$new>
 {my ($hash, $old, $new) = @_;                                                  # Hash of key value pairs representing files and data, optional old prefix, new prefix
  for my $file(sort keys %$hash)                                                # Write file data for each hash key
   {my $target = $old && $new ? swapFilePrefix($file, $old, $new) : $file;      # Optionally swap file prefix
    overWriteFile($file, $hash->{$file})
   }
 } # writeFiles

sub readFiles(@)                                                                # Read all the files in the specified B<@folders> into a hash
 {my (@folders) = @_;                                                           # Folders to read
  my %h;
  for my $file(searchDirectoryTreesForMatchingFiles(@folders))                  # 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. The file being appended to is locked first with L<https://perldoc.perl.org/functions/flock.html> to allow  multiple processes to append linearly to the same file.
 {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 file for write file:\n$file\n$!\n";
  binmode($F, ":utf8");
  flock($F, 2);
  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 setPermissionsForFile($$)                                                   # Set the permissions for the named file
 {my ($file, $permissions) = @_;                                                # File, permissions settings per chmod
  qx(chmod $permissions $file);                                                 # Use chmod to set permissions
 }

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

#D2 Copy                                                                        # Copy files and folders. The B<\Acopy.*Md5Normalized.*\Z> methods can be used to ensure that files have collision proof names that collapse duplicate content even when copied to another folder.

sub copyFile($$)                                                                # Copy a file encoded in utf8 and return the target name
 {my ($source, $target) = @_;                                                   # Source file, target file
  owf($target, readFile($source));
  my $s = fileSize($source);
  my $t = fileSize($target);
  $s eq $t or confess
    "Copied file has a different size\n".formatTable
    ([[$s, $source], [$t, $target]], <<END);
Size Size of file
File Name of file
END
  $target
 }

sub nameFromStringMaximumLength {128}                                           #P Maximum length of a name generated from a string

sub nameFromString($%)                                                          # Create a readable name from an arbitrary string of text.
 {my ($string, %options) = @_;                                                  # String, options

  my @name;
  if ($string =~ m(<(bookmap))s)                                                # The ghastly compromise
   {push @name, q(bm);
   }
  elsif ($string =~ m(<(bookmap|concept|glossentry|html|map|reference|task))s)  # The correct solution
   {push @name, substr($1, 0, 1);
   }

  $string =~ s(<[^>]*>) (_)gs;                                                  # Remove xml/html tags
  $string =~ s([^a-z0-9_])(_)gis;                                               # Reduce character set to produce a readable name
  push @name, $string;

  my $name = join q(_), @name;
     $name =~ s(_+)(_)gs;                                                       # Remove runs of underscores
     $name =~ s((\A_+|_+\Z)) ()gs;                                              # Remove leading and trailing underscores

  firstNChars($name, $options{maximumLength} // nameFromStringMaximumLength);   # Limit the name length
 }

sub nameFromStringRestrictedToTitle($%)                                         # Create a readable name from a string of text that might contain a title tag - fall back to L<nameFromString|/nameFromString> if that is not possible.
 {my ($string, %options) = @_;                                                  # String, options

  my @name;
  if ($string =~ m(<(bookmap))s)                                                # The ghastly compromise
   {push @name, q(bm);
   }
  elsif ($string =~ m(<(bookmap|concept|glossentry|html|map|reference|task))s)  # The correct solution
   {push @name, substr($1, 0, 1);
   }

  for my $t(qw(title mainbooktitle booktitlealt ))                               # Various title tags
   {if ($string =~ m(<$t>(.*?)</$t>)is)
     {push @name, $1;
     }
   }

  my $name = lc join '_', @name;                                                # Mim believes in lc
  $name =~ s(<[^>]*>) (_)gs;                                                    # Remove xml/html tags
  $name =~ s([^a-z0-9_])(_)gis;                                                 # Reduce character set to produce a readable name
  $name =~ s(_+)(_)gs;                                                          # Remove runs of underscores
  $name =~ s((\A_+|_+\Z)) ()gs;                                                 # Remove leading and trailing underscores

  firstNChars($name, $options{maximumLength} // nameFromStringMaximumLength);   # Limit the name length
 }

sub uniqueNameFromFile($)                                                       # Create a unique name from a file name and the md5 sum of its content
 {my ($source) = @_;                                                            # Source file
  my $sourceFile = fn $source;                                                  # File name component
  return fne($source) if $sourceFile =~ m([0-9a-z]{32}\Z)is;                    # Name already normalized
  my $sourceFileLimited = nameFromString($sourceFile);                          # File name with limited character set
  my $md5 = fileMd5Sum($source);                                                # Normalizing Md5 sum
  fpe($sourceFileLimited.q(_).$md5, fe $source);                                # Normalized name
 }

sub nameFromFolder($)                                                           # Create a name from the last folder in the path of a file name.  Return undef if the file does not have a path.
 {my ($file) = @_;                                                              # File name
  my $p = fp $file;
  my @p = split m(/), $p;
  return $p[-1] if @p;
  undef
 }

sub copyFileMd5Normalized(;$$)                                                  # Normalize the name of the specified B<$source> file to the md5 sum of its content, retaining its current extension, while placing the original file name in a companion file if the companion file does not already exist.  If no B<$target> folder is supplied the file is renamed to its normalized form in situ, otherwise it is copied to the target folder and renamed there. A companion file for the B<$source> file is created by removing the extension of the normalized file and writing the original B<$source> file name to it unless such a file already exists as we assume that it contains the 'original' original name of the B<$source> file. If the B<$source> file is copied to a new location then the companion file is copied as well to maintain the link back to the original name of the file.
 {my ($source, $Target) = @_;                                                   # Source file, target folder or a file in the target folder
cluck "Deprecated in favor of Dita::GB::Standard";
  -e $source && !-d $source or
    confess "Source file to normalize does not exist:\n$source";
  my $target = fp($Target // $source);                                          # Target folder
  my $sourceFile = fn $source;                                                  # File name component

  if ($sourceFile =~ m([0-9a-z]{32}\Z)is)                                       # Name already normalized
   {if (@_== 2)                                                                 # Copy source to new folder if necessary
     {my $target = fpf(fp($Target), fne($source));
      copyFile($source, $target);
      my $id = setFileExtension($source);
      my $od = setFileExtension($target);
      if (!-e $od)
       {if (-e $id)
         {copyFile($id, $od);
         }
        else
         {owf($od, $source);
         }
       }
      return $target;                                                           # Normalized target
     }
    return $source;                                                             # File is already normalized
   }

  my $out = fpe($target, nameFromString(readFile($source)));                    # Create normalized name in new folder depending only on the content of the source file
  my $id  = setFileExtension($source);                                          # Source companion file carrying original name
  my $od  = setFileExtension($out);                                             # Target companion file carrying original name

  if (!-e $out)                                                                 # Copy file unless it is already there - we know the target is correct because its name is normalized
   {copyFile($source, $out);                                                    # Copy source to normalized target
    if (-e $id)                                                                 # Copy or create companion file
     {copyFile($id, $od);
     }
    elsif (!-e $od)
     {owf($od, $source);                                                        # Create a companion file as none exists
     }
   }
  $out                                                                          # Return normalized image file name
 }

sub copyFileMd5NormalizedName($$@)                                              # Name a file using the GB Standard
 {my ($content, $extension, %options) = @_;                                     # Content, extension, options
cluck "Deprecated in favor of Dita::GB::Standard";
  defined($content) or
    confess "Content must be defined";
  defined($extension) && $extension =~ m(\A\S{2,}\Z)s or
    confess "Extension must be non blank and at least two characters long";
  my $name   = nameFromString($content);                                        # Human readable component
     $name   = nameFromStringRestrictedToTitle($content) if $options{titleOnly};# Not entirely satisfactory
  my $md5    = fileMd5Sum($content);                                            # Md5 sum
  fpe($name.q(_).$md5, $extension)                                              # Add extension
 }

sub copyFileMd5NormalizedCreate($$$$@)                                          # Create a file in the specified B<$folder> whose name is constructed from the md5 sum of the specified B<$content>, whose content is B<$content>, whose extension is B<$extension> and which has a companion file with the same name minus the extension which contains the specified B<$companionContent>.  Such a file can be copied multiple times by L<copyFileMd5Normalized|/copyFileMd5Normalized> regardless of the other files in the target folders.
 {my ($Folder, $content, $extension, $companionContent, %options) = @_;         # Target folder or a file in that folder, content of the file, file extension, contents of the companion file, options.
cluck "Deprecated in favor of Dita::GB::Standard";
  my $folder = fp $Folder;                                                      # Normalized folder name
  my $name   = nameFromString($content);                                        # Entirely satisfactory
     $name   = nameFromStringRestrictedToTitle($content) if $options{titleOnly};# Not entirely satisfactory
  my $md5    = fileMd5Sum($content);
  my $od     = fpf($folder, $name.q(_).$md5);                                   # Companion file
  my $out    = fpe($od, $extension);                                            # Normalized file
  owf($out, $content);                                                          # Write file content
  owf($od,  $companionContent );                                                # Write companion file
  $out
 }

sub copyFileMd5NormalizedGetCompanionContent($)                                 # Return the content of the companion file to the specified B<$source> file after it has been normalized via L<copyFileMd5Normalized|/copyFileMd5Normalized> or L<copyFileMd5NormalizedCreate|/copyFileMd5NormalizedCreate> or return B<undef> if the corresponding companion file does not exist.
 {my ($source) = @_;                                                            # Source file.
cluck "Deprecated in favor of Dita::GB::Standard";
  my $id = setFileExtension($source);
  -e $source && -e $id ? readFile($id) : undef
 }

sub copyFileMd5NormalizedDelete($)                                              # Delete a normalized and its companion file
 {my ($file) = @_;                                                              # File
cluck "Deprecated in favor of Dita::GB::Standard";
  my $companion = setFileExtension($file);
  unlink $_ for $companion, $file;
 }

sub copyBinaryFile($$)                                                          # Copy a binary file and return the target name,
 {my ($source, $target) = @_;                                                   # Source file, target file
  overWriteBinaryFile($target, readBinaryFile($source));
#  my $s = fileSize($source);                                                   # Appears to be unreliable across multiple CPUs
#  my $t = fileSize($target);
#  $s eq $t or confess
#    "Copied binary file has a different size\n".formatTable
#    ([[$s, $source], [$t, $target]], <<END);
#Size Size of file
#File Name of file
#END
  $target
 }

sub copyBinaryFileMd5Normalized($;$)                                            # Normalize the name of the specified B<$source> file to the md5 sum of its content, retaining its current extension, while placing the original file name in a companion file if the companion file does not already exist.  If no B<$target> folder is supplied the file is renamed to its normalized form in situ, otherwise it is copied to the target folder and renamed there. A companion file for the B<$source> file is created by removing the extension of the normalized file and writing the original B<$source> file name to it unless such a file already exists as we assume that it contains the 'original' original name of the B<$source> file. If the B<$source> file is copied to a new location then the companion file is copied as well to maintain the link back to the original name of the file.
 {my ($source, $Target) = @_;                                                   # Source file, target folder or a file in the target folder
cluck "Deprecated in favor of Dita::GB::Standard";
  -e $source or confess "File does not exist:\n$source\n";

  return $source if fn($source) =~ m([0-9a-z]{32}\Z)is and @_ == 1;             # Name already normalized and no target

  my $target = fp($Target);                                                     # Target folder
  my $ext = fe($source);                                                        # Extension
  my $out = fpe($target, $ext.q(_).fileMd5Sum($source), $ext);                  # Normalized name in new folder
  my $id  = setFileExtension($source);                                          # Source companion file carrying original name
  my $od  = setFileExtension($out);                                             # Target companion file carrying original name

  if (!-e $out)                                                                 # Copy file unless it is already there - we know the target is correct because its name is normalized
   {overWriteBinaryFile($out, readBinaryFile($source));
    if (-e $id)                                                                 # Copy or create companion file
     {copyFile($id, $od);
     }
    elsif (!-e $od)
     {owf($od, $source);
     }
   }
  $out                                                                          # Return normalized image file name
 }

sub copyBinaryFileMd5NormalizedCreate($$$$)                                     # Create a file in the specified B<$folder> whose name is constructed from the md5 sum of the specified B<$content>, whose content is B<$content>, whose extension is B<$extension> and which has a companion file with the same name minus the extension  which contains the specified B<$companionContent>.  Such a file can be copied multiple times by L<copyBinaryFileMd5Normalized|/copyBinaryFileMd5Normalized> regardless of the other files in the target folders while retaining the original name information.
 {my ($Folder, $content, $extension, $companionContent) = @_;                   # Target folder or a file in that folder, content of the file, file extension, optional content of the companion file.
cluck "Deprecated in favor of Dita::GB::Standard";
  my $folder = fp $Folder;                                                      # Normalized folder name
  my $md5    = fileMd5Sum($content);                                            # Md5 sum of content
  my $od     = fpf($folder, $extension.q(_).$md5);                              # Companion file
  my $out    = fpe($od, $extension);                                            # Normalized file
  owf($out, $content);                                                          # Write file content
  owf($od, $companionContent);                                                  # Write companion file
  -e $out or confess "Failed to create file $out";
  -e $od  or confess "Failed to create companion file $od";
  $out
 }

sub copyBinaryFileMd5NormalizedGetCompanionContent($)                           # Return the original name of the specified B<$source> file after it has been normalized via L<copyBinaryFileMd5Normalized|/copyBinaryFileMd5Normalized> or L<copyBinaryFileMd5NormalizedCreate|/copyBinaryFileMd5NormalizedCreate> or return B<undef> if the corresponding companion file does not exist.
 {my ($source) = @_;                                                            # Source file.
cluck "Deprecated in favor of Dita::GB::Standard";
  my $id = setFileExtension($source);
  -e $source && -e $id ? readFile($id) : undef
 }

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 --del $source $target), qr(\A\s*\Z));                         # Suppress command printing by supplying a regular expression to test the command output
 }

sub copyFolderToRemote($$)                                                      # Copy a folder to the corresponding folder on the server whose address is returned by L<awsIp>.
 {my ($Source, $userid) = @_;                                                   # Source file, userid on server
  my $source = fullyQualifyFile($Source);                                       # Fully qualify source folder
  -d $Source or confess "No such folder:\n$Source\n";                           # Check source exists
  -d $source or confess "No such folder:\n$source\n";                           # Check source exists
  my $ip  = &awsIp;                                                             # Ip of server
  my $dir = fp $source;                                                         # Folder to create if necessary
  my $c1  = qq(ssh $userid\@$ip mkdir -p $dir);                                 # Create folder
  my $c2  = qq(rsync -r --del $source $userid\@$ip:$source);                    # Transfer files;
  my $cmd = qq($c1; $c2);                                                       # Create folder and transfer files
  xxx($cmd, qr(\A\s*\Z));                                                       # Execute
 }

#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 with optional image reduction.
 {my ($Source, $target, $Size, $Tiles) = @_;                                    # Source file, target folder (as multiple files will be created),  optional size of each tile - defaults to 256, optional limit on the number of tiles in either dimension
  my $source = $Source;
  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

  if ($Tiles)                                                                   # Restrict the converted image to a maximum number of tiles if requested
   {my $s = quoteFile($source);
    my $t = temporaryFile;
    my $n = $Size*$Tiles;
    my $c = qq(convert $s -resize ${n}x${n}\\> $t);
    lll $_ for qx($c 2>&1);
    $source = $t;                                                               # Resized file is now source
   }

  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);
    lll $_ 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> applying an optional scaling if required.
 {my ($Source, $target, $Size, $Tiles) = @_;                                    # Source file, target folder (as multiple files will be created),  optional size of each tile - defaults to 256, optional limit in either direction on the number of tiles
  my $source = $Source;

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

  if ($Tiles)                                                                   # Restrict the converted image to a maximum number of tiles if requested
   {my $s = quoteFile($source);
    my $t = temporaryFile;
    my $n = $Size*$Tiles;
    my $c = qq(convert $s -resize ${n}x${n}\\> $t);
    lll $_ for qx($c 2>&1);
    $source = $t;                                                               # Resized file is now source
   }

  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);
    lll $_ 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
  lll "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;
   }
  lll "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";

    lll "$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)
  JSON->new->utf8->pretty->canonical->encode($string)
 }

sub decodeJson($)                                                               # Decode Perl from Json.
 {my ($string) = @_;                                                            # Data to decode
# decode_json($string);
  JSON->new->utf8->pretty->canonical->decode($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
 }

sub asciiToHexString($)                                                         # Encode an ascii string as a string of hexadecimal digits.
 {my ($ascii) = @_;                                                             # Ascii string
  my $c = '';                                                                   # Result
  for my $a(split //, $ascii)                                                   # Each ascii character
   {$c .= sprintf("%x", ord $a)                                                 # Format as hex
   }
  $c                                                                            # Return string of hexadecimal digits
 }

sub hexToAsciiString($)                                                         # Decode a string of hexadecimal digits as an ascii string.
 {my ($hex) = @_;                                                               # Hexadecimal string
  my @c = grep {m/[0-9a-f]/i} split //, $hex;                                   # Each hexadecimal digit
  my $c = '';                                                                   # Result
  for my $i(keys @c)                                                            # Index of each hexadecimal digit
   {if ($i % 2 == 1)                                                            # End of latest pair
     {$c .= chr hex $c[$i-1].$c[$i];                                            # Convert to character
     }
   }
  $c                                                                            # Return result
 }

#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 setCombination(@)                                                           #P Count the elements in sets represented as arrays of strings and/or the keys of hashes
 {my (@s) = @_;                                                                 # Array of arrays of strings and/or hashes
  my %e;
  for my $s(@s)                                                                 # Intersect each set
   {my $t = reftype($s);
    if (!defined $t)                                                            # Scalar as a set of one
     {$e{$s}++
     }
    elsif ($t =~ m(array)is)                                                    # Intersect array of strings
     {for my $e(@$s)                                                            # Count instances of each string
       {$e{$e}++
       }
     }
    elsif ($t =~ m(hash)is)                                                     # Intersect keys of hash
     {for my $e(keys %$s)                                                       # Count instances of each key
       {$e{$e}++
       }
     }
    else                                                                        # Unknown set type
     {confess "Unknown set type: $t";
     }
   }
  \%e                                                                           # Count of each set member
 }

sub setUnion(@)                                                                 # Union of sets represented as arrays of strings and/or the keys of hashes
 {my (@s) = @_;                                                                 # Array of arrays of strings and/or hashes
  my $e = setCombination(@_);
  sort keys %$e                                                                 # Return words in union
 }

sub setIntersection(@)                                                          # Intersection of sets represented as arrays of strings and/or the keys of hashes
 {my (@s) = @_;                                                                 # Array of arrays of strings and/or hashes
  my $e = setCombination(@_);
  my $S = @s;                                                                   # Set count
  grep {$e->{$_} == $S} sort keys %$e                                           # Return words that appear in all the sets
 }

sub setIntersectionOverUnion(@)                                                 # Returns the size of the intersection over the size of the union of one or more sets represented as arrays and/or hashes
 {my (@s) = @_;                                                                 # Array of arrays of strings and/or hashes
  my $e = setCombination(@_);                                                   # Set element count
  my $u = keys %$e;                                                             # Union size
  $u == 0 and confess "Empty union";                                            # 0/0 can be anything
  my $S = @s;                                                                   # Set count
  my $i = grep {$e->{$_} == $S} keys %$e;                                       # Intersection size
  $i/$u                                                                         # Return ratio
 }

sub setPartitionOnIntersectionOverUnion($@)                                     # Partition a set of sets so that within each partition the L<setIntersectionOverUnion|/setIntersectionOverUnion> of any two sets in the partition is never less than the specified B<$confidence**2>
 {my ($confidence, @sets) = @_;                                                 # Minimum setIntersectionOverUnion, array of arrays of strings and/or hashes representing sets
  my @s = sort {scalar(@$b) <=> scalar(@$a)} map {[setUnion($_)]} @sets;        # Input sets as arrays in descending order of length

  my @partition;
  while(@s)                                                                     # The proposed partition
   {my $base = shift @s;                                                        # Each set starting with the largest
    next unless defined $base;                                                  # No longer present
    my @base = ($base);                                                         # Create set of elements congruent with the base set
    for my $i(keys @s)                                                          # Each remaining set
     {my $s = $s[$i];                                                           # Current set to compare with base set
      next unless defined $s;                                                   # Current set has already been classified
      last if scalar(@$s) < scalar(@$base) * $confidence;                       # Too small in comparison to the base and the sets are in descending order of size so all the remainder will have the same problem
      my $o = setIntersectionOverUnion($base, $s);                              # Overlap
      if ($o > $confidence)                                                     # Overlap is better than confidence
       {push @base, $s;                                                         # Include in partition
        $s[$i] = undef;                                                         # Remove from further consideration
       }
     }
    push @partition, \@base;                                                    # Save partition
   }
  @partition;                                                                   # Return partitions
 }

sub setPartitionOnIntersectionOverUnionOfSetsOfWords($@)                         # Partition a set of sets of words so that within each partition the L<setIntersectionOverUnion|/setIntersectionOverUnion> of any two sets of words in the partition is never less than the specified B<$confidence**2>
 {my ($confidence, @sets) = @_;                                                 # Minimum setIntersectionOverUnion, array of arrays of strings and/or hashes representing sets

  my %u;                                                                        # Normalized set to input sets with this normalization
  for my $s(@sets)                                                              # Each set
   {push @{$u{join ' ', setUnion($s)}}, $s;                                     # Normalized set back to each input set of words
   }
  my @partition = setPartitionOnIntersectionOverUnion($confidence,              # Partition normalized sets
   map {[split / /, $_]} sort keys %u);                                         # We can split

  my @P;
  for my $partition(@partition)                                                 # Each partition
   {my @p;
    for my $set(@$partition)                                                    # Each set in the current partition
     {push @p, @{$u{join ' ',  @$set}};
     }

    push @P, \@p;
   }
  @P
 }

sub setPartitionOnIntersectionOverUnionOfStringSets($@)                         # Partition a set of sets, each set represented by a string containing words and punctuation, each word possibly capitalized, so that within each partition the L<setPartitionOnIntersectionOverUnionOfSetsOfWords|/setPartitionOnIntersectionOverUnionOfSetsOfWords> of any two sets of words in the partition is never less than the specified B<$confidence**2>
 {my ($confidence, @strings) = @_;                                              # Minimum setIntersectionOverUnion, sets represented by strings

  my %u;                                                                        # Normalized set to input sets with this normalization
  for my $s(@strings)                                                           # Each set
   {my $n = $s =~ s([^a-z ]) ()girs =~ s(\s+) ( )gsr;
    push @{$u{$n}}, $s;                                                         # Normalized set back to each input set of words
   }

  my @partition = setPartitionOnIntersectionOverUnionOfSetsOfWords($confidence, # Partition normalized strings
    map {[split /\s+/, $_]} keys %u);
  my @P;                                                                        # Partition of strings
  for my $partition(@partition)                                                 # Each partition
   {my @p;
    for my $set(@$partition)                                                    # Each set in the current partition
     {push @p, @{$u{join ' ',  @$set}};
     }

    push @P, \@p;
   }
  @P
 }

sub setPartitionOnIntersectionOverUnionOfHashStringSets($$)                     # Partition a set of sets represented by a hash, each hash value being a string containing words and punctuation, each word possibly capitalized, so that within each partition the L<setPartitionOnIntersectionOverUnionOfSetsOfWords|/setPartitionOnIntersectionOverUnionOfSetsOfWords> of any two sets of words in the partition is never less than the specified B<$confidence**2> and the partition entries are the hash keys of the string sets.
 {my ($confidence, $hashSet) = @_;                                              # Minimum setIntersectionOverUnion, sets represented by the hash value strings
  reftype($hashSet) =~ m(hash)is or confess "Second parameter must be a hash";

  my %u;                                                                        # Invert the hash so we can present the partitions by hash key
  for my $s(sort keys %$hashSet)                                                # Each set
   {push @{$u{$$hashSet{$s}}}, $s;                                              # Invert
   }

  my @partition = setPartitionOnIntersectionOverUnionOfStringSets($confidence,  # Partition strings
    sort values %$hashSet);

  my @P;                                                                        # Partition of strings
  for my $partition(@partition)                                                 # Each partition
   {my @p;
    my %p;                                                                      # If n sets are identical we get n repetitions - this hash prevents that.
    for my $set(@$partition)                                                    # Each set in the current partition
     {if (my $u = $u{$set})
       {for my $U(@$u)
         {push @p, $U unless $p{$U}++;
         }
       }
     }

    push @P, [sort @p];
   }
  sort {scalar(@$b) <=> scalar(@$a)} @P
 }

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
 }

sub countOccurencesInString($$)                                                 # Returns the number of times the first string occurs in the second string
 {my ($inString, $searchFor) = @_;                                              # String to search in, string to search for.

  my $n = 0;
  my $w = length($searchFor);
  my $W = length($inString);
  $W >= $w or confess "String to search must be longer than string to look for";
  for my $p(0..$W-$w)
   {++$n if substr($inString, $p, $w) eq $searchFor;
   }
  $n
 }

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

sub min(@)                                                                      # Find the minimum number in a list confessing to any ill defined values.
 {my (@m) = @_;                                                                 # Numbers
  my @n = grep {defined($_) and looks_like_number($_)} @_;
  @_ == @n or confess q(Undefined or non numeric parameters present);
  return undef unless @n;
  my $M = shift;
  for(@n)
   {$M = $_ if $_ < $M;
   }
  $M
 }

sub indexOfMin(@)                                                               # Find the index of the minimum number in a list confessing to any ill defined values.
 {my (@m) = @_;                                                                 # Numbers
  my @n = grep {defined($_) and looks_like_number($_)} @_;
  @_ == @n or confess q(Undefined or non numeric parameters present);
  return undef unless @n;
  my $M = 0;
  for my $i(keys @n)
   {my $n = $n[$i];
    $M = $i if $n < $n[$M];
   }
  $M
 }

sub max(@)                                                                      # Find the maximum number in a list confessing to any ill defined values.
 {my (@m) = @_;                                                                 # Numbers
  my @n = grep {defined($_) and looks_like_number($_)} @_;
  @_ == @n or confess q(Undefined or non numeric parameters present);
  return undef unless @n;
  my $M = shift;
  for(@n)
   {$M = $_ if $_ > $M;
   }
  $M
 }

sub indexOfMax(@)                                                               # Find the index of the maximum number in a list confessing to any ill defined values.
 {my (@m) = @_;                                                                 # Numbers
  my @n = grep {defined($_) and looks_like_number($_)} @_;
  @_ == @n or confess q(Undefined or non numeric parameters present);
  return undef unless @n;
  my $M = 0;
  for my $i(keys @n)
   {my $n = $n[$i];
    $M = $i if $n > $n[$M];
   }
  $M
 }

sub arraySum(@)                                                                 # Find the sum of any strings that look like numbers in an array
 {my (@a) = @_;                                                                 # Array to sum
  my @n = grep {defined($_) and looks_like_number($_)} @_;
  @_ == @n or confess q(Undefined or non numeric parameters present);
  my $sum = 0; $sum += $_ for @n;
  $sum
 }

sub arrayProduct(@)                                                             # Find the product of any strings that look like numbers in an array
 {my (@a) = @_;                                                                 # Array to multiply
  my @n = grep {defined($_) and looks_like_number($_)} @_;
  @_ == @n or confess q(Undefined or non numeric parameters present);
  my $product = 1; $product *= $_ for @n;
  $product
 }

sub arrayTimes($@)                                                              # Multiply the second and subsequent parameters by the first parameter and return as an array
 {my ($multiplier, @a) = @_;                                                    # Multiplier, array to multiply and return
  map {$multiplier * $_} @a
 }

#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
   {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 formatTableClearUpLeft($)                                                   #P Blank identical column values up and left
 {my ($data) = @_;                                                              # Array of arrays

  for   my $row(1..@$data)                                                      # Each row from last to first
   {my $d = $$data[-$row];
    last if $row == @$data;

    my $p = $row+1;
    for my $c(reverse 1..@$d)                                                   # Compare left values in current row to previous row
     {next unless my $dc = $$d[-$c];
      next unless my $pc = $$data[-$p][-$c];
      if ($dc eq $pc)                                                           # Blank equal value
       {$$d[-$c] = q();
       }
      else                                                                      # Values not equal terminates equal valued column supression
       {last;
       }
     }
   }
 }

sub formatTableAA($$%)                                                          #P Tabularize an array of arrays.
 {my ($data, $title, %options) = @_;                                            # Data to be formatted, reference to an array of titles, options
  return dump($data) unless ref($data) =~ /array/i and @$data;

  my $d;                                                                        # Copy of the input data because we are going to modify it
  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";
    push @$d, [q(), @$row];                                                     # Copy each row with space for a row number
   }

  formatTableClearUpLeft($d) if $options{clearUpLeft};                          # Clear up and left if requested
  $$d[$_-1][0] = $_ for 1..@$data;                                              # Number each row now that we have suppressed duplicates
  unshift @$d, ['', @$title] if $title;                                         # Add title
  formatTableBasic($d);                                                         # Format array
 }

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

our @formatTables;                                                              # tttt Report of all the reports that have been created

sub formatTable($;$%)                                                           #I Format various data structures as a table with titles as specified by B<$columnTitles>: either a reference to an array of column titles or a string each line of which contains the column title as the first word with the rest of the line describing that column.\mOptionally create a report from the table using the following optional report B<%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<foot=E<gt>$foot> footer text that will be placed immediately after the table.\mB<summarize=E<gt>$summarize> if true and B<$data> is an array of arrays, then each column of the will be summarized by printing its distinct values and a count of how often each value occurs in a series of smaller tables following the main table.\mB<wide=E<gt>$wide>write a note explaining the need to scroll to the right if true.\mB<msg=E<gt>$msg> if true a summary of the situation will be written to STDERR including the first line of the header and the file being written to.\mB<zero=E<gt>$zero> if true the report will be written to the specified file even if the report is empty.\mParameters:
 {my ($data, $columnTitles, %options) = @_;                                     # Data to be formatted, optional reference to an array of titles or string of column descriptions, options

  checkKeys(\%options,                                                          # Check report options
    {title=><<'END',
Title for the table
END
     head=><<'END',
Header text which will preceed the formatted table.
DDDD will be replaced with the current date and time.
NNNN will be replaced with the number of rows in the table.
TTTT will be replaced with the title from the title keyword
END
     foot=><<'END',
Footer text which will follow the table
END
     summarize=><<'END',
If true, each column of an array of arrays will be summarized by printing its
distinct values and a count of how often each value occurs in a series of
smaller tables following the main table.
END
     clearUpLeft=><<'END',
If numeric +/-\$N, replace any left hand column values repeated in the
following row with white space to make it easier to follow the range of keys.
If a positive count is given the clearing will always be stopped after the
numbered column (based from 1) if negative, then clearing will be stopped after
the column obtained by counting back counting 1-\$N columns from the last
column. Thus a value of -1 will stop clearing after the final column which
could potentially produce a blank row if there are two duplicate ros in
sequence.
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.),
     wide=>q(Write a note explaining the need to scroll to the right if true),
     msg =>q(Write a message to STDERR summarizing the situation if true),
     zwsp=>q(Make the rows of the table splitable on \u200B == the zero width space by including a zero width space before each column entry.),
     csv =>q(Add a line showing the summarized columnn contents in csv format if true),
    });

  my ($titleString, $title) = sub                                               # Title string, column headers
   {return (undef, undef) unless defined $columnTitles;                         # No titles
    if (my $r = reftype $columnTitles)                                          # Array of column titles
     {return (undef, $columnTitles) if $r =~ m(\Aarray\Z)si;
     }
    return (q(), q()) unless $columnTitles;                                     # Column titles are not required for hash of hashes
    my @c = map {[split m(\s+), $_, 2]} split "\n", $columnTitles;              # Column definitions
    my $s = &formatTable(\@c, [qw(Column Description)]);                        # Column definitions descriptions table
   ($s, [map {$$_[0]} @c])
   }->();

  my ($a, $h, $o) = (0, 0, 0);                                                  # Check structure of input data tttt
  my $checkStructure = sub
   {for(@_)
     {my $r = reftype($_);                                                      # Process arrays and hashes or objects built on them
      if ($r)
       {if ($r =~ /array/i)   {++$a}
        elsif ($r =~ /hash/i) {++$h}
        else                  {++$o}
       }
      else                    {++$o}
     }
   };

  my $formattedTable = sub                                                      # Format table
   {if    (reftype($data) =~ /array/i)
     {$checkStructure->(       @$data);
      return formatTableAA($data, $title, %options) if  $a and !$h and !$o;
      return formatTableAH($data)                   if !$a and  $h and !$o;
      return formatTableA ($data, $title);
     }
    elsif (reftype($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

  my ($Title, $head, $foot, $file, $zero, $summarize, $wide, $msg, $csv, $zwsp) = map{$options{$_}} # Options requested
    qw(title   head   foot   file   zero   summarize   wide   msg   csv   zwsp);

  my @report;
  my $date = dateTimeStamp;
  my $N    = keyCount(1, $data);
  my $H    = ($head//'') =~ s(DDDD) ($date)gr =~ s(NNNN) ($N)gr;
     $H    =~ s(TTTT_) ($title)gs         if $Title;
  push @report, $Title                    if $Title;
  push @report, $H                        if $head;
  push @report, qq(This file: $file)      if $file;
  push @report, $titleString              if $titleString;
  push @report, <<END                     if $wide;
Please note that this is a wide report: you might have to scroll
a long way to the right to see all the columns of data available!
END
  push @report, <<END                     if $summarize;
Summary_of_column                - Count of unique values found in each column                     Use the Geany flick capability by placing your cursor on the first word
Comma_Separated_Values_of_column - Comma separated list of the unique values found in each column  of these lines and pressing control + down arrow to see each sub report.
END

  push @report, $formattedTable;
  push @report, $foot                     if $foot;

  push @formatTables, [$N, $Title//nws($H, 80), $file];                         # Report of all the reports created

  if ($msg and $file and $head)
   {lll $H =~ s(\n.*\Z) ()gsr;
    lll qq(See file: $file);
   }

  if ($summarize)                                                               # Summarize an array of arrays if requested
   {my $s = '';
    if (reftype($data) =~ /array/i)
     {if ($a and !$h and !$o)
       {for my $col(1..@$title)
         {my $n = $title->[$col-1];
          my $c = qq(Summary_of_column_$n);
          my @s = summarizeColumn($data, $col-1);
          my $t = &formatTable(\@s, [q(Count), $n]);
          $s .= qq($c\n$t\n);
          if (1 or $csv)
           {my $v = join ",", map {dump($$_[1])} @s;
            $s .= "Comma_Separated_Values_of_column_$n: $v\n\n";
           }
         }
       }
     }
    push @report, $s;
   }

  my $report = join "\n\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 formattedTablesReport(@)                                                    # Report of all the reports created. The optional parameters are the same as for L<formatTable|/formatTable>
 {my (@options) = @_;                                                           # Options

  formatTable([sort {($a->[1]//'') cmp ($b->[1]//'')} @formatTables], <<END,
Rows   Number of entries in table
Title  Title of the report
File   File containing the report
END
    @options);
 }

sub summarizeColumn($$)                                                         # Count the number of unique instances of each value a column in a table assumes.
 {my ($data, $column) = @_;                                                     # Table == array of arrays, column number to summarize.
  my @data = map {$$_[$column]} @$data;
  my %data;
  for my $d(@data)
   {$data{$d}++ if defined $d;
   }
  sort {return $$a[1] cmp $$b[1] if $$b[0] == $$a[0];                           # Return array of [count, key]
        return $$b[0] <=> $$a[0]} map {[$data{$_}, $_]} sort keys %data;
 }

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 a 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);
    my $R = reftype($attributes{$m});                                           # Type of thing referred to
    my $r = !defined($R) ? q() : $R =~ m(array)i ? q( //= []) : q( //= {});     # Empty return type
    $s .= 'sub '.$bless.'::'.$m. ':lvalue {$_[0]{"'.$m.qq("}$r})."\n";          # LValue version for get and set
    $s .= 'sub '.$bless.'::'.$m. 'X       {$_[0]{"'.$m.'"}//q()}'."\n";         # Default to blank for get
   }

  if ($s)                                                                       # Add any new methods needed
   {eval $s;
    confess "$@\n$s\n$@" 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
 }

my $reloadHashesCount = 0;                                                      # Generate names for reloaded hashes that are not already blessed

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)                                                         # Array
   {$$progress{$d}++;
    &reloadHashes2($_, $progress) for @$d;
   }
  elsif ($d =~ m(hash)is)                                                       # Hash
   {$$progress{$d}++;
    &reloadHashes2($_, $progress) for values %$d;
    if (my $b = blessed($d))                                                    # Already blessed
     {genHash($b, %$d);
     }
    else                                                                        # Create a name
     {my $b = q(reloadHash_).++$reloadHashesCount;
      bless($d, $b);                                                            # Bless hash
      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($$@)                                                        #S 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(setUnion @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 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((\x{200b}|\A\s+|\s+\Z)) ()gr =~ 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;
 }

sub javaScriptExports($)                                                        # Extract the Javascript functions marked for export in a file or string.  Functions are marked for export by placing function in column 1 followed by //E on the same line.  The end of the exported function is located by \n }
 {my ($fileOrString) = @_;                                                      # File or string
  my $s = $fileOrString =~ m(\n) ? $fileOrString : readFile($fileOrString);
  my @s;
  my $state = 0;
  for my $line(split /\n/, $s)
   {if      ($state == 0)
     {if ($line =~ m(\Afunction.*\/\/E))
       {$state = 1;
        push @s, q(), $line;
       }
     }
    elsif ($state == 1)
     {$state = 0 if $line =~ m(\A \});
      push @s, $line;
     }
   }
  join "\n", @s, '';
 }

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

sub isFileUtf8($)                                                               # Return the file name quoted if its contents are in utf8 else return undef
 {my ($file) = @_;                                                              # File to test
  my $f = quoteFile($file);
  qx(isutf8 -q $f);                                                             # Test
  return $f unless $?;                                                          # File is utf8
  undef                                                                         # File is not utf8
 }

#D1 Unix domain communications                                                  # Send messages between processes via a unix domain socket.

sub newUdsr(@)                                                                  #P Create a communicator - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.
 {my (@parms) = @_;                                                             # Attributes per L<Udsr Definition|/Udsr Definition>
   my $u = genHash(q(Udsr),                                                     # Package name
    client       => undef,                                                      # Client socket and connection socket
    headerLength => 8,                                                          #I Length of fixed header which carries the length of the following message

    serverAction => undef,                                                      #I Server action sub, which receives a communicator every time a client creates a new connection. If this server is going to be started by systemd  as a service with the specified L<serverName> then this is the a actual text of the code that will be installed as a CGI script and run in response to an incoming transaction in a separate process with the userid set to L<serviceUser>. It receives the text of the http request from the browser as parameter 1 and should return the text to be sent back to the browser.

    serverPid    => undef,                                                      # Server pid which can be used to kill the server via kill q(kill), $pid
    socketPath   => q(unix-domain-socket-test.sock),                            #I Socket file

    serviceName  => q(zzz),                                                     #I Service name for install by systemd
    serviceUser  => q(),                                                        #I Userid for service
    @_
   );
 }

sub newUdsrServer(@)                                                            # Create a communications server - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.
 {my (@parms) = @_;                                                             # Attributes per L<Udsr Definition|/Udsr Definition>
  my $u = newUdsr(@_);
  my $f = $u->socketPath;
  unlink $f;
  my $s = IO::Socket::UNIX->new(Type=>SOCK_STREAM(), Local=>$f, Listen=>1);     # Create socket
  if (my $pid = fork)                                                           # Run the server in a process by itself
   {$u->serverPid = $pid;                                                       # Record server pid so it can be killed
    return $u;
   }
  else                                                                          # Run the server action on a client connection
   {while (my $con = $s->accept())
     {$u->client = $con;
      call sub{$u->serverAction->($u)};                                         # The server action sub should use the read and write routines in the passed communicator to interact with the client .
      $con->close;
     }
    exit;
   }
 }

sub newUdsrClient(@)                                                            # Create a new communications client - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.
 {my (@parms) = @_;                                                             # Attributes per L<Udsr Definition|/Udsr Definition>
  my $u = newUdsr(@_);
  $u->client = IO::Socket::UNIX->new(Type=>SOCK_STREAM(), Peer => $u->socketPath);
  $u
 }

sub Udsr::write($$)                                                             # Write a communications message to the L<newUdsrServer|/newUdsrServer> or the L<newUdsrClient|/newUdsrClient>.
 {my ($u, $msg) = @_;                                                           # Communicator, message
  my $con = $u->client;
  my $m = pad(length($msg), $u->headerLength).$msg;
  $con->print($m);
  $u
 }

sub Udsr::read($)                                                               # Read a message from the L<newUdsrServer|/newUdsrServer> or the L<newUdsrClient|/newUdsrClient>.
 {my ($u) = @_;                                                                 # Communicator
  my $con = $u->client;
  $con->read(my $length, $u->headerLength);
  $con->read(my $data,   $length);
  $data
 }

sub Udsr::kill($)                                                               # Kill a communications server.
 {my ($u) = @_;                                                                 # Communicator
  my $p = $u->serverPid;                                                        # Server Pid
  kill 'KILL', $p if $p;                                                        # Kill server
  $u->serverPid = undef;                                                        # Server Pid
  unlink $u->socketPath;                                                        # Remove socket
  $u
 }

sub Udsr::webUser($$)                                                           # Create a systemd installed server that processes http requests using a specified userid. The systemd and CGI files plus an installation script are written to the specified folder after it has been cleared. The L<serverAction> string contains the code to be executed by the server: the contained sub B<genResponse($hash)> will be called with a hash of the CGI variables, it should return the response to be sent back to the client.
 {my ($u, $folder) = @_;                                                        # Communicator, folder to contain server code

  clearFolder($folder, 9);                                                      # Clear the output folder

  my $parms = join ', ',                                                        # Parameters to hand to server and client
    map {my $v = $$u{$_}; defined($v) ? qq($_ => q($v)) : ()}
    grep {!m/serverAction/} keys %$u;

  my $user = $u->serviceUser;                                                   # Communicator details
  my $code = $u->serverAction;
  my $name = $u->serviceName;

  my $ssdt = fpe(qw(/etc systemd system), $name, q(service));                   # Systemd folder

  my $cgif = fpd(qw(/usr lib cgi-bin),    $name);                               # Cgi folder
  my $cgst = fpe($cgif, q(server), q(pl));                                      # cgi server
  my $cgct = fpe($cgif, q(client), q(pl));                                      # cgi client

  my $inst = fpe($folder, qw(install sh));                                      # Install script
  my $ssdl = fpe($folder, qw(service txt));
  my $cgsl = fpe($folder, q(server), q(pl));
  my $cgcl = fpe($folder, q(client), q(pl));

  owf($ssdl, <<END);                                                            # Systemd definition
[Unit]
Description=Http to unix domain socket server

[Service]
Type=forking
ExecStart=/usr/lib/cgi-bin/$name/server.pl
User=$user

[Install]
WantedBy=multi-user.target
END
  setPermissionsForFile($ssdl, q(ugo=rx));                                      # Permissions will be copied to server

  my $server = <<'END';                                                         # Server definition
#!/usr/bin/perl -I/home/phil/perl/cpan/DataTableText/lib/
#-------------------------------------------------------------------------------
# Http to unix domain socket server
#-------------------------------------------------------------------------------
use warnings FATAL => qw(all);
use strict;
use Carp;
use Data::Dump qw(dump);
use Data::Table::Text qw(:all);
use utf8;
use feature qw(say current_sub);

makeDieConfess;

# Server code which should contain a sub genResponse($hash) which returns the response to be sent to the client
<code>

my $parms = newUdsr(<parms>);

$parms->serverAction = sub                                                      # Perform server action
 {my ($c) = @_;                                                                 # Communicator
  my $parms = $c->read;                                                         # Parameter string from client
  my $data = $parms ? eval $parms : undef;                                      # Decode parameter string
  $@ and confess "Unable to decode webUser request:\n$parms\n";                 # Complain about parameter string
  my $resp = genResponse($data);                                                # Execute server action and capture returned value
  $c->write($resp);                                                             # Write back to the client
 };

unlink $parms->socketPath;
newUdsrServer(%$parms);
END
  $server =~ s(<parms>) ($parms)s;
  $server =~ s(<code>)  ($code)s;
  owf($cgsl, $server);
  setPermissionsForFile($cgsl, q(ugo=rx));

  my $client = <<'END';
#!/usr/bin/perl -I/home/phil/perl/cpan/DataTableText/lib/
#-------------------------------------------------------------------------------
# Http to unix domain socket client
#-------------------------------------------------------------------------------
use warnings FATAL => qw(all);
use strict;
use Carp;
use Data::Dump qw(dump);
use Data::Table::Text qw(:all);
use CGI;
use utf8;
use feature qw(say current_sub);

makeDieConfess;

my $cgi = CGI->new;

my %v = $cgi->Vars;

my $parms = newUdsr(<parms>);
my $c     = newUdsrClient(%$parms);
say $c->read($c->write(dump({%v})));
END
  $client =~ s(<parms>) ($parms)s;
  owf($cgcl, $client);
  setPermissionsForFile($cgcl, q(ugo=rx));

  owf($inst, <<END);
sudo rm $ssdt $cgst $cgct
sudo mkdir -p $cgif
sudo cp $ssdl $ssdt
sudo cp $cgsl $cgst
sudo cp $cgcl $cgct
sudo systemctl daemon-reload; sudo systemctl enable $name; sudo systemctl restart $name; sudo systemctl status $name
END

  copyFolderToRemote($folder, $user);                                           # Copy code created locally to remote server
  xxxr(qq(bash $inst), $user);                                                  # Install system by executing install procedure remotely
 }

#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 awsIp                                                                       #P Get ip address of server at aws
 {my $s = readFile(q(/home/phil/.local/bin/sshaws));
  $s =~ s(\A.+?ssh phil\@) ()gsr =~ s(\s*\Z) ()gsr
 }

my $awsCurrentIp;                                                               # Server IP address if running on AWS

sub awsCurrentIp                                                                # Get the ip address of the AWS server we are currently running on if we are running on an AWS server else return false
 {return $awsCurrentIp if $awsCurrentIp;
  $awsCurrentIp =                                                               # Shortest possible connection time so we do not throttle non AWS jobs
    qx(curl -m 0 -s http://169.254.169.254/latest/meta-data/public-ipv4/);
 }

my $numberOfCpus = qx(nproc);                                                   # Number of cpus
sub numberOfCpus {$numberOfCpus}                                                # Number of cpus

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, $folder, $zipFileName, $bucket, $S3Parms) = @_;           # Save every seconds, folder to save, zip file name, bucket/key, additional S3 parameters like profile or region as a string
  @_ == 5 or confess "Five parameters required";
  my $saveTimeFile = fpe($folder, q(codeSaveTimes));                            # Get last save time if any
  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
  my $target = fpe($bucket, $zipFileName, q(zip));                              # Target on S3
  lll "Saving latest version of code in $folder to s3://$target";

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

  if (my $c = qq(cd $folder; zip -qr $z *))                                     # Zip command
   {my $r = qx($c);
    confess "$c\n$r\n" if $r =~ m(\S);                                          # Confirm zip
   }

  my $s3Parms = $S3Parms // '';
  if (my $c = "aws s3 cp $z s3://$target $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
  lll "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
     }

    lll "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
    lll "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))
 }

my @translatePercentEncoding =
 (qq(\n)=>q(%0A),
  qq( ) =>q(%20),
  qq(\")=>q(%22),
  qq(\%)=>q(%25),
  qq(\-)=>q(%2d),
  qq(\.)=>q(%2e),
  qq(\<)=>q(%3c),
  qq(\>)=>q(%3e),
  qq(\\)=>q(%5c),
  qq(\^)=>q(%5e),
  qq(\_)=>q(%5f),
  qq(\`)=>q(%60),
  qq(\{)=>q(%7b),
  qq(\|)=>q(%7c),
  qq(\})=>q(%7d),
  qq(\~)=>q(%7e),
 );

my %translatePercentEncoding =         @translatePercentEncoding;
my %TranslatePercentEncoding = reverse @translatePercentEncoding;

sub wwwEncode($)                                                                # Percent encode a url per: https://en.wikipedia.org/wiki/Percent-encoding#Percent-encoding_reserved_characters
 {my ($string) = @_;                                                            # String
  join '', map {$translatePercentEncoding{$_}//$_} split //, $string
 }

sub wwwDecode($)                                                                # Percent decode a url per: https://en.wikipedia.org/wiki/Percent-encoding#Percent-encoding_reserved_characters
 {my ($string) = @_;                                                            # String
  my $r = '';
  my @s = split //, $string;
  while(@s)
   {my $c = shift @s;
    if ($c eq q(%) and @s >= 2)
     {$c .= shift(@s).shift(@s);
      $r .= $TranslatePercentEncoding{$c}//$c;
     }
    else
     {$r .= $c;
     }
   }
  $r
 }

sub awsTranslateText($$$;$)                                                     # Translate B<$text> from English to a specified B<$language> using AWS Translate with the specified global B<$options> and return the translated string.  Translations are cached in the specified B<$cacheFolder> for reuse were feasible.
 {my ($string, $language, $cacheFolder, $Options) = @_;                         # String to translate, language code, cache folder, aws global options string

  $language =~ m(\A(ar|zh|zh\-TW|cs|da|nl|en|fi|fr|de|he|id|it|ja|ko|pl|pt|ru|es|sv|tr)\Z)i or
  confess "Language code must be one of:\n".
    formatTable([map {split /\s+/, 2} split /\n/, <<END],
Arabic     ar
Chinese-Simplified  zh
Chinese-Traditional zh-TW
Czech      cs
Danish     da
Dutch      nl
English    en
Finnish    fi
French     fr
German     de
Hebrew     he
Indonesian id
Italian    it
Japanese   ja
Korean     ko
Polish     pl
Portuguese pt
Russian    ru
Spanish    es
Swedish    sv
Turkish    tr
END
<<END
Language  Name of the language
Code      Code used to describe language
END
);
  my $name = lc nameFromString($string);                                        # Cache name from input string
  my $cached = fpe($cacheFolder, $language, $name, q(txt));                     # Cache file
  return readFile($cached) if -e $cached;                                       # Assume that what is in the cache file is a reasonable translation.

  my $options = $Options // '';
  my $c = <<END =~ s(\n) ( )gsr;
aws translate translate-text
  --text "$string"
 --source-language-code "en"
 --target-language-code "$language"
 --region "us-east-1"
 $options
END

  if (my $J = qx($c))                                                           # Translate
   {my $p = decodeJson($J);                                                     # Decode json response
    if (my $t = $p->{TranslatedText})                                           # Get translation
     {owf($cached, $t);                                                         # Cache result
      return $t;                                                                # Return translation
     }
   }
  confess "Unable to perform translation";                                      # No useful response from Aws
 }

#D1 Processes                                                                   # Start processes, wait for them to terminate and retrieve their results

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
  cluck "Deprecated in favor of newProcessStarter";
  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
  cluck "Deprecated in favor of newProcessStarter";
  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, %options) = @_;                                # Maximum number of processes to start, options
  my $h = genHash(q(Data::Table::Text::Starter),                                # Process starter definition.
    transferArea             => temporaryFolder,                                # The name of the folder in which files transferring results from the child to the parent process will be stored.
    autoRemoveTransferArea   => 1,                                              # If true then automatically clear the transfer area at the end of processing.
    maximumNumberOfProcesses => $maximumNumberOfProcesses // 8,                 # 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                     => {},                                             # A hash of pids representing processes started but not yet completed.
    resultsArray             => [],                                             # Consolidated array of results.
    processingTitle          => undef,                                          #I Optional: title describing the processing being performed.
    processingLogFile        => undef,                                          #I Optional: name of a file to which process start and end information should be appended
    processingLogFileHandle  => undef,                                          # Handle for log file if a log file was supplied
    totalToBeStarted         => undef,                                          #I Optionally: the total number of processes to be started - if this is supplied then an estimate of the finish time for this processing is printed to the log file every time a process starts or finishes.
    processStartTime         => {},                                             # {pid} == time the process was started.
    processFinishTime        => {},                                             # {pid} == time the process finished.
    startTime                => time,                                           # Start time
   );

  loadHash($h, %options);                                                       # Load and validate the options
 }

sub Data::Table::Text::Starter::logEntry($$)                                    #P Create a log entry showing progress and eta.
 {my ($starter, $finish) = @_;                                                  # Starter, 0 - start; 1 - finish
  if (my $l = $starter->processingLogFile)                                      # Write a log entry if a log file has been supplied
   {my $t   = $starter->processingTitle // '';                                  # Title of processing
    my $sf  = $finish ? q(F) : q(S);                                            # Whether we are starting or finishing
    my $N   = $starter->totalToBeStarted;                                       # Total number to be started if known
    my $M   = $starter->maximumNumberOfProcesses // 1;                          # Maximum number of processes in parallel
    my $started  = keys %{$starter->processStartTime};                          # Number of processes started
    my $finished = keys %{$starter->processFinishTime};                         # Number of processes finished

    if (!$finish and $started == 1 and $t)                                      # Title message
     {my $n = $N ? qq(Start $N processes in parallel upto $M for:) :
                   qq(Process in parallel upto $M:);
      $starter->say(join " ", timeStamp, "$n $t");
     }

    my $eta = sub                                                               # Estimate finish time
     {if ($N and $finished)                                                     # Expected number of starts has been supplied and at least one process has finished
       {my $avgExecTime = $starter->averageProcessTime;                         # Average execution time process
        my $toGo        = ($N - $finished) * $avgExecTime / $M;                 # Time to go not with standing Amdahl's law.
        my @finishAt    = localtime(time + $toGo);                              # Finish time
        my $finishTime  = strftime('%H:%M:%S', @finishAt);                      # Format finish time
        return sprintf("eta: %.2f seconds at $finishTime", $toGo);              # Finish time message
       }
      q()                                                                       # No estimate available for finish time
     }->();

    my $w = $N ? length($N) : 0;                                                # Width of output field
    my $p = $N == 0 ? q()   :                                                   # Progress indicator
      sprintf("%${w}d", $finish ? $finished : $started).q(/).$N;

    $starter->say(join " ", timeStamp, $sf, $p, $eta, $t);
   }
 }

sub Data::Table::Text::Starter::averageProcessTime($)                           #P Average elapsed time spent by each process
 {my ($starter) = @_;                                                           # Starter
  my $execTime = 0;                                                             # Total execution time for all processes that have finished so far
  for my $finish(sort keys %{$starter->processFinishTime})                      # Sum execution time over all processes that have finished
   {my $f =                  $starter->processFinishTime->{$finish} // 0;       # Finish time
    my $s =                  $starter->processStartTime ->{$finish} // 0;       # Start time
    $execTime += $f - $s;                                                       # Execution time
   }
  my $finished = keys %{$starter->processFinishTime} || 1;                      # Number of processes finished
  $execTime / $finished;                                                        # Average execution time process
 }

sub Data::Table::Text::Starter::say($@)                                         #P Write to the log file if it is available.
 {my ($starter, @message) = @_;                                                 # Starter, text to write to log file.
  return unless my $F = $starter->processingLogFileHandle;                      # Number of processes started
  flock($F, 2);
  print {$F} join '', @message, "\n";
 }

sub Data::Table::Text::Starter::start($$)                                       # Start a new process to run the specified B<$sub>.
 {my ($starter, $sub) = @_;                                                     # Starter, sub to be run.

  my $started  = keys %{$starter->processStartTime};                            # Number of processes started

  if ($started == 0)
   {if (my $file = $starter->processingLogFile)
     {makePath($file);
      open my $F, ">>$file" or
        confess "Cannot open file for write, file:\n$file\n$!\n";
      binmode($F, ":utf8");
      $starter->processingLogFileHandle = $F;
     }
   }

  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
   {my $startTime = time;
    $starter->pids->{$pid}++;                                                   # Update pids
    $starter->processStartTime->{$pid} = time;                                  # Time process was started
    $starter->logEntry;                                                         # Write a log entry
   }
  else                                                                          # Run sub in new process
   {#setpriority(0, 0, +1);                                                     # Run at a slightly lower priority to make sure the parent can reap zombies as quickly as possible - questionable and does not work on "haiku"
    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);
      eval {store [$results], $f};                                              # Store data
      $@ and confess "$@\n";                                                    # Confess to any errors
     }
    exit;
   }
 }

sub Data::Table::Text::Starter::waitOne($)                                      #P Wait for at least one process to finish and consolidate its results.
 {my ($starter) = @_;                                                           # Starter
  my $select = 0;                                                               # Must wait for at least one process to finish
  my $startTime = time;

  while(keys(%{$starter->pids}) and my $p = waitpid 0, $select)                 # 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
        if (-e $f)
         {my $size = fileSize($f);
          my $big  = $size > 1e9;
cluck "Big file" if $big;
lll "Retrieve $f start size $size " if $big;
          if (my $d = eval {retrieve $f})                                       # Retrieve data
           {if (ref($d) =~ m(array)is)                                          # Check we got an array reference
             {if (@$d == 1)                                                     # array should have just one element
               {push @{$starter->resultsArray}, $$d[0];                         # Save data in parent
               }
              else
               {confess "Too many results returned";
               }
             }
            else
             {confess "Expected an array";
             }
           }
          else
           {cluck "Unable to retrieve results";
           }
lll "Retrieve $f end" if $big;
         }
        else
         {cluck "No such file $f";
         }
       }
     }

    $starter->processFinishTime->{$p} = time;                                   # Approximate time process ended
    $starter->logEntry(1);                                                      # Write a log entry
    delete $starter->pids->{$p};                                                # Remove pid from consideration
    $select = WNOHANG;                                                          # Subsequent waits do not, in fact,  wait.
   }
 }

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

  my @r = @{$starter->resultsArray};                                            # Return results

  if (my $l = $starter->processingLogFile)                                      # Log file provided
   {my $t        = $starter->processingTitle // '';                             # Title of processing
    my $N        = $starter->totalToBeStarted;                                  # Total number to be started if known
    my $started  = keys %{$starter->processStartTime};                          # Number of processes started
    my $finished = keys %{$starter->processFinishTime};                         # Number of processes finished

    my @m;
    if ($t)
     {push @m, timeStamp. " Finished $finished processes for: $t"
     }
    else
     {push @m, timeStamp. " Finished $finished processes"
     }

    push @m, "Elapsed time: ".
     sprintf("%.2f seconds", time - $starter->startTime);

    push @m, "Average process execution time: ".
      sprintf("%.2f seconds", $starter->averageProcessTime);

    my $but = qq(Started $started processes but);                               # Complain if not enough processes finished
    if ($started != @r)
     {my $r = @r;
      push @m, "$but only received results from $r";
     }
    if ($started != $finished)
     {push @m, "$but only $finished finished";
     }
    if ($started != $N)
     {push @m, "$but totalToBeStarted=>$N was specified";
     }
    if (my $F = $starter->processingLogFileHandle)                              # Log
     {$starter->say(join "\n", @m);                                             # Log message
      $starter->processingLogFileHandle = undef;
      close($F);                                                                # Close log
     }
   }

  if ($starter->autoRemoveTransferArea)                                         # Clear the transfer area if requested
   {clearFolder($starter->transferArea, scalar(@r)+1)
   }

  @r                                                                            # Return results
 }

sub squareArray(@)                                                              # Create a two dimensional square array from a one dimensional linear array.
 {my (@array) = @_;                                                             # Array
  my $N = @array;                                                               # Size of linear array
  my $n = int sqrt $N;                                                          # Dimension of square array
  ++$n unless $n*$n == $N;                                                      # Adjust up unless perfect square
  my @s;                                                                        # Square array
  my $i = 0; my $j = 0;                                                         # Current coordinates in square array
  for my $e(@array)                                                             # Load square array from linear array
   {$s[$j][$i] = $e;                                                            # Current element
    ++$i;                                                                       # Next minor coordinate
    ++$j, $i = 0 if $i >= $n;                                                   # Next major coordinate
   }
  @s                                                                            # Resulting square array
 }

sub deSquareArray(@)                                                            # Create a one dimensional array from a two dimensional array of arrays
 {my (@square) = @_;                                                            # Array of arrays
  my @a;
  for my $r(@square)                                                            # Each row
   {ref($r) =~ m(array)is or confess "Not an array reference";
    push @a, @$r;                                                               # Push row contents
   }
  @a                                                                            # Linear array
 }

sub countSquareArray(@)                                                         #P Count the number of elements in a square array
 {my (@square) = @_;                                                            # Array of arrays
  my $a = 0;
  for my $r(@square)                                                            # Each row
   {ref($r) =~ m(array)is or confess "Not an array reference";
    $a += scalar(@$r);                                                          # Push row contents
   }
  $a                                                                            # Count
 }

sub runInParallel($$$@)                                                         # Process each element of B<@array> in square root parallel with a maximum B<$maximumNumberOfProcesses> processes using sub B<&$parallel> to process an element and then call sub B<&$results> to process all the results returned by B<&$parallel>. B<&$parallel> receives an element from B<@array>. B<&$results> receives an array of all the results returned by B<&$parallel>.
 {my ($maximumNumberOfProcesses, $parallel, $results, @array) = @_;             # Maximum number of processes, parallel sub, results sub, array of items to process

  my $p = newProcessStarter($maximumNumberOfProcesses);                         # Process starter

  for my $s(@array)                                                             # Process each element of the array
   {$p->start(sub{&$parallel($s)});
   }

  &$results($p->finish)                                                         # Consolidate results
 } # runInParallel

sub runInSquareRootParallel($$$@)                                               # Process each element of B<@array> in square root parallel with a maximum B<$maximumNumberOfProcesses> processes using sub B<&$parallel> to process an element and then call sub B<&$results> to process all the results returned by B<&$parallel>. B<&$parallel> receives an element from B<@array>. B<&$results> receives an array of all the results returned by B<&$parallel>.
 {my ($maximumNumberOfProcesses, $parallel, $results, @array) = @_;             # Maximum number of processes, parallel sub, results sub, array of items to process

  my @s = squareArray(@array);                                                  # Square array of processes
  my $p = newProcessStarter($maximumNumberOfProcesses);                         # Process starter

  for my $row(@s)                                                               # Process each row of the square
   {$p->start(sub
     {my @r;
      for my $s(@$row)                                                          # Process each element of each row and consolidate the results
       {push @r, &$parallel($s);
       }
      [@r]
     });
   }

  &$results(deSquareArray $p->finish)                                           # Consolidate results
 } # runInSquareRootParallel

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  => int(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 ($service, $continue) = @_;                                                # Current service details, return result if B<$continue> is true else confess if the service has been replaced
  my $t = evalFile($service->file);                                             # Latest service details
  return $t if $t->start   == $service->start   and                             # Check service details match
               $t->service eq $service->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 parseDitaRef($;$$)                                                          # Parse a dita reference into its components optionally supplying a base file name for the file component and the topic id of the current topic as the default for the topicId if not present.
 {my ($ref, $File, $TopicId) = @_;                                              # Reference to parse, default absolute file, default topic id
  return (q()) x 3 unless $ref and $ref =~ m(\S)s;

  my ($file, $rest)  = split /#/, $ref, 2;
  my ($topicId, $id) = split m(/), $rest||q(), 2;
  $file    = $File && $file ? sumAbsAndRel($File, $file) : $File || $file||q(); # Full file path if possible
  $topicId = $topicId || $TopicId || q();
  $topicId = $TopicId if $TopicId and $topicId eq q(.);
  $id    ||= q();

  ($file, $topicId, $id)
 }

sub reportSettings($;$)                                                         # Report the current values of parameterless subs in a B<$sourceFile> that match \Asub\s+(\w+)\s*\{ and optionally write the report to B<$reportFile>. Return the text of the report.
 {my ($sourceFile, $reportFile) = @_;                                           # Source file, optional report file
  cluck "Deprecated, please use reportAttributeSettings instead";
  my $s = readFile($sourceFile);

  my %s;
  for my $l(split /\n/, $s)                                                     # Find the attribute subs
   {if ($l =~ m(\Asub\s*(\w+)\s*\{.*?#\s+(.*)\Z))
     {$s{$1} = $2;
     }
   }

  my @r;
  for my $s(sort keys %s)                                                       # Evaluate each sub
   {my ($package, $filename, $line) = caller;                                   # Callers context
    my $v = eval q(&).$package.q(::).$s;                                        # Current value in callers context
    my $r = $@ // '';                                                           # Failure description
    push @r, [$s, $v, $r, $s{$s}];                                              # Table entry of sub name, sub value, reason why there is no value, comment
   }

  formatTable(\@r, <<END,                                                       # Format table
Attribute The name of the program attribute
Value     The current value of the program attribute
END
    head      => qq(Found NNNN parameters on DDDD),
    title     => qq(Attributes in program: $sourceFile),
    summarize => 1,
    $reportFile ? (file=>$reportFile) : ());
 }

sub reportAttributes($)                                                         # Report the attributes present in a B<$sourceFile>
 {my ($sourceFile) = @_;                                                        # Source file
  my $s = readFile($sourceFile);
  my %s;
  for my $l(split /\n/, $s)                                                     # Find the attribute subs
   {if ($l =~ m(\Asub\s*(\w+)\s*\{.*?#\s+(.*)\Z))
     {$s{$1} = $2;
     }
   }
  \%s
 }

sub reportAttributeSettings(;$)                                                 # Report the current values of the attribute methods in the calling file and optionally write the report to B<$reportFile>. Return the text of the report.
 {my ($reportFile) = @_;                                                        # Optional report file
  my ($package, $sourceFile, $line) = caller;                                   # Callers context

  my $a = reportAttributes($sourceFile);                                        # Attribute methods in calling file

  my @r;
  for my $s(sort keys %$a)                                                      # Evaluate each sub
   {my $v = eval q(&).$package.q(::).$s;                                        # Current value in callers context
    my $r = $@ // '';                                                           # Failure description
    push @r, [$s, $v, $r, $$a{$s}];                                             # Table entry of sub name, sub value, reason why there is no value, comment
   }

  formatTable(\@r, <<END,                                                       # Format table
Attribute The name of the program attribute
Value     The current value of the program attribute
END
    head      => qq(Found NNNN parameters on DDDD),
    title     => qq(Attributes in program: $sourceFile),
    summarize => 1,
    $reportFile ? (file=>$reportFile) : ());

  \@r
 }

sub reportReplacableMethods($)                                                  # Report the replaceable methods marked with #r in a B<$sourceFile>
 {my ($sourceFile) = @_;                                                        # Source file
  my $s = readFile($sourceFile);
  my %s;
  for my $l(split /\n/, $s)                                                     # Find the attribute subs
   {if ($l =~ m(\Asub\s*(\w+).*?#\w*r\w*\s+(.*)\Z))
     {$s{$1} = $2;
     }
   }
  \%s
 }

sub reportExportableMethods($)                                                  # Report the exportable methods marked with #e in a B<$sourceFile>
 {my ($sourceFile) = @_;                                                        # Source file
  my $s = readFile($sourceFile);
  my %s;
  for my $l(split /\n/, $s)                                                     # Find the attribute subs
   {if ($l =~ m(\Asub\s*(\w+).*?#\w*e\w*\s+(.*)\Z))
     {$s{$1} = $2;
     }
   }
  \%s
 }

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 wellKnownUrls                                                               #P Short names for some well known urls
 {genHash(q(Short_Names_For_Well_Known_Urls),                                   #  Short names for some well known urls
    ascii           => [q(Ascii),                          "https://en.wikipedia.org/wiki/ASCII"                                                                                   ],
    aws             => [q(Amazon Web Services),            "http://aws.amazon.com"                                                                                   ],
    boson           => [q(boson),                          "https://en.wikipedia.org/wiki/Boson"                                                                                   ],
    commandline     => [q(command line),                   "https://en.wikipedia.org/wiki/Command-line_interface"                                                                  ],
    confess         => [q(confess),                        "http://perldoc.perl.org/Carp.html#SYNOPSIS/"                                                                           ],
    dex             => [q(Data::Edit::Xml),                "https://metacpan.org/pod/Data::Edit::Xml"                                                                                       ],
    die             => [q(die),                            "http://perldoc.perl.org/functions/die.html"                                                                            ],
    ditaot          => [q(DITA-OT),                        "http://www.dita-ot.org/download"                                                                                       ],
    dita            => [q(Dita),                           "http://docs.oasis-open.org/dita/dita/v1.3/os/part2-tech-content/dita-v1.3-os-part2-tech-content.html"                  ],
    dtt             => [q(Data::Table::Text),              "https://metacpan.org/pod/Data::Table::Text"                                                                                       ],
    eval            => [q(eval),                           "http://perldoc.perl.org/functions/eval.html"                                                                           ],
    extensions      => [q(file name extensions),           "https://en.wikipedia.org/wiki/List_of_filename_extensions"                                                             ],
    find            => [q(find),                           "https://en.wikipedia.org/wiki/Find_(Unix)"                                                                             ],
    gbstandard      => [q(GB Standard),                    "http://metacpan.org/pod/Dita::GB::Standard"                                                                            ],
    github          => [q(GitHub),                         "https://github.com"                                                                                                    ],
    gnufdl          => [q(GNU Free Documentation License), "https://en.wikipedia.org/wiki/Wikipedia:Text_of_the_GNU_Free_Documentation_License"                                    ],
    grep            => [q(grep),                           "https://en.wikipedia.org/wiki/Grep"                                                                                    ],
    guid            => [q(guid),                           "https://en.wikipedia.org/wiki/Universally_unique_identifier"                                                           ],
    gui             => [q(graphical user interface),       "https://en.wikipedia.org/wiki/Graphical_user_interface"                                                                ],
    htmltable       => [q(html table),                     "https://www.w3.org/TR/html52/tabular-data.html#the-table-element"                                                      ],
    imagemagick     => [q(Imagemagick),                    "https://www.imagemagick.org/script/index.php"                                                                          ],
    laser           => [q(laser),                          "https://en.wikipedia.org/wiki/Laser"                                                                                   ],
    lvaluemethod    => [q(lvalue method),                  "http://perldoc.perl.org/perlsub.html#Lvalue-subroutines"                                                               ],
    md5             => [q(md5 sum),                        "https://en.wikipedia.org/wiki/MD5"                                                                                     ],
    our             => [q(our),                            "https://perldoc.perl.org/functions/our.html"                                                                           ],
    oxygenformat    => [q(Oxygen Format),                  "https://www.oxygenxml.com/doc/versions/20.1/ug-author/topics/linked-output-messages-of-external-engine.html"           ],
    perlal          => [q(Perl Artistic Licence),          "https://dev.perl.org/licenses/artistic.html"                                                                           ],
    perl            => [q(Perl),                           "http://www.perl.org/"                                                                                                  ],
    shell           => [q(shell),                          "https://en.wikipedia.org/wiki/Shell_(computing)"                                                                       ],
    tab             => [q(tab),                            "https://en.wikipedia.org/wiki/Tab_key"                                                                                 ],
    unicode         => [q(Unicode),                        "https://en.wikipedia.org/wiki/Unicode"                                                                                 ],
    utf8            => [q(utf8),                           "https://en.wikipedia.org/wiki/UTF-8"                                                                                   ],
    xmlparser       => [q(Xml parser),                     "https://metacpan.org/pod/XML::Parser/"                                                                                 ],
    xref            => [q(Data::Edit::Xml::Xref),          "https://metacpan.org/pod/Data::Edit::Xml::Xref"                                                                                       ],
    zerowidthspace  => [q(zero width space),               "https://en.wikipedia.org/wiki/Zero-width_space"                                                                        ],
   );
 } # wellKnownUrls

sub expandWellKnownUrls($;$)                                                    # Expand short url names in a string given in the format LE<lt>url-nameE<gt> as listed in L<Short_Names_For_Well_Known_Urls>.
 {my ($string, $Format)  = @_;                                                  # String containing url names to expand, output format: perl; html; dita
  my $format = $Format // 'perl';                                               # Default expansion format
  my $wellKnown = wellKnownUrls;                                                # Well known urls to expand

  if ($format =~ m(p)is)                                                        # Expand well known urls as perl links
   {for my $w(sort keys %$wellKnown)
     {my ($t, $u) = @{$$wellKnown{$w}};
      $string =~ s(L<$w>) (L<$t|$u>)gis;
     }
   }
  elsif ($format =~ m(d)is)                                                     # Expand well known urls as dita xrefs links
   {for my $w(sort keys %$wellKnown)
     {my ($t, $u) = @{$$wellKnown{$w}};
      $string =~ s(L\[$w\]) (<xref scope="external" format="html" href="$u">$t</xref>)gis;
     }
   }
  elsif ($format =~ m(h)is)
   {for my $w(sort keys %$wellKnown)                                            # Expand well known urls as html a links
     {my ($t, $u) = @{$$wellKnown{$w}};
      $string =~ s(L\[$w\]) (<a format="html" href="$u">$t</a>)gis;
     }
   }
  $string                                                                       # Result
 }

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 = 200;                                                  # 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 %genHashFlags;                                                             # Flags on attributes in objects defined by genHash
  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 @synopsis;                                                                 # External synopsis to allow L<symbol> to be expanded
  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+)"
       {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 fff($L, $perlModule, "Too many lines in example");         # 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 fff($L, $perlModule, "Too many lines in test");              # 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*.+?#(\w*)\s+(.*)\Z))
         {my $flags = $genHashFlags{$p}{$1} = $2;
                      $genHashs    {$p}{$1} = $3;
          if (my $invalidFlags = $flags =~ s([I]) ()gsr)
           {confess "Invalid flags $invalidFlags on line $L:\n$nextLine";
           }
         }
        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".
          join("\n", @lines[$l..$L]);
       }
     }
   }

  for my $l(keys @lines)                                                        # Place the synopsis in a here doc block starting with my $documentationSynopsis = <<END; if this text contains L<symbol> that should be expanded. If present, the generated text will be used to generate a =head1 Synopsis section just before the description
   {my $line = $lines[$l];
    if ($line =~ m(\Amy \$documentationSynopsis = <<END;))
     {for(my ($L, $N) = ($l + 1, 0); $L < @lines; ++$L, ++$N)
       {my $nextLine = $lines[$L];
        last if $nextLine =~ m(\AEND\Z);
        push @synopsis, $nextLine;
       }
     }
   }

  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(off)?/)                                               # 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)
     {my @i; my @o;                                                             # Input and output attributes
      for my $attribute(sort keys %{$genHashs{$package}})
       {my $comment = $genHashs{$package}{$attribute}     // q();
        my $flags   = $genHashFlags{$package}{$attribute} // q();

        my $a = qq(B<$attribute> - $comment\n);                                 # Attribute description
        push @{$flags =~ m(I)s ? \@i : \@o}, $a;
       }

      push @doc, qq(\n), qq(=head2 $package Definition), qq(\n),                # Attributes header
                 $genHashPackage{$package}, qq(\n);

      if (@i)                                                                   # Input fields
       {push @doc, qq(\n), qq(=head3 Input fields), qq(\n), @i;
       }

      if (@o)                                                                   # Output fields
       {push @doc, qq(\n), qq(=head3 Output fields), qq(\n), @o;
       }
     }
   }

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

  if (@synopsis)                                                                # Add the generated synopsis at the front if present
   {unshift @doc, q(=head1 Synopsis), @synopsis;
   }

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

  my $doc = expandWellKnownUrls(join "\n", @doc);                               # Create documentation

  unless($sourceIsString)                                                       # Update source file
   {if (@synopsis)                                                              # Remove existing synopsis if adding a generated one
     {$source =~ s(=head1 Synopsis.*?(=head1 Description)) ($1)s;
     }
    $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(@lll
 absFromAbsPlusRel addCertificate addLValueScalarMethods adopt appendFile
 arrayProduct arraySum arrayTimes arrayToHash asciiToHexString assertPackageRefs
 assertRef awsIp awsCurrentIp
 binModeAllUtf8 boldString boldStringUndo
 call checkFile checkFilePath checkFilePathDir checkFilePathExt checkKeys
 clearFolder containingPowerOfTwo contains convertDocxToFodt convertImageToJpx
 convertUnicodeToXml copyBinaryFile copyBinaryFileMd5Normalized
 copyBinaryFileMd5NormalizedCreate
 copyBinaryFileMd5NormalizedGetCompanionContent copyFile copyFileMd5Normalized
 copyFileMd5NormalizedCreate copyFileMd5NormalizedName copyFileMd5NormalizedDelete
 copyFileMd5NormalizedGetCompanionContent copyFolder copyFolderToRemote countFileExtensions
 countFileTypes createEmptyFile currentDirectory currentDirectoryAbove
 cutOutImagesInFodtFile
 dateStamp dateTimeStamp dateTimeStampName decodeBase64 decodeJson deSquareArray
 dumpFile dumpGZipFile
 enclosedReversedString enclosedReversedStringUndo enclosedString
 enclosedStringUndo encodeBase64 encodeJson evalFile evalGZipFile
 expandWellKnownUrls
 fe fff fullyQualifiedFile fullyQualifyFile fileInWindowsFormat fileList
 fileMd5Sum fileModTime fileOutOfDate
 filePath filePathDir filePathExt fileSize findDirs findFiles
 findFileWithExtension firstFileThatExists firstNChars fn fne formatTableBasic
 formattedTablesReport fp fpd fpe fpf fpn fullFileName
 genClass genHash genLValueArrayMethods genLValueHashMethods
 genLValueScalarMethods genLValueScalarMethodsWithDefaultValues guidFromMd5
 guidFromString
 hexToAsciiString hostName htmlToc
 imageSize indentString indexOfMax indexOfMin ipAddressViaArp isBlank isFileUtf8
 isSubInPackage
 javaPackage javaPackageAsFileName javaScriptExports
 keyCount
 lll loadArrayArrayFromLines loadArrayFromLines loadArrayHashFromLines loadHash
 loadHashArrayFromLines loadHashFromLines loadHashHashFromLines
 makeDieConfess makePath matchPath max md5FromGuid microSecondsSinceEpoch min
 nameFromFolder nameFromString nameFromStringRestrictedToTitle newProcessStarter
 newServiceIncarnation newUdsr newUdsrClient newUdsrServer numberOfLinesInFile
 numberOfLinesInString numberOfCpus nws
 overWriteBinaryFile overWriteFile owf
 pad parseCommandLineArguments parseFileName powerOfTwo printFullFileName
 parseDitaRef
 printQw
 quoteFile
 readBinaryFile readFile readFiles readGZipFile readUtf16File relFromAbsAgainstAbs
 reloadHashes removeBOM removeDuplicatePrefixes removeFilePrefix
 reportAttributes reportAttributeSettings reportExportableMethods reportReplacableMethods reportSettings retrieveFile
 runInParallel runInSquareRootParallel
 saveCodeToS3 saveSourceToS3 searchDirectoryTreesForMatchingFiles
 setFileExtension setIntersection setIntersection
 setIntersectionOfArraysOfStrings setIntersectionOverUnion
 setIntersectionOverUnion setPackageSearchOrder
 setPartitionOnIntersectionOverUnion
 setPartitionOnIntersectionOverUnionOfHashStringSets
 setPartitionOnIntersectionOverUnionOfSetsOfWords
 setPartitionOnIntersectionOverUnionOfStringSets setUnion
 setPermissionsForFile
 setUnionOfArraysOfStrings squareArray startProcess storeFile stringsAreNotEqual
 subScriptString subScriptStringUndo sumAbsAndRel
 summarizeColumn superScriptString
 superScriptStringUndo swapFilePrefix swapFolderPrefix
 temporaryDirectory temporaryFile temporaryFolder timeStamp trackFiles trim
 uniqueNameFromFile updateDocumentation updatePerlModuleDocumentation userId
 versionCode versionCodeDashed
 waitForAllStartedProcessesToFinish writeBinaryFile writeFile writeFiles
 writeGZipFile wwwDecode wwwEncode
 xxx xxxr
 yyy
 zzz
);

if (0)                                                                          # Format exports
 {my $width = 80;
  binModeAllUtf8;
  my @e = sort {lc($a) cmp lc($b)} @EXPORT_OK;
  my @r = '';
  for my $i(keys @e)
   {my $e =  $e[$i];
    my $E = $i ? $e[$i-1] : q( );
    if (length($r[-1]) + 1 + length($e) > $width or
        substr($e, 0, 1) ne substr($E, 0, 1))
     {push @r, '';
     }
    $r[-1] .= qq( $e);
   }
  say STDERR "qw(", join("\n", @r);
  exit;
 }

%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 20190714.


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 with titles as specified by B<$columnTitles>: either a reference to an array of column titles or a string each line of which contains the column title as the first word with the rest of the line describing that column.

Optionally create a report from the table using the following optional report B<%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<foot=E<gt>$foot> footer text that will be placed immediately after the table.

B<summarize=E<gt>$summarize> if true and B<$data> is an array of arrays, then each column of the will be summarized by printing its distinct values and a count of how often each value occurs in a series of smaller tables following the main table.

B<wide=E<gt>$wide>write a note explaining the need to scroll to the right if true.

B<msg=E<gt>$msg> if true a summary of the situation will be written to STDERR including the first line of the header and the file being written to.

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

Parameters:

L<genHash|/genHash>

Return a B<$bless>ed hash with the specified B<$attributes> accessible via L<lvalue method|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 starting at the current working folder to get an absolute file name.

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 already exists.

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.

L<xxxr|/xxxr>

Execute a bash command B<$cmd> as user b<$user>on the server whose ip address is located in L<awsIp>.




=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), q(dts);


=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 and writing results.

=head2 fff($$@)

Confess a message with a line position and a file that Geany will jump to if clicked on.

     Parameter  Description
  1  $line      Line
  2  $file      File
  3  @m         Messages

B<Example:>


  𝗳𝗳𝗳 __LINE__, __FILE__, "Hello world";


=head2 lll(@)

Log messages including the project name if available. This method is not merged as we need to retain its prototype.

     Parameter  Description
  1  @m         Messages

B<Example:>


  𝗹𝗹𝗹 "Hello world";


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

Execute a bash command B<$cmd> as user b<$user>on the server whose ip address is located in L<awsIp>.

     Parameter  Description
  1  $cmd       Command string
  2  $user      Userid on remote system

B<Example:>


  if (0)
   {ok 𝘅𝘅𝘅𝗿(q(pwd), q(phil));
   }


=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. To execute remotely, add "ssh ... 'echo start" as the first line and "echo end'" as the last line with the commands to be executed on the lines in between.

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


=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 or string

     Parameter  Description
  1  $file      File or string

B<Example:>


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

  if (1) {
    ok 𝗳𝗶𝗹𝗲𝗠𝗱𝟱𝗦𝘂𝗺(join '', 1..100)     eq
       q(ef69caaaeea9c17120821a9eb6c7f1de);

    ok guidFromString(join '', 1..100) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok guidFromMd5(𝗳𝗶𝗹𝗲𝗠𝗱𝟱𝗦𝘂𝗺(join('', 1..100))) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok md5FromGuid(q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de)) eq
                        q(ef69caaaeea9c17120821a9eb6c7f1de);
  }

  if (1)
   {ok arraySum   (1..10) ==  55;
    ok arrayProduct(1..5) == 120;
    is_deeply[arrayTimes(2, 1..5)], [qw(2 4 6 8 10)];
   }


=head3 guidFromMd5($)

Create a guid from an md5 hash.

     Parameter  Description
  1  $m         Md5 hash

B<Example:>


  if (1) {
    ok fileMd5Sum(join '', 1..100)     eq
       q(ef69caaaeea9c17120821a9eb6c7f1de);

    ok guidFromString(join '', 1..100) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok 𝗴𝘂𝗶𝗱𝗙𝗿𝗼𝗺𝗠𝗱𝟱(fileMd5Sum(join('', 1..100))) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok md5FromGuid(q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de)) eq
                        q(ef69caaaeea9c17120821a9eb6c7f1de);
  }

  if (1)
   {ok arraySum   (1..10) ==  55;
    ok arrayProduct(1..5) == 120;
    is_deeply[arrayTimes(2, 1..5)], [qw(2 4 6 8 10)];
   }


=head3 md5FromGuid($)

Recover an md5 sum from a guid.

     Parameter  Description
  1  $G         Guid

B<Example:>


  if (1) {
    ok fileMd5Sum(join '', 1..100)     eq
       q(ef69caaaeea9c17120821a9eb6c7f1de);

    ok guidFromString(join '', 1..100) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok guidFromMd5(fileMd5Sum(join('', 1..100))) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok 𝗺𝗱𝟱𝗙𝗿𝗼𝗺𝗚𝘂𝗶𝗱(q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de)) eq
                        q(ef69caaaeea9c17120821a9eb6c7f1de);
  }

  if (1)
   {ok arraySum   (1..10) ==  55;
    ok arrayProduct(1..5) == 120;
    is_deeply[arrayTimes(2, 1..5)], [qw(2 4 6 8 10)];
   }


=head3 guidFromString($)

Create a guid from a file or string via an md5 hash.

     Parameter  Description
  1  $string    File name or string

B<Example:>


  if (1) {
    ok fileMd5Sum(join '', 1..100)     eq
       q(ef69caaaeea9c17120821a9eb6c7f1de);

    ok 𝗴𝘂𝗶𝗱𝗙𝗿𝗼𝗺𝗦𝘁𝗿𝗶𝗻𝗴(join '', 1..100) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok guidFromMd5(fileMd5Sum(join('', 1..100))) eq
       q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

    ok md5FromGuid(q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de)) eq
                        q(ef69caaaeea9c17120821a9eb6c7f1de);
  }

  if (1)
   {ok arraySum   (1..10) ==  55;
    ok arrayProduct(1..5) == 120;
    is_deeply[arrayTimes(2, 1..5)], [qw(2 4 6 8 10)];
   }


=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);


=head3 fileInWindowsFormat($)

Convert a unix file name to windows format

     Parameter  Description
  1  $file      File

B<Example:>


  if (1)
   {ok 𝗳𝗶𝗹𝗲𝗜𝗻𝗪𝗶𝗻𝗱𝗼𝘄𝘀𝗙𝗼𝗿𝗺𝗮𝘁(fpd(qw(/a b c d))) eq q(\a\b\c\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 B<$known> name to a B<$new> one if the file does in fact start with the B<$known> name otherwise returns the original file name. The B<$new> prefix is optional, if not supplied the B<$known> prefix is removed.

     Parameter  Description
  1  $file      File name
  2  $known     Existing prefix
  3  $new       Optional new prefix defaults to q()

B<Example:>


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


=head4 setFileExtension($$)

Set the extension of a file to a specified value. Removes the extension if no extension is specified.

     Parameter   Description
  1  $file       File name
  2  $extension  Optional new extension

B<Example:>


  ok 𝘀𝗲𝘁𝗙𝗶𝗹𝗲𝗘𝘅𝘁𝗲𝗻𝘀𝗶𝗼𝗻(q(.c),     q(d)) eq q(.d);

  ok 𝘀𝗲𝘁𝗙𝗶𝗹𝗲𝗘𝘅𝘁𝗲𝗻𝘀𝗶𝗼𝗻(q(b.c),    q(d)) eq q(b.d);

  ok 𝘀𝗲𝘁𝗙𝗶𝗹𝗲𝗘𝘅𝘁𝗲𝗻𝘀𝗶𝗼𝗻(q(/a/b.c), q(d)) eq q(/a/b.d);


=head4 swapFolderPrefix($$$)

Swaps a starting folder of a file name from a known name to a new one if the file does in fact start with the known name and the known name and new name are folders else return the file as is.

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

B<Example:>


  if (1) {
    my $g = fpd(qw(a b c d));
    my $h = fpd(qw(a b cc dd));
    my $i = fpe($g, qw(aaa txt));

    my $j = 𝘀𝘄𝗮𝗽𝗙𝗼𝗹𝗱𝗲𝗿𝗣𝗿𝗲𝗳𝗶𝘅($i, $g, $h);
    ok $j =~ m(a/b/cc/dd/)s;
   }


=head4 fullyQualifiedFile($)

Return whether a file is fully qualified or not

     Parameter  Description
  1  $file      File name to test

B<Example:>


  ok  𝗳𝘂𝗹𝗹𝘆𝗤𝘂𝗮𝗹𝗶𝗳𝗶𝗲𝗱𝗙𝗶𝗹𝗲(q(/a/b/c.d));

  ok !𝗳𝘂𝗹𝗹𝘆𝗤𝘂𝗮𝗹𝗶𝗳𝗶𝗲𝗱𝗙𝗶𝗹𝗲(q(c.d));


=head4 fullyQualifyFile($)

Return the fully qualified name of a file

     Parameter  Description
  1  $file      File name

B<Example:>


  if (0)
   {ok 𝗳𝘂𝗹𝗹𝘆𝗤𝘂𝗮𝗹𝗶𝗳𝘆𝗙𝗶𝗹𝗲(q(perl/cpan)) eq q(/home/phil/perl/cpan/);
   }


=head4 removeDuplicatePrefixes($)

Remove duplicated leading path components from a file name.

     Parameter  Description
  1  $file      File name

B<Example:>


  ok q(a/b.c) eq 𝗿𝗲𝗺𝗼𝘃𝗲𝗗𝘂𝗽𝗹𝗶𝗰𝗮𝘁𝗲𝗣𝗿𝗲𝗳𝗶𝘅𝗲𝘀("a/a/b.c");

  ok q(a/b.c) eq 𝗿𝗲𝗺𝗼𝘃𝗲𝗗𝘂𝗽𝗹𝗶𝗰𝗮𝘁𝗲𝗣𝗿𝗲𝗳𝗶𝘅𝗲𝘀("a/b.c");

  ok q(b.c) eq 𝗿𝗲𝗺𝗼𝘃𝗲𝗗𝘂𝗽𝗹𝗶𝗰𝗮𝘁𝗲𝗣𝗿𝗲𝗳𝗶𝘅𝗲𝘀("b.c");


=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) considering .. to be always part of the path ans using B<undef> to mark missing components.  This differs from (fp, fn, fe) which return q() for missing components and do not interpret . or .. as anything special

     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 absFile($)

Return B<undef> if the file is a relative file or b<$file> if the file is an absolute file name

     Parameter  Description
  1  $file      File to test

B<Example:>


  ok "/aaa/"                  eq 𝗮𝗯𝘀𝗙𝗶𝗹𝗲(qw(/aaa/));


=head3 sumAbsAndRel(@)

Combine zero or more absolute and relative file names starting at the current working folder to get an absolute file name.

     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 countFileExtensions(@)

Return a hash which counts the file extensions under the specified directories

     Parameter  Description
  1  @folders   Folders to search

B<Example:>


    𝗰𝗼𝘂𝗻𝘁𝗙𝗶𝗹𝗲𝗘𝘅𝘁𝗲𝗻𝘀𝗶𝗼𝗻𝘀(q(/home/phil/perl/));


=head3 countFileTypes($@)

Return a hash which counts, in parallel, the results of applying the B<file> command to each file under the specified directories.

     Parameter                  Description
  1  $maximumNumberOfProcesses  Maximum number of processes to run in parallel
  2  @folders                   Folders to search

B<Example:>


    𝗰𝗼𝘂𝗻𝘁𝗙𝗶𝗹𝗲𝗧𝘆𝗽𝗲𝘀(4, q(/home/phil/perl/));


=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 with L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> methods to access each hash element - an improvement on B<do> which silently ignores any errors.

     Parameter  Description
  1  $file      File to read

B<Example:>


  if (1) {
    my $f = dumpFile(undef, {a=>1, b=>2});
    my $d = 𝗲𝘃𝗮𝗹𝗙𝗶𝗹𝗲($f);
    ok $d->a == 1;
    ok $d->b == 2;
    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.  {my ($file, $string) = @_;                                                     # File to write to or B<undef> for a temporary file, unicode string to write

     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 already exists.

     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;

    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;

    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> optionally swapping the prefix of each file from B<$old> to B<$new>

     Parameter  Description
  1  $hash      Hash of key value pairs representing files and data
  2  $old       Optional old prefix
  3  $new       New prefix

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 the specified B<@folders> into a hash

     Parameter  Description
  1  @folders   Folders 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. The file being appended to is locked first with L<https://perldoc.perl.org/functions/flock.html> to allow  multiple processes to append linearly to the same file.

     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 setPermissionsForFile($$)

Set the permissions for the named file

     Parameter     Description
  1  $file         File
  2  $permissions  Permissions settings per chmod

B<Example:>


  if (1)
   {my $f = temporaryFile();
    𝘀𝗲𝘁𝗣𝗲𝗿𝗺𝗶𝘀𝘀𝗶𝗼𝗻𝘀𝗙𝗼𝗿𝗙𝗶𝗹𝗲($f, q(ugo=r));
    my $a = qx(ls -la $f);
    ok $a =~ m(-r--r--r--)s;
    𝘀𝗲𝘁𝗣𝗲𝗿𝗺𝗶𝘀𝘀𝗶𝗼𝗻𝘀𝗙𝗼𝗿𝗙𝗶𝗹𝗲($f, q(u=rwx));
    my $b = qx(ls -la $f);
    ok $b =~ m(-rwxr--r--)s;
   }


=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. The B<\Acopy.*Md5Normalized.*\Z> methods can be used to ensure that files have collision proof names that collapse duplicate content even when copied to another folder.

=head3 copyFile($$)

Copy a file encoded in utf8 and return the target name

     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 nameFromString($%)

Create a readable name from an arbitrary string of text.

     Parameter  Description
  1  $string    String
  2  %options   Options

B<Example:>


  if (1) {
  ok q(help) eq 𝗻𝗮𝗺𝗲𝗙𝗿𝗼𝗺𝗦𝘁𝗿𝗶𝗻𝗴(q(!@#$%^help___<>?><?>));
  ok q(bm_The_skyscraper_analogy) eq 𝗻𝗮𝗺𝗲𝗙𝗿𝗼𝗺𝗦𝘁𝗿𝗶𝗻𝗴(<<END);
  <bookmap id="b1">
  <title>The skyscraper analogy</title>
  </bookmap>
  END

  ok q(bm_The_skyscraper_analogy_An_exciting_tale_of_two_skyscrapers_that_meet_in_downtown_Houston)
     eq 𝗻𝗮𝗺𝗲𝗙𝗿𝗼𝗺𝗦𝘁𝗿𝗶𝗻𝗴(<<END);
  <bookmap id="b1">
  <title>The skyscraper analogy</title>
  An exciting tale of two skyscrapers that meet in downtown Houston
  <concept><html>
  </bookmap>
  END

  ok q(bm_the_skyscraper_analogy) eq nameFromStringRestrictedToTitle(<<END);
  <bookmap id="b1">
  <title>The skyscraper analogy</title>
  An exciting tale of two skyscrapers that meet in downtown Houston
  <concept><html>
  </bookmap>
  END
   }


=head3 nameFromStringRestrictedToTitle($%)

Create a readable name from a string of text that might contain a title tag - fall back to L<nameFromString|/nameFromString> if that is not possible.

     Parameter  Description
  1  $string    String
  2  %options   Options

B<Example:>


  if (1) {
  ok q(help) eq nameFromString(q(!@#$%^help___<>?><?>));
  ok q(bm_The_skyscraper_analogy) eq nameFromString(<<END);
  <bookmap id="b1">
  <title>The skyscraper analogy</title>
  </bookmap>
  END

  ok q(bm_The_skyscraper_analogy_An_exciting_tale_of_two_skyscrapers_that_meet_in_downtown_Houston)
     eq nameFromString(<<END);
  <bookmap id="b1">
  <title>The skyscraper analogy</title>
  An exciting tale of two skyscrapers that meet in downtown Houston
  <concept><html>
  </bookmap>
  END

  ok q(bm_the_skyscraper_analogy) eq 𝗻𝗮𝗺𝗲𝗙𝗿𝗼𝗺𝗦𝘁𝗿𝗶𝗻𝗴𝗥𝗲𝘀𝘁𝗿𝗶𝗰𝘁𝗲𝗱𝗧𝗼𝗧𝗶𝘁𝗹𝗲(<<END);
  <bookmap id="b1">
  <title>The skyscraper analogy</title>
  An exciting tale of two skyscrapers that meet in downtown Houston
  <concept><html>
  </bookmap>
  END
   }


=head3 uniqueNameFromFile($)

Create a unique name from a file name and the md5 sum of its content

     Parameter  Description
  1  $source    Source file

B<Example:>


  if (1) {
    my $f = owf(q(test.txt), join "", 1..100);
    ok 𝘂𝗻𝗶𝗾𝘂𝗲𝗡𝗮𝗺𝗲𝗙𝗿𝗼𝗺𝗙𝗶𝗹𝗲($f) eq q(test_ef69caaaeea9c17120821a9eb6c7f1de.txt);
    unlink $f;
   }


=head3 nameFromFolder($)

Create a name from the last folder in the path of a file name.  Return undef if the file does not have a path.

     Parameter  Description
  1  $file      File name

B<Example:>


  if (1) {
  ok 𝗻𝗮𝗺𝗲𝗙𝗿𝗼𝗺𝗙𝗼𝗹𝗱𝗲𝗿(fpe(qw( a b c d e))) eq q(c);
   }


=head3 copyFileMd5Normalized($$)

Normalize the name of the specified B<$source> file to the md5 sum of its content, retaining its current extension, while placing the original file name in a companion file if the companion file does not already exist.  If no B<$target> folder is supplied the file is renamed to its normalized form in situ, otherwise it is copied to the target folder and renamed there. A companion file for the B<$source> file is created by removing the extension of the normalized file and writing the original B<$source> file name to it unless such a file already exists as we assume that it contains the 'original' original name of the B<$source> file. If the B<$source> file is copied to a new location then the companion file is copied as well to maintain the link back to the original name of the file.

     Parameter  Description
  1  $source    Source file
  2  $Target    Target folder or a file in the target folder

B<Example:>


  if (0) {
    my $dir = temporaryFolder;
    my $a = fpe($dir, qw(a a jpg));
    my $b = fpe($dir, qw(b a jpg));
    my $c = fpe($dir, qw(c a jpg));

    my $content = join '', 1..1e3;

    my $A = copyFileMd5NormalizedCreate($a, $content, q(jpg), $a);
    ok readFile($A) eq $content;
    ok $A eq 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($A);

    my $B = 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($A, $b);
    ok readFile($B) eq $content;
    ok $B eq 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($B);

    my $C = 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($B, $c);
    ok readFile($C) eq $content;
    ok $C eq 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($C);

    ok fne($A) eq fne($_) for $B, $C;
    ok readFile($_) eq $content for $A, $B, $C;
    ok copyFileMd5NormalizedGetCompanionContent($_) eq $a for $A, $B, $C;

    ok 6 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($A);
    ok 4 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($B);
    ok 2 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($C);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);

    clearFolder($dir, 10);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);
   }


=head3 copyFileMd5NormalizedName($$@)

Name a file using the GB Standard

     Parameter   Description
  1  $content    Content
  2  $extension  Extension
  3  %options    Options

B<Example:>


  if (0) {
    ok 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗡𝗮𝗺𝗲(<<END, q(txt)) eq
  <p>Hello<b>World</b></p>
  END
  q(Hello_World_6ba23858c1b4811660896c324acac6fa.txt);
   }


=head3 copyFileMd5NormalizedCreate($$$$@)

Create a file in the specified B<$folder> whose name is constructed from the md5 sum of the specified B<$content>, whose content is B<$content>, whose extension is B<$extension> and which has a companion file with the same name minus the extension which contains the specified B<$companionContent>.  Such a file can be copied multiple times by L<copyFileMd5Normalized|/copyFileMd5Normalized> regardless of the other files in the target folders.

     Parameter          Description
  1  $Folder            Target folder or a file in that folder
  2  $content           Content of the file
  3  $extension         File extension
  4  $companionContent  Contents of the companion file
  5  %options           Options.

B<Example:>


  if (0) {
    my $dir = temporaryFolder;
    my $a = fpe($dir, qw(a a jpg));
    my $b = fpe($dir, qw(b a jpg));
    my $c = fpe($dir, qw(c a jpg));

    my $content = join '', 1..1e3;

    my $A = 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗖𝗿𝗲𝗮𝘁𝗲($a, $content, q(jpg), $a);
    ok readFile($A) eq $content;
    ok $A eq copyFileMd5Normalized($A);

    my $B = copyFileMd5Normalized($A, $b);
    ok readFile($B) eq $content;
    ok $B eq copyFileMd5Normalized($B);

    my $C = copyFileMd5Normalized($B, $c);
    ok readFile($C) eq $content;
    ok $C eq copyFileMd5Normalized($C);

    ok fne($A) eq fne($_) for $B, $C;
    ok readFile($_) eq $content for $A, $B, $C;
    ok copyFileMd5NormalizedGetCompanionContent($_) eq $a for $A, $B, $C;

    ok 6 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($A);
    ok 4 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($B);
    ok 2 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($C);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);

    clearFolder($dir, 10);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);
   }


=head3 copyFileMd5NormalizedGetCompanionContent($)

Return the content of the companion file to the specified B<$source> file after it has been normalized via L<copyFileMd5Normalized|/copyFileMd5Normalized> or L<copyFileMd5NormalizedCreate|/copyFileMd5NormalizedCreate> or return B<undef> if the corresponding companion file does not exist.

     Parameter  Description
  1  $source    Source file.

B<Example:>


  if (0) {
    my $dir = temporaryFolder;
    my $a = fpe($dir, qw(a a jpg));
    my $b = fpe($dir, qw(b a jpg));
    my $c = fpe($dir, qw(c a jpg));

    my $content = join '', 1..1e3;

    my $A = copyFileMd5NormalizedCreate($a, $content, q(jpg), $a);
    ok readFile($A) eq $content;
    ok $A eq copyFileMd5Normalized($A);

    my $B = copyFileMd5Normalized($A, $b);
    ok readFile($B) eq $content;
    ok $B eq copyFileMd5Normalized($B);

    my $C = copyFileMd5Normalized($B, $c);
    ok readFile($C) eq $content;
    ok $C eq copyFileMd5Normalized($C);

    ok fne($A) eq fne($_) for $B, $C;
    ok readFile($_) eq $content for $A, $B, $C;
    ok 𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗚𝗲𝘁𝗖𝗼𝗺𝗽𝗮𝗻𝗶𝗼𝗻𝗖𝗼𝗻𝘁𝗲𝗻𝘁($_) eq $a for $A, $B, $C;

    ok 6 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($A);
    ok 4 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($B);
    ok 2 == searchDirectoryTreesForMatchingFiles($dir);
    copyFileMd5NormalizedDelete($C);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);

    clearFolder($dir, 10);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);
   }


=head3 copyFileMd5NormalizedDelete($)

Delete a normalized and its companion file

     Parameter  Description
  1  $file      File

B<Example:>


  if (0) {
    my $dir = temporaryFolder;
    my $a = fpe($dir, qw(a a jpg));
    my $b = fpe($dir, qw(b a jpg));
    my $c = fpe($dir, qw(c a jpg));

    my $content = join '', 1..1e3;

    my $A = copyFileMd5NormalizedCreate($a, $content, q(jpg), $a);
    ok readFile($A) eq $content;
    ok $A eq copyFileMd5Normalized($A);

    my $B = copyFileMd5Normalized($A, $b);
    ok readFile($B) eq $content;
    ok $B eq copyFileMd5Normalized($B);

    my $C = copyFileMd5Normalized($B, $c);
    ok readFile($C) eq $content;
    ok $C eq copyFileMd5Normalized($C);

    ok fne($A) eq fne($_) for $B, $C;
    ok readFile($_) eq $content for $A, $B, $C;
    ok copyFileMd5NormalizedGetCompanionContent($_) eq $a for $A, $B, $C;

    ok 6 == searchDirectoryTreesForMatchingFiles($dir);
    𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗗𝗲𝗹𝗲𝘁𝗲($A);
    ok 4 == searchDirectoryTreesForMatchingFiles($dir);
    𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗗𝗲𝗹𝗲𝘁𝗲($B);
    ok 2 == searchDirectoryTreesForMatchingFiles($dir);
    𝗰𝗼𝗽𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗗𝗲𝗹𝗲𝘁𝗲($C);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);

    clearFolder($dir, 10);
    ok 0 == searchDirectoryTreesForMatchingFiles($dir);
   }


=head3 copyBinaryFile($$)

Copy a binary file and return the target name,

     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;

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

    𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲($f, my $F = temporaryFile);
    ok $s eq readBinaryFile($F);
    unlink $f, $F;
   }


=head3 copyBinaryFileMd5Normalized($$)

Normalize the name of the specified B<$source> file to the md5 sum of its content, retaining its current extension, while placing the original file name in a companion file if the companion file does not already exist.  If no B<$target> folder is supplied the file is renamed to its normalized form in situ, otherwise it is copied to the target folder and renamed there. A companion file for the B<$source> file is created by removing the extension of the normalized file and writing the original B<$source> file name to it unless such a file already exists as we assume that it contains the 'original' original name of the B<$source> file. If the B<$source> file is copied to a new location then the companion file is copied as well to maintain the link back to the original name of the file.

     Parameter  Description
  1  $source    Source file
  2  $Target    Target folder or a file in the target folder

B<Example:>


  if (0) {
    my $dir = temporaryFolder;
    my $a = fpe($dir, qw(a a jpg));
    my $b = fpe($dir, qw(b a jpg));
    my $c = fpe($dir, qw(c a jpg));

    my $content = join '', 1..1e3;

    my $A = copyBinaryFileMd5NormalizedCreate($a, $content, q(jpg), $a);
    ok readBinaryFile($A) eq $content;
    ok $A eq 𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($A);

    my $B = 𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($A, $b);
    ok readBinaryFile($B) eq $content;
    ok $B eq 𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($B);

    my $C = 𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($B, $c);
    ok readBinaryFile($C) eq $content;
    ok $C eq 𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱($C);

    ok fne($A) eq fne($_) for $B, $C;
    ok readBinaryFile($_) eq $content for $A, $B, $C;
    ok copyBinaryFileMd5NormalizedGetCompanionContent($_) eq $a for $A, $B, $C;

    ok 6 == searchDirectoryTreesForMatchingFiles($dir);
    clearFolder($dir, 10);
   }


=head3 copyBinaryFileMd5NormalizedCreate($$$$)

Create a file in the specified B<$folder> whose name is constructed from the md5 sum of the specified B<$content>, whose content is B<$content>, whose extension is B<$extension> and which has a companion file with the same name minus the extension  which contains the specified B<$companionContent>.  Such a file can be copied multiple times by L<copyBinaryFileMd5Normalized|/copyBinaryFileMd5Normalized> regardless of the other files in the target folders while retaining the original name information.

     Parameter          Description
  1  $Folder            Target folder or a file in that folder
  2  $content           Content of the file
  3  $extension         File extension
  4  $companionContent  Optional content of the companion file.

B<Example:>


  if (0) {
    my $dir = temporaryFolder;
    my $a = fpe($dir, qw(a a jpg));
    my $b = fpe($dir, qw(b a jpg));
    my $c = fpe($dir, qw(c a jpg));

    my $content = join '', 1..1e3;

    my $A = 𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗖𝗿𝗲𝗮𝘁𝗲($a, $content, q(jpg), $a);
    ok readBinaryFile($A) eq $content;
    ok $A eq copyBinaryFileMd5Normalized($A);

    my $B = copyBinaryFileMd5Normalized($A, $b);
    ok readBinaryFile($B) eq $content;
    ok $B eq copyBinaryFileMd5Normalized($B);

    my $C = copyBinaryFileMd5Normalized($B, $c);
    ok readBinaryFile($C) eq $content;
    ok $C eq copyBinaryFileMd5Normalized($C);

    ok fne($A) eq fne($_) for $B, $C;
    ok readBinaryFile($_) eq $content for $A, $B, $C;
    ok copyBinaryFileMd5NormalizedGetCompanionContent($_) eq $a for $A, $B, $C;

    ok 6 == searchDirectoryTreesForMatchingFiles($dir);
    clearFolder($dir, 10);
   }


=head3 copyBinaryFileMd5NormalizedGetCompanionContent($)

Return the original name of the specified B<$source> file after it has been normalized via L<copyBinaryFileMd5Normalized|/copyBinaryFileMd5Normalized> or L<copyBinaryFileMd5NormalizedCreate|/copyBinaryFileMd5NormalizedCreate> or return B<undef> if the corresponding companion file does not exist.

     Parameter  Description
  1  $source    Source file.

B<Example:>


  if (0) {
    my $dir = temporaryFolder;
    my $a = fpe($dir, qw(a a jpg));
    my $b = fpe($dir, qw(b a jpg));
    my $c = fpe($dir, qw(c a jpg));

    my $content = join '', 1..1e3;

    my $A = copyBinaryFileMd5NormalizedCreate($a, $content, q(jpg), $a);
    ok readBinaryFile($A) eq $content;
    ok $A eq copyBinaryFileMd5Normalized($A);

    my $B = copyBinaryFileMd5Normalized($A, $b);
    ok readBinaryFile($B) eq $content;
    ok $B eq copyBinaryFileMd5Normalized($B);

    my $C = copyBinaryFileMd5Normalized($B, $c);
    ok readBinaryFile($C) eq $content;
    ok $C eq copyBinaryFileMd5Normalized($C);

    ok fne($A) eq fne($_) for $B, $C;
    ok readBinaryFile($_) eq $content for $A, $B, $C;
    ok 𝗰𝗼𝗽𝘆𝗕𝗶𝗻𝗮𝗿𝘆𝗙𝗶𝗹𝗲𝗠𝗱𝟱𝗡𝗼𝗿𝗺𝗮𝗹𝗶𝘇𝗲𝗱𝗚𝗲𝘁𝗖𝗼𝗺𝗽𝗮𝗻𝗶𝗼𝗻𝗖𝗼𝗻𝘁𝗲𝗻𝘁($_) eq $a for $A, $B, $C;

    ok 6 == searchDirectoryTreesForMatchingFiles($dir);
    clearFolder($dir, 10);
   }


=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);
   }


=head3 copyFolderToRemote($$)

Copy a folder to the corresponding folder on the server whose address is returned by L<awsIp>.

     Parameter  Description
  1  $Source    Source file
  2  $userid    Userid on server

B<Example:>


  if (0)
   {𝗰𝗼𝗽𝘆𝗙𝗼𝗹𝗱𝗲𝗿𝗧𝗼𝗥𝗲𝗺𝗼𝘁𝗲(q(/home/phil/perl/cpan/), q(phil));
   }


=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> applying an optional scaling if required.

     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
  4  $Tiles     Optional limit in either direction on the number of tiles

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


=head2 asciiToHexString($)

Encode an ascii string as a string of hexadecimal digits.

     Parameter  Description
  1  $ascii     Ascii string

B<Example:>


  if (1) {
    ok 𝗮𝘀𝗰𝗶𝗶𝗧𝗼𝗛𝗲𝘅𝗦𝘁𝗿𝗶𝗻𝗴("Hello World!") eq                  "48656c6c6f20576f726c6421";
    ok                  "Hello World!"  eq hexToAsciiString("48656c6c6f20576f726c6421");
   }


=head2 hexToAsciiString($)

Decode a string of hexadecimal digits as an ascii string.

     Parameter  Description
  1  $hex       Hexadecimal string

B<Example:>


  if (1) {
    ok asciiToHexString("Hello World!") eq                  "48656c6c6f20576f726c6421";
    ok                  "Hello World!"  eq 𝗵𝗲𝘅𝗧𝗼𝗔𝘀𝗰𝗶𝗶𝗦𝘁𝗿𝗶𝗻𝗴("48656c6c6f20576f726c6421");
   }


=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 setUnion(@)

Union of sets represented as arrays of strings and/or the keys of hashes

     Parameter  Description
  1  @s         Array of arrays of strings and/or hashes

B<Example:>


  if (1) {
    is_deeply [qw(a b c)],     [𝘀𝗲𝘁𝗨𝗻𝗶𝗼𝗻(qw(a b c a a b b b))];
    is_deeply [qw(a b c d e)], [𝘀𝗲𝘁𝗨𝗻𝗶𝗼𝗻 {a=>1, b=>2, e=>3}, [qw(c d e)], qw(e)];
   }


=head2 setIntersection(@)

Intersection of sets represented as arrays of strings and/or the keys of hashes

     Parameter  Description
  1  @s         Array of arrays of strings and/or hashes

B<Example:>


  if (1) {
    is_deeply [qw(a b c)], [𝘀𝗲𝘁𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻[qw(e f g a b c )],[qw(a A b B c C)]];
    is_deeply [qw(e)],   [𝘀𝗲𝘁𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻 {a=>1, b=>2, e=>3}, [qw(c d e)], qw(e)];
   }


=head2 setIntersectionOverUnion(@)

Returns the size of the intersection over the size of the union of one or more sets represented as arrays and/or hashes

     Parameter  Description
  1  @s         Array of arrays of strings and/or hashes

B<Example:>


  if (1) {
    my $f = 𝘀𝗲𝘁𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻𝗢𝘃𝗲𝗿𝗨𝗻𝗶𝗼𝗻 {a=>1, b=>2, e=>3}, [qw(c d e)], qw(e);
    ok $f > 0.199999 && $f < 2.00001;
   }


=head2 setPartitionOnIntersectionOverUnion($@)

Partition a set of sets so that within each partition the L<setIntersectionOverUnion|/setIntersectionOverUnion> of any two sets in the partition is never less than the specified B<$confidence**2>

     Parameter    Description
  1  $confidence  Minimum setIntersectionOverUnion
  2  @sets        Array of arrays of strings and/or hashes representing sets

B<Example:>


  if (1) {
    is_deeply [𝘀𝗲𝘁𝗣𝗮𝗿𝘁𝗶𝘁𝗶𝗼𝗻𝗢𝗻𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻𝗢𝘃𝗲𝗿𝗨𝗻𝗶𝗼𝗻
     (0.80,
       [qw(a A   b c d e)],
       [qw(a A B b c d e)],
       [qw(a A B C b c d)],
     )],
    [[["A", "B", "a".."e"],
      ["A",      "a".."e"]],
     [["A".."C", "a".."d"]],
    ];
  }




  if (1) {
  is_deeply [setPartitionOnIntersectionOverUnionOfSetsOfWords
     (0.80,
       [qw(a A   b c d e)],
       [qw(a A B b c d e)],
       [qw(a A B C b c d)],
     )],
   [[["a", "A", "B", "C", "b", "c", "d"]],
    [["a", "A", "B", "b" .. "e"], ["a", "A", "b" .. "e"]],
   ];
   }


=head2 setPartitionOnIntersectionOverUnionOfSetsOfWords($@)

Partition a set of sets of words so that within each partition the L<setIntersectionOverUnion|/setIntersectionOverUnion> of any two sets of words in the partition is never less than the specified B<$confidence**2>

     Parameter    Description
  1  $confidence  Minimum setIntersectionOverUnion
  2  @sets        Array of arrays of strings and/or hashes representing sets

B<Example:>


  if (1) {
  is_deeply [𝘀𝗲𝘁𝗣𝗮𝗿𝘁𝗶𝘁𝗶𝗼𝗻𝗢𝗻𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻𝗢𝘃𝗲𝗿𝗨𝗻𝗶𝗼𝗻𝗢𝗳𝗦𝗲𝘁𝘀𝗢𝗳𝗪𝗼𝗿𝗱𝘀
     (0.80,
       [qw(a A   b c d e)],
       [qw(a A B b c d e)],
       [qw(a A B C b c d)],
     )],
   [[["a", "A", "B", "C", "b", "c", "d"]],
    [["a", "A", "B", "b" .. "e"], ["a", "A", "b" .. "e"]],
   ];
   }


=head2 setPartitionOnIntersectionOverUnionOfStringSets($@)

Partition a set of sets, each set represented by a string containing words and punctuation, each word possibly capitalized, so that within each partition the L<setPartitionOnIntersectionOverUnionOfSetsOfWords|/setPartitionOnIntersectionOverUnionOfSetsOfWords> of any two sets of words in the partition is never less than the specified B<$confidence**2>

     Parameter    Description
  1  $confidence  Minimum setIntersectionOverUnion
  2  @strings     Sets represented by strings

B<Example:>


  if (1) {
  is_deeply [𝘀𝗲𝘁𝗣𝗮𝗿𝘁𝗶𝘁𝗶𝗼𝗻𝗢𝗻𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻𝗢𝘃𝗲𝗿𝗨𝗻𝗶𝗼𝗻𝗢𝗳𝗦𝘁𝗿𝗶𝗻𝗴𝗦𝗲𝘁𝘀
     (0.80,
       q(The Emu            are seen here sometimes.),
       q(The Emu, Gnu       are seen here sometimes.),
       q(The Emu, Gnu, Colt are seen here.),
     )],
   [["The Emu, Gnu, Colt are seen here."],
    ["The Emu, Gnu       are seen here sometimes.",
     "The Emu            are seen here sometimes.",
    ]];
   }


=head2 setPartitionOnIntersectionOverUnionOfHashStringSets($$)

Partition a set of sets represented by a hash, each hash value being a string containing words and punctuation, each word possibly capitalized, so that within each partition the L<setPartitionOnIntersectionOverUnionOfSetsOfWords|/setPartitionOnIntersectionOverUnionOfSetsOfWords> of any two sets of words in the partition is never less than the specified B<$confidence**2> and the partition entries are the hash keys of the string sets.

     Parameter    Description
  1  $confidence  Minimum setIntersectionOverUnion
  2  $hashSet     Sets represented by the hash value strings

B<Example:>


  if (1) {
    is_deeply [𝘀𝗲𝘁𝗣𝗮𝗿𝘁𝗶𝘁𝗶𝗼𝗻𝗢𝗻𝗜𝗻𝘁𝗲𝗿𝘀𝗲𝗰𝘁𝗶𝗼𝗻𝗢𝘃𝗲𝗿𝗨𝗻𝗶𝗼𝗻𝗢𝗳𝗛𝗮𝘀𝗵𝗦𝘁𝗿𝗶𝗻𝗴𝗦𝗲𝘁𝘀
     (0.80,
       {e  =>q(The Emu            are seen here sometimes.),
        eg =>q(The Emu, Gnu       are seen here sometimes.),
        egc=>q(The Emu, Gnu, Colt are seen here.),
       }
     )],
   [["e", "eg"], ["egc"]];
   }


=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))];


=head2 countOccurencesInString($$)

Returns the number of times the first string occurs in the second string

     Parameter   Description
  1  $inString   String to search in
  2  $searchFor  String to search for.

B<Example:>


  if (1)
   {ok 𝗰𝗼𝘂𝗻𝘁𝗢𝗰𝗰𝘂𝗿𝗲𝗻𝗰𝗲𝘀𝗜𝗻𝗦𝘁𝗿𝗶𝗻𝗴(q(a<b>c<b><b>d), q(<b>)) == 3;
   }


=head1 Minima and Maxima

Find the smallest and largest elements of arrays.

=head2 min(@)

Find the minimum number in a list confessing to any ill defined values.

     Parameter  Description
  1  @m         Numbers

B<Example:>


  ok 𝗺𝗶𝗻(1) == 1;

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


=head2 indexOfMin(@)

Find the index of the minimum number in a list confessing to any ill defined values.

     Parameter  Description
  1  @m         Numbers

B<Example:>


    ok 𝗶𝗻𝗱𝗲𝘅𝗢𝗳𝗠𝗶𝗻(qw(2 3 1 2)) == 2;


=head2 max(@)

Find the maximum number in a list confessing to any ill defined values.

     Parameter  Description
  1  @m         Numbers

B<Example:>


  ok !𝗺𝗮𝘅;

  ok 𝗺𝗮𝘅(1) == 1;

  ok 𝗺𝗮𝘅(1,4,2,3) == 4;


=head2 indexOfMax(@)

Find the index of the maximum number in a list confessing to any ill defined values.

     Parameter  Description
  1  @m         Numbers

B<Example:>


   {ok 𝗶𝗻𝗱𝗲𝘅𝗢𝗳𝗠𝗮𝘅(qw(2 3 1 2)) == 1;


=head2 arraySum(@)

Find the sum of any strings that look like numbers in an array

     Parameter  Description
  1  @a         Array to sum

B<Example:>


   {ok 𝗮𝗿𝗿𝗮𝘆𝗦𝘂𝗺   (1..10) ==  55;


=head2 arrayProduct(@)

Find the product of any strings that look like numbers in an array

     Parameter  Description
  1  @a         Array to multiply

B<Example:>


    ok 𝗮𝗿𝗿𝗮𝘆𝗣𝗿𝗼𝗱𝘂𝗰𝘁(1..5) == 120;


=head2 arrayTimes($@)

Multiply the second and subsequent parameters by the first parameter and return as an array

     Parameter    Description
  1  $multiplier  Multiplier
  2  @a           Array to multiply and return

B<Example:>


    is_deeply[𝗮𝗿𝗿𝗮𝘆𝗧𝗶𝗺𝗲𝘀(2, 1..5)], [qw(2 4 6 8 10)];


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


  if (1) {
    my $d = [[qw(a 1)], [qw(bb 22)], [qw(ccc 333)], [qw(dddd 4444)]];
    ok 𝗳𝗼𝗿𝗺𝗮𝘁𝗧𝗮𝗯𝗹𝗲𝗕𝗮𝘀𝗶𝗰($d) eq <<END, q(ftb);
  a        1
  bb      22
  ccc    333
  dddd  4444
  END
    }

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


=head2 formatTable($$%)

Format various data structures as a table with titles as specified by B<$columnTitles>: either a reference to an array of column titles or a string each line of which contains the column title as the first word with the rest of the line describing that column.

Optionally create a report from the table using the following optional report B<%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<foot=E<gt>$foot> footer text that will be placed immediately after the table.

B<summarize=E<gt>$summarize> if true and B<$data> is an array of arrays, then each column of the will be summarized by printing its distinct values and a count of how often each value occurs in a series of smaller tables following the main table.

B<wide=E<gt>$wide>write a note explaining the need to scroll to the right if true.

B<msg=E<gt>$msg> if true a summary of the situation will be written to STDERR including the first line of the header and the file being written to.

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

Parameters:

     Parameter      Description
  1  $data          Data to be formatted
  2  $columnTitles  Optional reference to an array of titles or string of column descriptions
  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 nws($t) eq nws(<<END);
  Sample report.

  Table has 2 rows.

  This file: report.txt

        BC
  1  a
  2     b
        c
  END
   }


=head2 formattedTablesReport(@)

Report of all the reports created. The optional parameters are the same as for L<formatTable|/formatTable>

     Parameter  Description
  1  @options   Options

B<Example:>


  if (1) {
    @formatTables = ();

    for my $m(2..8)
     {formatTable([map {[$_, $_*$m]} 1..$m], [q(Single), qq(* $m)],
        title=>qq(Multiply by $m));
     }

    ok nws(𝗳𝗼𝗿𝗺𝗮𝘁𝘁𝗲𝗱𝗧𝗮𝗯𝗹𝗲𝘀𝗥𝗲𝗽𝗼𝗿𝘁) eq nws(<<END);
     Rows  Title          File
  1     2  Multiply by 2
  2     3  Multiply by 3
  3     4  Multiply by 4
  4     5  Multiply by 5
  5     6  Multiply by 6
  6     7  Multiply by 7
  7     8  Multiply by 8
  END
   }


=head2 summarizeColumn($$)

Count the number of unique instances of each value a column in a table assumes.

     Parameter  Description
  1  $data      Table == array of arrays
  2  $column    Column number to summarize.

B<Example:>


  if (1) {
    is_deeply
     [𝘀𝘂𝗺𝗺𝗮𝗿𝗶𝘇𝗲𝗖𝗼𝗹𝘂𝗺𝗻([map {[$_]} qw(A B D B C D C D A C D C B B D)], 0)],
     [[5, "D"], [4, "B"], [4, "C"], [2, "A"]];

    ok nws(formatTable
     ([map {[split m//, $_]} qw(AA CB CD BC DC DD CD AD AA DC CD CC BB BB BD)],
      [qw(Col-1 Col-2)],
       summarize=>1)) eq nws(<<'END');

  Summary_of_column                - Count of unique values found in each column                     Use the Geany flick capability by placing your cursor on the first word
  Comma_Separated_Values_of_column - Comma separated list of the unique values found in each column  of these lines and pressing control + down arrow to see each sub report.

      Col-1  Col-2
   1  A      A
   2  C      B
   3  C      D
   4  B      C
   5  D      C
   6  D      D
   7  C      D
   8  A      D
   9  A      A
  10  D      C
  11  C      D
  12  C      C
  13  B      B
  14  B      B
  15  B      D

  Summary_of_column_Col-1
     Count  Col-1
  1      5  C
  2      4  B
  3      3  A
  4      3  D

  Comma_Separated_Values_of_column_Col-1: "C","B","A","D"

  Summary_of_column_Col-2
     Count  Col-2
  1      6  D
  2      4  C
  3      3  B
  4      2  A

  Comma_Separated_Values_of_column_Col-2: "D","C","B","A"

  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 a 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 method|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 method|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 method|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 method|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 method|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 method|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);
     }
   }


This is a static method and so should be invoked as:

  Data::Table::Text::overrideMethods


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


=head2 javaScriptExports($)

Extract the Javascript functions marked for export in a file or string.  Functions are marked for export by placing function in column 1 followed by //E on the same line.  The end of the exported function is located by
 }

     Parameter      Description
  1  $fileOrString  File or string

B<Example:>


  if (1) {
    ok 𝗷𝗮𝘃𝗮𝗦𝗰𝗿𝗶𝗽𝘁𝗘𝘅𝗽𝗼𝗿𝘁𝘀(<<END) eq <<END;
  function aaa()            //E
   {console.log('aaa');
   }


=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;
   }


=head2 isFileUtf8($)

Return the file name quoted if its contents are in utf8 else return undef

     Parameter  Description
  1  $file      File to test

B<Example:>


  if (0) {
    my $f = writeFile(undef, "aaa");
    ok 𝗶𝘀𝗙𝗶𝗹𝗲𝗨𝘁𝗳𝟴 $f;
   }


=head1 Unix domain communications

Send messages between processes via a unix domain socket.

=head2 newUdsrServer(@)

Create a communications server - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.

     Parameter  Description
  1  @parms     Attributes per L<Udsr Definition|/Udsr Definition>

B<Example:>


  if (1) {
    my $N = 20;
    my $s = 𝗻𝗲𝘄𝗨𝗱𝘀𝗿𝗦𝗲𝗿𝘃𝗲𝗿(serverAction=>sub
     {my ($u) = @_;
      my $r = $u->read;
      $u->write(qq(Hello from server $r));
     });

    my $p = newProcessStarter(min(100, $N));                                      # Run some clients
    for my $i(1..$N)
     {$p->start(sub
       {my $count = 0;
        for my $j(1..$N)
         {my $c = newUdsrClient;
          my $m = qq(Hello from client $i x $j);
          $c->write($m);
          my $r = $c->read;
          ++$count if $r eq qq(Hello from server $m);
         }
        [$count]
       });
     }

    my $count;
    for my $r($p->finish)                                                         # Consolidate results
     {my ($c) = @$r;
      $count += $c;
     }

    ok $count == $N*$N;                                                           # Check results and kill
    $s->kill;
   }


=head2 newUdsrClient(@)

Create a new communications client - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.

     Parameter  Description
  1  @parms     Attributes per L<Udsr Definition|/Udsr Definition>

B<Example:>


  if (1) {
    my $N = 20;
    my $s = newUdsrServer(serverAction=>sub
     {my ($u) = @_;
      my $r = $u->read;
      $u->write(qq(Hello from server $r));
     });

    my $p = newProcessStarter(min(100, $N));                                      # Run some clients
    for my $i(1..$N)
     {$p->start(sub
       {my $count = 0;
        for my $j(1..$N)
         {my $c = 𝗻𝗲𝘄𝗨𝗱𝘀𝗿𝗖𝗹𝗶𝗲𝗻𝘁;
          my $m = qq(Hello from client $i x $j);
          $c->write($m);
          my $r = $c->read;
          ++$count if $r eq qq(Hello from server $m);
         }
        [$count]
       });
     }

    my $count;
    for my $r($p->finish)                                                         # Consolidate results
     {my ($c) = @$r;
      $count += $c;
     }

    ok $count == $N*$N;                                                           # Check results and kill
    $s->kill;
   }


=head2 Udsr::write($$)

Write a communications message to the L<newUdsrServer|/newUdsrServer> or the L<newUdsrClient|/newUdsrClient>.

     Parameter  Description
  1  $u         Communicator
  2  $msg       Message

B<Example:>


  if (1) {
    my $N = 20;
    my $s = newUdsrServer(serverAction=>sub
     {my ($u) = @_;
      my $r = $u->read;
      $u->write(qq(Hello from server $r));
     });

    my $p = newProcessStarter(min(100, $N));                                      # Run some clients
    for my $i(1..$N)
     {$p->start(sub
       {my $count = 0;
        for my $j(1..$N)
         {my $c = newUdsrClient;
          my $m = qq(Hello from client $i x $j);
          $c->write($m);
          my $r = $c->read;
          ++$count if $r eq qq(Hello from server $m);
         }
        [$count]
       });
     }

    my $count;
    for my $r($p->finish)                                                         # Consolidate results
     {my ($c) = @$r;
      $count += $c;
     }

    ok $count == $N*$N;                                                           # Check results and kill
    $s->kill;
   }


=head2 Udsr::read($)

Read a message from the L<newUdsrServer|/newUdsrServer> or the L<newUdsrClient|/newUdsrClient>.

     Parameter  Description
  1  $u         Communicator

B<Example:>


  if (1) {
    my $N = 20;
    my $s = newUdsrServer(serverAction=>sub
     {my ($u) = @_;
      my $r = $u->read;
      $u->write(qq(Hello from server $r));
     });

    my $p = newProcessStarter(min(100, $N));                                      # Run some clients
    for my $i(1..$N)
     {$p->start(sub
       {my $count = 0;
        for my $j(1..$N)
         {my $c = newUdsrClient;
          my $m = qq(Hello from client $i x $j);
          $c->write($m);
          my $r = $c->read;
          ++$count if $r eq qq(Hello from server $m);
         }
        [$count]
       });
     }

    my $count;
    for my $r($p->finish)                                                         # Consolidate results
     {my ($c) = @$r;
      $count += $c;
     }

    ok $count == $N*$N;                                                           # Check results and kill
    $s->kill;
   }


=head2 Udsr::kill($)

Kill a communications server.

     Parameter  Description
  1  $u         Communicator

B<Example:>


  if (1) {
    my $N = 20;
    my $s = newUdsrServer(serverAction=>sub
     {my ($u) = @_;
      my $r = $u->read;
      $u->write(qq(Hello from server $r));
     });

    my $p = newProcessStarter(min(100, $N));                                      # Run some clients
    for my $i(1..$N)
     {$p->start(sub
       {my $count = 0;
        for my $j(1..$N)
         {my $c = newUdsrClient;
          my $m = qq(Hello from client $i x $j);
          $c->write($m);
          my $r = $c->read;
          ++$count if $r eq qq(Hello from server $m);
         }
        [$count]
       });
     }

    my $count;
    for my $r($p->finish)                                                         # Consolidate results
     {my ($c) = @$r;
      $count += $c;
     }

    ok $count == $N*$N;                                                           # Check results and kill
    $s->kill;
   }


=head2 Udsr::webUser($$)

Create a systemd installed server that processes http requests using a specified userid. The systemd and CGI files plus an installation script are written to the specified folder after it has been cleared. The L<serverAction> string contains the code to be executed by the server: the contained sub B<genResponse($hash)> will be called with a hash of the CGI variables, it should return the response to be sent back to the client.

     Parameter  Description
  1  $u         Communicator
  2  $folder    Folder to contain server code

B<Example:>


  if (0)
   {my $fold = fpd(qw(/home phil zzz));                                           # Folder to contain server code
    my $name = q(test);                                                           # Service
    my $user = q(phil);                                                           # User

    my $udsr = newUdsr                                                            # Create a Udsr parameter list
     (serviceName => $name,
      serviceUser => $user,
      socketPath  => qq(/home/phil/$name.socket),
      serverAction=> <<'END'
  my $user = userId;
  my $list = qx(ls -l);
  my $dtts = dateTimeStamp;
  return <<END2;
  Content-type: text/html

  <h1>Hello World to you $user on $dtts!</h1>

  <pre>
  $list
  </pre>
  END2
  END
     );

    𝗨𝗱𝘀𝗿::𝘄𝗲𝗯𝗨𝘀𝗲𝗿($udsr, $fold);                                                  # Create and install web service interface
    my $ip = awsIp;
    say STDERR qx(curl http://$ip/cgi-bin/$name/client.pl);                       # Enable port 80 on AWS first)
   }


=head1 Cloud Cover

Useful for operating across the cloud.

=head2 makeDieConfess()

Force die to confess where the death occurred.


B<Example:>


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


=head2 awsCurrentIp()

Get the ip address of the AWS server we are currently running on if we are running on an AWS server else return false


B<Example:>


  if (0) {
    𝗮𝘄𝘀𝗖𝘂𝗿𝗿𝗲𝗻𝘁𝗜𝗽;
   }


=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  $folder         Folder to save
  3  $zipFileName    Zip file name
  4  $bucket         Bucket/key
  5  $S3Parms        Additional S3 parameters like profile or region as a string

B<Example:>


    𝘀𝗮𝘃𝗲𝗖𝗼𝗱𝗲𝗧𝗼𝗦𝟯(1200, q(.), q(projectName), q(bucket/folder), q(--quiet));


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

Percent encode a url per: https://en.wikipedia.org/wiki/Percent-encoding#Percent-encoding_reserved_characters

     Parameter  Description
  1  $string    String

B<Example:>


  if (1) {
    ok 𝘄𝘄𝘄𝗘𝗻𝗰𝗼𝗱𝗲(q(a  {b} <c>)) eq q(a%20%20%7bb%7d%20%3cc%3e);
    ok 𝘄𝘄𝘄𝗘𝗻𝗰𝗼𝗱𝗲(q(../))        eq q(%2e%2e/);
    ok wwwDecode(𝘄𝘄𝘄𝗘𝗻𝗰𝗼𝗱𝗲 $_) eq $_ for q(a  {b} <c>), q(a  b|c),
      q(%), q(%%), q(%%.%%);
   }

  sub 𝘄𝘄𝘄𝗘𝗻𝗰𝗼𝗱𝗲($)
   {my ($string) = @_;                                                            # String
    join '', map {$translatePercentEncoding{$_}//$_} split //, $string
   }


=head2 wwwDecode($)

Percent decode a url per: https://en.wikipedia.org/wiki/Percent-encoding#Percent-encoding_reserved_characters

     Parameter  Description
  1  $string    String

B<Example:>


  if (1) {
    ok wwwEncode(q(a  {b} <c>)) eq q(a%20%20%7bb%7d%20%3cc%3e);
    ok wwwEncode(q(../))        eq q(%2e%2e/);
    ok 𝘄𝘄𝘄𝗗𝗲𝗰𝗼𝗱𝗲(wwwEncode $_) eq $_ for q(a  {b} <c>), q(a  b|c),
      q(%), q(%%), q(%%.%%);
   }

  sub 𝘄𝘄𝘄𝗗𝗲𝗰𝗼𝗱𝗲($)
   {my ($string) = @_;                                                            # String
    my $r = '';
    my @s = split //, $string;
    while(@s)
     {my $c = shift @s;
      if ($c eq q(%) and @s >= 2)
       {$c .= shift(@s).shift(@s);
        $r .= $TranslatePercentEncoding{$c}//$c;
       }
      else
       {$r .= $c;
       }
     }
    $r
   }


=head2 awsTranslateText($$$$)

Translate B<$text> from English to a specified B<$language> using AWS Translate with the specified global B<$options> and return the translated string.  Translations are cached in the specified B<$cacheFolder> for reuse were feasible.

     Parameter     Description
  1  $string       String to translate
  2  $language     Language code
  3  $cacheFolder  Cache folder
  4  $Options      Aws global options string

B<Example:>


    ok 𝗮𝘄𝘀𝗧𝗿𝗮𝗻𝘀𝗹𝗮𝘁𝗲𝗧𝗲𝘅𝘁("Hello", "it", ".translations/") eq q(Ciao);


=head1 Processes

Start processes, wait for them to terminate and retrieve their results

=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;
    sub{𝘀𝘁𝗮𝗿𝘁𝗣𝗿𝗼𝗰𝗲𝘀𝘀 {} %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;
    sub{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  %options                   Options

B<Example:>


  if (1)
   {my $N = 100;
    my $l = q(logFile.txt);
    unlink $l;
    my $s = 𝗻𝗲𝘄𝗣𝗿𝗼𝗰𝗲𝘀𝘀𝗦𝘁𝗮𝗿𝘁𝗲𝗿(4);
       $s->processingTitle   = q(Test processes);
       $s->totalToBeStarted  = $N;
       $s->processingLogFile = $l;

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

    ok readFile($l) =~ m(Finished $N processes for: Test processes)s;
    clearFolder($s->transferArea, 1e3);
    unlink $l;
   }


=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 (1)
   {my $N = 100;
    my $l = q(logFile.txt);
    unlink $l;
    my $s = newProcessStarter(4);
       $s->processingTitle   = q(Test processes);
       $s->totalToBeStarted  = $N;
       $s->processingLogFile = $l;

    for my $i(1..$N)
     {𝗗𝗮𝘁𝗮::𝗧𝗮𝗯𝗹𝗲::𝗧𝗲𝘅𝘁::𝗦𝘁𝗮𝗿𝘁𝗲𝗿::𝘀𝘁𝗮𝗿𝘁($s, sub{$i*$i});
     }

    is_deeply
     [sort {$a <=> $b} Data::Table::Text::Starter::finish($s)],
     [map {$_**2} 1..$N];

    ok readFile($l) =~ m(Finished $N processes for: Test processes)s;
    clearFolder($s->transferArea, 1e3);
    unlink $l;
   }


=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 (1)
   {my $N = 100;
    my $l = q(logFile.txt);
    unlink $l;
    my $s = newProcessStarter(4);
       $s->processingTitle   = q(Test processes);
       $s->totalToBeStarted  = $N;
       $s->processingLogFile = $l;

    for my $i(1..$N)
     {Data::Table::Text::Starter::start($s, sub{$i*$i});
     }

    is_deeply
     [sort {$a <=> $b} 𝗗𝗮𝘁𝗮::𝗧𝗮𝗯𝗹𝗲::𝗧𝗲𝘅𝘁::𝗦𝘁𝗮𝗿𝘁𝗲𝗿::𝗳𝗶𝗻𝗶𝘀𝗵($s)],
     [map {$_**2} 1..$N];

    ok readFile($l) =~ m(Finished $N processes for: Test processes)s;
    clearFolder($s->transferArea, 1e3);
    unlink $l;
   }


=head2 squareArray(@)

Create a two dimensional square array from a one dimensional linear array.

     Parameter  Description
  1  @array     Array

B<Example:>


  if (1) {
    is_deeply [𝘀𝗾𝘂𝗮𝗿𝗲𝗔𝗿𝗿𝗮𝘆 @{[1..4]} ], [[1, 2], [3, 4]];
    is_deeply [𝘀𝗾𝘂𝗮𝗿𝗲𝗔𝗿𝗿𝗮𝘆 @{[1..22]}],
     [[1 .. 5], [6 .. 10], [11 .. 15], [16 .. 20], [21, 22]];

    is_deeply [1..$_], [deSquareArray 𝘀𝗾𝘂𝗮𝗿𝗲𝗔𝗿𝗿𝗮𝘆 @{[1..$_]}] for 1..22;
    ok $_ == countSquareArray         𝘀𝗾𝘂𝗮𝗿𝗲𝗔𝗿𝗿𝗮𝘆 @{[1..$_]}  for 222;
   }


=head2 deSquareArray(@)

Create a one dimensional array from a two dimensional array of arrays

     Parameter  Description
  1  @square    Array of arrays

B<Example:>


  if (1) {
    is_deeply [squareArray @{[1..4]} ], [[1, 2], [3, 4]];
    is_deeply [squareArray @{[1..22]}],
     [[1 .. 5], [6 .. 10], [11 .. 15], [16 .. 20], [21, 22]];

    is_deeply [1..$_], [𝗱𝗲𝗦𝗾𝘂𝗮𝗿𝗲𝗔𝗿𝗿𝗮𝘆 squareArray @{[1..$_]}] for 1..22;
    ok $_ == countSquareArray         squareArray @{[1..$_]}  for 222;
   }


=head2 runInParallel($$$@)

Process each element of B<@array> in square root parallel with a maximum B<$maximumNumberOfProcesses> processes using sub B<&$parallel> to process an element and then call sub B<&$results> to process all the results returned by B<&$parallel>. B<&$parallel> receives an element from B<@array>. B<&$results> receives an array of all the results returned by B<&$parallel>.

     Parameter                  Description
  1  $maximumNumberOfProcesses  Maximum number of processes
  2  $parallel                  Parallel sub
  3  $results                   Results sub
  4  @array                     Array of items to process

B<Example:>


  if (1) {
    my @N = 1..100;
    my $N = 100;
    my $R = 0; $R += $_*$_ for 1..$N;

    ok 338350 == $R;

    ok $R == runInSquareRootParallel
       (4,
        sub {my ($p) = @_; $p * $p},
        sub {my $p = 0; $p += $_ for @_; $p},
        @{[1..$N]}
       );

    ok $R == 𝗿𝘂𝗻𝗜𝗻𝗣𝗮𝗿𝗮𝗹𝗹𝗲𝗹
       (4,
        sub {my ($p) = @_; $p * $p},
        sub {my $p = 0; $p += $_ for @_; $p},
        @{[1..$N]}
       );
   }


=head2 runInSquareRootParallel($$$@)

Process each element of B<@array> in square root parallel with a maximum B<$maximumNumberOfProcesses> processes using sub B<&$parallel> to process an element and then call sub B<&$results> to process all the results returned by B<&$parallel>. B<&$parallel> receives an element from B<@array>. B<&$results> receives an array of all the results returned by B<&$parallel>.

     Parameter                  Description
  1  $maximumNumberOfProcesses  Maximum number of processes
  2  $parallel                  Parallel sub
  3  $results                   Results sub
  4  @array                     Array of items to process

B<Example:>


  if (1) {
    my @N = 1..100;
    my $N = 100;
    my $R = 0; $R += $_*$_ for 1..$N;

    ok 338350 == $R;

    ok $R == 𝗿𝘂𝗻𝗜𝗻𝗦𝗾𝘂𝗮𝗿𝗲𝗥𝗼𝗼𝘁𝗣𝗮𝗿𝗮𝗹𝗹𝗲𝗹
       (4,
        sub {my ($p) = @_; $p * $p},
        sub {my $p = 0; $p += $_ for @_; $p},
        @{[1..$N]}
       );

    ok $R == runInParallel
       (4,
        sub {my ($p) = @_; $p * $p},
        sub {my $p = 0; $p += $_ for @_; $p},
        @{[1..$N]}
       );
   }


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

Parse a dita reference into its components optionally supplying a base file name for the file component and the topic id of the current topic as the default for the topicId if not present.

     Parameter  Description
  1  $ref       Reference to parse
  2  $File      Default absolute file
  3  $TopicId   Default topic id

B<Example:>


  if (1) {
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗗𝗶𝘁𝗮𝗥𝗲𝗳(q(a#b/c))], [qw(a b c)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗗𝗶𝘁𝗮𝗥𝗲𝗳(q(#b/c))],  [q(), qw(b c)];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗗𝗶𝘁𝗮𝗥𝗲𝗳(q(#b))],    [q(), q(b), q()];
    is_deeply [𝗽𝗮𝗿𝘀𝗲𝗗𝗶𝘁𝗮𝗥𝗲𝗳(q(#/c))],   [q(), q(), q(c)];
   }


=head2 reportSettings($$)

Report the current values of parameterless subs in a B<$sourceFile> that match \Asub\s+(\w+)\s*\{ and optionally write the report to B<$reportFile>. Return the text of the report.

     Parameter    Description
  1  $sourceFile  Source file
  2  $reportFile  Optional report file

B<Example:>


  𝗿𝗲𝗽𝗼𝗿𝘁𝗦𝗲𝘁𝘁𝗶𝗻𝗴𝘀($0);


=head2 reportAttributes($)

Report the attributes present in a B<$sourceFile>

     Parameter    Description
  1  $sourceFile  Source file

B<Example:>


  if (0) {
    my $d = temporaryFile;

    my $f = writeFile(undef, <<'END'.<<END2);
  #!perl -I/home/phil/perl/cpan/DataTableText/lib/
  use Data::Table::Text qw(reportAttributeSettings);
  sub attribute {1}                                                               # An attribute
  sub replaceable($)                                                              #r A replaceable method
   {
   }


=head2 reportAttributeSettings($)

Report the current values of the attribute methods in the calling file and optionally write the report to B<$reportFile>. Return the text of the report.

     Parameter    Description
  1  $reportFile  Optional report file

B<Example:>


  if (0) {
    my $d = temporaryFile;

    my $f = writeFile(undef, <<'END'.<<END2);
  #!perl -I/home/phil/perl/cpan/DataTableText/lib/
  use Data::Table::Text qw(𝗿𝗲𝗽𝗼𝗿𝘁𝗔𝘁𝘁𝗿𝗶𝗯𝘂𝘁𝗲𝗦𝗲𝘁𝘁𝗶𝗻𝗴𝘀);
  sub attribute {1}                                                               # An attribute
  sub replaceable($)                                                              #r A replaceable method
   {
   }


=head2 reportReplacableMethods($)

Report the replaceable methods marked with #r in a B<$sourceFile>

     Parameter    Description
  1  $sourceFile  Source file

B<Example:>


  if (0) {
    my $d = temporaryFile;

    my $f = writeFile(undef, <<'END'.<<END2);
  #!perl -I/home/phil/perl/cpan/DataTableText/lib/
  use Data::Table::Text qw(reportAttributeSettings);
  sub attribute {1}                                                               # An attribute
  sub replaceable($)                                                              #r A replaceable method
   {
   }

  sub 𝗿𝗲𝗽𝗼𝗿𝘁𝗥𝗲𝗽𝗹𝗮𝗰𝗮𝗯𝗹𝗲𝗠𝗲𝘁𝗵𝗼𝗱𝘀($)
   {my ($sourceFile) = @_;                                                        # Source file
    my $s = readFile($sourceFile);
    my %s;
    for my $l(split /
/, $s)                                                     # Find the attribute subs
     {if ($l =~ m(\Asub\s*(\w+).*?#\w*r\w*\s+(.*)\Z))
       {$s{$1} = $2;
       }
     }
    \%s
   }


=head2 reportExportableMethods($)

Report the exportable methods marked with #e in a B<$sourceFile>

     Parameter    Description
  1  $sourceFile  Source file

B<Example:>


  if (0) {
    my $d = temporaryFile;

    my $f = writeFile(undef, <<'END'.<<END2);
  #!perl -I/home/phil/perl/cpan/DataTableText/lib/
  use Data::Table::Text qw(reportAttributeSettings);
  sub attribute {1}                                                               # An attribute
  sub replaceable($)                                                              #r A replaceable method
   {
   }


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

Expand short url names in a string given in the format LE<lt>url-nameE<gt> as listed in L<Short_Names_For_Well_Known_Urls>.

     Parameter  Description
  1  $string    String containing url names to expand
  2  $Format    Output format: perl; html; dita

B<Example:>


  ok 𝗲𝘅𝗽𝗮𝗻𝗱𝗪𝗲𝗹𝗹𝗞𝗻𝗼𝘄𝗻𝗨𝗿𝗹𝘀(q(L<GitHub|https://github.com>)) eq q(L<GitHub|https://github.com>);

  ok 𝗲𝘅𝗽𝗮𝗻𝗱𝗪𝗲𝗹𝗹𝗞𝗻𝗼𝘄𝗻𝗨𝗿𝗹𝘀(q(github))    eq q(github);


=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';



=head2 Data::Exchange::Service Definition


Service details.




=head3 Output fields


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.




=head3 Input fields


B<processingLogFile> - Optional: name of a file to which process start and end information should be appended

B<processingTitle> - Optional: title describing the processing being performed.

B<totalToBeStarted> - Optionally: the total number of processes to be started - if this is supplied then an estimate of the finish time for this processing is printed to the log file every time a process starts or finishes.



=head3 Output fields


B<autoRemoveTransferArea> - If true then automatically clear the transfer area at the end of processing.

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<pids> - A hash of pids representing processes started but not yet completed.

B<processFinishTime> - {pid} == time the process finished.

B<processStartTime> - {pid} == time the process was started.

B<processingLogFileHandle> - Handle for log file if a log file was supplied

B<resultsArray> - Consolidated array of results.

B<startTime> - Start time

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.




=head3 Output fields


B<a> - Definition of attribute aa.

B<b> - Definition of attribute bb.



=head2 Udsr Definition


Package name




=head3 Input fields


B<headerLength> - Length of fixed header which carries the length of the following message

B<serverAction> - Server action sub, which receives a communicator every time a client creates a new connection. If this server is going to be started by systemd  as a service with the specified L<serverName> then this is the a actual text of the code that will be installed as a CGI script and run in response to an incoming transaction in a separate process with the userid set to L<serviceUser>. It receives the text of the http request from the browser as parameter 1 and should return the text to be sent back to the browser.

B<serviceName> - Service name for install by systemd

B<serviceUser> - Userid for service

B<socketPath> - Socket file



=head3 Output fields


B<client> - Client socket and connection socket

B<serverPid> - Server pid which can be used to kill the server via kill q(kill), $pid



=head1 Attributes


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


nameFromStringMaximumLength numberOfCpus


=head2 nameFromStringMaximumLength

Maximum length of a name generated from a string


=head2 numberOfCpus

Number of cpus




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

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

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

=head2 findAllFilesAndFolders($)

Find all the files and folders under a folder.

     Parameter  Description
  1  $dir       Folder to start the search with

=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 with optional image reduction.

     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
  4  $Tiles     Optional limit on the number of tiles in either dimension

=head2 setCombination(@)

Count the elements in sets represented as arrays of strings and/or the keys of hashes

     Parameter  Description
  1  @s         Array of arrays of strings and/or hashes

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

Blank identical column values up and left

     Parameter  Description
  1  $data      Array of arrays

=head2 formatTableAA($$%)

Tabularize an array of arrays.

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

B<Example:>


  if (1) {
   ok formatTable
    ([[1,1,1],[1,1,2],[1,2,2],[1,2,3]], [], clearUpLeft=>1) eq <<END;             # Clear matching columns

  1  1  1  1
  2        2
  3     2  2
  4        3
  END
   }


=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 newUdsr(@)

Create a communicator - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.

     Parameter  Description
  1  @parms     Attributes per L<Udsr Definition|/Udsr Definition>

=head2 awsIp()

Get ip address of server at aws


=head2 saveSourceToS3($$)

Save source code.

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

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

Create a log entry showing progress and eta.

     Parameter  Description
  1  $starter   Starter
  2  $finish    0 - start; 1 - finish

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

Average elapsed time spent by each process

     Parameter  Description
  1  $starter   Starter

=head2 Data::Table::Text::Starter::say($@)

Write to the log file if it is available.

     Parameter  Description
  1  $starter   Starter
  2  @message   Text to write to log file.

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

Wait for at least one process to finish and consolidate its results.

     Parameter  Description
  1  $starter   Starter

=head2 countSquareArray(@)

Count the number of elements in a square array

     Parameter  Description
  1  @square    Array of arrays

=head2 wellKnownUrls()

Short names for some well known urls


=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<absFile|/absFile> - Return B<undef> if the file is a relative file or b<$file> if the file is an absolute file name

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

3 L<absFromAbsPlusRel2|/absFromAbsPlusRel2> - Create an absolute file from an absolute file and a relative file.

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

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

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

7 L<arrayProduct|/arrayProduct> - Find the product of any strings that look like numbers in an array

8 L<arraySum|/arraySum> - Find the sum of any strings that look like numbers in an array

9 L<arrayTimes|/arrayTimes> - Multiply the second and subsequent parameters by the first parameter and return as an array

10 L<arrayToHash|/arrayToHash> - Create a hash from an array

11 L<asciiToHexString|/asciiToHexString> - Encode an ascii string as a string of hexadecimal digits.

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

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

14 L<awsCurrentIp|/awsCurrentIp> - Get the ip address of the AWS server we are currently running on if we are running on an AWS server else return false

15 L<awsIp|/awsIp> - Get ip address of server at aws

16 L<awsTranslateText|/awsTranslateText> - Translate B<$text> from English to a specified B<$language> using AWS Translate with the specified global B<$options> and return the translated string.

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

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

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

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

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

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

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

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

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

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

27 L<convertImageToJpx|/convertImageToJpx> - Convert an image to jpx format using L<Imagemagick|https://www.imagemagick.org/script/index.php> applying an optional scaling if required.

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

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

30 L<copyBinaryFile|/copyBinaryFile> - Copy a binary file and return the target name,

31 L<copyBinaryFileMd5Normalized|/copyBinaryFileMd5Normalized> - Normalize the name of the specified B<$source> file to the md5 sum of its content, retaining its current extension, while placing the original file name in a companion file if the companion file does not already exist.

32 L<copyBinaryFileMd5NormalizedCreate|/copyBinaryFileMd5NormalizedCreate> - Create a file in the specified B<$folder> whose name is constructed from the md5 sum of the specified B<$content>, whose content is B<$content>, whose extension is B<$extension> and which has a companion file with the same name minus the extension  which contains the specified B<$companionContent>.

33 L<copyBinaryFileMd5NormalizedGetCompanionContent|/copyBinaryFileMd5NormalizedGetCompanionContent> - Return the original name of the specified B<$source> file after it has been normalized via L<copyBinaryFileMd5Normalized|/copyBinaryFileMd5Normalized> or L<copyBinaryFileMd5NormalizedCreate|/copyBinaryFileMd5NormalizedCreate> or return B<undef> if the corresponding companion file does not exist.

34 L<copyFile|/copyFile> - Copy a file encoded in utf8 and return the target name

35 L<copyFileMd5Normalized|/copyFileMd5Normalized> - Normalize the name of the specified B<$source> file to the md5 sum of its content, retaining its current extension, while placing the original file name in a companion file if the companion file does not already exist.

36 L<copyFileMd5NormalizedCreate|/copyFileMd5NormalizedCreate> - Create a file in the specified B<$folder> whose name is constructed from the md5 sum of the specified B<$content>, whose content is B<$content>, whose extension is B<$extension> and which has a companion file with the same name minus the extension which contains the specified B<$companionContent>.

37 L<copyFileMd5NormalizedDelete|/copyFileMd5NormalizedDelete> - Delete a normalized and its companion file

38 L<copyFileMd5NormalizedGetCompanionContent|/copyFileMd5NormalizedGetCompanionContent> - Return the content of the companion file to the specified B<$source> file after it has been normalized via L<copyFileMd5Normalized|/copyFileMd5Normalized> or L<copyFileMd5NormalizedCreate|/copyFileMd5NormalizedCreate> or return B<undef> if the corresponding companion file does not exist.

39 L<copyFileMd5NormalizedName|/copyFileMd5NormalizedName> - Name a file using the GB Standard

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

41 L<copyFolderToRemote|/copyFolderToRemote> - Copy a folder to the corresponding folder on the server whose address is returned by L<awsIp>.

42 L<countFileExtensions|/countFileExtensions> - Return a hash which counts the file extensions under the specified directories

43 L<countFileTypes|/countFileTypes> - Return a hash which counts, in parallel, the results of applying the B<file> command to each file under the specified directories.

44 L<countOccurencesInString|/countOccurencesInString> - Returns the number of times the first string occurs in the second string

45 L<countSquareArray|/countSquareArray> - Count the number of elements in a square array

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

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

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

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

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

51 L<Data::Table::Text::Starter::averageProcessTime|/Data::Table::Text::Starter::averageProcessTime> - Average elapsed time spent by each process

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

53 L<Data::Table::Text::Starter::logEntry|/Data::Table::Text::Starter::logEntry> - Create a log entry showing progress and eta.

54 L<Data::Table::Text::Starter::say|/Data::Table::Text::Starter::say> - Write to the log file if it is available.

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

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

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

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

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

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

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

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

63 L<deSquareArray|/deSquareArray> - Create a one dimensional array from a two dimensional array of arrays

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

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

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

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

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

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

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

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

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

73 L<evalFile|/evalFile> - Read a file containing unicode in utf8, evaluate it, confess to any errors and then return any result with L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> methods to access each hash element - an improvement on B<do> which silently ignores any errors.

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

75 L<expandWellKnownUrls|/expandWellKnownUrls> - Expand short url names in a string given in the format LE<lt>url-nameE<gt> as listed in L<Short_Names_For_Well_Known_Urls>.

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

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

78 L<fff|/fff> - Confess a message with a line position and a file that Geany will jump to if clicked on.

79 L<fileInWindowsFormat|/fileInWindowsFormat> - Convert a unix file name to windows format

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

81 L<fileMd5Sum|/fileMd5Sum> - Get the Md5 sum for a file or string

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

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

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

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

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

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

88 L<findAllFilesAndFolders|/findAllFilesAndFolders> - Find all the files and folders under a folder.

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

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

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

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

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

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

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

96 L<formatTable|/formatTable> - Format various data structures as a table with titles as specified by B<$columnTitles>: either a reference to an array of column titles or a string each line of which contains the column title as the first word with the rest of the line describing that column.

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

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

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

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

101 L<formatTableClearUpLeft|/formatTableClearUpLeft> - Blank identical column values up and left

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

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

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

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

106 L<formattedTablesReport|/formattedTablesReport> - Report of all the reports created.

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

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

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

110 L<fullyQualifiedFile|/fullyQualifiedFile> - Return whether a file is fully qualified or not

111 L<fullyQualifyFile|/fullyQualifyFile> - Return the fully qualified name of a file

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

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

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

115 L<genLValueScalarMethods|/genLValueScalarMethods> - Generate L<lvalue method|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>.

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

117 L<guidFromMd5|/guidFromMd5> - Create a guid from an md5 hash.

118 L<guidFromString|/guidFromString> - Create a guid from a file or string via an md5 hash.

119 L<hexToAsciiString|/hexToAsciiString> - Decode a string of hexadecimal digits as an ascii string.

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

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

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

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

124 L<indexOfMax|/indexOfMax> - Find the index of the maximum number in a list confessing to any ill defined values.

125 L<indexOfMin|/indexOfMin> - Find the index of the minimum number in a list confessing to any ill defined values.

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

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

128 L<isFileUtf8|/isFileUtf8> - Return the file name quoted if its contents are in utf8 else return undef

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

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

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

132 L<javaScriptExports|/javaScriptExports> - Extract the Javascript functions marked for export in a file or string.

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

134 L<lll|/lll> - Log messages including the project name if available.

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

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

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

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

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

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

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

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

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

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

145 L<max|/max> - Find the maximum number in a list confessing to any ill defined values.

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

147 L<md5FromGuid|/md5FromGuid> - Recover an md5 sum from a guid.

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

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

150 L<min|/min> - Find the minimum number in a list confessing to any ill defined values.

151 L<nameFromFolder|/nameFromFolder> - Create a name from the last folder in the path of a file name.

152 L<nameFromString|/nameFromString> - Create a readable name from an arbitrary string of text.

153 L<nameFromStringRestrictedToTitle|/nameFromStringRestrictedToTitle> - Create a readable name from a string of text that might contain a title tag - fall back to L<nameFromString|/nameFromString> if that is not possible.

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

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

156 L<newUdsr|/newUdsr> - Create a communicator - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.

157 L<newUdsrClient|/newUdsrClient> - Create a new communications client - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.

158 L<newUdsrServer|/newUdsrServer> - Create a communications server - a means to communicate between processes on the same machine via L<Udsr::read|/Udsr::read> and L<Udsr::write|/Udsr::write>.

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

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

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

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

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

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

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

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

167 L<parseDitaRef|/parseDitaRef> - Parse a dita reference into its components optionally supplying a base file name for the file component and the topic id of the current topic as the default for the topicId if not present.

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

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

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

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

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

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

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

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

176 L<readFiles|/readFiles> - Read all the files in the specified B<@folders> into a hash

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

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

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

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

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

182 L<removeDuplicatePrefixes|/removeDuplicatePrefixes> - Remove duplicated leading path components from a file name.

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

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

185 L<reportAttributes|/reportAttributes> - Report the attributes present in a B<$sourceFile>

186 L<reportAttributeSettings|/reportAttributeSettings> - Report the current values of the attribute methods in the calling file and optionally write the report to B<$reportFile>.

187 L<reportExportableMethods|/reportExportableMethods> - Report the exportable methods marked with #e in a B<$sourceFile>

188 L<reportReplacableMethods|/reportReplacableMethods> - Report the replaceable methods marked with #r in a B<$sourceFile>

189 L<reportSettings|/reportSettings> - Report the current values of parameterless subs in a B<$sourceFile> that match \Asub\s+(\w+)\s*\{ and optionally write the report to B<$reportFile>.

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

191 L<runInParallel|/runInParallel> - Process each element of B<@array> in square root parallel with a maximum B<$maximumNumberOfProcesses> processes using sub B<&$parallel> to process an element and then call sub B<&$results> to process all the results returned by B<&$parallel>.

192 L<runInSquareRootParallel|/runInSquareRootParallel> - Process each element of B<@array> in square root parallel with a maximum B<$maximumNumberOfProcesses> processes using sub B<&$parallel> to process an element and then call sub B<&$results> to process all the results returned by B<&$parallel>.

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

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

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

196 L<setCombination|/setCombination> - Count the elements in sets represented as arrays of strings and/or the keys of hashes

197 L<setFileExtension|/setFileExtension> - Set the extension of a file to a specified value.

198 L<setIntersection|/setIntersection> - Intersection of sets represented as arrays of strings and/or the keys of hashes

199 L<setIntersectionOverUnion|/setIntersectionOverUnion> - Returns the size of the intersection over the size of the union of one or more sets represented as arrays and/or hashes

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

201 L<setPartitionOnIntersectionOverUnion|/setPartitionOnIntersectionOverUnion> - Partition a set of sets so that within each partition the L<setIntersectionOverUnion|/setIntersectionOverUnion> of any two sets in the partition is never less than the specified B<$confidence**2>

202 L<setPartitionOnIntersectionOverUnionOfHashStringSets|/setPartitionOnIntersectionOverUnionOfHashStringSets> - Partition a set of sets represented by a hash, each hash value being a string containing words and punctuation, each word possibly capitalized, so that within each partition the L<setPartitionOnIntersectionOverUnionOfSetsOfWords|/setPartitionOnIntersectionOverUnionOfSetsOfWords> of any two sets of words in the partition is never less than the specified B<$confidence**2> and the partition entries are the hash keys of the string sets.

203 L<setPartitionOnIntersectionOverUnionOfSetsOfWords|/setPartitionOnIntersectionOverUnionOfSetsOfWords> - Partition a set of sets of words so that within each partition the L<setIntersectionOverUnion|/setIntersectionOverUnion> of any two sets of words in the partition is never less than the specified B<$confidence**2>

204 L<setPartitionOnIntersectionOverUnionOfStringSets|/setPartitionOnIntersectionOverUnionOfStringSets> - Partition a set of sets, each set represented by a string containing words and punctuation, each word possibly capitalized, so that within each partition the L<setPartitionOnIntersectionOverUnionOfSetsOfWords|/setPartitionOnIntersectionOverUnionOfSetsOfWords> of any two sets of words in the partition is never less than the specified B<$confidence**2>

205 L<setPermissionsForFile|/setPermissionsForFile> - Set the permissions for the named file

206 L<setUnion|/setUnion> - Union of sets represented as arrays of strings and/or the keys of hashes

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

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

209 L<squareArray|/squareArray> - Create a two dimensional square array from a one dimensional linear array.

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

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

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

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

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

215 L<sumAbsAndRel|/sumAbsAndRel> - Combine zero or more absolute and relative file names starting at the current working folder to get an absolute file name.

216 L<summarizeColumn|/summarizeColumn> - Count the number of unique instances of each value a column in a table assumes.

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

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

219 L<swapFilePrefix|/swapFilePrefix> - Swaps the start of a file name from a B<$known> name to a B<$new> one if the file does in fact start with the B<$known> name otherwise returns the original file name.

220 L<swapFolderPrefix|/swapFolderPrefix> - Swaps a starting folder of a file name from a known name to a new one if the file does in fact start with the known name and the known name and new name are folders else return the file as is.

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

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

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

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

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

226 L<Udsr::kill|/Udsr::kill> - Kill a communications server.

227 L<Udsr::read|/Udsr::read> - Read a message from the L<newUdsrServer|/newUdsrServer> or the L<newUdsrClient|/newUdsrClient>.

228 L<Udsr::webUser|/Udsr::webUser> - Create a systemd installed server that processes http requests using a specified userid.

229 L<Udsr::write|/Udsr::write> - Write a communications message to the L<newUdsrServer|/newUdsrServer> or the L<newUdsrClient|/newUdsrClient>.

230 L<uniqueNameFromFile|/uniqueNameFromFile> - Create a unique name from a file name and the md5 sum of its content

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

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

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

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

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

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

237 L<wellKnownUrls|/wellKnownUrls> - Short names for some well known urls

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

239 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 already exists.

240 L<writeFiles|/writeFiles> - Write the values of a hash into files identified by the key of each value using L<overWriteFile|/overWriteFile> optionally swapping the prefix of each file from B<$old> to B<$new>

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

242 L<wwwDecode|/wwwDecode> - Percent decode a url per: https://en.

243 L<wwwEncode|/wwwEncode> - Percent encode a url per: https://en.

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

245 L<xxxr|/xxxr> - Execute a bash command B<$cmd> as user b<$user>on the server whose ip address is located in L<awsIp>.

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

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

=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-2019 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__
use Test::More;

Test::More->builder->output("/dev/null")                                        # Reduce number of confirmation messages during testing
  if ((caller(1))[0]//'Data::Table::Text') eq "Data::Table::Text";

if ($^O !~ m(bsd|linux)i)
 {plan skip_all => 'Not supported';
 }

my $timeStart = time;

#goto latestTest;

if (1)                                                                          # Unicode to local file
 {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);

  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 (1) {                                                                        # 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;
   }
 }

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;
   }
  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
ok q(a/b.c) eq removeDuplicatePrefixes("a/a/b.c");                              #TremoveDuplicatePrefixes
ok q(a/b.c) eq removeDuplicatePrefixes("a/b.c");                                #TremoveDuplicatePrefixes
ok q(b.c) eq removeDuplicatePrefixes("b.c");                                    #TremoveDuplicatePrefixes

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


if (1) {                                                                        #TsetIntersection
  is_deeply [qw(a b c)], [setIntersection[qw(e f g a b c )],[qw(a A b B c C)]];
  is_deeply [qw(e)],   [setIntersection {a=>1, b=>2, e=>3}, [qw(c d e)], qw(e)];
 }


if (1) {                                                                        #TsetUnion
  is_deeply [qw(a b c)],     [setUnion(qw(a b c a a b b b))];
  is_deeply [qw(a b c d e)], [setUnion {a=>1, b=>2, e=>3}, [qw(c d e)], qw(e)];
 }

if (1) {                                                                        #TsetIntersectionOverUnion
  my $f = setIntersectionOverUnion {a=>1, b=>2, e=>3}, [qw(c d e)], qw(e);
  ok $f > 0.199999 && $f < 2.00001;
 }

if (1) {                                                                        #TsetPartitionOnIntersectionOverUnion
  is_deeply [setPartitionOnIntersectionOverUnion
   (0.80,
     [qw(a A   b c d e)],
     [qw(a A B b c d e)],
     [qw(a A B C b c d)],
   )],
  [[["A", "B", "a".."e"],
    ["A",      "a".."e"]],
   [["A".."C", "a".."d"]],
  ];
}




if (1) {                                                                        #TsetPartitionOnIntersectionOverUnionOfSetsOfWords
is_deeply [setPartitionOnIntersectionOverUnionOfSetsOfWords
   (0.80,
     [qw(a A   b c d e)],
     [qw(a A B b c d e)],
     [qw(a A B C b c d)],
   )],
 [[["a", "A", "B", "C", "b", "c", "d"]],
  [["a", "A", "B", "b" .. "e"], ["a", "A", "b" .. "e"]],
 ];
 }

if (1) {                                                                        #TsetPartitionOnIntersectionOverUnionOfStringSets
is_deeply [setPartitionOnIntersectionOverUnionOfStringSets
   (0.80,
     q(The Emu            are seen here sometimes.),
     q(The Emu, Gnu       are seen here sometimes.),
     q(The Emu, Gnu, Colt are seen here.),
   )],
 [["The Emu, Gnu, Colt are seen here."],
  ["The Emu, Gnu       are seen here sometimes.",
   "The Emu            are seen here sometimes.",
  ]];
 }

if (1) {                                                                        #TsetPartitionOnIntersectionOverUnionOfHashStringSets
  is_deeply [setPartitionOnIntersectionOverUnionOfHashStringSets
   (0.80,
     {e  =>q(The Emu            are seen here sometimes.),
      eg =>q(The Emu, Gnu       are seen here sometimes.),
      egc=>q(The Emu, Gnu, Colt are seen here.),
     }
   )],
 [["e", "eg"], ["egc"]];
 }

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/"                  eq absFile(qw(/aaa/));                              #TabsFile
ok "/aaa/bbb/ccc/ddd.txt"   eq sumAbsAndRel(qw(/aaa/AAA/ ../bbb/bbb/BBB/ ../../ccc/ddd.txt)); #TsumAbsAndRel

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 (1) {
sub
 {our $a = q(1);                                                                #Tcall
  our @a = qw(1);
  our %a = (a=>1);
  our $b = q(1);
  for(2..4) {
    call {$a = $_  x 1e3; $a[0] = $_ x 1e2; $a{a} = $_ x 1e1; $b = 2;} qw($a @a %a);
    ok $a    == $_ x 1e3;
    ok $a[0] == $_ x 1e2;
    ok $a{a} == $_ x 1e1;
    ok $b    == 1;
   }
 }->();
 }

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 q(./)     eq fp q(./);
ok q(../)    eq fp q(../);
ok q(../../) eq fp q(../../);

if (0) {
ok q(a)      eq fn q(./a);
ok q(a)      eq fn q(../a);
ok q(a)      eq fn q(../../a);

ok q(a)      eq fe q(.a);
ok q(a)      eq fe q(./.a);
ok q(a)      eq fe q(../.a);
ok q(a)      eq fe q(../../.a);
}

if (1) {                                                                        #TwwwEncode #TwwwDecode
  ok wwwEncode(q(a  {b} <c>)) eq q(a%20%20%7bb%7d%20%3cc%3e);
  ok wwwEncode(q(../))        eq q(%2e%2e/);
  ok wwwDecode(wwwEncode $_) eq $_ for q(a  {b} <c>), q(a  b|c),
    q(%), q(%%), q(%%.%%);
 }

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 (1) {
  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
 }

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 (1) {
  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;
 }

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

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) {                                                                        #TformatTableBasic
  my $d = [[qw(a 1)], [qw(bb 22)], [qw(ccc 333)], [qw(dddd 4444)]];
  ok formatTableBasic($d) eq <<END, q(ftb);
a        1
bb      22
ccc    333
dddd  4444
END
  }

if (0) {                                                                        #TstartProcess #TwaitForAllStartedProcessesToFinish
  my %pids;
  sub{startProcess {} %pids, 1; ok 1 >= keys %pids}->() for 1..8;
  waitForAllStartedProcessesToFinish(%pids);
  ok !keys(%pids)
 }

if (1) {
ok dateTimeStamp     =~ m(\A\d{4}-\d\d-\d\d at \d\d:\d\d:\d\d\Z), q(dts);       #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
 }

if (0) {
  saveCodeToS3(1200, q(.), q(projectName), q(bucket/folder), q(--quiet));       #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
  countFileExtensions(q(/home/phil/perl/));                                     #TcountFileExtensions
  countFileTypes(4, q(/home/phil/perl/));                                       #TcountFileTypes
 }

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
  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 (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;
 }

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

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 nws($t) eq nws(<<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;
 }

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 nws($T) eq nws(<<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 (1)                                                                          #TnewProcessStarter #TData::Table::Text::Starter::start #TData::Table::Text::Starter::finish
 {my $N = 100;
  my $l = q(logFile.txt);
  unlink $l;
  my $s = newProcessStarter(4);
     $s->processingTitle   = q(Test processes);
     $s->totalToBeStarted  = $N;
     $s->processingLogFile = $l;

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

  ok readFile($l) =~ m(Finished $N processes for: Test processes)s;
  clearFolder($s->transferArea, 1e3);
  unlink $l;
 }

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 (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);
   }
 }

#eval {readFile($f)};                                                           # Fails to fail in the following section on a number of operating systems
#ok $@, "readFile";

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;

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

if (1) {                                                                        #TsquareArray #TdeSquareArray
  is_deeply [squareArray @{[1..4]} ], [[1, 2], [3, 4]];
  is_deeply [squareArray @{[1..22]}],
   [[1 .. 5], [6 .. 10], [11 .. 15], [16 .. 20], [21, 22]];

  is_deeply [1..$_], [deSquareArray squareArray @{[1..$_]}] for 1..22;
  ok $_ == countSquareArray         squareArray @{[1..$_]}  for 222;
 }

if (1) {                                                                        #TsummarizeColumn
  is_deeply
   [summarizeColumn([map {[$_]} qw(A B D B C D C D A C D C B B D)], 0)],
   [[5, "D"], [4, "B"], [4, "C"], [2, "A"]];

  ok nws(formatTable
   ([map {[split m//, $_]} qw(AA CB CD BC DC DD CD AD AA DC CD CC BB BB BD)],
    [qw(Col-1 Col-2)],
     summarize=>1)) eq nws(<<'END');

Summary_of_column                - Count of unique values found in each column                     Use the Geany flick capability by placing your cursor on the first word
Comma_Separated_Values_of_column - Comma separated list of the unique values found in each column  of these lines and pressing control + down arrow to see each sub report.

    Col-1  Col-2
 1  A      A
 2  C      B
 3  C      D
 4  B      C
 5  D      C
 6  D      D
 7  C      D
 8  A      D
 9  A      A
10  D      C
11  C      D
12  C      C
13  B      B
14  B      B
15  B      D

Summary_of_column_Col-1
   Count  Col-1
1      5  C
2      4  B
3      3  A
4      3  D

Comma_Separated_Values_of_column_Col-1: "C","B","A","D"

Summary_of_column_Col-2
   Count  Col-2
1      6  D
2      4  C
3      3  B
4      2  A

Comma_Separated_Values_of_column_Col-2: "D","C","B","A"

END
 }


if (0) {                                                                        #TisFileUtf8
  my $f = writeFile(undef, "aaa");
  ok isFileUtf8 $f;
 }

if (0) {                                                                        # Needs direct testing on multiple sytems
if (1) {                                                                        #TnewUdsrServer #TnewUdsrClient #TUdsr::read #TUdsr::write #TUdsr::kill
  my $N = 20;
  my $s = newUdsrServer(serverAction=>sub
   {my ($u) = @_;
    my $r = $u->read;
    $u->write(qq(Hello from server $r));
   });

  my $p = newProcessStarter(min(100, $N));                                      # Run some clients
  for my $i(1..$N)
   {$p->start(sub
     {my $count = 0;
      for my $j(1..$N)
       {my $c = newUdsrClient;
        my $m = qq(Hello from client $i x $j);
        $c->write($m);
        my $r = $c->read;
        ++$count if $r eq qq(Hello from server $m);
       }
      [$count]
     });
   }

  my $count;
  for my $r($p->finish)                                                         # Consolidate results
   {my ($c) = @$r;
    $count += $c;
   }

  ok $count == $N*$N;                                                           # Check results and kill
  $s->kill;
 }
 }
else
 {ok 1 for 1..1;
 }

if (1) {                                                                        #TguidFromMd5 #TguidFromString #TfileMd5Sum #Tmd5FromGuid
  ok fileMd5Sum(join '', 1..100)     eq
     q(ef69caaaeea9c17120821a9eb6c7f1de);

  ok guidFromString(join '', 1..100) eq
     q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

  ok guidFromMd5(fileMd5Sum(join('', 1..100))) eq
     q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de);

  ok md5FromGuid(q(GUID-ef69caaa-eea9-c171-2082-1a9eb6c7f1de)) eq
                      q(ef69caaaeea9c17120821a9eb6c7f1de);
}

if (1)
 {ok arraySum   (1..10) ==  55;                                                 #TarraySum
  ok arrayProduct(1..5) == 120;                                                 #TarrayProduct
  is_deeply[arrayTimes(2, 1..5)], [qw(2 4 6 8 10)];                             #TarrayTimes
 }

if (1)
 {ok indexOfMax(qw(2 3 1 2)) == 1;                                              #TindexOfMax
  ok indexOfMin(qw(2 3 1 2)) == 2;                                              #TindexOfMin
 }

if (1)
 {is_deeply [arrayTimes(2, 1..3)], [2,4,6];
 }

if (1)                                                                          #TcountOccurencesInString
 {ok countOccurencesInString(q(a<b>c<b><b>d), q(<b>)) == 3;
 }

if (1)                                                                          #TfileInWindowsFormat
 {ok fileInWindowsFormat(fpd(qw(/a b c d))) eq q(\a\b\c\d\\);
 }

if (1) {                                                                        #TformattedTablesReport
  @formatTables = ();

  for my $m(2..8)
   {formatTable([map {[$_, $_*$m]} 1..$m], [q(Single), qq(* $m)],
      title=>qq(Multiply by $m));
   }

  ok nws(formattedTablesReport) eq nws(<<END);
   Rows  Title          File
1     2  Multiply by 2
2     3  Multiply by 3
3     4  Multiply by 4
4     5  Multiply by 5
5     6  Multiply by 6
6     7  Multiply by 7
7     8  Multiply by 8
END
 }

if (1) {
  my $t = [[qw(a b c)], [1..3], [4..6]];

  ok nws(formatTable($t, [qw(A B C)], summarize=>1, csv=>q(/dev/null))) eq nws(<<END)
Summary_of_column                - Count of unique values found in each column                     Use the Geany flick capability by placing your cursor on the first word
Comma_Separated_Values_of_column - Comma separated list of the unique values found in each column  of these lines and pressing control + down arrow to see each sub report.
   A  B  C
1  a  b  c
2  1  2  3
3  4  5  6
Summary_of_column_A
   Count  A
1      1  1
2      1  4
3      1  a
Comma_Separated_Values_of_column_A: 1,4,"a"
Summary_of_column_B
   Count  B
1      1  2
2      1  5
3      1  b
Comma_Separated_Values_of_column_B: 2,5,"b"
Summary_of_column_C
   Count  C
1      1  3
2      1  6
3      1  c
Comma_Separated_Values_of_column_C: 3,6,"c"
END
 }

if (1) {                                                                        #TasciiToHexString #ThexToAsciiString
  ok asciiToHexString("Hello World!") eq                  "48656c6c6f20576f726c6421";
  ok                  "Hello World!"  eq hexToAsciiString("48656c6c6f20576f726c6421");
 }

if (1) {                                                                        #TswapFolderPrefix
  my $g = fpd(qw(a b c d));
  my $h = fpd(qw(a b cc dd));
  my $i = fpe($g, qw(aaa txt));

  my $j = swapFolderPrefix($i, $g, $h);
  ok $j =~ m(a/b/cc/dd/)s;
 }

if (0) {
reportSettings($0);                                                             #TreportSettings
lll "Hello world";                                                              #Tlll
fff __LINE__, __FILE__, "Hello world";                                          #Tfff
}

if (1) {
  #local $formatTableWithZwSp = 1;
  my $d = [[qw(a 1)], [qw(bb 22)], [qw(ccc 333)], [qw(dddd 4444)]];
  ok nws(formatTableBasic($d)) eq nws(<<END);
a        1
bb      22
ccc    333
dddd  4444
END
  }


if (1) {                                                                        #TnameFromString #TnameFromStringRestrictedToTitle
ok q(help) eq nameFromString(q(!@#$%^help___<>?><?>));
ok q(bm_The_skyscraper_analogy) eq nameFromString(<<END);
<bookmap id="b1">
<title>The skyscraper analogy</title>
</bookmap>
END

ok q(bm_The_skyscraper_analogy_An_exciting_tale_of_two_skyscrapers_that_meet_in_downtown_Houston)
   eq nameFromString(<<END);
<bookmap id="b1">
<title>The skyscraper analogy</title>
An exciting tale of two skyscrapers that meet in downtown Houston
<concept><html>
</bookmap>
END

ok q(bm_the_skyscraper_analogy) eq nameFromStringRestrictedToTitle(<<END);
<bookmap id="b1">
<title>The skyscraper analogy</title>
An exciting tale of two skyscrapers that meet in downtown Houston
<concept><html>
</bookmap>
END
 }

if (0) {                                                                        #TcopyFileMd5Normalized #TcopyFileMd5NormalizedGetCompanionContent #TcopyFileMd5NormalizedCreate #TcopyFileMd5NormalizedDelete
  my $dir = temporaryFolder;
  my $a = fpe($dir, qw(a a jpg));
  my $b = fpe($dir, qw(b a jpg));
  my $c = fpe($dir, qw(c a jpg));

  my $content = join '', 1..1e3;

  my $A = copyFileMd5NormalizedCreate($a, $content, q(jpg), $a);
  ok readFile($A) eq $content;
  ok $A eq copyFileMd5Normalized($A);

  my $B = copyFileMd5Normalized($A, $b);
  ok readFile($B) eq $content;
  ok $B eq copyFileMd5Normalized($B);

  my $C = copyFileMd5Normalized($B, $c);
  ok readFile($C) eq $content;
  ok $C eq copyFileMd5Normalized($C);

  ok fne($A) eq fne($_) for $B, $C;
  ok readFile($_) eq $content for $A, $B, $C;
  ok copyFileMd5NormalizedGetCompanionContent($_) eq $a for $A, $B, $C;

  ok 6 == searchDirectoryTreesForMatchingFiles($dir);
  copyFileMd5NormalizedDelete($A);
  ok 4 == searchDirectoryTreesForMatchingFiles($dir);
  copyFileMd5NormalizedDelete($B);
  ok 2 == searchDirectoryTreesForMatchingFiles($dir);
  copyFileMd5NormalizedDelete($C);
  ok 0 == searchDirectoryTreesForMatchingFiles($dir);

  clearFolder($dir, 10);
  ok 0 == searchDirectoryTreesForMatchingFiles($dir);
 }

if (0) {                                                                        #TcopyBinaryFileMd5Normalized #TcopyBinaryFileMd5NormalizedGetCompanionContent #TcopyBinaryFileMd5NormalizedCreate
  my $dir = temporaryFolder;
  my $a = fpe($dir, qw(a a jpg));
  my $b = fpe($dir, qw(b a jpg));
  my $c = fpe($dir, qw(c a jpg));

  my $content = join '', 1..1e3;

  my $A = copyBinaryFileMd5NormalizedCreate($a, $content, q(jpg), $a);
  ok readBinaryFile($A) eq $content;
  ok $A eq copyBinaryFileMd5Normalized($A);

  my $B = copyBinaryFileMd5Normalized($A, $b);
  ok readBinaryFile($B) eq $content;
  ok $B eq copyBinaryFileMd5Normalized($B);

  my $C = copyBinaryFileMd5Normalized($B, $c);
  ok readBinaryFile($C) eq $content;
  ok $C eq copyBinaryFileMd5Normalized($C);

  ok fne($A) eq fne($_) for $B, $C;
  ok readBinaryFile($_) eq $content for $A, $B, $C;
  ok copyBinaryFileMd5NormalizedGetCompanionContent($_) eq $a for $A, $B, $C;

  ok 6 == searchDirectoryTreesForMatchingFiles($dir);
  clearFolder($dir, 10);
 }

ok setFileExtension(q(.c),     q(d)) eq q(.d);                                  #TsetFileExtension
ok setFileExtension(q(b.c),    q(d)) eq q(b.d);                                 #TsetFileExtension
ok setFileExtension(q(/a/b.c), q(d)) eq q(/a/b.d);                              #TsetFileExtension

if (0) {
  ok awsTranslateText("Hello", "it", ".translations/") eq q(Ciao);              #TawsTranslateText
 }

if (1) {                                                                        #TuniqueNameFromFile
  my $f = owf(q(test.txt), join "", 1..100);
  ok uniqueNameFromFile($f) eq q(test_ef69caaaeea9c17120821a9eb6c7f1de.txt);
  unlink $f;
 }

if (1) {                                                                        #TnameFromFolder
ok nameFromFolder(fpe(qw( a b c d e))) eq q(c);
 }

if (1) {                                                                        #TparseDitaRef
  is_deeply [parseDitaRef(q(a#b/c))], [qw(a b c)];
  is_deeply [parseDitaRef(q(#b/c))],  [q(), qw(b c)];
  is_deeply [parseDitaRef(q(#b))],    [q(), q(b), q()];
  is_deeply [parseDitaRef(q(#/c))],   [q(), q(), q(c)];
 }

if (1) {                                                                        #TjavaScriptExports
  ok javaScriptExports(<<END) eq <<END;
function aaa()            //E
 {console.log('aaa');
 }

//EEEEEEEEE

function bbb()            //E
 {console.log('bbb');
 }
END

function aaa()            //E
 {console.log('aaa');
 }

function bbb()            //E
 {console.log('bbb');
 }
END
 }

if (0) {                                                                        #TcopyFileMd5NormalizedName
  ok copyFileMd5NormalizedName(<<END, q(txt)) eq
<p>Hello<b>World</b></p>
END
q(Hello_World_6ba23858c1b4811660896c324acac6fa.txt);
 }

if (!-e q(recursion)) {                                                         # Prevent recursion while testing
  my $recursion = createEmptyFile(q(recursion));
if (0) {                                                                        #TreportAttributes #TreportReplacableMethods #TreportExportableMethods #TreportAttributeSettings
  my $d = temporaryFile;

  my $f = writeFile(undef, <<'END'.<<END2);
#!perl -I/home/phil/perl/cpan/DataTableText/lib/
use Data::Table::Text qw(reportAttributeSettings);
sub attribute {1}                                                               # An attribute
sub replaceable($)                                                              #r A replaceable method
 {
 }
sub exportable($)                                                               #e An exportable method
 {
 }
END
reportAttributeSettings(q($d));
END2

  is_deeply reportAttributes($f),        {attribute  =>"An attribute"};
  is_deeply reportReplacableMethods($f), {replaceable=>"A replaceable method"};
  is_deeply reportExportableMethods($f), {exportable =>"An exportable method"};
  qx(perl $f);
  ok readFile($d) =~ m(attribute\s*1\s*An attribute);
  unlink $d, $f;
 }
  unlink $recursion;
 }

ok  fullyQualifiedFile(q(/a/b/c.d));                                            #TfullyQualifiedFile
ok !fullyQualifiedFile(q(c.d));                                                 #TfullyQualifiedFile

if (1)                                                                          #TsetPermissionsForFile
 {my $f = temporaryFile();
  setPermissionsForFile($f, q(ugo=r));
  my $a = qx(ls -la $f);
  ok $a =~ m(-r--r--r--)s;
  setPermissionsForFile($f, q(u=rwx));
  my $b = qx(ls -la $f);
  ok $b =~ m(-rwxr--r--)s;
 }

if (0)                                                                          #TcopyFolderToRemote
 {copyFolderToRemote(q(/home/phil/perl/cpan/), q(phil));
 }

if (0)                                                                          #TfullyQualifyFile
 {ok fullyQualifyFile(q(perl/cpan)) eq q(/home/phil/perl/cpan/);
 }

if (0)                                                                          #Txxxr
 {ok xxxr(q(pwd), q(phil));
 }

if (0)                                                                          #TUdsr::webUser
 {my $fold = fpd(qw(/home phil zzz));                                           # Folder to contain server code
  my $name = q(test);                                                           # Service
  my $user = q(phil);                                                           # User

  my $udsr = newUdsr                                                            # Create a Udsr parameter list
   (serviceName => $name,
    serviceUser => $user,
    socketPath  => qq(/home/phil/$name.socket),
    serverAction=> <<'END'
my $user = userId;
my $list = qx(ls -l);
my $dtts = dateTimeStamp;
return <<END2;
Content-type: text/html

<h1>Hello World to you $user on $dtts!</h1>

<pre>
$list
</pre>
END2
END
   );

  Udsr::webUser($udsr, $fold);                                                  # Create and install web service interface
  my $ip = awsIp;
  say STDERR qx(curl http://$ip/cgi-bin/$name/client.pl);                       # Enable port 80 on AWS first)
 }

if (1) {                                                                        #TrunInSquareRootParallel #TrunInParallel
  my @N = 1..100;
  my $N = 100;
  my $R = 0; $R += $_*$_ for 1..$N;

  ok 338350 == $R;

  ok $R == runInSquareRootParallel
     (4,
      sub {my ($p) = @_; $p * $p},
      sub {my $p = 0; $p += $_ for @_; $p},
      @{[1..$N]}
     );

  ok $R == runInParallel
     (4,
      sub {my ($p) = @_; $p * $p},
      sub {my $p = 0; $p += $_ for @_; $p},
      @{[1..$N]}
     );
 }

if (0) {                                                                        #TawsCurrentIp
  awsCurrentIp;
 }

if (1) {                                                                        #TevalFile
  my $f = dumpFile(undef, {a=>1, b=>2});
  my $d = evalFile($f);
  ok $d->a == 1;
  ok $d->b == 2;
  unlink $f;
 }

ok expandWellKnownUrls(q(L<github>)) eq q(L<GitHub|https://github.com>);        #TexpandWellKnownUrls
ok expandWellKnownUrls(q(github))    eq q(github);                              #TexpandWellKnownUrls

latestTest:;

if (1) {                                                                        #TformatTableAA
 ok formatTable
  ([[1,1,1],[1,1,2],[1,2,2],[1,2,3]], [], clearUpLeft=>1) eq <<END;             # Clear matching columns

1  1  1  1
2        2
3     2  2
4        3
END
 }

done_testing;

say STDERR "Finished in ", (time() - $timeStart), " seconds";

#tttt

1
