Here are some of my subs that I have written and may use quite often:
NOSPACE()
Trim()
CollapseWhitespace()
SwapNum()
escape()
unescape()
Ceil()
Floor()
ENV()
SpitBMP()
RandomString()
JoinPath()
GetPath()
FMOD()
Checksum()
Hex2Bin()
HEX()
CRC()
##################################################
# v2019.08.25
# Removes all whitespace from a string and returns
# a new string. (Whitespace is here defined as a byte
# whose ASCII value is 32 or less. That includes tab,
# space, new line characters, esc, bel, null, etc.
# Usage: STRING = NOSPACE(STRING)
#
sub NOSPACE
{
my $X = defined $_[0] ? $_[0] : '';
!length($X) || $X =~ tr| \t\r\n\0\1\2\3\4\5\6\7\x08\x0B\x0C\x0E\x0F\
+x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F||d;
return $X;
}
##################################################
# v2019.8.25
# Removes whitespace from before and after STRING.
# Whitespace is here defined as any byte whose
# ASCII value is less than 33. That includes
# tabs, esc, null, vertical tab, new lines, etc.
# Usage: STRING = Trim(STRING)
#
sub Trim
{
defined $_[0] or return '';
(my $L = length($_[0])) or return '';
my $P = 0;
while ($P <= $L && vec($_[0], $P++, 8) < 33) {}
for ($P--; $P <= $L && vec($_[0], $L--, 8) < 33;) {}
substr($_[0], $P, $L - $P + 2)
}
##################################################
# v2019.08.25
# Converts all adjacent whitespace characters to a single space.
# Usage: STRING = CollapseWhitespace(STRING)
#
sub CollapseWhitespace
{
my $X = defined $_[0] ? $_[0] : '';
my ($U, $N, $P, $i, $c) = (1, 0, 0, 0);
while ($i < length($X))
{
$c = vec($X, $i++, 8);
if ($c < 33)
{
if ($N++)
{
$U = 0;
}
else
{
vec($X, $P++, 8) = 32;
}
}
else
{
$U or vec($X, $P, 8) = $c;
$N = 0;
$P++;
}
}
return $U ? $X : substr($X, 0, $P)
}
##################################################
# v2019.8.29
# Takes number V and returns the same number
# unless it equals either A or B in which case
# it swaps the output:
# If V == A, then returns B.
# If V == B, then returns A.
#
# Usage: NUMBER = SwapNum(V, A, B)
#
sub SwapNum
{
@_ == 3 or return 0;
my ($V, $A, $B) = @_;
return $V == $A ? $B : ($V == $B ? $A : $V);
}
# v2019.09.05 STRING = escape(STRING)
# Converts a binary string to URL-safe string.
sub escape {my$X=defined$_[0]?$_[0]:'';my$Z='';for(my$i=0;$i<length($X
+);){my$C=vec($X,$i++,8);$Z.=$C==32?'+':$C==96?'%60':$C>44&&$C<58||$C>
+94&&$C<123||$C>63&&$C<91||$C==42?chr($C):'%'.sprintf('%.02X',$C);}$Z}
# v2019.09.08 STRING = unescape(STRING)
# Converts an URL string to regular binary string. It's the opposite o
+f the escape() function. This function silently ignores errors.
sub unescape {my$X=defined$_[0]?$_[0]:'';$X=~tr|+| |;my$i=index($X,'%'
+)>=0||return$X;my($H,$j,$C,$D)=('0123456789ABCDEF',$i);while($i<lengt
+h($X)){$C=vec($X,$i++,8);if($C==37){$C=substr($X,$i++,1);length($C)||
+last;$C=index($H,uc($C));if($C<0){$i--;next;}$D=substr($X,$i++,1);if(
+length($D)){$D=index($H,uc($D));if($D<0){$i--;}else{$C<<=4;$C+=$D;}}}
+vec($X,$j++,8)=$C;}substr($X,0,$j)}
sub CEIL { int($_[0]) + ($_[0] - int($_[0]) > 0) }
sub FMOD { $_[0] - int($_[0] / $_[1]) * $_[1] }
sub BEEP { print chr(7); }
sub say { print "@_\n"; }
sub min { return ($_[0] > $_[1]) ? $_[1] : $_[0]; }
sub max { return ($_[0] > $_[1]) ? $_[0] : $_[1]; }
sub round { int(($_[0] < 0) ? ($_[0] - 0.5) : ($_[0] + 0.5)); }
sub Str2Hex { unpack('H*', $_[0] ? $_[0] : ''); }
sub Str2Bin { unpack('B*', $_[0] ? $_[0] : ''); }
sub Hex2Str { pack('H*', $_[0] ? $_[0] : ''); }
sub ClearAB { $a = $b = ''; }
# v2019.09.08 INTEGER = Floor(NUMBER)
# Returns the largest integer less than or equal to a number.
sub FLOOR {my$N=defined$_[0]?$_[0]:0;my$I=int($N);$N>0?$I:$N-$I==0?$I:
+$I-1;}
# v2019.6.15 VALUE = ENV(NAME, [DEFAULT, [OVERRIDE]])
# Returns the named environment variable. Returns "" or DEFAULT if the
+ environment variable doesn't exist. If a third argument is provided,
+ this function will return the value of the third argument ALWAYS wit
+hout even checking the environment variable.
sub ENV {my$N=defined$_[0]?shift:'';my$D=@_?shift:'';return @_?shift:l
+ength($N)&&exists($ENV{$N})?Trim($ENV{$N}):$D;}
##################################################
# v2019.6.15
# Sends a simple B/W bitmap image to stdout.
# Usage: SpitBMP(WIDTH, HEIGHT)
#
sub SpitBMP
{
$| = 1;
my $W = defined $_[0] ? $_[0] : 1;
my $H = defined $_[1] ? $_[1] : 1;
my $HEADERLEN = 62;
my $BITS_PER_PIXEL = 1;
my $DATASIZE = CEIL(($W * $H) >> 3);
my $FILESIZE = $DATASIZE + $HEADERLEN;
my $HEADER = 'BM' . pack('VxxxxVVVV', $FILESIZE, $HEADERLEN, 40, $W,
+ $H) . chr(1) . pack('xCxxxxxV', $BITS_PER_PIXEL, $DATASIZE) . "\0" x
+ 20 . "\xFF\xFF\xFF\0";
my $OUTPUT = $HEADER . "\0" x $DATASIZE;
print "Content-Type: image/bmp\n",
'Content-Length: ', length($OUTPUT), "\n\n", $OUTPUT;
}
##################################################
# v2019.9.8
# Creates a random string of letters and numbers.
# Usage: STRING = RandomString(LENGTH)
#
sub RandomString
{
my $i = defined $_[0] ? $_[0] : 0;
my $A = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvw
+xyz';
my $S = '';
while ($i--)
{
vec($S, $i, 8) = vec($A, int(rand(length($A))), 8);
}
return $S;
}
##################################################
# v2019.7.13 STRING = JoinPath(STRING, [STRING], [STRING]])
# This function joins two names into a single path by
# adding / in between the names. It also simplifies the
# resulting path by removing repeated \\ // characters,
# and tries to resolve the "." and ".." in a path name
# to literal names only.
#
sub JoinPath
{
@_ or return '';
my @A;
my $P;
foreach (@_) # Collapse array
{
defined $_ or next;
length($_) or next;
$P = $_; # Change "/" to "\" on DOS/Win
$LINUX or $P =~ tr#/#\\#;
push(@A, $P);
}
@A or return '';
$P = shift(@A); # Extract first element
$P = Trim($P);
my $L = length($P);
$L or return '';
# Remove prefix
if (uc(substr($P, 0, 8)) eq 'FILE:///')
{ $P = substr($P, 8, length($P)); }
# Detect drive letter / start point on DOS/Win
my $DRIVE = '';
my $BACKSLASH = '';
my $SEPARATOR = '/';
if ($MSWIN)
{
if (vec($P, 1, 8) == 58)
{
$DRIVE = substr($P, 0, 2);
$P = substr($P, 2, $L);
}
if (vec($P, 0, 8) == 92)
{
$BACKSLASH = '\\';
$P = substr($P, 1, $L);
}
$SEPARATOR = '\\';
}
unshift(@A, $P); # Put it back
# Split along each separator
@A = split("\\$SEPARATOR", join($SEPARATOR, @A));
# Process each section of path
my $TRIM = $LINUX ? '/' : '/\\';
for (my $i = 0; $i < @A; $i++)
{
# Remove leading and trailing slashes
$A[$i] = TrimChar($A[$i], $TRIM);
# Remove "." or zero-length string
if ($A[$i] eq '.' || length($A[$i]) == 0)
{ splice(@A, $i--, 1); next; }
# Resolve ".."
if ($A[$i] eq '..')
{
if ($i > 0)
{ splice(@A, --$i, 2); $i--; }
else
{ splice(@A, $i, 1); $i--; }
}
}
return $DRIVE . $BACKSLASH . join($SEPARATOR, @A);
}
# v2019.9.15 PATH = GetPath(FULL_FILE_NAME)
# This function returns the path portion of a full file name without t
+he trailing / or \ character.
sub GetPath {JoinPath($_[0],'..')}
# v2019.9.15 STRING = Checksum(STRING)
# This function calculates an 8-digit hex number (checksum) for a stri
+ng. "RAT" and "TAR" will have two identical checksum values, however
+"YYY" and "YZX" will produce two different values.
sub Checksum {my$S=defined$_[0]?$_[0]:'';my$L=length($S);my$x;my$A=$L;
+my$B=$L*$L;my$C=$B*$B;while($L--){$x=vec($S,$L,8);$A+=$x;$B+=$C^$x;$C
++=$x*$x;$A&=255;$B&=65535;$C&=65535;}HEX(~$A,2).HEX($B,3).HEX($C,3)}
# v2019.9.15 STRING = Hex2Bin(STRING)
# Converts a hex string to a string of ones and zeros. No Limit!
sub Hex2Bin {my$X=defined$_[0]?$_[0]:'';my($B,$j,$i,$c)=('',0,0);while
+($i<length($X)){$c=vec($X,$i++,8);next if($c<48||$c>102);$c|=32;$c-=$
+c>96?87:48;vec($B,$j++,32)=vec('0000000100100011010001010110011110001
+001101010111100110111101111',$c,32);}$B}
# v2019.9.15 STRING = HEX(A, N)
# This function converts integer A to hex format and returns a string
+that is exactly N bytes long.
sub HEX {my$A=defined$_[0]?$_[0]|0:0;my$N=defined$_[1]?$_[1]|0:8;my$X=
+sprintf('%X',$A);my$L=length($X);$L<$N?'0'x($N-$L).$X:$L==$N?$X:subst
+r($X,$L-$N,$L)}
# v2019.9.15 STRING = CRC(STRING)
# This function returns a unique 8-digit hex number (hash) for a strin
+g. "ABC" and "CAB" will have two different CRC values.
sub CRC {my$S=defined$_[0]?$_[0]:'';my$L=length($S);my$X=$L;my$M=0;whi
+le($L--){$X=FMOD((vec($S,$L,8)+$X+23.0912)*2145,1222);$M+=$X;$M&=6553
+5;}HEX($X*8765,4).HEX($M,4)}
|
