view release on metacpan or  search on metacpan

lib/AC/Misc.pm  view on Meta::CPAN

use AC::Import;
use Socket;
use POSIX;
use MIME::Base64;
use Sys::Hostname;

use strict;

our @EXPORT = qw(inet_atoi inet_ntoi inet_iton inet_itoa inet_lton inet_ntoa inet_aton
                 inet_valid inet_normalize
		 random_text random_bytes unique
                 url_encode url_decode
		 encode_base64_safe decode_base64_safe
		 hex_dump shuffle);

# network length => packed netmask
sub inet_lton {
    my $l = shift;

    pack 'N', (0xFFFFFFFF << (32-$l));
}

# ascii => integer
sub inet_atoi {
    my $a = shift;
    return inet_ntoi(inet_aton($a));
}

# packed => integer
sub inet_ntoi {
    my $n = shift;
    return unpack('N', $n);
}

# integer => packed
sub inet_iton {
    my $i = shift;
    return pack('N', $i);
}

# integer => ascii
sub inet_itoa {
    my $i = shift;
    return inet_ntoa(inet_iton($i));
}

sub inet_valid {
    my $ip = shift;

    return 1 if $ip =~ /^\d+\.\d+\.\d+\.\d+$/;
    return 1 if $ip =~ /^[0-9a-f]*:[0-9a-f:.]+$/i;
    return ;
}

sub inet_normalize {
    my $ip = shift;

    # ipv4
    return $ip if $ip =~ /^\d+\.\d+\.\d+\.\d+$/;

    # ipv6: expand ::
    my($l, $r) = split /::/, lc($ip);
    my @ln = split /:/, $l;
    my @rn = split /:/, $r;
    my @mn = ('0') x (8 - @ln - @rn);

    return join(':', @ln, @mn, @rn);
}

################################################################

sub hex_dump {
    my $s = shift;
    my $r;
    my $off = 0;

    while( my $l = substr($s,0, 16, '') ){
	(my $t = $l) =~ s/\W/\./g;
	my $h = unpack('H*', $l) . ('  ' x (16 - length($l)));
	$h =~ s/(..)/$1 /g;
	$h =~ s/(.{24})/$1 /;

	$r .= sprintf('%04X: ', $off) . "$h $t\n";
	$off += 16;
    }

    $r;
}

################################################################

sub encode_base64_safe {
    my $t = shift;

    my $u = encode_base64( $t );
    $u =~ tr/\r\n//d;
    $u =~ s/=*$//;
    $u =~ tr%+/=%-._%;

    return $u;
}

sub decode_base64_safe {
    my $u = shift;

    $u  =~ tr%-._%+/=%;
    $u  =~ tr%\r\n\t %%d;	# remove white

    # re-add final =s
    my $l = length($u) %4;
    $u .= '=' x (4-$l) if $l;

    return decode_base64($u);
}

################################################################

sub url_encode {
    my $txt = shift;

    $txt =~ s/([^a-z0-9_\.\-])/sprintf('%%%02x',ord($1))/gei;