File Coverage

blib/lib/Win32/Wlan.pm

Criterion	Covered	Total	%
statement	12	40	30.0
branch	0	18	0.0
condition	0	6	0.0
subroutine	4	12	33.3
pod	7	7	100.0
total	23	83	27.7

package Win32::Wlan;
use strict;
use Carp qw(croak);
use Win32::Wlan::API qw<
    WlanOpenHandle
    WlanCloseHandle
    WlanQueryCurrentConnection
    WlanEnumInterfaces
    WlanGetAvailableNetworkList
    $wlan_available
>;
use vars qw<$VERSION>;
$VERSION = '0.07';

# Ideally, the handle should be (another) singleton
# that fetches and keeps the handle until the application
# closes or the last Win32::Wlan object gets destroyed

=head1 NAME

Win32::Wlan - Query wlan properties

=head1 SYNOPSIS

    require Win32::Wlan;
    my $wlan = Win32::Wlan->new;
    if ($wlan->available) {
        print "Connected to ", $wlan->connection->{profile_name},"\n";
        print "I see the following networks\n";
        for ($wlan->visible_networks) {
            printf "%s\t-%d dbm\n", $_->{name}, $_->{signal_quality};
        };

    } else {
        print "No Wlan detected (or switched off)\n";
    };

=head1 METHODS

=head2 C<< Win32::Wlan->new( %args ) >>

    my $wlan = Win32::Wlan->new();

Creates a new Win32::Wlan object.

=over 4

=item *

C - optional argument to force detection of general Wlan availability

=item *

C - optional argument to give an existing Wlan handle to the object

=item *

C - optional argument to give an existing guuid to the object

=back

=cut

sub new {
    my ($class,%args) = @_;

    if ($args{ available } or !exists $args{ available }) {
        if (! $args{handle}) {
            $args{handle} = eval { WlanOpenHandle() };
            $args{available} = $wlan_available;
        } else {
            #
            # User gave a handle, so assume availibility is true
            #
            $args{available} = 1;
        }
        if ($args{available}) {
            if (! $args{ interface }) {
                my @interfaces = WlanEnumInterfaces($args{handle});
                if (@interfaces > 1) {
                    warn "More than one Wlan interface found. Using first.";
                }
                $args{interface} = $interfaces[0];
            }
        }
    }
    bless \%args => $class;
};


sub DESTROY {
    my ($self) = @_;
    if ($self->handle and $self->available) {
        WlanCloseHandle($self->handle);
    };
}

=head2 C<< $wlan->handle >>

Returns the Windows API handle for the Wlan API.

=cut

sub handle { $_[0]->{handle} };

=head2 C<< $wlan->interface >>

    print $wlan->interface->{name};

Returns a hashref describing the interface. The keys are
C for the guuid, C for the human-readable name and
C for the status of the interface.

=cut

sub interface { $_[0]->{interface} };

=head2 C<< $wlan->available >>

    $wlan->available
        or warn "Wlan API is not available";

Returns whether the Wlan API is available. The Wlan API is available
on Windows XP SP3 or higher.

=cut

sub available { $_[0]->{available} };

=head2 C<< $wlan->connected >>

    $wlan->connected
        or warn "Wlan connection unavailable";

Returns whether a Wlan connection is established. No connection is established
when Wlan is switched off or no access point is in range.

=cut

sub connected {
    my $conn = $_[0]->connection;
    defined $conn->{profile_name} && $conn->{profile_name}
};

=head2 C<< $wlan->connection >>

    if ($wlan->connected) {
        print "Connected to ";
        print $wlan->connection->{profile_name};
    };

Returns information about the current connection in a hashref. The keys
are

=over 4

=item *

C - the name of the profile of the current connection

=back

=cut

sub connection {
    my ($self) = @_;
    if ($self->available) {
        return { WlanQueryCurrentConnection( $self->handle, $self->interface->{guuid} ) };
    };
};

=head2 C<< $wlan->visible_networks >>

Returns information about the currently visible networks as a list of
hashrefs.

=over 4

=item *

C - the SSID of the network

=item *

C - the signal quality ranging linearly from 0 to 100
meaning -100 dbm to -50 dbm

=back

=cut

sub visible_networks {
    my ($self) = @_;
    if ($self->available) {
        return WlanGetAvailableNetworkList( $self->handle, $self->interface->{guuid} );
    };
};

1;

__END__