Data-Table-Text
view release on metacpan or search on metacpan
lib/Data/Table/Text.pm view on Meta::CPAN
$string # Result
}
sub expandWellKnownUrlsInDitaFormat($) # Expand short L<url> names found in a string in the format L[url-name] in the L[Dita] B<xref>format.
{my ($string) = @_; # String containing url names to expand
my $wellKnown = wellKnownUrls; # Well known urls to expand
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;
}
$string # Result
}
sub expandWellKnownWordsInMarkDownFile($$) #P Expand well known words in a mark down file.
{my ($s, $t) = @_; # Source file, target file
owf $t, expandWellKnownWordsAsUrlsInMdFormat readFile $s
}
sub formatSourcePodAsHtml #P Format the L<pod> in the current source file as L<html>.
{my $s1 = readFile $0; # Read source file
my $s2 = expandWellKnownUrlsInPerlFormat $s1; # Expand Perl links
my $s3 = expandWellKnownUrlsInHtmlFormat $s2; # Expand Html links
$s3 =~ s(<th>) (<th align="left">)g; # Align headers
my $s = writeTempFile $s3; # Write expanded source to temporary file
my $t = setFileExtension $0, q(html);
lll qx(pod2html --infile $s --outfile $t; rm pod2htmd.tmp); # Format expanded source as HTML
lll qx(opera $t); # Show HTML
}
sub expandNewLinesInDocumentation($) # Expand new lines in documentation, specifically \n for new line and \m for two new lines.
{my ($s) = @_; # String to be expanded
$s =~ s(\\m) (\n\n)gs; # Double new line
$s =~ s(\\n) (\n)gs; # Single new line
$s
}
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 extractCodeBlock($;$) # Extract the block of code delimited by B<$comment>, starting at qq($comment-begin), ending at qq($comment-end) from the named B<$file> else the current Perl program $0 ...
{my ($comment, $file) = @_; # Comment delimiting the block of code, file to read from if not $0
my $s = readFile($file//$0);
if ($s =~ m($comment-begin\s*\n(.*?)$comment-end)is)
{my $c = $1;
$c =~ s(\s+\Z) ()s;
return qq($c\n);
}
confess "Unable to locate code delimited by $comment in $0\n"; #CODEBLOCK-begin
my $a = 1;
my $b = 2; #CODEBLOCK-end
}
sub updateDocumentation(;$) # Update the 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...
{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 = 900; # 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 %exported; # Exported methods
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 %isUseful; # 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 %signatureNames; # Signature using parameter names
my %static; # Static methods
my %substitutions; # Substitute variables from the code into the documentation: my $key = q(value); #Substitute will replace all occurrences of B<$key> in the documentation with B<value>.
my $svg; # A url pointing to an an online folder of svg images to illustrate this package
my %svg; # Svg images used - only include each svg image once each time as otherwise it gets overwhelming very quickly
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 %title; # Method to title of section describing method
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 %unitary; # A unitary method - all of its parameters other than the first are strings or numbers
my $version; # Version of package being documented
my @ctags; # Ctags file in pipe format for each sub
my %moduleDescription; # Hash of {section}{method}{detail}=value
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;
$moduleDescription{version} = $v; # Record version in module description
}
}
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
lib/Data/Table/Text.pm view on Meta::CPAN
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 = expandWellKnownUrlsInPerlFormat(join "\n", @doc); # Create documentation
for my $m(sort keys %title) # Links to titles
{my $t = $title{$m};
$t = substr($t, 0, 256) if length($t) > 256; # Otherwise some one line subroutines produce very long titles
$doc =~ s(L\[$m\]) (L<$m|/"$t">)gs unless $m =~ m(\{); # Unless a one line subroutine
}
for my $s(sort keys %substitutions) # Perform any substitutions requested
{my $v = $substitutions{$s};
$doc =~ s($s) ($v)gs;
}
unless($sourceIsString) # Update source file
{if (@synopsis) # Remove existing synopsis if adding a generated one
{$source =~ s(=head1 Synopsis.*?(=head1 Description)) ($1)s;
}
if ($source =~ m/\n1;\n/) # Edit module source from =head1 description to final 1;
{$source =~ s/\n+=head1 Description\n.*?\n+1;\n+/\n\n$doc\n1;\n/gs;
}
else # Insert documentation in modules that use evaluated tests
{my @cut = split/=cut/, $source; pop @cut; # Count Cut statements
my $cut = @cut;
confess "Update documentation requires exactly one =cut not $cut" unless $cut == 1;
my $pod = $doc =~ s(# Tests and documentation\n.*\Z) ()sr; # Remove test start
$source =~ m(\n+=head1 Description\n.*?\n=cut\n+)s or confess "No insertion point = need =head1 Description line";
$pod =~ m(=head1 Description\n)s or confess "No insertion text - try adding some examples via #T";
$source =~ s/\n+=head1 Description\n.*?\n+=cut\n+/\n\n$pod/gs;
}
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 ...
{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 B<$perlModule> and display 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 zzz.html && ".
" (sleep 3 && rm zzz.html pod2htmd.tmp) &");
}
sub extractPodDocumentation($) # Extract pod from a file.
{my ($perl) = @_; # Perl source file
my $p = readFile($perl);
my $c = countOccurencesInString $p, "\n=cut\n";
my $n = countOccurencesInString $p, "\n=pod\n";
confess "$n =pod but $c =cut" unless $n == $c; # Check we have balanced start and end of pod sections
$p =~ s(\n=cut\n.*?\n=pod\n) (\n)gs;
$p =~ s(\A.*?\n=pod\n) ()gs;
$p =~ s(\n=cut\n.*?\Z) ()gs;
$p
}
sub extractPythonDocumentationFromFiles(@) #P Extract python documentation from the specified files.
{my (@sources) = @_; # Python source files
my $docRe = qr(['"]{3}); # Doc string marker
my sub formatDocString($) # Format a doc string
{my ($s) = @_; # String
return $s;
return '' unless $s;
$s =~ s(input\s*:) (<p><b>Input</b>:)gsi;
$s =~ s(output\s*:) (<p><b>Output</b>:)gsi;
$s =~ s(return\s*:) (<p><b>Return</b>:)gsi;
$s =~ s(Parameters\s*\-+) (<p><b>Parameters</b>:)gsi;
$s =~ s(Returns\s*\-+) (<p><b>Returns</b>:)gsi;
$s =~ s(\.?\s*\Z) (.)s;
$s
};
my %parameters; # Parameters for each def
my %comments; # Comments for each def
my %tests; # Tests for each def
my %testsCommon; # Common line for tests
my %classDefinitions; # Class definitions
my %classFiles; # Class files
my %errors; # Errors by source file
for my $source(@sources) # Each source file
{my @text = readFile($source); # Read source file
my $lines = @text;
my $class = fne $source;
my sub currentLine {$lines - @text}; # Current line number
my sub getDocString # Get a doc string
{my @c;
my sub strip # Strip leading and trailing quotes
{return unless @c;
$c[0] =~ s(\A\s*$docRe) ();
( run in 1.349 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )