Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

harangzsolt33's scratchpad

by harangzsolt33 (Friar)
on Jun 25, 2016 at 18:17 UTC ( #1166560=scratchpad: print w/replies, xml ) Need Help??

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)}
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (7)
As of 2020-04-06 18:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The most amusing oxymoron is:
















    Results (40 votes). Check out past polls.

    Notices?