I need to time how long a certain piece of code takes to complete. I wrote a simple PHP stopwatch function to accomplish this:

sw(); // Start the stopwatch
$x  = some_slow_code();
$ms = sw(); // Return milliseconds since start

// Stopwatch function: returns milliseconds
function sw() {
    static $start = null;

    if (!$start) {
        $start = hrtime(1);
    } else {
        $ret   = (hrtime(1) - $start) / 1000000;
        $start = null; // Reset the start time
        return $ret;
    }
}

If you have a function that will get called lots of times, and you'd like to cache the results so as not to incur a performance penalty for hitting the disk/DB again use static variables.

function get_user($id) {
  // Sanitize the input
  $id = intval($id);

  // Declaring as static prevents the variable from dying when the function exits
  static $cache;

  // If the data is already in the cache just return that
  if ($cache[$id]) { return $cache[$id]; }

  // Get the data from the DB/Disk/Slow Source
  $rs = mysql_query("SELECT * FROM UserTable WHERE ID = $id");
  $ret = mysql_fetch_assoc($rs);

  // Store the results in the cache so it will be there next time
  $cache[$id] = $ret;

  return $ret;
}

This will store the results in cache (memory), speeding up subsequent requests. This cache will last until your script ends. To store across multiple script executions you'll want to look at something like memcache.

PHP lacks a good "or" comparison operator. Neither the or operator, nor the || return a value. I wrote a function that will take two (or more) variables and return the first one that has a non-empty value.

$limit = $array_count || 15;       // true (bad!)
$limit = $array_count or 15;       // true (also bad!)
$limit = either($array_count, 15); // 15 (good!)

function either() {
    $items = func_get_args();

    // Return the first non-empty item
    foreach ($items as $x) {
        if (!empty($x)) {
            return $x;
        }
    }

    return null;
}

I needed a function to take a chunk of text and turn all the URLs inside of it to hyperlinks. Here is the solution I came up with:

function linkify($str) {
    $new_str = preg_replace("@[http|https|ftp]+://[^<>[:space:]]+[[:alnum:]/]@","<a href=\"\\0\">\\0</a>", $str);
    return $new_str;
}

This function will tell you if an IP address is a valid IPV6 address.

function is_ipv6($ip) {
    // If it contains anything other than hex characters, periods, colons or a / it's not IPV6
    if (!preg_match("/^([0-9a-f\.\/:]+)$/",strtolower($ip))) { return false; }

    // An IPV6 address needs at minimum two colons in it
    if (substr_count($ip,":") < 2) { return false; }

    // If any of the "octets" are longer than 4 characters it's not valid
    $part = preg_split("/[:\/]/",$ip);
    foreach ($part as $i) { if (strlen($i) > 4) { return false; } }

    return true;
}

I needed to calculate days since the epoch. I wrote up a quick bash function to do the math for me.

function epoch_days() { 
    time=$(date --utc +%s);
    day=86400;
    days=$(( $time / $day ));

    echo $days;
}

Javascript is by it's nature asynchronous, which makes returning data from an AJAX call complicated. Modern Javascript uses the concept of a "promise" to allow you to run code after an asynchronous call competes. This is similar to using a callback function, but it reads cleaner. JQuery implements this type of call with the then() function. A simple example is as follows:

function getData() {
    return $.ajax({
        url: '/api/data'
    });
}

// Usage
getData().then(function(data) {
    console.log(data);
});

Given an IP address I need to determine if it is part of a subnet for whitelist/blacklist purposes.

$allowed = ip_in_subnet('65.182.224.40','65.182.224.0/24');

// Borrowed from http://php.net/manual/en/function.ip2long.php#82397
function ip_in_subnet($ip, $cidr) {
    list ($net, $mask) = explode ('/', $cidr);
    return (ip2long ($ip) & ~((1 << (32 - $mask)) - 1)) == ip2long($net);
}

I also ported this function to Perl:

sub ip_in_subnet {
    my ($ip, $cidr)  = @_;
    my ($net, $mask) = split('/', $cidr);

    my $ret = (ip2long ($ip) & ~((1 << (32 - $mask)) - 1)) == ip2long($net);

    return int($ret);
}

Note: You will need the ip2long function.

I just spent several hours working on an Internet Explorer issue. I seems Internet Explorer does NOT include empty elements in the results of a split. Browser brokeness with relation to the split function is well documented. If you have a string:

var txt = "a|b||c||d|e|f";

and you split on the | character you would expect eight pieces. Internet Explorer will only give you six pieces instead of eight because the 3rd and 5th elements are null strings. The problem is compounded if your string starts or ends with a | character.

Note: looks like this is fixed in IE9.

I need a simple way to hash strings into 64bit integers so I started some research. Initially I was focusing on xxHash but it's slightly complicated to implement. I ended up landing on the amazing Komihash which bills itself as: "a very fast 64-bit hash function, mainly designed for hash-table, hash-map, and bloom-filter uses".

