File Coverage

blib/lib/Convert/TLI.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	3	6	50.0
condition	2	4	50.0
subroutine	10	10	100.0
pod	0	5	0.0
total	63	73	86.3

package Convert::TLI;

use 5.008008;
use strict;
use warnings;
use Carp;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	encode_tli decode_tli detect_tli
);

our $VERSION = '0.01';

sub new {
    my $class = shift;
    my %opts  = @_;

    my $self = {
    	%opts
    };

    bless $self, $class;
    $self->initialize(@_);
    return $self;
}

sub initialize {
    my $self = shift;
    my $val  = shift;
    $self->{prefix} = $self->{prefix} || "0x0002";
    $self->{nulls} = $self->{nulls} || "";
}


sub encode_tli {
	my $self = shift;
	my $host_to_encode = shift;
	my $port_to_encode = shift;

	my @hosts = split '.', $host_to_encode;

    my $ip = $self->_get_ip_address( $host_to_encode, 'hex');

    my $hexport = sprintf("%4.4x", $port_to_encode);

    return  $self->{prefix}."$hexport$ip".$self->{nulls};


}

sub decode_tli {
	my $self = shift;
    my $to_decode = shift;

	my $rsl = eval {
		hex(substr($to_decode, 10, 2))
	};

	return if $@;

	my ( @arr ) = (
	   hex(substr($to_decode, 10, 2)),
	   hex(substr($to_decode, 12, 2)),
	   hex(substr($to_decode, 14, 2)),
	   hex(substr($to_decode, 16, 2))
	);

	my $port = hex(substr($to_decode, 6, 4));
	my $ip = join('.', @arr);

	return ( $ip, $port );
}

sub detect_tli {
	my $self = shift;
    my $str  = shift;

    return ( $str =~ /0x/ ) ? '1' : '0';

}


sub _get_ip_address {
	my $self = shift;
    my ($host, $mode) = @_;
    my ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($host);

    my $mask = join('.', unpack('C4', $addrs[0]));

    if ($mode eq 'hex')
    {
        $mask = sprintf("%2.2x%2.2x%2.2x%2.2x", split(/\./, $mask));
    }

    return $mask;
}

1;
__END__