gistfile1.pl

#!/usr/bin/perl -w
# vold.pl, Volume control "daemon" for Denon x311 AVR
# Copyright (C) 2011 Kristian Lyngstol <[email protected]>
# 
# 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 2 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.


use strict;
use IO::Socket;
use IO::Select;


# The receiver
my $remote;

# The select() struct
my $sel;

# Read from the receiver. Assume unmuted at start-up (worst case scenario:
# Hit mute twice to unmute so vold catches the MUON in return).
my $mute = 0;

# No volume at start-up.
my $vol = "NA";

# for readin' stuff
my $line;

# listen-socket.
my $listen;

# (Re-)connect to the receiver and re-add it to the select-queue.
sub recon {
	$sel->remove($remote);
	$remote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => "denon.nat.kly.no", PeerPort => "23", Timeout => 5,) or die "cannot connect to avr";
	$sel->add($remote);
	print "Re-opened connection to AVR\n";
}

# Handle data from the receiver, possibly reconnecting if needed.
sub handle_remote {
	local $/ = "\r";
	if (!$remote->connected) {
		recon();
		return;
	}

	$line = <$remote>;
	if ($line =~ m/MV[0-9][0-9][0-9]?/) {
		print "Debug: Volume found: " . $line ."\n";
		$vol = $line;
		$vol =~ s/[^0-9]//g;
		if (length($vol)>2) {
			print "Length found: " . length($vol) . "\n";
			$vol =~ s/[0-9]$//;
		}
		if ($vol == "99") {
			$vol = "0";
		} else {
			$vol -= 1;
		}
	} elsif ($line =~ m/MUON/) {
		$mute = 1;
	} elsif ($line =~ m/MUOFF/) {
		$mute = 0;
	}
}

# Close a peer and remove it from the select queue
sub go_away {
	my $fh = $_[0];
	print "Lost peer: " . $fh->peerhost . "\n";
	$sel->remove($fh);
	$fh->close;
	return;
}

# Handle client-data, defaulting to getting rid of it.
sub handle_client {
	my $fh = $_[0];
	if (!$fh->connected) {
		go_away($fh);
		return;
	}
	$line = <$fh>;
	if (!defined $line) {
		go_away($fh);
		return;
	}
	$line =~ s/[^a-zA-Z0-9]//g;
	print "Read: " . $line . "\n";
	if ($line =~ m/UP/) {
		print $remote "MVUP\r";
	} elsif ($line =~ m/DOWN/) {
		print $remote "MVDOWN\r";
	} elsif ($line =~ m/VOL/) {
		print $fh "". $vol . "\n";
	} elsif ($line =~ m/MUTE/) {
		if ($mute == 0) {
			print $remote "MUON\r";
		} else {
			print $remote "MUOFF\r";
		}
	} else {
		print $fh "What you say?\n";
		print $fh "Use: DOWN, UP, MUTE or VOL\n";
		go_away($fh);
	}
}

$listen = new IO::Socket::INET(Listen => 1, LocalPort => 1337, Timeout=>0,ReuseAddr =>1) or die "WHAT?";
$sel = new IO::Select( $listen );
recon();

# Let the games begin.
# Short: Both accepts new connections on $listen and adds them to $sel,
# reads client-connections and reads the denon-receiver, hopefully catching
# disconnects.
while(my @ready = $sel->can_read) {
	if (!defined $remote || !$remote->connected) {
		recon();
	}
	foreach my $fh (@ready) {
		if($fh == $listen) {
			# Create a new socket
			my $new = $listen->accept;
			$sel->add($new);
			print "Accepted: " . $new->peerhost . "\n";
		} elsif ($fh == $remote) {
			handle_remote();
		} else {
			handle_client($fh);
		}
	}
}