Komihash is available as a single Komihash.h file and is extremely easy to implement into existing code.

#include <stdio.h>
#include <stdlib.h>
#include "komihash.h"

int main(int argc, char *argv[]) {
    int seed        = 0;
    const char *buf = "Hello world";

    uint64_t hash_num = komihash(buf, strlen(buf), seed);

    printf("Komihash: %s = %llu\n", buf, hash_num); // 3745467240760726046
}

As a bonus it also comes with a PRNG which is equally simple to implement:

#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include "komihash.h"

int main(int argc, char *argv[]) {
    uint64_t seed1 = time(NULL) * 0x61c8864680b583ebull; // hash64
    uint64_t seed2 = seed1      * 0x61c8864680b583ebull; // hash64

    for (int i = 0; i < 5; i++) {
        uint64_t rand64 = komirand(&seed1, &seed2);
        printf("Komirand: %llu\n", rand64);
    }
}

In fact, I liked it so much I ported it to Perl and called it Crypt::Komihash.

I need to read the RPMs of some 12v PC fans so I wrote up a quick sketch to have an ESP32 monitor and log the RPM for me. You need to use an external interrupt that triggers every time the fan rotates (it triggers 2x per full rotation). I was having crashes before I added the ICACHE_RAM_ATTR parameter to the function. ICACHE_RAM_ATTR tell Arduino to store this function in RAM instead of on the flash. The logic here is that your interrupt function will probably be getting called a lot so it needs to be fast.

Connect the yellow RPM wire from your fan to pin 4, and the ground wire from the fan to the ground of the Arduino. Without the ground wire connected you will now have a shared ground between the Arduino and the fan and the interrupt will not fire.

const uint8_t tachoPin    = 4;
volatile uint32_t counter = 0;

ICACHE_RAM_ATTR void countPulses() {
    counter++;
}

void setup() {
    pinMode(tachoPin, INPUT_PULLUP);
    attachInterrupt(digitalPinToInterrupt(tachoPin), countPulses, FALLING);
    Serial.begin(115200);
}

void loop() {
    delay(1000);
    Serial.printf("%u fan revolutions in the last second\n", counter / 2);

    counter = 0;
}

Note: This code will work on an Arduino Uno without the ICACHE_RAM_ATTR which can be confusing.

Note: Using the internal pull-up resistor on the ESP32 means you can connect the yellow fan wire directly to the MCU. On an Arduino Uno an external pull-up resistor is required.

I have a multi-dimensional array that I need to extract data from. Given a string in the format of "person.first" I want to descend in to the array looking for person -> first. I wrote this array_dive() function to facilitate this lookup.

function array_dive(string $needle, array $haystack) {
    // Split at the periods
    $parts = explode(".", $needle);

    // Loop through each level of the hash looking for elem
    $arr = $haystack;
    foreach ($parts as $elem) {
        //print "Diving for $elem<br />";
        $arr = $arr[$elem] ?? null;

        // If we don't find anything stop looking
        if ($arr === null) {
            break;
        }
    }

    // If we find a scalar it's the end of the line, anything else is just
    // another branch, so it doesn't cound as finding something
    if (is_scalar($arr)) {
        $ret = $arr;
    } else {
        $ret = null;
    }

    return $ret;
}

Here is a sample script that shows the function in action.

Getting a random element from a PHP array is a multi-step process and I often forget the syntax. Here is a simple function that will return a random element from the provided array.

function random_elem(array $arr) {
    $key = array_rand($arr);
    $ret = $arr[$key];

    return $ret;
}

I can never remember the correct MIME type for JSON so I wrote this wrapper function to simplify sending JSON to a browser.

// Convert a PHP data structure to JSON and send it to the browser
function json_output($obj) {
    $output = json_encode($obj, JSON_INVALID_UTF8_SUBSTITUTE);

    // http://tools.ietf.org/html/rfc4627
    header('Content-type: application/json');
    print $output;
    exit;
}

I need to run a shell command in PHP and capture STDOUT and STDERR separately. This function lets you run a command and returns a hash with the various components and outputs.

function run_cmd($cmd) {
    $start   = hrtime(true);
    $cmd     = escapeshellcmd($cmd);
    $process = proc_open($cmd, [
        1 => ['pipe', 'w'], // STDOUT
        2 => ['pipe', 'w'], // STDERR
    ], $pipes);

    if (!is_resource($process)) { return []; }

    $stdout = stream_get_contents($pipes[1]);
    fclose($pipes[1]);
    $stderr = stream_get_contents($pipes[2]);
    fclose($pipes[2]);
    $exit   = proc_close($process);

    $ret = [
        'exit_code' => $exit,
        'stdout'    => trim($stdout),
        'stderr'    => trim($stderr),
        'cmd'       => $cmd,
        'exec_ms'   => (hrtime(true) - $start) / 1000000,
    ];

    return $ret;
}

