File Coverage

blib/lib/NetPacket/LLC.pm

Criterion	Covered	Total	%
statement	18	47	38.3
branch	0	6	0.0
condition			n/a
subroutine	6	10	60.0
pod	4	4	100.0
total	28	67	41.7

#
# NetPacket::LLC - Decode and encode IEEE Logical Link Layer
#
# Comments/suggestions to [e-mail]
#

package NetPacket::LLC;

#
# Copyright (c) 2002 Chander Ganesan.
#
# This package is free software and is provided "as is" without express
# or implied warranty.  It may be used, redistributed and/or modified
# under the terms of the Perl Artistic License (see
# http://www.perl.com/perl/misc/Artistic.html)
#
# This software and all associated data and documentation
# ('Software') is available free of charge.  You may make copies of the
# Software but you must include all of this notice on any copy.
#
# The Software was developed for research purposes does not
# warrant that it is error free or fit for any purpose.  The author
# disclaims any liability for all claims, expenses, losses, damages
# and costs any user may incur as a result of using, copying or
# modifying the Software.
#

use 5.006;
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

my $myclass;
BEGIN {
    $myclass = __PACKAGE__;
    $VERSION = "0.01";
}
sub Version () { "$myclass v$VERSION" }

BEGIN {
    @ISA = qw(Exporter NetPacket);

# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)

    @EXPORT = qw(
    );

# Other items we are prepared to export if requested

    @EXPORT_OK = qw(llc_strip
                    );

# Tags:

    %EXPORT_TAGS = (
    ALL         => [@EXPORT, @EXPORT_OK],
    strip       => [qw(llc_strip)],
    types       => [qw(
                       )],
);

}

#
# Decode the packet
#

sub decode {
    my $class = shift;
    my($pkt, $parent, @rest) = @_;
    my $self = {};

    # Class fields

    $self->{_parent} = $parent;
    $self->{_frame} = $pkt;

    # Decode LLC data

    if (defined($pkt)) {
         ($self->{dsap},$self->{ssap}, $self->{control},
          $self->{data}) =
	    unpack('H2H2B8a*' , $pkt);
    }

    # Return a blessed object

    bless($self, $class);
    return $self;
}

#
# Strip header from data and return the data contained in it
#

undef &llc_strip;        # Create llc_strip alias
*llc_strip = \&strip;

sub strip {
    my ($pkt, @rest) = @_;
    my $llc_obj = NetPacket::LLC->decode($pkt);
    return $llc_obj->{data};;
}

#
# Encode a packet - now implemented!
#

sub encode {
    my ($self, $data) = @_;
    my $defaults = {
        dsap => undef,
        ssap => undef,
        control => undef,
        data => undef,
    };

    my $packStruct = {
        1 => { 'dsap' => 'H2' },
        2 => { 'ssap' => 'H2' },
        3 => { 'control' => 'B8' },
        4 => { 'data' => 'a*' },
    };

    #
    # Ensure all required parameters are passed, and those that aren't
    # are defaulted.
    #
    foreach my $name (keys %$defaults) {
        if (defined $data->{$name}) {
            next;
        } else {
            if (defined $defaults->{$name}) { # we have a defaults
                $data->{$name} = $defaults->{$name};
            } else {
                die "$name parameter is required to encode LLC\n";
            }
        }
    }

    #
    # Encode the data
    #
    my $packed_data = "";
    foreach my $key (sort { $a <=> $b } keys %$packStruct) {
        foreach my $subkey (keys %{$packStruct->{$key}}) {
            $packed_data .= pack ($packStruct->{$key}{$subkey},
                                  $data->{$subkey});
        }
    }
    return $packed_data;
}

#
# Module return value
#
1;

# autoloaded methods go after the END token (&& pod) below

__END__