Category: Perl

This snippet is a simple wrapper around Digest::MD5‘s md5_base64() builds unsalted MD5 digests encoded in base64, very useful for LDAP management and LDIF file processing.

#!/usr/bin/perl
++$|;

use Digest::MD5 qw(md5_base64);

if(!defined($pass=shift)) {
        print "> ";
        $pass=<STDIN>;
        chomp $pass;
}
print encrypted($pass)."\n";

sub encrypted {
        my($passwd) = @_;
        return '{md5}'.md5_base64($passwd).'==';
}

(Source code)

Use it as such:

$ bin/md5pass
> password
{md5}X03MO1qnZdYdgyfeuILPmQ==

[tags]Perl, MD5, code, code snippet[/tags]

This small script is an alternative to sleep(1) that gives a visual clue to the user about the remaining seconds in the delay

#!/usr/bin/perl
$|++;

my $secs = shift;
die("Usage: $0 <secs>\n") unless (defined $secs) && ($secs>=0);
while($secs>0) {
        printf("\r% 4d", $secs);
        sleep 1;
        --$secs;
}
print "Done          \n";

(Download)
There are numerous instances where you might want your shell scripts to sleep(1) giving the user a clue about what’s going on, but just to relate to a previous example, let’s see how this can be used to throttle file leeching:

$ for i in `count 1 10 %02d`; do wget http://..../file-$i.pdf; countdown 30; done

count is a minimalist perl script in the spirit of seq(1) but with a simpler syntax. It only counts in increments of 1, but -on the other hand- it knows how to count down.

#!/usr/bin/perl
use strict;
my($from,$to,$fmt,$inc)=@ARGV;
$to||=$from;
$fmt||="%d";
print join("\n",map{sprintf("$fmt",$_)}($from>$to?reverse($to..$from):($from..$to))),"\n";

(Download)
For instance, “count 10 1 %03d” will count down from 10 to 0 padding with zeroes to three digits. “count 0 15 %x” will count in hex. If you omit the format string it will default to “%d” (decimal, no padding).
count is very useful -among other things- for file leeching:

$ for i in `count 1 10 %02d`; do wget http://..../file-$i.pdf; done

Base64 is used to encode binary data in printable ASCII form. de64 is a trivial perl script to decode such strings:

#!/usr/bin/perl
use MIME::Base64;
local $/ = undef;
print decode_base64(shift||<STDIN>);

(Download)
One application of de64 is decoding UTF8 LDAP attributes inside LDIF files. For instance, “cn:: Um9iZXJ0byBNYXJ0w61uZXo=” may be decoded with

$ de64 Um9iZXJ0byBNYXJ0w61uZXo=
Roberto Martí­nez

(Look Randal! I’m using a CPAN module this time! ;-) ) Of course, all the heavy lifting is done by MIME::Base64 from CPAN.

Are you wondering where the heck does some arcane module come from? Wonder no more, perlwhich comes to the rescue:

#!/usr/bin/perl
use strict;
use File::Spec;

my $module = shift @ARGV;
$module=~s,\.,,igs;
my $pm=$module.'.pm';
my @path = split(/::/,$pm);
my $found = 0;
foreach my $dir (@INC) {
        my $file = File::Spec->catfile($dir,@path);
        if(-f $file) {
                print $file,"\n";
                $found=1;
        }
}
exit(!$found);

(Download)
Next time you need to know some module’s path just run it like this:

$ perlwhich Data::Dumper
/usr/lib/perl/5.8/Data/Dumper.pm

If a module resides in multiple locations under @INC, perlwhich will let you know as well:

$ perlwhich Salesforce
/usr/local/lib/site_perl/Salesforce.pm
/usr/local/share/perl/5.8.4/Salesforce.pm

Here’s an implementation of the Luhn algorithm in perl.

#!/usr/bin/perl
use strict;
my $number = shift(@ARGV) || die("Usage: $0 <number>\n");
$number=~s,[^0-9],,g;
my($sum,$odd);
foreach my $n (split(//,$number)) {
        $odd=!$odd;
        if($odd) {
                $sum+=$n;
        } else {
                my $x=2*$n;
                $sum+=$x>9?$x-9:$x;
        }
}
my $ok = 0+(($sum%10)==0);
exit(($sum%10)!=0);

(Download)

This program was designed for shell scripting, using something like

$ if ./luhn 457623486; then echo "ok"; else echo "error"; fi
ok

but it should be trivial to modify it for other purposes.
I’m using this algorithm to validate GSM IMEI numbers, but the Luhn algorithm is also behind credit card numbers.

A small filter to phonetize STDIN into the NATO phonetic alphabet. It’s very useful to spell passwords over the phone.

#!/usr/bin/perl
use strict;
my %ALPHA = map {uc(substr($_,0,1))=>$_} qw( Alpha Bravo Charlie Delta Echo Foxtrot Golf Hotel India Juliett Kilo Lima Mike November Oscar Papa Quebec Romeo Sierra Tango Uniform Victor Whiskey X-ray Yankee Zulu );
while(<STDIN>) {
        chomp;
        print $_, "\n";
        print join(' ',map {$ALPHA{uc($_)}||$_} (split(//,$_))),"\n";
}

Here’s the source code.
Yup, I know about Lingua::Alphabet::Phonetic::NATO but I needed a quick script without module dependencies. Yes, I haven’t been able to learn the NATO phonetic alphabet yet -unlike some geeks with too much time in their hands (you know who you are)- and yes, I know I’m lazy, but that’s why I am a perl fan anyway ;-) .
There’s more information about this alphabet atWikipedia. You migth want to donate a few bucks while you’re there.