97 lines
1.7 KiB
Perl
97 lines
1.7 KiB
Perl
#!/usr/bin/perl
|
|
|
|
package TLV::Parser;
|
|
|
|
use strict;
|
|
use parent qw/Exporter/;
|
|
use Carp qw/croak/;
|
|
|
|
our $VERSION = '1.0';
|
|
|
|
sub new {
|
|
my ($class, $content);
|
|
|
|
$class = shift;
|
|
$content = shift;
|
|
|
|
croak 'No content' unless (length $content);
|
|
|
|
my $self = {
|
|
content => $content,
|
|
content_length => length $content,
|
|
index => 0,
|
|
tag => undef,
|
|
length => 0,
|
|
value => undef
|
|
};
|
|
|
|
return bless ($self, $class);
|
|
}
|
|
|
|
sub next_tag {
|
|
my $self = shift;
|
|
|
|
croak 'No space for tag' if ($self->{index} + 1 > $self->{content_length});
|
|
|
|
$self->{tag} = unpack ('C', substr ($self->{content}, $self->{index}, 1));
|
|
$self->{index} += 1;
|
|
|
|
return $self->{tag};
|
|
}
|
|
|
|
sub next_length {
|
|
my $self = shift;
|
|
|
|
croak 'No space for length' if ($self->{index} + 2 > $self->{content_length});
|
|
|
|
$self->{length} = unpack ('S>', substr ($self->{content}, $self->{index}, 2));
|
|
$self->{index} += 2;
|
|
|
|
croak 'Length is 0' unless ($self->{length});
|
|
|
|
return $self->{length};
|
|
}
|
|
|
|
sub next_value {
|
|
my $self = shift;
|
|
|
|
croak 'No space for value' if ($self->{index} + $self->{length} > $self->{content_length});
|
|
|
|
$self->{value} = substr ($self->{content}, $self->{index}, $self->{length});
|
|
$self->{index} += $self->{length};
|
|
|
|
return $self->{value};
|
|
}
|
|
|
|
sub index {
|
|
my $self = shift;
|
|
return $self->{index};
|
|
}
|
|
|
|
sub tag {
|
|
my $self = shift;
|
|
return $self->{tag};
|
|
}
|
|
|
|
sub length {
|
|
my $self = shift;
|
|
return $self->{length};
|
|
}
|
|
|
|
sub value {
|
|
my $self = shift;
|
|
return $self->{value};
|
|
}
|
|
|
|
sub content {
|
|
my $self = shift;
|
|
return $self->{content};
|
|
}
|
|
|
|
sub done {
|
|
my $self = shift;
|
|
return $self->{index} == $self->{content_length};
|
|
}
|
|
|
|
1;
|