PAC Manager Code

package PACPoller;

###################################################################
# This file is part of PAC( Perl Auto Connector)
#
# Copyright (C) 2010  David Torrejon Vaquerizas
# 
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
###################################################################

$|++;

###################################################################
# Import Modules

# Standard
use strict;
use warnings;
use FindBin qw ( $RealBin $Bin $Script );
use Net::ARP;
use Net::Ping;
use threads;
use threads::shared;
#use Data::Dumper;

# PAC modules
use PACUtils;

# END: Import Modules
###################################################################

###################################################################
# Define GLOBAL CLASS variables

my $APPNAME			= $PACUtils::APPNAME;
my $APPVERSION		= $PACUtils::APPVERSION;
my $CFG_DIR			= $ENV{'HOME'} . '/.pac';
my $CFG_FILE		= $CFG_DIR . '/pac.yml';

my $N_THREADS		= 10;
my $STOP : shared	= 0;
my $SLEEP_TIME		= 2;
my %POLL : shared;

# END: Define GLOBAL CLASS variables
###################################################################

$SIG{'INT'} = SIG{'TERM'} = sub { $STOP = 1; };

###################################################################
# START: Define PUBLIC CLASS methods

sub new
{
	my $class	= shift;
	my $self	= {};
	
	$self -> {_THREADS} = ();
	
	for( my $i = 0; $i < $N_THREADS; $i++ ) { push( @{ $$self{_THREADS} }, threads -> new( sub { &_buildPoller; }, $self, $i ) ); }
	
	bless( $self, $class );
	return $self;
}

# DESTRUCTOR
sub DESTROY
{
	my $self = shift;
	undef $self;
	return 1;
}

# END: Define PUBLIC CLASS methods
###################################################################

###################################################################
# START: Define PRIVATE CLASS functions

sub _buildPoller
{
	my $self	= shift;
	my $n		= shift;
	
	while( ! $STOP )
	{
		
		
		sleep $SLEEP_TIME;
	}
	
	return 1;
}

sub _ping
{
	my $ip			= shift // '';
	my $port		= shift // 9;
	my $mac			= shift // '';
	my $ping_port	= shift // 7;
	
	if ( ! ( ( $ip =~ /\b(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\b/ ) && $1 < 255 && $2 < 255 && $3 < 255 && $4 < 255 ) )
	{
		my $packed_ip = gethostbyname( $ip );
		defined $packed_ip and $ip = inet_ntoa( $packed_ip );
	}
	
	##########################################################
	# Try some net movement to resolve remote host's MAC address
	if ( $ip )
	{
		Gtk2 -> main_iteration while Gtk2 -> events_pending;
		my $PING = Net::Ping -> new( 'tcp' );
		$PING -> tcp_service_check( 1 );
		$PING -> port_number( $ping_port );
		my $up = $PING -> ping( $ip, '1' );
		$mac = Net::ARP::arp_lookup( '', $ip );
		if ( $mac eq 'unknown' )
		{
			$up = $PING -> ping( $ip, '1' );
			$mac = Net::ARP::arp_lookup( '', $ip );
		}
		# =~ /^[\da-fA-F]{2}[:-][\da-fA-F]{2}[:-][\da-fA-F]{2}[:-][\da-fA-F]{2}[:-][\da-fA-F]{2}[:-][\da-fA-F]{2}$/go ? 1 : 0 );
	}
	
	return 1;
}

# END: Define PRIVATE CLASS functions
###################################################################

1;