Browsing CategoryOld Notes

Sorting Section Numbers

Here’s a code to sort section numbers in ascending order:


sub sort_sections {
    my ($data) = @_;

    my $sorted = ();
    @$sorted = map { $_->[0] }
        sort {
            my $x=1;
            while (defined $b->[1][$x]) {
                defined $a->[1][$x] or return -1;
                if ($x%2) {
                    ## Strict numeric comparison
                    return 1
                        if $a->[1][$x] > $b->[1][$x];
                    return -1
                        if $a->[1][$x] [1][$x];
                } else {
                    ## Non-numeric comparison
                    return 1
                        if $a->[1][$x] gt $b->[1][$x];
                    return -1
                        if $a->[1][$x] lt $b->[1][$x];
                }
                $x++;
            }
            return defined $a->[1][$x] ? 1 : 0;
        }
        map { [$_, [split(/(d+)/, $_)]] } @$data;

    return $sorted;
}

Here’s a test for it:


$sects = ['1.1', '1.2.2', '1.3', '1.2', '1.3.1'];
print Dumper($sects);

$sorted_sects = sort_sections($sects);

use Data::Dumper;
print Dumper($sorted_sects);

And here’s the output:


$VAR1 = [
          '1.1',
          '1.2.2',
          '1.3',
          '1.2',
          '1.3.1'
        ];
$VAR1 = [
          '1.1',
          '1.2',
          '1.2.2',
          '1.3',
          '1.3.1'
        ];

Found in Perlmonks.

Base Conversion

The following routines will convert a number to and from among the different bases: decimal, hexadecimal, and binary.


################################################
# Convert a binary input to hex
# Does not return any leading 0s
#
 sub bin2hex {
    my $inpt = shift;
    my $hex;
    my $bits = length($inpt);
    $inpt = (32 - $bits) x '0' . $inpt;
    my $dec = unpack("N",
                 pack("B32", substr("0" x 32 . $inpt, -32)));

    return(sprintf("%x", $dec));
}

################################################
# Convert a decimal input to binary
# Arguments = decimal_number, number_of_bits
#
sub dec2bin {
    my $dec = int(shift);
    my $bits = shift;
    my $bin = unpack("B32", pack("N", $dec));
    substr($bin, 0, (32 - $bits)) = '';
    return($bin);
}

################################################
# Convert a binary input to decimal
#
sub bin2dec {
    my $bin = shift;
    my $bits = length($bin);
    $bin = (32 - $bits) x '0' . $bin;
    my $dec = unpack("N",
                 pack("B32", substr("0" x 32 . $bin, -32)));
    return($dec);
}

###############################################
# Convert a hex input to decimal
#
sub hex2dec {
    my $h = shift;
    $h =~ s/^0x//g;
    return( hex($h));
}

Verify Valid Domain

Use this code to verify if the domain part of an email address is valid:


use Net::DNS;

$email = "[email protected]";
(undef, $domain) = split (/@/, $email);
$resolver = new Net::DNS::Resolver();
$response ||= $resolver->query($domain, "MX")
  || $resolver->query($domain, "A");
defined ($response) ? print "$domain is valid"
  : print "$domain is invalidn";

It might also be a good idea to skip known domains, such as yahoo.com, google.com, etc.

Checking Regular Expression Syntax

If your program accepts a regular expression pattern, either from a user input or another module, you need to check that the pattern you receive is valid or not. To check for a valid pattern, apply the pattern against an empty string and wrap the expression in an eval.


sub my_func {
    my ($pattern) = @_;

    eval {
        "" =~ $pattern;
    };
    if ($@) {
        die "Something wrong with your pattern: $pattern";
    }

    # Otherwise, pattern is good and use it here.
}

How To Determine Installed Modules

Here’s how to determine what modules have been installed after the original Perl installation, hence showing those modules not part of the core installation. Type this from a command line:


perldoc perllocal