File Coverage

blib/lib/POE/Component/WakeOnLAN.pm

Criterion	Covered	Total	%
statement	61	65	93.8
branch	7	16	43.7
condition	4	11	36.3
subroutine	10	10	100.0
pod	1	1	100.0
total	83	103	80.5

package POE::Component::WakeOnLAN;
{
  $POE::Component::WakeOnLAN::VERSION = '1.04';
}

#ABSTRACT: A POE Component to send packets to power on computers.

use strict;
use warnings;
use Socket;
use Carp;
use IO::Socket::INET;
use Net::IP::Minimal;
use POE;

sub wake_up {
  my $package = shift;
  my %params = @_;
  $params{lc $_} = delete $params{$_} for keys %params;
  croak "$package wake_up requires a 'macaddr' parameter\n" unless $params{macaddr};
  croak "$package wake_up requires an 'event' parameter\n" unless $params{event};
  $params{macaddr} =~ s/://g;
  $params{port} = 9 unless $params{port} and $params{port} =~ /^\d+$/;
  $params{address} = '255.255.255.255' unless $params{address} and Net::IP::Minimal::ip_get_version( $params{address} );
  my $options = delete $params{options};
  my $self = bless \%params, $package;
  $self->{session_id} = POE::Session->create(
	object_states => [
		$self => [qw(_start _ready)],
	],
	heap => $self,
	( ref($options) eq 'HASH' ? ( options => $options ) : () ),
  )->ID();
  return $self;
}

sub _start {
  my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER];
  $self->{session_id} = $_[SESSION]->ID();
  if ( $kernel == $sender and !$self->{session} ) {
	croak "Not called from another POE session and 'session' wasn't set\n";
  }
  my $sender_id;
  my $session = delete $self->{session};
  if ( $session ) {
    if ( my $ref = $kernel->alias_resolve( $self->{session} ) ) {
	$sender_id = $ref->ID();
    }
    else {
	croak "Could not resolve 'session' to a valid POE session\n";
    }
  }
  else {
    $sender_id = $sender->ID();
  }
  $kernel->refcount_increment( $sender_id, __PACKAGE__ );
  $self->{sender_id} = $sender_id;
  my $sock = new IO::Socket::INET(Proto=>'udp') || return;
  my $ip_addr = inet_aton( $self->{address} );
  my $sock_addr = sockaddr_in($self->{port}, $ip_addr);
  my $packet = pack('C6H*', 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, $self->{macaddr} x 16);
  $kernel->select_write( $sock, '_ready' );
  setsockopt($sock, SOL_SOCKET, SO_BROADCAST, 1);
  send($sock, $packet, 0, $sock_addr);
  return;
}

sub _ready {
  my ($kernel,$self,$socket) = @_[KERNEL,OBJECT,ARG0];
  $kernel->select_write( $socket );
  my $response = { };
  $response->{$_} = $self->{$_} for keys %{ $self };
  delete $response->{session_id};
  my $sender_id = delete $response->{sender_id};
  my $event = delete $response->{event};
  $kernel->post( $sender_id, $event, $response );
  $kernel->refcount_decrement( $sender_id, __PACKAGE__ );
  return;
}

1;


__END__