Skip to Content.
Sympa Menu

linux-sony-z1 - Re: [linux-sony-z1] New Sony Control Daemon - the spiritual successor to sonypidd

Subject: Linux users of Sony Z1 series

List archive

Re: [linux-sony-z1] New Sony Control Daemon - the spiritual successor to sonypidd


Chronological Thread 
  • From: Brouard Nicolas <>
  • To: , Stuart Shelton <>
  • Subject: Re: [linux-sony-z1] New Sony Control Daemon - the spiritual successor to sonypidd
  • Date: Mon, 23 Aug 2004 19:17:34 +0200
Le lun 02/08/2004 à 21:35, Stuart Shelton a écrit :
> There are several items that are needed for sonyoxsd to work:
>
> * The X11::Protocol, X::Osd, Term::ANSIColor and Term::Size Perl modules
> (see
> cpan(1) if these are not available in your distro)

On latest Mandrake 10.0 official these perl modules were not included in
the packages, so I have had to download them with commands:
cpan X11::Protocol
cpan X::Osd
cpan Term::ANSIColor
cpan Term::Size

but also
cpan Term::ANSIScreen

And for Osd I also needed
libwosd2-devel to get the included files needed by the installation
launched by cpan.

On Mandrake, as probably on many other distros, 'vtinfo' doesn't exist
and has to be replaced by 'fgconsole', also 'swtichvt' has to be
replaced by 'chvt' .

Could you check if, on your system, fgconsole and chvt do exist, because
I think that they are more general (at least on google).
fgconsole tells you on which terminal you typed the command (for example
7 on Mandrake if running on X). Doing a 'chvt 1' switches you to
terminal 1 (do chvt 7 to go back to X window).

So I slightly modified your perl script in order to have all these
variables in the "variables" section and not hard coded later in the
source code.

I also added the hibernate (suspend to disk) on Fn F12 because it is
working now on a recent cooker kernel.

My most important change concerns "Fn F7" and now I have the circled
sequences LCD -> LCD &CRT -> CRT . I am working with a replicator (and
an external 20" Display) and often use a video projector for
presentations, so I need this standard (at least on Windows) sequence
(which was not set on sonypidd).

Please find here after the diff with your original and here enclosed
'my' version. If you agree with the changes I can make a Mandrake/redhat
rpm for your perl script like I did for sonypidd and submit it to
Mandrake contrib. But you have to give a version number to your script
because it will be probably improved in the future, at least when
someone will find which bit has to be set in order to differentiate P1
from P2.

Just to say that I found this tool very useful. Bravo!

Nicolas Brouard

--- working directory: /home/brouard/RPMS/
% diff -bur sonyxosd.pl~ sonyxosd.pl
--- sonyxosd.pl~ 2004-08-23 10:29:18.623184872 +0200
+++ sonyxosd.pl 2004-08-23 18:15:34.850151912 +0200
@@ -16,6 +16,12 @@
#
# Concept inspired by sonypidd by Craig DeForest
#
+# Releases:
+#
+# August 22 2004 Nicolas Brouard (brouard at ined dot fr)
+# - All binaries are now declared in the "variables" section.
+# - The Fn F7 has now the standard sequence LCD -> LCD & CRT -> CRT
+#


###############################################################################
# Additional Modules & Functions
@@ -53,7 +59,8 @@

# User-alterable values
#
-my $xtty = 11; # Which TTY does X use?
+#my $xtty = 11; # Which TTY does X use?
+my $xtty = 7; # Use 7 On Mandrake
# NB: Default is 7
my $multiline = TRUE; # Show all settings at once?
my $osdcolour = 'Green'; # Colour for xOSD
@@ -71,12 +78,18 @@
my $name = 'sonyxosd';

my $brightsteps = int( 256 / 8 );
-my $sonypid = '/usr/bin/sonypid';
-my $spicctrl = '/bin/sonyctl';
+my $sonypid = '/usr/sbin/sonypid';
+my $spicctrl = '/usr/sbin/spicctrl';
# my $click = '/usr/bin/bplay
/usr/share/sawfish/1.3/sounds/clicked.wav';
my $click = undef;
-# my $suspend = '/usr/bin/sudo /usr/sbin/hibernate';
-my $blankscreen = '/usr/bin/radeontool';
+my $suspend = '/usr/bin/sudo /usr/local/sbin/hibernate';
+my $radeontool = '/usr/local/bin/radeontool';
+
+my $vtinfo = '/usr/bin/fgconsole';
+my $vtswitch = '/usr/bin/chvt';
+my $amixer = '/usr/bin/amixer';
+my $aumix = '/usr/bin/aumix';
+


###############################################################################
# Internal variables
@@ -323,9 +336,9 @@

sub sndctl {
if( $alsa ) {
- return '/usr/bin/amixer';
+ return $amixer;
} else {
- return '/usr/bin/aumix';
+ return $aumix;
}
}

@@ -415,11 +428,13 @@
if( $alsa ) {
$muted = TRUE;
my $command = sndctl() . " set Master off";
+ warn "ALSA command: $command\n" if $debug;
eval { `$command` };
} else {
my $volume = sndstate();
$lastlevel = $volume if defined $volume;
my $command = sndctl() . " -v 0";
+ warn "SOUND command: $command\n" if $debug;
eval { `$command` };
}
}
@@ -473,7 +488,6 @@
}
undef $x;

