Navigation
Home
gpl
lampgui
1.0
Lamp.pm








































Lamp.pm
   #!/usr/bin/perl
   
   use Socket;
   
   
   $FlagSet=1;
   $FlagGet=2;
   $FlagDefault=4;
   $LampState[0]='off';
   $LampState[1]='on';
   $LampState[2]='blinking';
   
   
   sub LampInit {
   	local ($LampHost) = @_;
   
   	socket(Conn,PF_INET,SOCK_DGRAM,getprotobyname('udp'));
   
   	$LampAddr = sockaddr_in(4321,inet_aton($LampHost));
   }
   
   sub LampSet {
   	local ($LampNr,$State,$Flags) = @_;
   	local $StateNr = -1;
   
   	if ($State eq 'off') {
   		$StateNr=0;
   	}
   	if ($State eq 'on') {
   		$StateNr=1;
   	}
   	if ($State eq 'blink') {
   		$StateNr=2;
   	}
   
   	if ($Flags eq 'default') {
   		$Flag=$FlagSet|$FlagDefault;
   	} else {
   		$Flag=$FlagSet;
   	}
   
   	if ($StateNr ne -1) {
   		$Request=pack("ccxxcxxx",$Flag,$LampNr,$StateNr);
   		send(Conn,$Request,0,$LampAddr);
   	}
   
   	local $SIG{ALRM} = 'IGNORE';
   	alarm 1;
   	recv(Conn,$msg,200,0);
   	alarm 0;
   }
   
   
   sub LampGet {
   	local @Arr;
   
   	$Request=pack("ccxxcxxx",2,0,0);
   	send(Conn,$Request,0,$LampAddr);
   
   	local $SIG{ALRM} = 'IGNORE';
   	alarm 1;
   	recv(Conn,$msg,200,0) or return 'Lamp server error!';
   	alarm 0;
   
   	#offset 0 : lampnr
   	#offset 4 : state
   	#offset 8 : timeout
   
   	for $Cnt (0..7) {
   		($LampNr,$State,$Timeout) = unpack('cxxxcxxxc',substr($msg,12*$Cnt,9));
   		$Arr[$Cnt]="$LampNr $State $Timeout";
   	}
   
   	return @Arr;
   }
   
   sub LampGetFriendly {
   	local @States = LampGet();
   
   	if ($States[0] =~ 'error') {
   		return @States;
   	}
   
   	$Cnt=0;
   	foreach $Lamp (@States) {
   		($LampNr,$State,$Timeout)=split(' ',$Lamp);
   
   		if ($Timeout == 0) {
   			$Arr[$Cnt++]="$LampState[$State] - default";
   		} else {
   			$Arr[$Cnt++]="$LampState[$State] - going back to default in $Timeout seconds";
   		}
   	}
   
   	return @Arr;
   }
   
   
   
   
   return 1;
   
   
   
   
   

syntax highlighted by Code2HTML, v. 0.9.1


Email me with questions/comments : Daan <Daan @ pa4dan . nl>