I'm working with a 32bit PRNG and I'd like to get a 64bit integer out of it. You can take two random 32bit integers and combine them into a 64bit one this way:

uint64_t high = rand32();
uint64_t low  = rand32();

uint64_t num64 = (high << 32) | low;

Someone on Reddit suggested using this cool hash to perform a similar task to "upgrade" a 32bit number into a 64bit one by hashing it:

// Borrowed from: https://elixir.bootlin.com/linux/v6.11.5/source/include/linux/hash.h
static inline uint64_t hash64(uint64_t val, unsigned bits) {
        return (val * 0x61c8864680b583ebull) >> (64 - bits);
}

I needed this functionality in Perl so got some help from Reddit and wrote it up:

sub hash64 {
    my ($val, $bits)   = @_;
    my $magic_constant = 7046029254386353131;

    use integer; # This forces integer math and overflow
    my $result = ($val * $magic_constant) >> (64 - $bits);

    # Convert from signed int to unsigned
    if ($result < 0) {
        no integer;
        $result += 18446744073709551615; # 2**64 - 1
        $result += 1;
    }

    return $result;
}

Perl v5.25.7 added support for the @{^CAPTURE} variable which wrapped all the regexp parenthesis captures up into an array. If you need this functionality in an older version of Perl you can use this function:

my $str =  "Hello Jason Doolis";
$str    =~ /Hello (\w+) (\w+)/;

my @captures = get_captures(); # ("Jason", "Doolis")

sub get_captures {
    no strict 'refs';

    my $last_idx = scalar(@-) - 1;
    my @arr      = 1 .. $last_idx;
    my @ret      = map { $$_; } @arr;

    return @ret;
}

I needed to find the second occurrence of a substring inside of a larger string. PHP has strpos() which gets you the first occurrence, but nothing beyond that. I wrote a wrapper function around strpos() to let you specify the number you want to find. Returns false if nothing is found.

function strpos_num(string $haystack, string $needle, int $num) {
    $offset = 0;
    $length = strlen($needle);
    $pos    = null;

    for ($i = 0; $i < $num; $i++) {
        $pos = strpos($haystack, $needle, $offset);

        // Short circuit continued lookups if we don't find anything
        if ($pos === false) { return false; }

        $offset = $pos + $length;
    }

    return $pos;
}

I have a list of IP addresses that I want sorted in a human readable fashion. A simple sort() on a list of IPs will not work because the octets may be: one, two, or three digits long which confuses sort(). Here is a simple sorting function for a list of IP addresses:

my @ips    = qw(198.15.0.20 4.2.2.1 10.11.1.1 10.100.1.1 65.182.224.40);
my @sorted = sort by_ip_address @ips;

sub by_ip_address {
    return ip2long($a) <=> ip2long($b);
}

Note: You will need my ip2long() function for this to work.

PHP has a mechanism that allows you stop the compiler on a given line. This allows you to put non-PHP code after that line without affecting your code. You can put data, JSON, HTML, etc after the __halt_compiler() line and then read it with your script. Here is a simple function that reads the text after your __halt_compiler()

// Borrowed from https://gist.github.com/ziadoz/5286233
function get_halt_str() {
    return file_get_contents(__FILE__, false, null, __COMPILER_HALT_OFFSET__ + 1);
}

See also: Perl version

I'm a big fan of .ini files because they're human readable, and also very machine readable. I wrote a quick function to convert a hashref to a simple .ini string.

my $str = hash_to_ini({ data => { 'name' => 'scott', animal => 'dog' }});