- chomp( ( my $vtinfo ) = split( ' ', `which vtinfo 2>&1`, 1 ) );
if( -x "$vtinfo" ) {
chomp( my $tty = `$vtinfo` );
$tty =~ s#^/dev/tty## if( defined( $tty ) );
@@ -681,7 +695,6 @@
# TTY, so we need to clear it first...
if( -t CONSOLE ) {
my $doblank = TRUE;
- chomp( ( my $vtinfo ) = split( ' ', `which vtinfo 2>&1`, 1 )
);
if( -x "$vtinfo" ) {
chomp( my $tty = `$vtinfo` );
$tty =~ s#^/dev/tty## if( defined( $tty ) );
@@ -1001,17 +1014,28 @@
};

# Switch backlight state
-#
+# Sequence is LCD -> LCD&CRT -> CRT etc.
my $switchlightstate = sub {
`$click` if( defined( $click ) );

- chomp( my $state = `$blankscreen light` );
- warn "Output is $state\n" if( $debug );
- $state =~ s/^.* //;
- warn "State is \"$state\"\n" if( $debug );
+ chomp( my $lcd_state = `$radeontool light` );
+ warn "Output is $lcd_state\n" if( $debug );
+ $lcd_state =~ s/^.* //;
+ warn "LCD state is \"$lcd_state\"\n" if( $debug );
+
+ chomp( my $crt_state = `$radeontool dac` );
+ warn "Output is $crt_state\n" if( $debug );
+ $crt_state =~ s/^.* //;
+ warn "CRT state is \"$crt_state\"\n" if( $debug );
+
+ if($lcd_state eq "on"){
+ `$radeontool dac on` if( "off" eq $crt_state );
+ `$radeontool light off` if( "on" eq $crt_state );
+ }else{
+ `$radeontool light on`;
+ `$radeontool dac off` if( "on" eq $crt_state );
+ }

- `$blankscreen light off` if( "on" eq $state );
- `$blankscreen light on` if( "off" eq $state );
};

# Switch Bluetooth state
@@ -1032,9 +1056,7 @@
#
my $consolereturn = sub {
warn "\$consolereturn called...\n" if( $debug );
- chomp( ( my $vtinfo ) = split( ' ', `which vtinfo`, 1 ) );
if( -x "$vtinfo" ) {
- chomp( ( my $vtswitch ) = split( ' ', `which switchvt`, 1 ) );
if( -x "$vtswitch" ) {
if( defined( $lastvt ) ) {
# &{ $redrawbar };
@@ -1066,7 +1088,6 @@

`$click` if( defined( $click ) );

- chomp( ( my $vtinfo ) = split( ' ', `which vtinfo`, 1 ) );
if( -x "$vtinfo" ) {
chomp( $lastvt = `$vtinfo` );
$lastvt =~ s#^/dev/tty## if( defined( $lastvt ) );
@@ -1244,6 +1265,7 @@
$action{ 'F5' } = $brightnessup;
$action{ 'F6' } = $brightnessdown;
$action{ 'F7' } = $switchlightstate;
+$action{ 'F12' } = $suspend;
$action{ 'E' } = 'eject';
$action{ '1' } = $acpidown;
$action{ '2' } = $acpiup;










#!/usr/bin/perl -w
#
# sonyxosd
#
# Conceived and written by Stuart Shelton
#
# Many thanks go out to the Zeus Technology Global Services team, who
# helped greatly with suggestions of how to code certain functions more
# efficiently, and suggesting the use of SIGALRM to avoid having to fork
# repeatedly.
#
# Copyright (C) 2004 Stuart Shelton
#
# You may distribute this under the terms of the GPL version 2; the 
# complete license is available at http://www.gnu.org/licenses/gpl.txt
#
# Concept inspired by sonypidd by Craig DeForest
#
#  Releases:
#
#  August 22 2004  Nicolas Brouard (brouard at ined dot fr)
#  - All binaries are now declared in the "variables" section.
#  - The Fn F7 has now the standard sequence LCD -> LCD & CRT -> CRT
#

###############################################################################
# Additional Modules & Functions
###############################################################################

use strict;
use POSIX 'setsid';
use Fcntl ':flock';
use IO::Handle;

# X functions
use X11::Protocol;
use X::Osd;

# Console functions
use Term::Size 'chars';
use Term::ANSIScreen qw/:color :cursor :screen/;

###############################################################################
# Internal functions
###############################################################################

# IMHO, these make things much more readable...
#
sub TRUE  { 1 };
sub FALSE { 0 };

# When restoring the screen, how many lines of context should we check?
#
sub CONTEXT { 2 };

###############################################################################
# User-alterable variables
###############################################################################

# User-alterable values
#
#my $xtty	= 11;			# Which TTY does X use?
my $xtty	= 7;			# Use  7 On Mandrake
					# NB: Default is 7
my $multiline	= TRUE;			# Show all settings at once?
my $osdcolour	= 'Green';		# Colour for xOSD
my $barfilled	= 'blue on green';	# Colour for terminal bar
my $barempty	= 'green on blue';	# Colour for terminal bar
my $barmute	= 'bold red on black';	# Colour for terminal "M U T E" text
my $bartitle	= 'bold';		# Colour for terminal title text
my $barback	= 'black on black';	# Colour for terminal background
my $clearback	= 'black on black';	# Colour for terminal background, once cleared
my $alsa	= TRUE;			# Use amixer or aumix for sound control
my $debug	= FALSE;		# Print debug statements?

# Some miscellaneous variables collected here for convenience
#
my $name	= 'sonyxosd';

my $brightsteps	= int( 256 / 8 );
my $sonypid	= '/usr/sbin/sonypid';
my $spicctrl	= '/usr/sbin/spicctrl';
# my $click	= '/usr/bin/bplay /usr/share/sawfish/1.3/sounds/clicked.wav';
my $click	= undef;
my $suspend	= '/usr/bin/sudo /usr/local/sbin/hibernate';
my $radeontool	= '/usr/local/bin/radeontool';

my $vtinfo	= '/usr/bin/fgconsole';
my $vtswitch	= '/usr/bin/chvt';
my $amixer	= '/usr/bin/amixer';
my $aumix	= '/usr/bin/aumix';


###############################################################################
# Internal variables
###############################################################################

# Internal global variables
#
my $lastlevel;
my $muted;
my $lasttop;
my @linebuffer;
my $linebufferwidth;
my $lastvt = 1;
my $lastbarvt;
my $spidpid;
my $osd;
my $bounce = 0;

###############################################################################
# Helper subroutines
###############################################################################

# Interrupt handling - clean up the sonypid process before dying...
#
my $die = sub {
	if( defined( $spidpid ) ) {
		# Use a sigTERM - I don't like the idea of going around KILLing things
		my $signal = 15;
		kill( $signal, $spidpid );
	}
	exit 1;
};

# Daemonise(!)
#
sub daemonise {
	chdir '/' 				|| die "Can't chdir to /: $!";
	if( not( $debug ) ) {
		open( STDIN, '/dev/null' )	|| die "Can't read /dev/null: $!";
		open( STDOUT, '>/dev/null' )	|| die "Can't write to /dev/null: $!";
	}
	defined( my $pid = fork() )		|| die "Can't fork: $!";
	exit( 0 ) if( $pid );			   # Kill original parent
	POSIX::setsid()				|| die "Can't create new session: $!";
	if( not( $debug ) ) {
		open( STDERR, '>/dev/null' )	|| die "Can't dup STDOUT: $!";
	}
}

sub getacpiprocessorspeed {
	my %acpiinfo;

	if( `mount` =~ / on (.*) type sysfs \((r.)\)/ ) {
		my $mountpoint = $1;

		$acpiinfo{ sysfs } = TRUE;

		my $success = TRUE;
		if( not( open( CPU0freq, "$mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_available_frequencies" ) ) ) {
			warn "Cannot open $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_available_frequencies: $!\n" if $debug;
			$success = FALSE;
		}
		if( not( open( CPU0current, "$mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_cur_freq" ) ) ) {
			warn "Cannot open $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_cur_freq: $!\n" if $debug;
			$success = FALSE;
		}
		return( undef ) if( not( $success ) );

		my @speeds;
		my $numspeeds;
		my $reverse;
		if( defined( chomp( ( @speeds ) = split( /\s+/, <CPU0freq> ) ) ) ) {
			$numspeeds = ( scalar @speeds ) - 1;
			if( $speeds[ 0 ] > $speeds[ $numspeeds ] ) {
				$acpiinfo{ max } = $speeds[ 0 ];
				$acpiinfo{ min } = $speeds[ $numspeeds ];
				$reverse = FALSE;
			} else {
				$acpiinfo{ max } = $speeds[ $numspeeds ];
				$acpiinfo{ min } = $speeds[ 0 ];
				$reverse = TRUE;
			}
			$success = TRUE;
		} else {
			$success = FALSE;
		}

		close( CPU0freq );

		if( not( $success ) ) {
			close( CPU0current );
			return undef;
		}

		$success = FALSE;
		if( defined( chomp( my $currentspeed = <CPU0current> ) ) ) {
			$acpiinfo{ speed } = $acpiinfo{ limit } = $currentspeed;
			for( my $n = $numspeeds ; $n >= 0 ; $n-- ) {
				if( $speeds[ $n ] == $currentspeed ) {
					$success = TRUE;
					my $index;
					$index = "down";
					$index = "up" if( $reverse );
					if( $n < $numspeeds ) {
						$acpiinfo{ $index } = $speeds[ $n + 1 ];
					} else {
						$acpiinfo{ $index } = undef;
					}
					$index = "up";
					$index = "down" if( $reverse );
					if( $n > 0 ) {
						$acpiinfo{ $index } = $speeds[ $n - 1 ];
					} else {
						$acpiinfo{ $index } = undef;
					}
				}
			}
		}

		close( CPU0current );

		return undef if( not( $success ) );
	} else {
		# 2.4 Kernel (or sysfs not mounted)

		$acpiinfo{ sysfs } = FALSE;

		my $success = TRUE;
		if( not( open( CPU0perf, '/proc/acpi/processor/CPU0/performance' ) ) ) {
			warn "Cannot open /proc/acpi/processor/CPU0/performance: $!\n" if $debug;
			$success = FALSE;
		}
		if( $success && not( open( CPU0lim, '/proc/acpi/processor/CPU0/limit' ) ) ) {
			warn "Cannot open /proc/acpi/processor/CPU0/limit: $!\n" if $debug;
			$success = FALSE;
		}
		return( undef ) if( not( $success ) );

		# Format: "user limit:              P3:T0"
		$success = FALSE;
		while( my $data = <CPU0lim> ) {
			if( $data =~ m/^user limit\:[[:space:]]+P([0-9]+)\:T([0-9]+)$/ ) {
				$acpiinfo{ limit } = $1;
				$acpiinfo{ throttle } = $2;
				$success = TRUE;
			}
		}
		if( not( $success ) ) {
			warn "Unable to read CPU0 limit data\n" if $debug;
			return undef;
		}

		close( CPU0lim );

		# Format: "   *P3:                  1000 MHz, 13000 mW, 100 uS"
		while( my $data = <CPU0perf> ) {
			if( $data =~ m/^[[:space:]]+\*P([0-9]+):/ ) {
				if( $1 != $acpiinfo{ limit } ) {
					warn "Error: Read user limit " . $acpiinfo{ limit } . " but performance state " . $1 . "\n" if $debug;
				}
			}
			if( $data =~ m/^[[:space:]]+\*?P([0-9]+):/ ) {
				$acpiinfo{ min } = $1 if( not( defined( $acpiinfo{ min } ) ) || $1 > $acpiinfo{ min } );
				$acpiinfo{ max } = $1 if( not( defined( $acpiinfo{ max } ) ) || $1 < $acpiinfo{ max } );
			}
		}
		close( CPU0perf );

		# $acpiinfo{ min } = 255 if( not( defined( $acpiinfo{ min } ) ) );
		# $acpiinfo{ max } = 0 if( not( defined( $acpiinfo{ max } ) ) );
	}

	return( %acpiinfo );
}

sub setacpiprocessorspeed( $ ) {
	my ( $speed ) = @_;
	my $success = FALSE;

	if( `mount` =~ / on (.*) type sysfs \((r.)\)/ ) {
		my $mountpoint = $1;

		if( not( open( CPU0gov, "$mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_governor" ) ) ) {
			warn "Cannot open $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_governor: $!\n" if $debug;
		} else {
			if( <CPU0gov> !~ m/userspace/ ) {
				if( not( open( CPU0getgov, "$mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_available_governors" ) ) ) {
					warn "Cannot open $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_available_governors: $!\n" if $debug;
				} else {
					if( <CPU0getgov> =~ m/userspace/ ) {
						if( not( open( CPU0setgov, ">$mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_governor" ) ) ) {
							warn "Cannot open $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_governor: $!\n" if $debug;
						} else {
							if( not( flock( CPU0setgov, LOCK_EX ) ) ) {
								warn "Cannot flock $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_governor: $!\n" if $debug;
							} else {
								print CPU0setgov "userspace";
								flock( CPU0setgov, LOCK_UN );
								$success = TRUE;
							}
						}
						close( CPU0setgov );
					}
					close( CPU0getgov );
				}
			} else {
				$success = TRUE;
			}
			close( CPU0gov );
		}

		if( $success ) {
			$success = FALSE;

			if( not( open( CPU0speed, ">$mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_setspeed" ) ) ) {
				warn "Cannot open $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_setspeed: $!\n" if $debug;
			} else {
				if( not( flock( CPU0speed, LOCK_EX ) ) ) {
					warn "Cannot flock $mountpoint/devices/system/cpu/cpu0/cpufreq/scaling_setspeed: $!\n" if $debug;
				} else {
					print CPU0speed $speed;
					flock( CPU0speed, LOCK_UN );
					$success = TRUE;
				}
				close( CPU0speed );
			}
		}
	} else {
		if( not( open( CPU0lim, '>/proc/acpi/processor/CPU0/limit' ) ) ) {
			warn "Cannot open /proc/acpi/processor/CPU0/limit: $!\n" if $debug;
		} else {
			if( not( flock( CPU0lim, LOCK_EX ) ) ) {
				warn "Cannot flock /proc/acpi/processor/CPU0/limit: $!\n" if $debug;
			} else {
				print CPU0lim $speed;
				flock( CPU0lim, LOCK_UN );
				$success = TRUE;
			}
			close( CPU0lim );
		}
	}
	return $success;
}

sub sndctl {
	if( $alsa ) {
		return $amixer;
	} else {
		return $aumix;
	}
}

sub sndstate() {
	if( $alsa ) {
		my $command = sndctl() . " get Master";
		my $soundstats;
		eval { $soundstats = `$command` };
		if( defined( $soundstats ) ) {
			$soundstats =~ m/Playback channels: (.*) - (.*)/;
			my $c1 = $1;
			my $c2 = $2;
			$soundstats =~ m/$c1: Playback (.*) \[(.*)\%\] \[(.*)\]/;
			my $c1vol = $1;
			my $c1pc = $2;
			my $c1state = $3;
			$soundstats =~ m/$c2: Playback (.*) \[(.*)\%\] \[(.*)\]/;
			my $c2vol = $1;
			my $c2pc = $2;
			my $c2state = $3;
			my $soundlevel = int( ( $c1pc + $c2pc ) / 2 );
			return $soundlevel;
		} else {
			warn "ALSA returned error: $@\n" if $debug;
			return undef;
		}
	} else {
		my $command = sndctl() . " -v q";
		my $soundstats;
		eval { $soundstats = `$command` };
		if( not( defined( $@ ) ) ) {
			$soundstats =~ m/vol\s+(\d*),\s+(\d*),\s+\w*/;
			my $soundlevel = int( ( $1 + $2 ) / 2 );
			return $soundlevel;
		} else {
			warn "aumix returned error: $!\n" if $debug;
			return undef;
		}
	}
}

sub sndup {
	if( $alsa ) {
		my $volume = sndstate();
		if( defined( $volume ) ) {
			$volume += 10;
			$volume = 100 if $volume > 100;
			$volume = 0 if $volume < 0;
		} else {
			$volume = 10;
		}
		my $command = sndctl() . " set Master " . $volume . "%";
		eval { `$command` };
		$command = sndctl() . " set Master on";
		eval { `$command` };
	} else {
		my $volume = sndstate();
		$lastlevel = $volume if defined $volume;
		my $command = sndctl() . " -v +10";
		eval { `$command` };
	}
}

sub snddown {
	if( $alsa ) {
		my $volume = sndstate();
		if( defined( $volume ) ) {
			$volume -= 10;
			$volume = 100 if $volume > 100;
			$volume = 0 if $volume < 0;
		} else {
			$volume = 0;
		}
		my $command = sndctl() . " set Master " . $volume . "%";
		eval { `$command` };
		$command = sndctl() . " set Master on";
		eval { `$command` };
	} else {
		my $volume = sndstate();
		$lastlevel = $volume if defined $volume;
		my $command = sndctl() . " -v -10";
		eval { `$command` };
	}
}

sub sndmute {
	if( $alsa ) {
		$muted = TRUE;
		my $command = sndctl() . " set Master off";
		warn "ALSA command: $command\n" if $debug;
		eval { `$command` };
	} else {
		my $volume = sndstate();
		$lastlevel = $volume if defined $volume;
		my $command = sndctl() . " -v 0";
		warn "SOUND command: $command\n" if $debug;
		eval { `$command` };
	}
}

sub sndunmute {
	if( $alsa ) {
		$muted = FALSE;
		my $command = sndctl() . " set Master on";
		eval { `$command` };
	} else {
		$lastlevel = 10 if( not( defined( $lastlevel ) ) || $lastlevel < 0 );
		$lastlevel = 100 if $lastlevel > 100;
		my $command = sndctl() . " -v " . $lastlevel;
		eval { `$command` };
	}
}

###############################################################################
# OSD Drawing subroutines
###############################################################################

# Create $osd object if we can connect to X and it doesn't already exist
#
sub prepareosd {
	my $lines = 3;

	# If we're tunnelling over SSH, then we don't want to use X,
	# because it breaks things...
	my $xtarget = $ENV{ DISPLAY };
	if( defined( $xtarget ) ) {
		$xtarget =~ s/^.*://;
		$xtarget =~ s/\.[0-9]$//;
		$ENV{ DISPLAY } = undef if( $xtarget >= 10 );
	}

	# Yes, this *really is* all that we use X11::Protocol for...
	my $x;
	eval {
		$x = X11::Protocol -> new();
	};
	warn "X11 says \"$@\"\n" if( defined( $@ ) && $@ ne "" );
	if( defined( $x ) || defined( $@ ) ) {
		warn "Established X connection\n" if $debug;

		# Hardcoding DISPLAY 0 is broken and wrong, but works 99% of
		# the time...
		$ENV{ DISPLAY } = ':0.0';
	} else {
		warn "Cannot connect to X\n" if $debug;
		return FALSE;
	}
	undef $x;

	if( -x "$vtinfo" ) {
		chomp( my $tty = `$vtinfo` );
		$tty =~ s#^/dev/tty## if( defined( $tty ) );
		warn "Currently active TTY is VT$tty\n" if $debug;
		if( $tty != $xtty ) {
			# Active TTY is text-mode, so don't do anything with X
			# FIXME: If you're running X and VNC, but have a text-mode 
			#        (or, to be pedantic, fb-mode) console foremost,
			#        then using the function keys via VNC won't show an
			#        XOSD on the VNC client.
			#        If we did do this, then once X was running no
			#        further terminal interaction could occur, so the
			#        current situation is definitely best.
			#        And anyway, is it even possible to synthesize
			#        SonyPI events (remotely)?
			return FALSE;
		}
	} else {
		# Don't know where we are (sounds familiar :) so go ahead and try X anyway...
		warn "Cannot find vtinfo\n" if $debug;
	}

	if( not( defined( $osd ) ) ) {
		warn "Creating new xOSD\n" if $debug;

		if(     $osd = X::Osd	-> new( $lines ) ) {
			$osd		-> set_font( "-misc-fixed-*-r-normal-*-*-*-100-100-*-*-iso8859-15" );
			$osd		-> set_colour( $osdcolour );
			$osd		-> set_timeout( 5 );
			$osd		-> set_pos( XOSD_bottom );
			$osd		-> set_align( XOSD_center );
			$osd		-> set_vertical_offset( 25 );
			$osd		-> set_shadow_offset( 1 );
			warn "OSD initialised\n" if $debug;
			return TRUE;
		} else {
			warn "Cannot create OSD object: $!\n" if $debug;
			return FALSE;
		}
	} else {
		warn "OSD already exists\n" if $debug;
		return TRUE;
	}
}

sub osdstring($$$) {
	my ( $line, $text, $check ) = @_;

	if( defined( $check ) && $check ) {
		if( not( $osd -> is_onscreen() ) ) {
			$osd -> show();
		}
	}
	$osd -> string( $line, $text );
}

sub osdslider($$$) {
	my ( $line, $level, $check ) = @_;

	if( defined( $check ) && $check ) {
		if( not( $osd -> is_onscreen() ) ) {
			$osd -> show();
		}
	}
	$osd -> slider( $line, $level );
}

sub osdpercentage($$$) {
	my ( $line, $level, $check ) = @_;

	if( defined( $check ) && $check ) {
		if( not( $osd -> is_onscreen() ) ) {
			$osd -> show();
		}
	}
	$osd -> percentage( $line, $level );
}

# Erase term OSD bar after a period of time
#
my $redrawbar = sub {
	# Disable any pending sigALRM, so we don't get called twice...
	alarm( 0 );

	# Don't do anything unless fd CONSOLE is open on a terminal
	if( -t CONSOLE ) {
		# Build the string to use first, to minimise the work necessary
		# whilst CONSOLE is locked

		my $top = 1;
		if( not( defined( $lasttop ) ) ) {
			# Should *never* happen...
			warn "No value for \$lasttop in \$redrawbar\n" if( $debug );
			$top = 1;
		} else {
			$top = $lasttop;
		}
		my $bottom = $top + 3;

		flock( CONSOLE, LOCK_SH ) || warn "Cannot flock /dev/tty0: $!\n" if( $debug );

		( my $termwidth, my $termheight ) = chars( *CONSOLE{ IO } );

		flock( CONSOLE, LOCK_UN ) || warn "Cannot funlock /dev/tty0: $!\n" if( $debug );

		my $string = savepos() . setscroll( 1, $termheight ) . color( $clearback );
		for my $line ( $top .. $bottom ) {
			$string .= locate( $line, 1 ) . clline();
		}
		$string .= color( 'reset' ) . loadpos();

		flock( CONSOLE, LOCK_SH ) || warn "Cannot flock /dev/tty0: $!\n" if( $debug );

		print CONSOLE $string;

		flock( CONSOLE, LOCK_UN ) || warn "Cannot funlock /dev/tty0: $!\n" if( $debug );

		close( CONSOLE );
	}
};

# Draw a custom text-mode status bar
#
sub drawbar( $$$$$$$$$$$$$$ ) {
	# Okay - I admit it: This one's pretty awful...

	# Disable any pending sigALRM, so we don't call $redrawbar twice...
	alarm( 0 );

	# FIXME: Get rid of most (all?) of these damned positional paramters
	#        They're evil and make maintainance of this code painful
	#        I really should just pass a single data-structure containing
	#        the following data...

	# TODO:  Use /dev/vcs to read current screen contents, to be restored
	#        later if we haven't scrolled since blitzing the screen.
	#        Limitations:    We'll need 4 + context (at least 1) lines of
	#                        data to determine whether and what to restore.
	#        Considerations: Almost certainly a *huge gaping* security
	#                        vunerability.
	#                        We'd need to store a seperate set of lines for
	#                        every TTY.
	#        Problems:       /dev/vcs returns a single string for the entire
	#                        screen, so we'll need a / +$/\n/
	#                        Noooo! This ia a thinko - we actually want to
	#                        match /.{80}/ into a list...

	# NB:    Could use lots of "shift"s here (instead of "$_[ x ]" - but this
	#        would probably not ease maintainance...

	my $current	= int( $_[0] );		# Current value to show as a bar (line $top + 1)
	my $min		= int( $_[1] );		# Minimum possible value
	my $max		= int( $_[2] );		# Maximum possible value
	my $title	= $_[3];		# Title text (shown below the bar on line $top + 2)
	my $fullchar	= $_[4];		# Character to use for full bar segments
	my $emptychar	= $_[5];		# Character to use for empty bar segments
	my $fullansi	= $_[6];		# Colour codes, etc. for full bar segments
	my $emptyansi	= $_[7];		# Colour codes, etc. for empty bar segments
	my $titleansi	= $_[8];		# Colour codes, etc. for title
	my $extraansi	= $_[9];		# Colour codes, etc. for +/-
	my $side	= int( $_[10] );	# Number of characters to indent bar
	my $top		= int( $_[11] );	# Line on which to start drawing bar
	my $reverse	= $_[12];		# Swap -/+ on bar, to confuse everyone in the entire
						# world except me...
						# ...ok, including me...
						# ...but it *did* make sense when I did it! :)
	my $showbar	= $_[13];		# Draw bar, or just show a message?

	my $border	= TRUE;			# Blank out bar area
						# FIXME: Does this make sense? If we have no border,
						#        then how do we erase the bar afterwards?

	# So much as possible, protect programmers from themselves
	# (whereas I, of course, am perfect </heavy sarcasm> :)
	$top = 1 if( $top < 1 );
	$side = 0 if( $side < 0 );

	my $bottom = $top + 3;			# Almost an "ooh-err matron!" moment :)

	# Prepare output string first (as much as possible) to prevent flickering
	my $prestring = savepos();
	if( $border ) {
		# FIXME: Should we blank from $top - 1, or from line 1?
		#        Since there can be only 1 active scrolling region, it
		#        only seems sensible to clear out the entire screen above.
		#        (Even though this is *not* what happens right now :)

		# TODO:  New idea: Let the bar be at the bottom of the screen, and
		#        set the scrolling region above. Nice...

		$prestring .= color( $barback );
		for my $line ( $top .. $bottom ) {
			$prestring .= locate( $line, 1 ) . clline()
		}
		$prestring .= color( 'reset' )
	}
	$prestring .= locate( $top + 1, $side + 1 );

	# Nasty hack to ensure that we're not in the first lines of the screen...
	# FIXME: Can we sort it so that if there's a shell prompt within these lines,
	#        we get that redrawn too?
	my $poststring .= up( $bottom ) . down( $bottom );

	# If the fd CONSOLE is already valid, then we've still got an OSD on another
	# TTY, so we need to clear it first...
	if( -t CONSOLE ) {
		my $doblank = TRUE;
		if( -x "$vtinfo" ) {
			chomp( my $tty = `$vtinfo` );
			$tty =~ s#^/dev/tty## if( defined( $tty ) );
			if( defined( $lastbarvt ) && $tty == $lastbarvt ) {
				warn "Same VT - not blanking display\n" if( $debug );
				$doblank = FALSE;
			}
			$lastbarvt = $tty;
		}
		$redrawbar -> () if( $doblank );
	}

	# Open a fd to the current TTY
	open( CONSOLE, '>/dev/tty0' );
	# It took me ages to realise that *this* is why I wasn't getting all of my
	# output until I quit the program - D'oh!
	CONSOLE -> autoflush( 1 );
	flock( CONSOLE, LOCK_SH );

	( my $termwidth, my $termheight ) = chars( *CONSOLE{ IO } );

	flock( CONSOLE, LOCK_UN );

	my $string = "";
	if( $showbar ) {
		my $barlength = $termwidth - ( $side * 2 );
		my $length;

		# It *really* helps not to think about it too much...
		if( $reverse ) {
			$length = int( ( ( $current - $max ) / ( $min - $max ) ) * $barlength );
			for( 1 .. $length ) {
				$string .= colored( $emptychar, $emptyansi );
			}
			for( $length + 1 .. $barlength ) {
				$string .= colored( $fullchar, $fullansi );
			}
			$string .= locate( $top + 2, $side + 1 ) . colored( '+', $extraansi );
			$string .= locate( $top + 2, $termwidth - $side ) . colored( '-', $extraansi );
		} else {
			$length = int( ( ( $current - $min ) / ( $max - $min ) ) * $barlength );
			for( 1 .. $length ) {
				$string .= colored( $fullchar, $fullansi );
			}
			for( $length + 1 .. $barlength ) {
				$string .= colored( $emptychar, $emptyansi );
			}
			$string .= locate( $top + 2, $side + 1 ) . colored( '-', $extraansi );
			$string .= locate( $top + 2, $termwidth - $side ) . colored( '+', $extraansi );
		}
	}
	$string .= locate( $top + 2, int( ( $termwidth - length( $title ) ) / 2 ) );
	$string .= colored( $title, $titleansi ) . setscroll( $bottom + 1, $termheight) . loadpos();

	# We know exactly what we're going to do, so we can finally sent it all to the screen
	flock( CONSOLE, LOCK_SH );

	print CONSOLE $prestring . $string . $poststring;

	# Leave the CONSOLE fd open, but unlock it.
	# We'll need it later to erase the bar, even if the active VT changes
	flock( CONSOLE, LOCK_UN );

	# Now we're done, so we can save the latest $top value
	$lasttop = $top;

	# Do %SIG{ ALRM } in 5 seconds
	alarm( 5 );
}

sub showtext( $$$ ) {
	my ( $line, $text, $style ) = @_;

	if( prepareosd() ) {
		osdstring( $line, $text, TRUE );
	} else {
		drawbar( 0, 0, 0, $text, '', '', $barempty, $barfilled, $style, $bartitle, 2, 1, FALSE, FALSE );
	}
}

###############################################################################
# Display-Trigger subroutines
###############################################################################

# Show Mute status on OSD display
#
sub showmute {
	my $line = 0;

	if( prepareosd() ) {
		osdstring( $line, "M U T E", TRUE );
	} else {
		drawbar( 0, 0, 255, 'M U T E', ' ', ' ', $barempty, $barfilled, $barmute, 'black on black', 2, 1, FALSE, TRUE );
	}
}

# Show volume on OSD display
#
sub showvolume {
	my $line = 1;

	my $level = sndstate();

	if( prepareosd() ) {
		osdslider( $line, $level, TRUE );
	} else {
		drawbar( $level, 0, 100, 'Master Volume', '>', ' ', $barempty, $barfilled, $bartitle, $bartitle, 2, 1, FALSE, TRUE );
	}
}

# Show brightness on OSD display
#
sub showbrightness {
	my $line = 2;

	if( prepareosd() ) {
		my $level = int( ( `$spicctrl -B` / 255 ) * 100 );
		osdpercentage( $line, $level, TRUE );
	} else {
		drawbar( `$spicctrl -B`, 0, 255, 'LCD Backlight Setting', '<', ' ', $barempty, $barfilled, $bartitle, $bartitle, 2, 1, TRUE, TRUE );
	}
}

# Show all data
#
sub showall( $ ) {
	my ( $fallback ) = @_;

	if( prepareosd() ) {
		my $brightlevel = int( ( `$spicctrl -B` / 255 ) * 100 );
		my $soundlevel = sndstate();
		if(  ( 0 == $soundlevel && ! $alsa ) || $muted ) {
			osdstring( 0, "M U T E", TRUE );
		} else {
			# Clear previous messages
			osdstring( 0, "", TRUE );
		}
		osdslider( 1, $soundlevel, FALSE );
		osdpercentage( 2, $brightlevel, FALSE );
	} else {
		if( defined( $fallback ) ) {
			showvolume()		if( $fallback eq 'volume');
			showmute()		if( $fallback eq 'mute');
			showbrightness()	if( $fallback eq 'brightness');
		}
	}
}

###############################################################################
# Event subroutines
###############################################################################

# Increase volume
#
my $volumeup = sub {
	sndup();

	`$click` if( defined( $click ) );

	if( $alsa ) {
		if( $muted ) {
			if( $multiline ) {
				showall( 'mute' );
			} else {
				showmute();
			}
		} else {
			if( $multiline ) {
				showall( 'volume' );
			} else {
				showvolume();
			}
		}
	} else {
		if( $multiline ) {
			showall( 'volume' );
		} else {
			showvolume();
		}
	}
};

# Mute volume
#
my $mute = sub {
	if( $alsa ) {
		if( $muted ) {
			sndunmute();

			`$click` if( defined( $click ) );

			if( $multiline ) {
				showall( 'volume' );
			} else {
				showvolume();
			}
		} else {
			sndmute();

			if( $multiline ) {
				showall( 'mute' );
			} else {
				showmute();
			}
		}
	} else {
		my $soundlevel = sndstate();
		if( $soundlevel != 0 ) {
		        sndmute();
			if( $multiline ) {
				showall( 'mute' );
			} else {
				showmute();
			}
		} else {
			sndunmute();

			`$click` if( defined( $click ) );

			if( $multiline ) {
				showall( 'volume' );
			} else {
				showvolume();
			}
		}
	}
};

# Decrease volume
#
my $volumedown = sub {
	snddown();

	`$click` if( defined( $click ) );

	if( $alsa ) {
		if( $muted ) {
			if( $multiline ) {
				showall( 'mute' );
			} else {
				showmute();
			}
		} else {
			if( $multiline ) {
				showall( 'volume' );
			} else {
				showvolume();
			}
		}
	} else {
		my $soundlevel = sndstate();
		if( $soundlevel == 0 ) {
			if( $multiline ) {
				showall( 'mute' );
			} else {
				showmute();
			}
		} else {
			if( $multiline ) {
				showall( 'volume' );
			} else {
				showvolume();
			}
		}
	}
};

# Increase brightness
#
my $brightnessup = sub {
	`$click` if( defined( $click ) );

	my $level = `$spicctrl -B`;
	$level += $brightsteps;
	$level -= ( $level % $brightsteps );

	if( $level > 255 ) {
		$level = 255;
	} elsif( $level < 0 ) {
		$level = 0;
	}
	warn "Changing brightness to $level\n" if( $debug );
	`$spicctrl -b $level`;

	if( $multiline ) {
		showall( 'brightness' );
	} else {
		showbrightness();
	}
};

# Change brightness with OSD display
#
my $brightnessdown = sub {
	`$click` if( defined( $click ) );

	my $level = `$spicctrl -B`;

	$level = 256 if( $level == 255 );

	$level -= $brightsteps;
	$level -= ( $level % $brightsteps );

	if( $level > 255 ) {
		$level = 255;
	} elsif( $level < 0 ) {
		$level = 0;
	}
	warn "Changing brightness to $level\n" if( $debug );
	`$spicctrl -b $level`;

	if( $multiline ) {
		showall( 'brightness' );
	} else {
		showbrightness();
	}
};

# Switch backlight state
# Sequence is LCD -> LCD&CRT -> CRT etc.
my $switchlightstate = sub {
	`$click` if( defined( $click ) );

	chomp( my $lcd_state = `$radeontool light` );
	warn "Output is $lcd_state\n"  if( $debug );
	$lcd_state =~ s/^.* //;
	warn "LCD state is \"$lcd_state\"\n" if( $debug );

	chomp( my $crt_state = `$radeontool dac` );
	warn "Output is $crt_state\n"  if( $debug );
	$crt_state =~ s/^.* //;
	warn "CRT state is \"$crt_state\"\n" if( $debug );

	if($lcd_state eq "on"){
	`$radeontool dac on` if( "off" eq $crt_state );
	`$radeontool light off` if( "on" eq $crt_state );
        }else{
	  `$radeontool light on`;
	  `$radeontool dac off` if( "on" eq $crt_state );
	}

};

# Switch Bluetooth state
#
my $switchbtstate = sub {
	`$click` if( defined( $click ) );

	chomp( my $state = `$spicctrl -L` );

	`$spicctrl -l 1` if( 0 == $state );
	`$spicctrl -l 0` if( 1 == $state );
};

# Console return
#
# The concept here is that you hit a key, at which point you're switched to the
# last console where you previously hit said key...
#
my $consolereturn = sub {
	warn "\$consolereturn called...\n" if( $debug );
	if( -x "$vtinfo" ) {
		if( -x "$vtswitch" ) {
			if( defined( $lastvt ) ) {
				# &{ $redrawbar };
				$redrawbar -> ();
				# We came here from somewhere else...
				warn "About to run \"$vtswitch $lastvt\"\n" if $debug;
				chomp( my $currentvt = `$vtinfo` );
				$currentvt =~ s#/dev/tty## if( defined( $currentvt ) );
				`$vtswitch $lastvt`;
				$lastvt = $currentvt;
#			} else {
#				# Save this VT
#				chomp( $lastvt = `$vtinfo` );
#				$lastvt =~ s#/dev/tty## if( defined( $lastvt ) );
# #				if( $lastvt < $xtty ) {
					showtext( 0, "Primary Console saved", "bold" );
# #				}
			}
		} else {
			warn "Cannot find vtinfo\n" if $debug;
		}
	} else {
		warn "Cannot find vtinfo\n" if $debug;
	}
};

my $consolesave = sub {
	warn "\$consolesave called...\n" if( $debug );

	`$click` if( defined( $click ) );

	if( -x "$vtinfo" ) {
		chomp( $lastvt = `$vtinfo` );
		$lastvt =~ s#^/dev/tty## if( defined( $lastvt ) );
#		if( $lastvt < $xtty ) {
			showtext( 0, "Primary Console saved", "bold" );
#		}
	} else {
		warn "Cannot find vtinfo\n" if $debug;
	}
};

my $acpiup = sub {
	`$click` if( defined( $click ) );

	my $line = 0;
	my $level = 0;
	my %acpi = getacpiprocessorspeed();

	if( $acpi{ sysfs } ) {
		my $speed = $acpi{ speed };
		if( defined( $acpi{ up } ) ) {
			if( setacpiprocessorspeed( $acpi{ up } ) ) {
				$speed = $acpi{ up };
			}
		}
		if( defined( $acpi{ min } ) && defined( $acpi{ max } ) ) {
			if( prepareosd() ) {
				$level = int( ( ( $speed - $acpi{ min } ) / ( $acpi{ max } - $acpi{ min } ) ) * 100 ) ;
				osdpercentage( $line, $level, TRUE );
			} else {
				drawbar( $speed, $acpi{ min }, $acpi{ max }, 'Processor Speed', '>', ' ', $barempty, $barfilled, $bartitle, $bartitle, 2, 1, FALSE, TRUE );
			}
		}
	} else {
		if( defined( $acpi{ limit } ) && defined( $acpi{ throttle } ) && defined( $acpi{ min } ) && defined( $acpi{ max } ) ) {
			if( $acpi{ limit } > $acpi{ max } ) {
				my $speed = $acpi{ limit };
				$speed--;
				if( setacpiprocessorspeed( $speed . ":" . $acpi{ throttle } ) ) {
					$level = int( 100 - ( ( $speed / ( $acpi{ min } - $acpi{ max } ) ) * 100 ) );
				}
			} else {
				$level = int( 100 - ( ( $acpi{ limit } / ( $acpi{ min } - $acpi{ max } ) ) * 100 ) );
			}
			if( prepareosd() ) {
				osdpercentage( $line, $level, TRUE );
			} else {
				drawbar( $level, 0, 100, 'Processor Speed', '>', ' ', $barempty, $barfilled, $bartitle, $bartitle, 2, 1, FALSE, TRUE );
			}
		}
	}
};

my $acpidown = sub {
	`$click` if( defined( $click ) );

	my $line = 0;
	my $level = 0;
	my %acpi = getacpiprocessorspeed();

	if( $acpi{ sysfs } ) {
		my $speed = $acpi{ speed };
		if( defined( $acpi{ down } ) ) {
			if( setacpiprocessorspeed( $acpi{ down } ) ) {
				$speed = $acpi{ down };
			}
		}
		if( defined( $acpi{ min } ) && defined( $acpi{ max } ) ) {
			if( prepareosd() ) {
				$level = int( ( ( $speed - $acpi{ min } ) / ( $acpi{ max } - $acpi{ min } ) ) * 100 );
				osdpercentage( $line, $level, TRUE );
			} else {
				drawbar( $speed, $acpi{ min }, $acpi{ max }, 'Processor Speed', '>', ' ', $barempty, $barfilled, $bartitle, $bartitle, 2, 1, FALSE, TRUE );
			}
		}
	} else {
		if( defined( $acpi{ limit } ) && defined( $acpi{ throttle } ) && defined( $acpi{ min } ) && defined( $acpi{ max } ) ) {
			if( $acpi{ limit } < $acpi{ min } ) {
				my $speed = $acpi{ limit };
				$speed++;
				if( setacpiprocessorspeed( $speed . ":" . $acpi{ throttle } ) ) {
					$level = int( 100 - ( ( $speed / ( $acpi{ min } - $acpi{ max } ) ) * 100 ) );
				}
			} else {
				$level = int( 100 - ( ( $acpi{ limit } / ( $acpi{ min } - $acpi{ max } ) ) * 100 ) );
			}
			if( prepareosd() ) {
				osdpercentage( $line, $level, TRUE );
			} else {
				drawbar( $level, 0, 100, 'Processor Speed', '>', ' ', $barempty, $barfilled, $bartitle, $bartitle, 2, 1, FALSE, TRUE );
			}
		}
	}
};

my $debounce = sub {
	my ( $sub ) = @_;

	if( ( 0 == $bounce ) || not( defined( $bounce ) ) ) {
		$bounce = 1;
		$sub -> ();
	} else {
		$bounce = 0;
	}
};

###############################################################################
# Initialise
###############################################################################

warn "$name now starting - any output from here-on in is due to warns\n" if $debug;

# Daemon stuff - check the lockfile and daemonise
# 
if( open( FILE, "</var/run/$name.pid" ) ) {
	chomp( my $currentpid = <FILE> );
	my @processes = `ps -e`;
	my @found = grep( /^\s*$currentpid\s/o && /$name/, @processes );
	if( @found ) {
		print STDERR "$name is already running (PID $currentpid)\n";
		exit( 1 );
	}
}
daemonise();
open( FILE, ">/var/run/$name.pid" || die "Couldn't open lock file: $!\n" );
print FILE $$, "\n";
close( FILE );

# Open a sonypid process to read the sonypi device
#
pipe( READ, WRITE );
$spidpid = fork();
$| = 1;
if( not( $spidpid ) ) {
	close( READ );
	open( STDERR, ">&WRITE" );
	open( STDOUT, ">&WRITE" );
	# We don't want sonypid trying to pass input events to X, even if it is running...
	$ENV{ DISPLAY } = undef if( defined( $ENV{ DISPLAY } ) );
	exec( $sonypid );
	die;
}
close( WRITE );

$SIG{ HUP } = $SIG{ INT } = $SIG{ QUIT } = $SIG{ TERM } = $die;
$SIG{ ALRM } = sub { $redrawbar -> (); };

# if( $debug ) {
#	warn "DISPLAY is $ENV{ DISPLAY }\n" if( defined( $ENV{ DISPLAY } ) );
# }

###############################################################################
# Main Event Loop
###############################################################################

$lastlevel = sndstate();
sndunmute();

# Define actions for given keypress, as shell command or
# sub-routine reference.
#
# Valid keys: Esc, F1 - F12, B, D, E, F, S, 1, 2, P1, Any.
#
# NB: "P2" key generates a "P1" event.  "P1" and "P2" generate an event on
#     press and on release, so need to be de-bounced... :(
#     "Any" is produced when any hardware button is used: $state will be
#     "pressed" or "released".
#
my %action;
$action{ 'Esc' } = $consolereturn;
$action{  'F1' } = $consolesave;
$action{  'F2' } = $volumedown;
$action{  'F3' } = $mute;
$action{  'F4' } = $volumeup;
$action{  'F5' } = $brightnessup;
$action{  'F6' } = $brightnessdown;
$action{  'F7' } = $switchlightstate;
$action{  'F12' } = $suspend;
$action{   'E' } = 'eject';
$action{   '1' } = $acpidown;
$action{   '2' } = $acpiup;
$action{  'P1' } = sub{ $debounce -> ( $switchbtstate ) };

# Wait for function-key events, and take appropriate action
# Quit if sonypid dies.
#
while( defined( my $input = <READ> ) ) {
	my @output = split( m/\s+/, $input );

	if( ( $output[ 1 ] =~ m/^Fn-(F\d+|\w|1|2|Esc)$/ )
	 || ( $output[ 1 ] =~ m/^(P\d)$/ )
	 || ( $input       =~ m/^Event: (\w+) button (\w+)$/ )
	) {
		my $event = $1;
		my $state = $2;

		if( $debug ) {
			if( defined( $state ) ) {
				warn "Detected $event $state\n";
			} else {
				warn "Detected $event\n"
			}
		}

		if( defined( $action{ $event } ) ) {
			if( ref( $action{ $event } ) eq 'CODE' ) {
				$action{ $event } -> ();
			} else {
				warn "\$action\{ $event \} is \"" . $action{ $event } . "\"\n" if( $debug );
				warn "ref is \"" . ref( $action{ $event } ) . "\"\n" if( $debug );
				`$action{ $event }`;
			}
		} else {
			warn "No action for event \"$event\"\n" if( $debug );
		}
	} else {
		chomp $input;
		warn "Unknown input sequence \"$input\"\n" if( $debug );
	}
}
exit 0;

###############################################################################
# EOF - Move along now folks; nothing to see here.
###############################################################################

Archive powered by MHonArc 2.6.18.

Top of Page