File Coverage

blib/lib/TLV/Parser.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	7	10	70.0
condition	2	4	50.0
subroutine	5	5	100.0
pod	2	2	100.0
total	61	66	92.4

package TLV::Parser;
use strict;
use warnings;

our ( $VERSION );

BEGIN {
    $VERSION = '1.01';
}

sub new {
    my $class = shift;
    my $href  = shift;
    die "No tags defined!" unless scalar @{$href->{tag_aref}};
    my $self = {};
    my ($tag_href, $tag_len_href);
    foreach ( @{$href->{tag_aref}} ) {
        $tag_href->{$_} = undef;
        my $len         = length $_;
        $tag_len_href->{$len} = undef unless exists $tag_len_href->{$len};
    }
    $self->{tag} = $tag_href;
    $self->{tag_len} = [ keys %{$tag_len_href} ];
    $self->{l_len} = $href->{l_len} || 2;

    bless $self, $class;
}

sub parse {
    my $self = shift;
    my $tlv_string = shift || die "no string to parse?";
    my $l_len = $self->{l_len};
    my $result;

    while ( length $tlv_string > 0 ) {
        my $found;
        foreach my $t_len ( @{$self->{tag_len}} ) {
            my $tmp = substr($tlv_string, 0, $t_len);

            if ( exists $self->{tag}->{$tmp} ) {
                my $v_len = hex (substr $tlv_string, $t_len, $l_len);
                my $v = substr $tlv_string, ($t_len + $l_len), 2 * $v_len;
                $result->{$tmp} = $v;
                $found = 1;

                my $offset = $t_len + $l_len + 2 * $v_len;
                $tlv_string = substr $tlv_string, $offset;
                last if $found;
            }
        }
        unless ( $found ) {
            $self->{remain} = $tlv_string;
            $self->{error}  = "parsing incomplete";
            last;
        }
    }
    $self->{result} = $result;
}
1;

__END__