File Coverage

blib/lib/NetStumbler/Wap.pm

Criterion	Covered	Total	%
statement	28	37	75.6
branch	5	6	83.3
condition	2	6	33.3
subroutine	5	8	62.5
pod	3	6	50.0
total	43	63	68.2

package NetStumbler::Wap;

use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

#
# We do not Export anything
#
our $VERSION = '0.09';

=head1 Object Methods

=head2 new()

Returns a new Wap object. NOTE: this method may take some time to execute
as it loads the list into memory at construction time

=cut

sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {} ;
    $self->{VENDORS} = {};
    bless ($self, $class);
    return $self;
}

sub initialize
{
    my $self = shift;
    while()
    {
	if(/END/)
	{
	    last;
	}
	chomp;
	my ($prefix,$ven) = split(/\t/);
	if($prefix && $prefix =~ /\w\w:\w\w:\w\w/i)
	{
		chomp($ven);
	    $self->{VENDORS}->{$prefix} = $ven;
	}
    }
}

=head2 isAdhoc($flags)

Params:
	-number 801.11 Capability flags
Returns:
	true is the flags indicate the access point is in adhoc mode
Example:
	if($obj->isAdhoc($flags))
	{
		# do something here
	}

=cut

sub isAdhoc
{

	my $self = shift;
	my $flags = shift;
	return $flags & 0x0002;
}

=head2 isInfrascruture($flags)

Params:
	-number 801.11 Capability flags
Returns:
	true is the flags indicate the access point is in infrastructure mode
Example:
	if($obj->isInfrascructure($flags))
	{
		# do something here
	}

=cut

sub isInfrastructure
{
	my $self = shift;
	my $flags = shift;
	return !isAdhoc($flags);
}

=head2 hasWEP($flags)

Params:
	-number 801.11 Capability flags
Returns:
	true is the flags indicate the access point has WEP enabled
Example:
	if($obj->hasWEP($flags))
	{
		# do something here
	}

=cut

sub isWEP
{
	my $self = shift;
	my $flags = shift;
	return $flags & 0x0010;
}


=head2 getVendorForBBSID ($mac)

Determine the vendor or a nic by the MAC prefix
The argument should be a mac address in the format of
00000000000
or
00:00:00:00:00:00

C will return the vendor or undef
if the mac address could not be translated to a vendor

=cut

sub getVendorForBBSID
{
    my $self = shift;
    my $mac = shift;
    if(length($mac) > 12)
    {
	my $prefix = substr($mac,0,8);
    	return $self->{VENDORS}->{uc($prefix)};
    }
    else
    {
    	my $prefix = substr($mac,0,2) . ":" . substr($mac,2,2) . ":" . substr($mac,4,2);
    	return $self->{VENDORS}->{uc($prefix)};
    }
}
1;
__DATA__