You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
120 lines
3.6 KiB
120 lines
3.6 KiB
#!/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 $
|
|
|