Data-Table-Text
view release on metacpan or search on metacpan
lib/Data/Table/Text.pm view on Meta::CPAN
$r
} # zzz
sub execPerlOnRemote($;$) #I Execute some Perl B<$code> on the server whose ip address is specified by B<$ip> or returned by L<awsIp>.
{my ($code, $ip) = @_; # Code to execute, optional ip address
my $file = writeFile(fpe(&temporaryFolder, qw(code pl)), $code); # Create code file
copyFileToRemote($file); # Copy code to server
say STDERR xxxr(qq(perl $file 2>&1)); # Execute code on server and return its output
}
sub parseCommandLineArguments(&$;$) # Call the specified B<$sub> after classifying the specified array of [arguments] in B<$args> into positional and keyword parameters. Keywords are always preceded by one ...
{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 %keywords;
my @positionals;
lib/Data/Table/Text.pm view on Meta::CPAN
}
$keywords{lc($1)} = $3; # Save valid keyword parameter
}
else # Positional parameter
{push @positionals, $arg;
}
}
$sub->([@positionals], {%keywords})
} # parseCommandLineArguments
sub call(&;@) # Call the specified B<$sub> in a separate child process, wait for it to complete, then copy back the named B<@our> variables from the child process to the calling parent...
{my ($sub, @our) = @_; # Sub to call, names of our variable names with preceding sigils to copy back
my ($package) = caller; # Caller's package
my $folder = &temporaryFolder; # Folder for returned data files
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
lib/Data/Table/Text.pm view on Meta::CPAN
sub guidFromString($) # Create a guid representation of the L<md5> of the content of a string.
{my ($string) = @_; # String
guidFromMd5 &stringMd5Sum($string);
}
sub fileModTime($) # Get the modified time of a B<$file> as seconds since the epoch.
{my ($file) = @_; # File name
(stat($file))[9] // 0
}
sub fileOutOfDate(&$@) # Calls the specified sub B<$make> for each source file that is missing and then again against the B<$target> file if any of the B<@source> files were missing or the $tar...
{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;
lib/Data/Table/Text.pm view on Meta::CPAN
}
if ($a > $ab)
{return "First array has an additional line at index: $ab\n$a[$ab]\n";
}
if ($b > $ab)
{return "Second array has an additional line at index: $ab\n$b[$ab]\n";
}
undef
}
sub forEachKeyAndValue(&%) # Iterate over a hash for each key and value.
{my ($body, %hash) = @_; # Body to be executed, hash to be iterated
&$body($_, $hash{$_}) for sort keys %hash;
}
sub validateHash($@) # Confess if the specified hash does not have all of the specified keys.
{my ($hash, @keys) = @_; # Hash, list of keys that the hash must contain
my @m;
for my $k(sort @keys) # Check each key
{push @m, $k unless exists $$hash{$k};
}
lib/Data/Table/Text.pm view on Meta::CPAN
END
$inst # Install script
}
#D2 www # Web processing
sub wwwHeader {say STDOUT qq(Content-Type: text/html;charset=UTF-8\n\n)} # Html header.
sub wwwGitHubAuth(&$$$$) # Logon as a L<GitHub> L<OAuth> app per: L<https://github.com/settings/developers>. If no L<OAuth> code is supplied then a web page is printed that allows the user to req...
{my ($saveUserDetails, $clientId, $clientSecret, $code, $state) = @_; # Process user token once obtained from GitHub, Client id, client secret, authorization code, random string
if (!$code) # Show logon page if no code has been supplied
{my $r = rand =~ s(\A0.) ()r;
say STDOUT <<HTML; # Logon page
<html>
<meta charset="utf-8"/>
<body>
<p>Logon with <a href="https://github.com/login/oauth/authorize?client_id=$clientId&state=$r&scope=repo">GitHub</a></p>
<script>
lib/Data/Table/Text.pm view on Meta::CPAN
next unless -e $s;
my $t = fpd $dir, $x;
copyFolder($s, $t);
clearFolder($s, undef);
}
@r # Results of each upload
}
#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|/waitFor...
{my ($sub, $pids, $maximum) = @_; # Sub to start, hash in which to record the process ids, maximum number of processes to run at a time
warn "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
lib/Data/Table/Text.pm view on Meta::CPAN
my @r; # Rectangular array
for my $i(keys @array) # Load rectangular array from linear array
{my $r = $i % $second;
my $j = ($i - $r) / $second;
$r[$j][$r] = $array[$i];
}
@r # Resulting rectangular array
}
sub callSubInParallel(&) # Call a sub reference in parallel to avoid memory fragmentation and return its results.
{my ($sub) = @_; # Sub reference
my $file = temporaryFile; # Temporary file to receive results
if (my $pid = fork) # Parent: wait for child Xref to finish
{waitpid $pid, 0; # Wait for results
my $x = retrieveFile($file); # Retrieve results
unlink $file; # Remove results file
return @$x if wantarray; # Return results as an array
$$x[0]; # Return results
}
else # Child: call in a separate process to avoid memory fragmentation in parent
{storeFile($file, [&$sub]); # Execute child and return results
exit;
}
}
sub callSubInOverlappedParallel(&&) # Call the B<$child> sub reference in parallel in a separate child process and ignore its results while calling the B<$parent> sub reference in the parent process and ret...
{my ($child, $parent) = @_; # Sub reference to call in child process, sub reference to call in parent process
if (my $pid = fork) # Parent
{my $r = [&$parent]; # Parent sub
waitpid $pid, 0; # Wait for child
return @$r if wantarray; # Return results as an array
$$r[0]; # Return results
}
else # Child
{&$child; # Ignore results
( run in 2.509 seconds using v1.01-cache-2.11-cpan-49f99fa48dc )