Description
The following sections describe the methods in each functional area of this module. For an alphabetic listing of all methods by name see Index.
END my @private; # Documentation of private methods my $level = 0; my $off = 0; # Header levels
my @l = split /\n/, readFile($perlModule); # Read the perl module
for my $l(keys @l) # Tests associated with each method
{my $line = $l[$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 < @l; ++$L)
{my $nextLine = $l[$L];
push @testLines, extractTest($nextLine);
if ($nextLine =~ m/\AEND/) # Add a blank line after the END
{last
}
}
}
push @testLines, ''; # Blank line between each test line
for my $testLine(@testLines) # Save test lines
{for my $t(sort keys %tags)
{push @{$examples{$t}}, $testLine;
}
}
}
}
unless($perlModule eq qq(Text.pm)) # 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 this module as it is already loaded
{do "$perlModule";
confess dump($@, $!) if $@;
}
for my $l(keys @l)
{my $line = $l[$l]; # This line
my $nextLine = $l[$l+1]; # The next line
if ($line =~ /\A#(\d)\s+(.*?)\s*(#\s*(.+)\s*)?\Z/) # Sections are marked with #n in column 1-2 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#/) # Switch documentation off
{$level = 0;
}
elsif ($level and $line =~ /\A\s*sub\s*(.*?)\s*#(\w*)\s+(.+?)\s*\Z/) # Documentation for a method
{my ($sub, $flags, $comment, $example, $produces) = # Name from sub, flags, description
($1, $2, $3);
$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\(//gsr =~
s/\)\s*(:lvalue\s*)?\Z//gsr =~
s/;//gsr; # Remove optional parameters marker from signature
my $name = $sub =~ s/\(.+?\)//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 $userFlags = $flags =~ s/[IPSX]//gsr; # User flags == all flags minus the known flags
$methodX {$name} = $methodX if $methodX; # MethodX
$private {$name} = $private if $private; # Private
$static {$name} = $static if $static; # Static
$iUseful {$name} = $comment if $iUseful; # Immediately useful
$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*\(//r =~ s/\)\s*=\s*\@_;//r;
@parameters == length($signature) or # Check signature length
confess "Signature $signature for method: $name".
" has wrong number of parameters";
my @parmDescriptions = map {ucfirst()} split /,\s*/, $parmDescriptions; # Parameter descriptions with first letter uppercased
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([[qw(Parameter Description)],
map{[$parameters[$_], $parmDescriptions[$_]]} keys @parameters]), ' ')
if $parmNames and $parmDescriptions and $parmDescriptions !~ /\A#/; # Add parameter description if present
push @method, # Add user documentation
"\n".$userFlags{$name}[0]."\n" if $userFlags{$name}[0];
push @method, # Add example
"\nExample:\n\n $example" if $example;
push @method, # Produces
"\n$produces" if $produces;
if (my $examples = $examples{$name}) # Format examples
{if (my @examples = @$examples)
{push @method, '\nExample:\m', map {" $_"} @examples;
}
}
push @method, # 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 @{$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*\(qw\((\w+)\)\);\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
push @doc, "\n=head$headLevel $name :lvalue\n\n$description\n"; # Method description
}
}
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 useful 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, "$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
push @doc, "\n\n=head1 Index\n\n";
for my $s(sort {lc($a) cmp lc($b)} keys %methodParms) # Alphabetic listing of methods
{my $t = $methodParms{$s};
push @doc, "L<$s|/$t>\n"
}
push @doc, <<END; # Standard stuff
`head1 Installation
This module is written in 100% Pure Perl and, thus, it is easy to read, use, modify and install.
Standard Module::Build process for building and installing modules:
perl Build.PL
./Build
./Build test
./Build install
`head1 Author
`head1 Copyright
Copyright (c) 2016-2017 Philip R Brenan.
This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
`cut END
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__; return if eval "eof(${p}::DATA)"; my $s = eval "join('', <${p}::DATA>)"; $@ and die $@; eval $s; $@ and die $@; }
test unless caller; END
s/\\m/\n\n/gs for @doc; # Expand \\m to two new lines in documentation
s/\\n/\n/gs for @doc; # Expand \\n to one new line in documentation
s/\\x//gs for @doc; # Expand \\x to '' in documentation
s/`/=/gs for @doc; # Convert ` to =
join "\n", @doc # Return documentation
}
sub docUserFlags($$$$) # Generate documentation for a 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($) # 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: $perlModule"; my $t = extractDocumentation($perlModule); # Get documentation my $s = readFile($perlModule); # Read module source writeFile(filePathExt($perlModule, qq(backup)), $s); # Backup module source $s =~ s/\n+=head1 Description.+?\n+1;\n+/\n\n$t\n1;\n/gs; # Edit module source from =head1 description to final 1; writeFile($perlModule, $s); # Write updated module source
xxx("pod2html --infile=$perlModule --outfile=zzz.html && ". # View documentation
" google-chrome zzz.html pods2 && ".
" rm zzz.html pod2htmd.tmp");
}
#------------------------------------------------------------------------------- # Examples #-------------------------------------------------------------------------------
if (0 and !caller) {say STDERR "\n","\nsay STDERR formatTable(",dump($_), ");\n# ", formatTable($_) =~ s/\n/\n# /gr for [[qw(. aa bb cc)], [qw(1 A B C)], [qw(2 AA BB CC)], [qw(3 AAA BBB CCC)], [qw(4 1 22 333)]], [{aa=>'A', bb=>'B', cc=>'C'}, {aa=>'AA', bb=>'BB', cc=>'CC'}, {aa=>'AAA', bb=>'BBB', cc=>'CCC'}, {aa=>'1', bb=>'22', cc=>'333'}], {''=>[qw(aa bb cc)], 1=>[qw(A B C)], 22=>[qw(AA BB CC)], 333=>[qw(AAA BBB CCC)], 4444=>[qw(1 22 333)]}, {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'}}, [qw(a bb ccc 4444)], {aa=>'A', bb=>'B', cc=>'C'}; }
#------------------------------------------------------------------------------- # Export #-------------------------------------------------------------------------------
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter); @EXPORT = qw(formatTable); @EXPORT_OK = qw(appendFile checkKeys containingPowerOfTwo containingFolder convertImageToJpx currentDirectory currentDirectoryAbove dateStamp dateTimeStamp extractDocumentation fileList fileModTime fileOutOfDate filePath filePathDir filePathExt fileSize findDirs findFiles formatTableBasic fullFileName genLValueArrayMethods genLValueHashMethods genLValueScalarMethods genLValueScalarMethodsWithDefaultValues imageSize indentString isBlank javaPackage keyCount loadArrayArrayFromLines loadArrayFromLines loadHashArrayFromLines loadHashFromLines makePath nws pad parseFileName powerOfTwo quoteFile readBinaryFile readFile printFullFileName saveToS3 searchDirectoryTreesForMatchingFiles temporaryDirectory temporaryFile temporaryFolder timeStamp trim updatePerlModuleDocumentation writeBinaryFile writeFile xxx); %EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);
# podDocumentation
Name
Data::Table::Text - Write data in tabular text format
Synopsis
use Data::Table::Text;
say STDERR formatTable([
[".", "aa", "bb", "cc"],
[1, "A", "B", "C"],
[2, "AA", "BB", "CC"],
[3, "AAA", "BBB", "CCC"],
[4, 1, 22, 333]]);
# . aa bb cc
# 1 1 A B C
# 2 2 AA BB CC
# 3 3 AAA BBB CCC
# 4 4 1 22 333
say STDERR 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 }]);
# aa bb cc
# 1 A B C
# 2 AA BB CC
# 3 AAA BBB CCC
# 4 1 22 333
say STDERR formatTable({
"" => ["aa", "bb", "cc"],
"1" => ["A", "B", "C"],
"22" => ["AA", "BB", "CC"],
"333" => ["AAA", "BBB", "CCC"],
"4444" => [1, 22, 333]});
# aa bb cc
# 1 A B C
# 22 AA BB CC
# 333 AAA BBB CCC
# 4444 1 22 333
say STDERR 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 }});
# aa bb cc
# a A B C
# aa AA BB CC
# aaa AAA BBB CCC
# aaaa 1 22 333
say STDERR formatTable(["a", "bb", "ccc", 4444]);
# 0 a
# 1 bb
# 2 ccc
# 3 4444
say STDERR formatTable({ aa => "A", bb => "B", cc => "C" });
# aa A
# bb B
# cc C
Description
Time stamps
Date and timestamps as used in logs of long running commands
dateTimeStamp()
Year-monthNumber-day at hours:minute:seconds
dateStamp()
Year-monthName-day
timeStamp()
hours:minute:seconds
xxx(@)
Execute a command checking and logging the results
1 @cmd Command to execute specified as one or more strings with optionally the last string being a regular expression that is used to confirm that the command executed successfully and thus that it is safe to suppress the command output as uninteresting.
Files and paths
Operations on files and paths
Statistics
Information about each file
fileSize($)
Get the size of a file
1 $file File name
fileModTime($)
Get the modified time of a file in seconds since the epoch
1 $file File name
fileOutOfDate($@)
Returns undef if all the files exist and the first file is younger than all the following files; else returns the first file that does not exist or is younger than the first file.
1 $target Target
2 @sources Sources
Example:
make($target) if fileOutOfDate($target, $source1, $source2, $source3)
Use fileOutOfDateX to execute fileOutOfDate but die 'fileOutOfDate' instead of returning undef
Components
Create file names from file name components
filePath(@)
Create a file path from an array of file name components. If all the components are blank then a blank file name is returned
1 @file File components
filePathDir(@)
Directory from an array of file name components. If all the components are blank then a blank file name is returned
1 @file File components
filePathExt(@)
File name from file name components and extension
1 @File File components and extension
quoteFile($)
Quote a file name
1 $file File name
currentDirectory()
Get the current working directory tracking changes made by chdir
currentDirectoryAbove()
The path to the folder above the current working folder
parseFileName($)
Parse a file name into (path, name, extension)
1 $file File name to parse
containingFolder($)
Path to the folder that contains this file, or use "parseFileName"
1 $file File name
Temporary
Temporary files and folders
temporaryFile()
Create a temporary file that will automatically be unlinked during END
temporaryFolder()
Create a temporary folder that will automatically be rmdired during END
temporaryDirectory()
Create a temporary directory that will automatically be rmdired during END
Find
Find files and folders below a folder
findFiles($)
Find all the file under a folder
1 $dir Folder to start the search with
findDirs($)
Find all the folders under a folder
1 $dir Folder to start the search with
fileList($)
File list
1 $pattern Search pattern
searchDirectoryTreesForMatchingFiles(@)
Search the specified directory trees for files that match the specified extensions - the argument list should include at least one folder and one extension to be useful
1 @foldersandExtensions Mixture of folder names and extensions
Read and write files
Read and write strings from and to files creating paths as needed
readFile($)
Read a file containing unicode
1 $file Name of unicode file to read
readBinaryFile($)
Read binary file - a file whose contents are not to be interpreted as unicode
1 $file File to read
makePath($)
Make a path for a file name or a folder
1 $path Path
writeFile($$)
Write a unicode string to a file after creating a path to the file if necessary
1 $file File to write to
2 $string Unicode string to write
appendFile($$)
Append a unicode string to a file after creating a path to the file if necessary
1 $file File to append to
2 $string Unicode string to append
writeBinaryFile($$)
Write a non unicode string to a file in after creating a path to the file if necessary
1 $file File to write to
2 $string Non unicode string to write
Images
Image operations
imageSize($)
Return (width, height) of an image obtained via imagemagick
1 $image File containing image
convertImageToJpx($$$)
Convert an image to jpx format
1 $source Source file
2 $target Target folder (as multiple files will be created)
3 $size Size of each tile
Powers
Integer powers of two
powerOfTwo($)
Test whether a number is a power of two, return the power if it is else undef
1 $n Number to check
Use powerOfTwoX to execute powerOfTwo but die 'powerOfTwo' instead of returning undef
containingPowerOfTwo($)
Find log two of the lowest power of two greater than or equal to a number
1 $n Number to check
Use containingPowerOfTwoX to execute containingPowerOfTwo but die 'containingPowerOfTwo' instead of returning undef
Format
Format data structures as tables
formatTableBasic($$)
Tabularize text - basic version
1 $data Data to be formatted
2 $separator Optional line separator
formatTable($$$)
Format various data structures
1 $data Data to be formatted
2 $title Optional title
3 $separator Optional line separator
keyCount($$)
Count keys down to the specified level
1 $maxDepth Maximum depth to count to
2 $ref Reference to an array or a hash
Lines
Load data structures from lines
loadArrayFromLines($)
Load an array from lines of text in a string
1 $string The string of lines from which to create an array
loadHashFromLines($)
Load a hash: first word of each line is the key and the rest is the value
1 $string The string of lines from which to create a hash
loadArrayArrayFromLines($)
Load an array of arrays from lines of text: each line is an array of words
1 $string The string of lines from which to create an array of arrays
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
1 $string The string of lines from which to create a hash of arrays
checkKeys($$)
Check the keys in a hash
1 $test The hash to test
2 $permitted The permitted keys and their meanings
LVALUE methods
Replace $a->{value} = $b with $a->value = $b which reduces the amount of typing required, is easier to read and provides a hard check that {value} is spelt correctly.
genLValueScalarMethods(@)
Generate LVALUE scalar methods in the current package, A method whose value has not yet been set will return a new scalar with value undef.
1 @names List of method names
Example:
$a->value = 1;
genLValueScalarMethodsWithDefaultValues(@)
Generate LVALUE 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.
1 @names List of method names
Example:
$a->value == qq(value);
genLValueArrayMethods(@)
Generate LVALUE 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.
1 @names List of method names
Example:
$a->value->[1] = 2;
genLValueHashMethods(@)
Generate LVALUE 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.
1 @names Method names
Example:
$a->value->{a} = 'b';
Strings
Actions on strings
indentString($$)
Indent lines contained in a string or formatted table by the specified amount
1 $string The string of lines to indent
2 $indent The indenting string
isBlank($)
Test whether a string is blank
1 $string String
trim($)
Trim off white space from from front and end of string
1 $string String
pad($$)
Pad a string with blanks to a multiple of a specified length
1 $string String
2 $length Tab width
nws($)
Normalize white space in a string to make comparisons easier
1 $string String to normalize
javaPackage($)
Extract the package name from a java string or file,
1 $java Java file if it exists else the string of java
perlPackage($)
Extract the package name from a perl string or file,
1 $perl Perl file if it exists else the string of perl
Documentation
Extract, format and update documentation for a perl module
extractDocumentation($)
Extract documentation from a perl script between the lines marked with:
#n title # description
and:
#...
where n is either 1 or 2 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 any combination of:
- P
-
private method
- S
-
static method
- X
-
die rather than received a returned undef result
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.
The character sequence \n in the comment will be expanded to one new line and \m to two new lines.
Search for '#1': in https://metacpan.org/source/PRBRENAN/Data-Table-Text-20170728/lib/Data/Table/Text.pm to see examples.
Parameters:
1 $perlModule Optional file name with caller's file being the default
Private Methods
formatTableAA($$$)
Tabularize an array of arrays
1 $data Data to be formatted
2 $title Optional title
3 $separator Optional line separator
formatTableHA($$$)
Tabularize a hash of arrays
1 $data Data to be formatted
2 $title Optional title
3 $separator Optional line separator
formatTableAH($$$)
Tabularize an array of hashes
1 $data Data to be formatted
2 $title Optional title
3 $separator Optional line separator
formatTableHH($$$)
Tabularize a hash of hashes
1 $data Data to be formatted
2 $title Optional title
3 $separator Optional line separator
formatTableA($$$)
Tabularize an array
1 $data Data to be formatted
2 $title Optional title
3 $separator Optional line separator
formatTableH($$$)
Tabularize a hash
1 $data Data to be formatted
2 $title Optional title
3 $separator Optional line separator
extractTest($)
Extract a line of a test
1 $string String containing test line
Index
genLValueScalarMethodsWithDefaultValues
searchDirectoryTreesForMatchingFiles
Installation
This module is written in 100% Pure Perl and, thus, it is easy to read, use, modify and install.
Standard Module::Build process for building and installing modules:
perl Build.PL
./Build
./Build test
./Build install
Author
Copyright
Copyright (c) 2016-2017 Philip R Brenan.
This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.