sub hash_to_ini {
    my $x   = $_[0];
    my $ret = '';

    foreach my $key (sort(keys(%$x))) {
        my $val = $x->{$key};

        if (ref($val) eq "HASH") {
            $ret .= "[$key]\n";
            foreach my $k (sort(keys(%$val))) { $ret .= "$k = " . $val->{$k} . "\n"; }
        } else { $ret .= "$key = $val\n" }
    }

    $ret =~ s/\n\[/\n\n[/; # Add a space between sections
    return $ret;
}

I also wrote a version in PHP

function hash_to_ini($x) {
    $ret = '';

    foreach (array_keys($x) as $key) {
        $val = $x[$key];

        if (is_array($val)) {
            $ret .= "[$key]\n";
            foreach (array_keys($val) as $k) { $ret .= "$k = " . $val[$k] . "\n"; }
        } else { $ret .= "$key = $val\n"; }
    }

    $ret = preg_replace("/\n\[/", "\n\n[", $ret);
    return $ret;
}

Note: see also parse_ini()

I need to extract all the unique elements from an array. There is no built-in way to do this, but there are several user functions you can use.

my @x = qw(one two one three one four);
my @y = array_unique(@x); # ("one", "two", "three", "four")

# Borrowed from: https://perlmaven.com/unique-values-in-an-array-in-perl
sub array_unique {
    my %seen;
    return grep { !$seen{$_}++ } @_;
}

I stand corrected, List::Util includes a uniq() function to do exactly this, is a core module, and is included with all Perl installations.

It's common to come across date strings in log files that you want to convert to a Unixtime. Perl has Data::Parse which offers a str2time() function to do this.

use Date::Parse;

my $ut = str2time("Thu, 13 Oct 94 10:13:13 +0700") # 782017993;

I wrote a version of strtotime() in a function that may be more portable. It has the limitation that it does not support timezone strings, but if you don't need them then it is a valid alternative.

If you want to a simple way to serve a file for download in PHP you can use this function:

function serve_file($filepath) {
    $filename = basename($filepath);

    if (headers_sent()) {
        die("Cannot output file because output already started");
    }

    $mime_type = mime_content_type($filepath);
    header("Content-type: $mime_type");
    header("Content-Disposition: attachment; filename=\"$filename\"");

    readfile($filepath);

    exit(0);
}

I have a function that takes a filehandle for an argument. This is easy for filehandles that you create with open() but gets more complex if you try to use one of the automatic filehandles. Using the * syntax you can create a pointer to the symbol table for that entry.

$fh = \*STDIN;
$fh = \*STDOUT;
$fh = \*DATA;

Once it's a standard scalar variable it can easily be passed to a function.

Perl doesn't support nested sub-routines natively, but you can fake them by using functions defined at runtime.

sub a {
    local *b = sub {
        return 123;
    };

    return b();  # Works as expected
}

b();  # Error: "Undefined subroutine &main::b called at ..."

Some times nested functions can be useful for simplifying readability of code while also allowing simple copy/paste for code re-use.

I need to rename a function anywhere it is found in my code base. This requires going through every file and directory recursively, and checking each file. Using the Linux find command we can find all the files and then hand the search and replace off to Perl. Easy peasy.

find codebase/ -type f -exec perl -pi -E 's/foo/bar/g' {} +

or using fd instead:

fd . codebase/ --type f --exec-batch -pi -E 's/foo/bar/g' {}

I use sessions on my sites for user authentication. Calling session_start() initiates a session and allows me to check if the user is logged in or not. However, calling session_start() creates a new session for every hit on your site: bots, unauthenticated users, etc. This can lead to an excess of session files on your filesystem.

A better way is to explicitly call start_session() when your user logs in. On your other pages you can check if the user has the appropriate session cookie and start a session only when it's needed.

function start_session_if_exists() {
    if (isset($_COOKIE[session_name()]) && session_status() !== PHP_SESSION_ACTIVE) {
        session_start();
    }
}

This will avoid creating a session for every hit on your site.

I needed a modern way to copy a string to the clipboard in JavaScript. Claude.ai helped me come up with this:

// With async/await
async function copyToClipboard(text) {
    try {
        await navigator.clipboard.writeText(text);
        console.log('Copied to clipboard');
    } catch (err) {
        console.error('Failed to copy: ', err);
    }
}

Then you simply call it with a string

copyToClipboard("Hello world");

The password_hash() function in PHP is excellent for storing passwords securely. In order to generate password to store in a database or config file I like to generate passwords from the CLI. This has the risk of storing the password in your bash history. This command prompts you for the password on the fly and protects your history.

php -r 'echo "Password: "; $pwd = trim(fgets(STDIN)); echo password_hash($pwd, PASSWORD_DEFAULT) . "\n";'

Pseudo-random number generators use complex math to generate random numbers on your computer. These random numbers are used for all sorts of things: simulations, fractals, games, art, and even math experiments. Computers can only do math, which makes generating a random number difficult.

PRNGs need a "seed" number to kick off the math that generates sequences of random numbers. Some PRNGs require a 32bit seed, and some require a 64bit seed. Some PRNGs require one seed, and some require four (or more). It is important to know what type of seed your PRNG needs.

A 32bit number is between 0 and 4.2 billion and a 64bit number is between 0 and 18.4 quintillion. The larger a number is, the more bits are required to store it, and the better a seed it will make. The closer your seed is to the upper end of the number range the better. As a general rule a good seed will be a decimal number with 18 or 19 digits.

12 is a small number and not a good seed, 4611686018427387906 is a big number but still not a great seed. Seeds should not have large sections of zero/one bits. This is why small numbers do not make good seeds. Bits can be visualized by printing the number in binary:

# Horrible
$ perl -E 'printf("%064b\n", 4611686018427387906)'
0100000000000000000000000000000000000000000000000000000000000010

# Bad
$ perl -E 'printf("%064b\n", 17770)'
0000000000000000000000000000000000000000000000000100010101101010

# Poor
$ perl -E 'printf("%064b\n", 2850756010)'
0000000000000000000000000000000010101001111010110001010110101010

# Good
$ perl -E 'printf("%064b\n", 11337502976607798025)'
1001110101010110111001101110001101111000101001000100001100001001

Good seeds should have a roughly even mix of zero and one bits. 9223372036854775808 is a large number and looks promising but it has 63 zeros, and only a single one bit. You can visualize the quality of your seed with seed_quality.pl. Quality above 75% should make for good seed numbers.

Seeds should not be predictable. Do not use dates, times, or phone numbers as they are potentially guessable. Combinations of numbers can be good sources. Process PID, UID, unixtime are good potential sources if they are combined together in a non-predictable way. PID multiplied by UID multiplied by Unixtime is an example of combining values. Memory locations of variables, especially if ASLR is in use is a potentially good source as well.

Hashing numbers, strings, or combinations of numbers can be a good way to generate seeds. Hashing a value with Komihash or xxHash will generate a suitable 64bit number. Hashing a value with SHA256 will generate a 256bit value which can be split into four 64bit values. Hashing functions also do a good job of ensuring the bits are mixed well and do not include large repeating sections.

The best source of seed numbers is directly from your OS. On Linux this is /dev/urandom and on Windows you can interface with the RtlGenRandom API. These are carefully curated sources of true randomness, but they can be slow-ish. Using them as a source for a fast PRNG is best practice.

sub get_64bit_seed {
    open my $urandom, '<:raw', '/dev/urandom' or croak("Couldn't open /dev/urandom: $!");
    sysread($urandom, my $buf, 8) or croak("Couldn't read from csprng: $!");

    return unpack("Q*", $buf);
}

Quick Perl function to calculate the number of bits required to store a given number.

sub bits_required {
    my ($n) = @_;

    # Handle special case for 0
    return 0 if $n == 0;

    # Use logarithm to calculate the number of bits
    my $bits = int(log($n) / log(2)) + 1;
    return $bits;
}

I needed a function to use as a simple seed for srand(). Unixtime in nanoseconds changes very frequently and serves as a semi-decent random seed.

#include <time.h> // for clock_gettime()

// Nanoseconds since Unix epoch
uint64_t nanos() {
    struct timespec ts;

    // int8_t ok = clock_gettime(CLOCK_MONOTONIC, &ts); // Uptime
    int8_t ok = clock_gettime(CLOCK_REALTIME, &ts);  // Since epoch

    if (ok != 0) {
        return 0; // Return 0 on failure (you can handle this differently)
    }

    // Calculate nanoseconds
    uint64_t ret = (uint64_t)ts.tv_sec * 1000000000ULL + (uint64_t)ts.tv_nsec;

    return ret;
}

See also: Microseconds since epoch in Perl

I need to get system uptime with a higher resolution that just one second. This is the function I came up with to return uptime in microseconds.

sub micros {
    require Time::HiRes;

    my @p   = Time::HiRes::gettimeofday();
    my $ret = ($p[0] * 1000000) + $p[1];

    return $ret;
}

If you need to see if a file is world readable you'll need to be able to break out file permissions.

my @p     = get_file_permissions("/tmp/foo.txt");
my $other = $p[2];

# 4 = readable, 2 = writeable, 1 = executable
if ($other & 4) { print "File is world readable\n"; }
if ($other & 2) { print "File is world writeable\n"; }
if ($other & 1) { print "File is world executable\n"; }

sub get_file_permissions {
    my $file = shift();

    my @x    = stat($file);
    my $mode = $x[2];

    my $user  = ($mode & 0700) >> 6;
    my $group = ($mode & 0070) >> 3;
    my $other = ($mode & 0007);

    my @ret = ($user, $group, $other);

    return @ret;
}

If you want a dedicated function it's pretty simple:

sub is_world_readable {
    my $file  = shift();
    if (!-r $file) { return undef; }

    my @x     = stat($file);
    my $perms = $x[2];

    my $ret = $perms & 0006; # Readable

    return $ret;
}

If you've written some Perl and you want to improve upon the execution speed you can use a profiler. There are several profilers available, but the best one I've found is Devel::NYTProf. Once you have the module installed you run your Perl script as normal but invoke the profiler:

perl -d:NYTProf term-colors.pl

This will result in a nytprof.out file being created in the current directory. This file contains raw stats about function calls and code timings. You can turn this data into something human readable by converting it to HTML.

nytprofhtml nytprof.out --out perl-profile/

This will create a nice HTML page with all kinds of information about how the Perl interpreter ran your script. With this information hopefully you can find places in your code that could use improvement.

If you want to add an element to the middle of an existing array you can use the splice() function. Splice modifies arrays in place. Splice takes four arguments for this: the array to modify, the index of where you want to modify, the number of items you want to remove, and an array of the elements to add.

my @x = qw(one three);

# At the 2nd index, add (replace zero elements) a one element array
splice(@x, 1, 0, ('two'));

print join(" ", @x); # "one two three"

I have a small array in Python, and I need to get the 2nd element of that array, or a default value if it's not present. All the other languages (PHP, Perl, Javascript) I use have a simple null coallescing operator that makes it simple, but not Python. I got tired of writing it out every time to so I wrote a simple wrapper function:

x = [2,4,6]

# Get the 3rd item from x
y = arrayItem(2, x, -1) # 6
# Get the 8th (non-existent) item from x
y = arrayItem(7, x, -1) # -1

# Get an item from an array, or a default value if the array isn't big enough
def arrayItem(needle, haystack, default = None):
    if needle > (len(haystack) - 1):
        return default
    else:
        return haystack[needle]

If there is a better, simpler, built-in way I'm open to hearing it.

Quicky helper function to connect to WiFi on Arduino so I don't have to re-invent the wheel every time I start a new project.

void init_wifi(const char *ssid, const char *password) {
    WiFi.mode(WIFI_STA); WiFi.begin(ssid, password);

    while (WiFi.status() != WL_CONNECTED) {
        delay(500); Serial.print(".");
    }

    Serial.printf("\r\nConnected to: \"%s\"\r\n",ssid);
    Serial.print("IP address  : "); Serial.println(WiFi.localIP());
    Serial.print("MAC address : "); Serial.println(WiFi.macAddress().c_str());
}

Perl allows you to create a reference to subroutine and store it in a variable. This allows subroutines to be passed around to other functions. In Perl speak these are called coderefs. There are two ways to create them:

my $one = sub { print "Hello world!"; }
my $two = \&hello_world;

sub hello_world {
    print "Hello world!";
}

Calling a code reference is simple:

$coderef->(); # No params
$coderef->($param1, $param2);

Perl has a unique feature where if it sees a line that contains __DATA__ the parser will stop there as if the file ended. This allows you put non-perl code after your __DATA__ line: text, json, HTML, etc. Perl will even allow you to read the text after the __DATA__ like it's a normal file handle. This function will read all the text after your __DATA__ block.

sub get_data_str {
    local $/ = undef; # Slurp mode
    return readline(DATA);
}

Note: Perl also recognizes __END__ but that text is not readable.

See also: PHP version

Often I will need to take a quick backup of a directory or file before I make some changes. Sometimes I will need multiple backups, so I include the date/time in the output filename. After doing it manually enough I wrote a quick bash function that will handle creating the backup file, and naming it appropriately. Put these in your ~/.bashrc or copy and paste to your terminal

# Quick tar/file commands
qtar() { C=$(basename $1); O=/var/tmp/quicktar-$C-$(date +%F_%H-%M).tar.gz; tar -cvpaf $O $*; echo; ls -sh $O; }
qfb()  { C=$(basename $1); O=/var/tmp/quickfile-$C-$(date +%F_%H-%M).gz; gzip $1 -c > $O; ls -sh $O; }

Then to run it simply invoke it like this:

# Multiple files or directories
qtar file1.txt file2.txt
qtar /path/to/dir
qtar files/

# One file
qfb /etc/dhcp/dhcpd.conf
qfb /etc/php.ini

This will make an appropriately named file in /var/tmp/ with the files/dirs you listed tarred and gzipped up. It's not perfect, there are some corner cases that will break it, but I needed something super simple to drop on remote servers for quicky backups.

Update: Less common, but I also whipped up a zip option.

qzip() { C=$(basename $1); O=/var/tmp/quickzip-$C-$(date +%F_%H-%M).zip; zip -9vr $O $*; ls -sh $O; }

Update: I learned that Vim has built in diff support, even inside of .gz files. This means you can do vim -d /etc/orig.txt /var/tmp/quickfile-orig.txt-2022-08-03_08-13.gz and it will show you the diff.

Perl function to return a human readable string for a time duration in seconds.

my $str = human_time_diff(320);  # "5 minutes"
my $str = human_time_diff(3700); # "1 hour"

sub human_time_diff {
    my $seconds = int(shift());
    my $num     = 0;
    my $unit    = "";
    my $ret     = "";

    if ($seconds < 120) {
        $ret = "just now";
    } elsif ($seconds < 3600) {
        $num  = int($seconds / 60);
        $unit = "minute";
    } elsif ($seconds < 86400) {
        $num  = int($seconds / 3600);
        $unit = "hour";
    } elsif ($seconds < 86400 * 30) {
        $num  = int($seconds / 86400);
        $unit = "day";
    } elsif ($seconds < (86400 * 365)) {
        $num  = int($seconds / (86400 * 30));
        $unit = "month";
    } else {
        $num  = int($seconds / (86400 * 365));
        $unit = "year";
    }

    if ($num > 1) { $unit .= "s"; }
    if ($unit) { $ret = "$num $unit"; }

    return $ret;
}

See also: PHP version

function human_time_diff(int $seconds) {
    $num  = 0;
    $unit = "";

    if ($seconds < 300) {
        $ret = "just now";
    } elseif ($seconds < 3600) {
        $num  = intval($seconds / 60);
        $unit = "minute";
    } elseif ($seconds < 86400) {
        $num  = intval($seconds / 3600);
        $unit = "hour";
    } elseif ($seconds < 86400 * 30) {
        $num  = intval($seconds / 86400);
        $unit = "day";
    } elseif ($seconds < (86400 * 365)) {
        $num  = intval($seconds / (86400 * 30));
        $unit = "month";
    } else {
        $num  = intval($seconds / (86400 * 365));
        $unit = "year";
    }

    if ($num > 1) {
        $unit .= "s";
    }

    if ($unit) {
        $ret = "$num $unit";
    }

    return $ret;
}

See also: Perl version

I need a Perl way to find the maximum string length in an array so here is a function to do that:

my @words = qw(Apple Pear Watermelon Banana Cherry);
my $max   = max_length(@words); # 10

sub max_length {
    my $max = 0;

    foreach my $item (@_) {
        my $len = length($item);
        if ($len > $max) {
            $max = $len;
        }
    }

    return $max;
}

If you want to sort an array naturally (the way a human would) you can use Perl's sort() function, but use a custom sort method:

my @input  = qw(foo foo250 foo12 foo23 bar999 bar7 bar17 bar99 18);
my @sorted = sort { natural(); } @input;

print join(", ", @sorted);

sub natural {
    # Separate the word and numeric parts
    my ($word_a, $num_a) = $a =~ /(.*?)(\d+|$)/;
    my ($word_b, $num_b) = $b =~ /(.*?)(\d+|$)/;

    #print "$a / $b: $word_a, $num_a, $word_b, $num_b\n";

    # If the words are diff it's an alpha sort on the words
    if ($word_a ne $word_b) {
        return $word_a cmp $word_b;
    # Words are the same, numeric sort the number part
    } else {
        return ($num_a || 0) <=> ($num_b || 0);
    }
}

See also: Natural Sort

I wrote a simple .ini parsing function in Perl.

my $hash_ref = parse_ini("/tmp/config.ini");

sub parse_ini {
    open (my $INI, "<", $_[0]) or return undef;

    my $ret     = {};
    my $section = "_";

    while (my $line = readline($INI)) {
        if ($line =~ /^\[(.+?)\]/) { # Section heading
            $section = $1;
        } elsif ($line =~ /^(\w.*?)\s*=\s*"?(.*?)"?\s*$/) { # Key/Value pair
            $ret->{$section}->{$1} = $2;
        }
    }

    return $ret;
}

I wrote a simple function to let you glob a directory recursively. It's limited to a single path/glob pattern, but that's good enough for now.

use File::Find;

my @files = globr("/etc/*.cfg");

sub globr {
    my ($str)       = @_;
    my ($dir,$glob) = $str =~ m/(.*\/)(.*)/;

    $dir  ||= './'; # Only a glob, so assume current dir
    $glob ||= $str; # No dir only a glob: *.pl

    # Find all the dirs in the target dir so we can recurse through them later
    my (@ret, @dirs);
    find( { wanted => sub { if (-d $_) { push(@dirs, $_) } }, no_chdir => 1 }, $dir);

    # Go through each dir we found above and glob in them for matching files
    foreach my $dir (@dirs) {
        my @g = glob("$dir/$glob");
        push(@ret, @g);
    }

    return @ret;
}

See also: Find files recursively

I needed to search recursively through a directory structure for files that matched a specific pattern. The simplest way that I found was using File::Find. I wrote a simple wrapper function to make searching simpler and more straight-forward. It uses regular expression matching so it should be quite flexible.

use File::Find;

# All the files that end in .pl
my @perl_files = find_recurse(qr/\.pl$/, "/home/user/");
# Anything with kitten in the name
my @kittens    = find_recurse(qr/kitten/, "/home/user/");
# All .mp3 and .ogg files
my @aud_files  = find_recurse(qr/\.(mp3|ogg)$/, "/home/user/");
# Search two directories
my @cfg_files  = find_recurse(qr/\.cfg$/, ("/tmp/", "/etc/"));

# Recursively search for files matching a pattern
sub find_recurse {
    my ($pattern, @dirs) = @_;
    if (!@dirs) {
        @dirs = (".");
    }

    my @ret = ();
    find(sub { if (/$pattern/) { push(@ret, $File::Find::name) } }, @dirs);

    return @ret;
}

Linux has a common date/time format used in logs that looks like May 4 01:04:16. Often I will need to parse that into a unixtime so I wrote a function to do it so I won't have to reinvent the wheel next time:

use Time::Piece;

my $epoch = linux_timestr("May  4 01:04:16");

sub linux_timestr {
    my $time_str = shift();
    # Since this string type doesn't include the year we append the current
    # year to make the calculations correct. Otherwise we get 1970
    my $year     = (localtime())[5] + 1900;
    $time_str   .= " $year";

    my $format = "%b %d %H:%M:%S %Y";
    my $x      = localtime->strptime($time_str, $format);

    return $x->epoch();
}

Other common formats are cdate and ISO 8601

# cdate
my $x = localtime->strptime("Sat May  8 21:24:31 2021", "%a %b %d %H:%M:%S %Y");
# ISO 8601
my $y = localtime->strptime("2000-02-29T12:34:56", "%Y-%m-%dT%H:%M:%S");

If you need to round a number in Perl you can use the POSIX method round(). If for some reason you don't want to use the POSIX method I wrote a pure Perl version of round() that is pretty fast.

use POSIX;

my $num = 3.14156;

print(POSIX::round($num)); # 3
print(round($num));        # 3

sub round {
    my $num = shift();
    my $ret;

    if ($num < 0) {
        $ret = int($num - 0.5);
    } else {
        $ret = int($num + 0.5);
    }

    return $ret;
}

Along with round, sometimes you want "round to the nearest X", which I also implemented:

sub nearest {
    my ($nearest, $num) = @_;

    my $div = $num / $nearest;
    my $ret = round($div) * $nearest;

    return $ret;
}

Note: Math::Round also includes both of these functions.

I have a hash that contains counts for a bunch of stats. Unfortunately you can't just increment a hash like: $hash['key']++ and have it be E_NOTICE compliant. If that key does not exist in the array and you try and increment it you will trigger an E_NOTICE alert. I wrote this quick increment implementation that will allow you to increment a non-existing key.

$hash = [];

incr($hash['key']); // Inits to 1
incr($hash['key']); // Sets to 2

// Increment a variable (E_NOTICE compatible)
function incr(&$i, $value = 1) {
    // If the value is already there add to it
    if (isset($i)) {
        $i += $value;
    // If the value isn't there, just set it initially
    } else {
        $i = $value;
    }
}

In Perl if you want to calculate time in milliseconds (thousandths of a second) you can use Time::HiRes and the time() function.

use Time::HiRes qw(time);

my $start = time();

# Stuff you want to time here

my $elapsed = time() - $start;

printf("%0.2f seconds\n", $elapsed);
printf("%0.1f milliseconds\n", $elapsed * 1000);
printf("%d microseconds\n", $elapsed * 1000 * 1000);
printf("%d nanoseconds\n", $elapsed * 1000 * 1000 * 1000);

Often I'll want to run a shell command and capture STDOUT and STDERR separately. I wrote a function to simplify this process:

my $x    = shell_cmd($cmd);
my $exit = $x->{exit};
my $err  = $x->{stderr};
my $out  = $x->{stdout};

# Run a command and return STDOUT/STDERR/Exit
sub shell_cmd {
    use IPC::Open3;
    my ($cmd) = @_;
    my ($STDIN, $STDOUT, $STDERR, $pid, $ret) = (1,2,3,undef,{});

    # If it's an arrayref run it directly (no shell)
    if (ref($cmd) eq 'ARRAY') {
        $pid = IPC::Open3::open3($STDIN, $STDOUT, $STDERR, @$cmd);
    } else {
        $pid = IPC::Open3::open3($STDIN, $STDOUT, $STDERR, $cmd);
    }
    waitpid($pid, 0);

    # Set FH slurp mode
    local $/ = undef;

    $ret->{exit}   = int($? >> 8);
    $ret->{stderr} = readline($STDERR);
    $ret->{stdout} = readline($STDOUT);
    $ret->{cmd}    = $cmd;

    return $ret;
}

Perl has a great core module for dealing with dates and times: Time::Piece.

use Time::Piece;

my $t = localtime();

my $unixtime = $t->epoch(); # Unixtime
my $human    = $t->cdate(); # Human readable

# Format a date/time for output
print $t->strftime("%Y-%M-%d") . "\n";

# Convert a specific format to a date/time object
my $bd = localtime->strptime("1985-02-14", "%Y-%M-%d");
print "You were born on a " . $bd->fullday . " in " . $bd->year . "\n";

# Date/Time addition
print "In one hour it will be: " . (localtime() + 3600)->hms . "\n";

It works by overriding the built in localtime() and gmtime() functions and giving them an object oriented interface. I highly recommend looking at it if you have to deal with dates and times.