File Coverage

blib/lib/Net/Friends.pm

Criterion	Covered	Total	%
statement	22	67	32.8
branch	1	12	8.3
condition	1	5	20.0
subroutine	6	12	50.0
pod	3	4	75.0
total	33	100	33.0

package Net::Friends;

use 5.008;
use strict;
use warnings;
use Carp;
use IO::Socket::INET;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw( query report ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );  # none by default

our $VERSION = '1.03';

sub Version { $VERSION }

sub new {
    my ($class, $host, $port);

    $class = shift;

    ($host = shift) || croak "Hostname must be specified in call to new.";

    $port = shift || 50123;

    my $self = {host => $host, port => $port, others => {}, name => 'Query',
        lat => '90.000000', lon => '0.000000', speed => 0, dir => 0,
        last_update => 0, last_report => 0, max_update_freq => 60,
        id => 'queryqueryqueryqueryqu'};

    bless $self, $class;

    return $self;
}

# makes sure update isn't called more than once per max_update_freq seconds
sub _maybe_update {
    my $self = shift;

    if ($self->{last_update} + $self->{max_update_freq} > time) {
        return;  # updated too recently
    }
    $self->_update;
}

# give our position and get positions of others
sub _update {
    my $self = shift;

    $self->{last_update} = time;

    my $sock = IO::Socket::INET->new(PeerAddr => $self->{host},
        PeerPort => $self->{port}, Proto => 'udp');

    send $sock, (join ' ', ('POS:', $self->{id}, $self->{name}, $self->{lat},
        $self->{lon}, $self->{last_report}, $self->{speed}, $self->{dir})), 0;

    my %friends = ();

    my $val;

    do {
        recv $sock, $val, 1024, 0;
        chomp $val;
        if ($val =~ m/^POS:\s+(\S{22})\s+(\S+)\s+([\d\.-]+)\s+([\d\.-]+)\s+
            (\d+)\s+(\d+)\s+(\d+)/x) {
          my %entry;
          %entry = ();
          $entry{'name'} = $2;
          next if ($entry{'id'} eq 'queryqueryqueryqueryqu'); # skip lookups
          $entry{'lat'} = $3;
          $entry{'lon'} = $4;
          $entry{'time'} = $5;
          $entry{'speed'} = $6;
          $entry{'dir'} = $7;
          $friends{$2} = \%entry;
        }
    } while ($val ne '$END:$' && $val ne '');

    $self->{others} = \%friends;
}

# internally and remotely update our position information
sub report {
    my $self = shift;
    while (@_) { # push named parameters into object
        my $key = shift;
        $self->{$key} = shift;
    }
    $self->{last_report} = time;

    # set the 'id' randomly if it's still queryqueryqueryquery
    if ($self->{id} eq 'queryqueryqueryqueryqu') {
        $self->{id} = $self->_random_id;
    }

    $self->_update;
}

sub _random_id {
    my @chars = ('A' .. 'Z', 'a' .. 'z', 0, 1 .. 9);
    my @slice;
    foreach (1 .. 22) {
        push @slice, int rand @chars;
    }
    return join '', @chars[@slice];
}

# get last known position information about us and others
sub query {
    my $self = shift;
    my $who = shift;

    $self->_maybe_update;

    if (defined $who) {
        return $self->{others}->{$who}
    } else {
        return $self->{others}
    }
}

1;
__END__