|
@ -0,0 +1,120 @@ |
|
|
|
|
|
#!/usr/bin/perl |
|
|
|
|
|
|
|
|
|
|
|
# |
|
|
|
|
|
# Intent: |
|
|
|
|
|
# re-usable routines ... |
|
|
|
|
|
# |
|
|
|
|
|
# Note: |
|
|
|
|
|
# This work has been done during my time at Doctor I·T |
|
|
|
|
|
# |
|
|
|
|
|
# -- Copyright drit, 2021 -- |
|
|
|
|
|
# |
|
|
|
|
|
package misc; |
|
|
|
|
|
require Exporter; |
|
|
|
|
|
@ISA = qw(Exporter); |
|
|
|
|
|
# Subs we export by default. |
|
|
|
|
|
@EXPORT = qw(); |
|
|
|
|
|
# Subs we will export if asked. |
|
|
|
|
|
#@EXPORT_OK = qw(nickname); |
|
|
|
|
|
@EXPORT_OK = grep { $_ !~ m/^_/ && defined &$_; } keys %{__PACKAGE__ . '::'}; |
|
|
|
|
|
|
|
|
|
|
|
use strict; |
|
|
|
|
|
|
|
|
|
|
|
# The "use vars" and "$VERSION" statements seem to be required. |
|
|
|
|
|
use vars qw/$dbug $VERSION/; |
|
|
|
|
|
# ---------------------------------------------------- |
|
|
|
|
|
our $VERSION = sprintf "%d.%02d", q$Revision: 0.0 $ =~ /: (\d+)\.(\d+)/; |
|
|
|
|
|
my ($State) = q$State: Exp $ =~ /: (\w+)/; our $dbug = ($State eq 'dbug')?1:0; |
|
|
|
|
|
# ---------------------------------------------------- |
|
|
|
|
|
$VERSION = &version(__FILE__) unless ($VERSION ne '0.00'); |
|
|
|
|
|
|
|
|
|
|
|
# ----------------------------------------------------------------------- |
|
|
|
|
|
sub khash { # keyed hash |
|
|
|
|
|
use Crypt::Digest qw(); |
|
|
|
|
|
my $alg = shift; |
|
|
|
|
|
my $data = join'',@_; |
|
|
|
|
|
my $msg = Crypt::Digest->new($alg) or die $!; |
|
|
|
|
|
$msg->add($data); |
|
|
|
|
|
my $hash = $msg->digest(); |
|
|
|
|
|
return $hash; |
|
|
|
|
|
} |
|
|
|
|
|
# ----------------------------------------------------------------------- |
|
|
|
|
|
sub version { |
|
|
|
|
|
#y ($atime,$mtime,$ctime) = (lstat($_[0]))[8,9,10]; |
|
|
|
|
|
my @times = sort { $a <=> $b } (lstat($_[0]))[9,10]; # ctime,mtime |
|
|
|
|
|
my $vtime = $times[-1]; # biggest time... |
|
|
|
|
|
my $version = &rev($vtime); |
|
|
|
|
|
|
|
|
|
|
|
if (wantarray) { |
|
|
|
|
|
my $shk = &get_shake(160,$_[0]); |
|
|
|
|
|
print "$_[0] : shk:$shk\n" if $dbug; |
|
|
|
|
|
my $pn = unpack('n',substr($shk,-4)); # 16-bit |
|
|
|
|
|
my $build = &word($pn); |
|
|
|
|
|
return ($version, $build); |
|
|
|
|
|
} else { |
|
|
|
|
|
return sprintf '%g',$version; |
|
|
|
|
|
} |
|
|
|
|
|
} |
|
|
|
|
|
# ----------------------------------------------------------------------- |
|
|
|
|
|
sub rev { |
|
|
|
|
|
my ($sec,$min,$hour,$mday,$mon,$yy,$wday,$yday) = (localtime($_[0]))[0..7]; |
|
|
|
|
|
my $rweek=($yday+&fdow($_[0]))/7; |
|
|
|
|
|
my $rev_id = int($rweek) * 4; |
|
|
|
|
|
my $low_id = int(($wday+($hour/24)+$min/(24*60))*4/7); |
|
|
|
|
|
my $revision = ($rev_id + $low_id) / 100; |
|
|
|
|
|
return (wantarray) ? ($rev_id,$low_id) : $revision; |
|
|
|
|
|
} |
|
|
|
|
|
# ----------------------------------------------------------------------- |
|
|
|
|
|
sub fdow { |
|
|
|
|
|
my $tic = shift; |
|
|
|
|
|
use Time::Local qw(timelocal); |
|
|
|
|
|
## 0 1 2 3 4 5 6 7 |
|
|
|
|
|
#y ($sec,$min,$hour,$day,$mon,$year,$wday,$yday) |
|
|
|
|
|
my $year = (localtime($tic))[5]; my $yr4 = 1900 + $year ; |
|
|
|
|
|
my $first = timelocal(0,0,0,1,0,$yr4); |
|
|
|
|
|
our $fdow = (localtime($first))[6]; |
|
|
|
|
|
#printf "1st: %s -> fdow: %s\n",&hdate($first),$fdow; |
|
|
|
|
|
return $fdow; |
|
|
|
|
|
} |
|
|
|
|
|
# ----------------------------------------------------------------------- |
|
|
|
|
|
sub get_shake { # use shake 256 because of ipfs' minimal length of 20Bytes |
|
|
|
|
|
use Crypt::Digest::SHAKE; |
|
|
|
|
|
my $len = shift; |
|
|
|
|
|
local *F; open F,$_[0] or do { warn qq{"$_[0]": $!}; return undef }; |
|
|
|
|
|
#binmode F unless $_[0] =~ m/\.txt/; |
|
|
|
|
|
my $msg = Crypt::Digest::SHAKE->new(256); |
|
|
|
|
|
$msg->addfile(*F); |
|
|
|
|
|
my $digest = $msg->done(($len+7)/8); |
|
|
|
|
|
return $digest; |
|
|
|
|
|
} |
|
|
|
|
|
# ----------------------------------------------------------------------- |
|
|
|
|
|
sub word { # 20^4 * 6^3 words (25bit worth of data ...) |
|
|
|
|
|
use integer; |
|
|
|
|
|
my $n = $_[0]; |
|
|
|
|
|
my $vo = [qw ( a e i o u y )]; # 6 |
|
|
|
|
|
my $cs = [qw ( b c d f g h j k l m n p q r s t v w x z )]; # 20 |
|
|
|
|
|
my $str = ''; |
|
|
|
|
|
if (1 && $n < 26) { |
|
|
|
|
|
$str = chr(ord('a') +$n%26); |
|
|
|
|
|
} else { |
|
|
|
|
|
$n -= 6; |
|
|
|
|
|
while ($n >= 20) { |
|
|
|
|
|
my $c = $n % 20; |
|
|
|
|
|
$n /= 20; |
|
|
|
|
|
$str .= $cs->[$c]; |
|
|
|
|
|
#print "cs: $n -> $c -> $str\n"; |
|
|
|
|
|
$c = $n % 6; |
|
|
|
|
|
$n /= 6; |
|
|
|
|
|
$str .= $vo->[$c]; |
|
|
|
|
|
#print "vo: $n -> $c -> $str\n"; |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
if ($n > 0) { |
|
|
|
|
|
$str .= $cs->[$n]; |
|
|
|
|
|
} |
|
|
|
|
|
return $str; |
|
|
|
|
|
} |
|
|
|
|
|
} |
|
|
|
|
|
# ----------------------------------------------------------------------- |
|
|
|
|
|
1; # $Source: /my/perl/modules/misc.pm $ |
|
|
|
|
|
|