Move all state into the state tracker. Reduce tracking to a single loop. Increase internal delays in clients.

Next we should move the common code to a library, but this is a good start.

dmx/fan.pl

@@ -1,8 +1,8 @@
 #!/usr/bin/perl
 use strict;
 use warnings;
-use IO::Socket;
-use Time::HiRes qw( usleep );
+use IO::Select;
+use IO::Socket::UNIX;
 use File::Temp qw( tempfile );
 
 # Prototypes
@@ -23,8 +23,12 @@ my $SOCK_TIMEOUT = 5;
 my $TEMP_DIR     = `getconf DARWIN_USER_TEMP_DIR`;
 chomp($TEMP_DIR);
 my $DATA_DIR     = $TEMP_DIR . 'plexMonitor/';
-my $CMD_FILE     = $DATA_DIR . 'DMX.socket';
+my $DMX_SOCK     = $DATA_DIR . 'DMX.socket';
+my $SUB_SOCK     = $DATA_DIR . 'STATE.socket';
+my $STATE_SOCK   = $DATA_DIR . 'ROPE.socket';
+my $MAX_CMD_LEN  = 1024;
 my $PUSH_TIMEOUT = 20;
+my $PULL_TIMEOUT = $PUSH_TIMEOUT * 3;
 
 # Debug
 my $DEBUG = 0;
@@ -35,28 +39,49 @@ if ($ENV{'DEBUG'}) {
 # Command-line arguments
 my ($DELAY) = @ARGV;
 if (!$DELAY) {
-	$DELAY = 0.5;
+	$DELAY = $PULL_TIMEOUT / 2;
 }
-$DELAY *= 1000000;    # Microseconds;
 
 # Sanity check
-if (!-d $DATA_DIR || !-S $CMD_FILE) {
+if (!-d $DATA_DIR || !-S $DMX_SOCK || !-S $SUB_SOCK) {
 	die("Bad config\n");
 }
 
-# Socket init
-my $sock = IO::Socket::UNIX->new(
-	'Peer'    => $CMD_FILE,
+# State socket init
+if (-e $STATE_SOCK) {
+	unlink($STATE_SOCK);
+}
+my $state_fh = IO::Socket::UNIX->new(
+	'Local' => $STATE_SOCK,
+	'Type'  => SOCK_DGRAM
+) or die('Unable to open socket: ' . $STATE_SOCK . ": ${@}\n");
+my $select = IO::Select->new($state_fh)
+  or die('Unable to select socket: ' . $STATE_SOCK . ": ${!}\n");
+
+# DMX socket init
+my $dmx_fh = IO::Socket::UNIX->new(
+	'Peer'    => $DMX_SOCK,
 	'Type'    => SOCK_DGRAM,
 	'Timeout' => $SOCK_TIMEOUT
-) or die('Unable to open socket: ' . $CMD_FILE . ": ${@}\n");
+) or die('Unable to open socket: ' . $DMX_SOCK . ": ${@}\n");
+
+# Subscribe to state updates
+my $sub_fh = IO::Socket::UNIX->new(
+	'Peer'    => $SUB_SOCK,
+	'Type'    => SOCK_DGRAM,
+	'Timeout' => $SOCK_TIMEOUT
+) or die('Unable to open socket: ' . $SUB_SOCK . ": ${@}\n");
+$sub_fh->send($STATE_SOCK)
+  or die('Unable to subscribe: ' . $! . "\n");
+shutdown($sub_fh, 2);
+undef($sub_fh);
 
 # State
 my $state     = 'INIT';
 my $stateLast = $state;
-my $fan       = 0;
-my $projector = 0;
+my %exists    = ();
 my $pushLast  = 0;
+my $pullLast  = time();
 
 # Always force lights out at launch
 dim({ 'channel' => 11, 'value' => 0, 'time' => 0 });
@@ -67,47 +92,52 @@ while (1) {
 	# Set anywhere to force an update this cycle
 	my $forceUpdate = 0;
 
-	# Monitor the PROJECTOR file for state
-	{
-		$projector = 0;
-		my $fh;
-		open($fh, $DATA_DIR . 'PROJECTOR')
-		  or die("Unable to open PROJECTOR\n");
-		my $text = <$fh>;
-		close($fh);
-		if ($text =~ /1/) {
-			$projector = 1;
-		}
-		if ($DEBUG) {
-			print STDERR 'Projector: ' . $projector . "\n";
-		}
-	}
+	# State is calculated; use newState to gather data
+	my $newState = $state;
 
-	# Monitor the FAN_CMD file for presence
-	{
+	# Wait for state updates
+	my @ready_clients = $select->can_read($DELAY);
+	foreach my $fh (@ready_clients) {
 
-		# Clear the flag when the projector is off
-		if ($fan && !$projector) {
-			unlink($DATA_DIR . 'FAN_CMD');
-		}
+		# Grab the inbound text
+		my $text = undef();
+		$fh->recv($text, $MAX_CMD_LEN);
 
-		$fan = 0;
-		if (-e $DATA_DIR . 'FAN_CMD') {
-			$fan = 1;
+		# Parse the string
+		%exists = ();
+		my ($cmdState, $exists_text) = $text =~ /^(\w+)\s+\(([^\)]+)\)/;
+		if (!defined($cmdState) || !defined($exists_text)) {
+			print STDERR 'State parse error: ' . $text . "\n";
+			next;
+		}
+		foreach my $exists (split(/\s*,\s*/, $exists_text)) {
+			my ($name, $value) = $exists =~ /(\w+)\:(0|1)/;
+			if (!defined($name) || !defined($value)) {
+				print STDERR 'State parse error (exists): ' . $text . "\n";
+				next;
+			}
+			$exists{$name} = $value;
 		}
 		if ($DEBUG) {
-			print STDERR 'Fan: ' . $fan . "\n";
+			my @exists_tmp = ();
+			foreach my $key (keys(%exists)) {
+				push(@exists_tmp, $key . ':' . $exists{$key});
+			}
+			print STDERR 'Got state: ' . $cmdState . ' (' . join(', ', @exists_tmp) . ")\n";
 		}
+
+		# We don't really care about the master state for the fan
+		# But we have to parse the exists records, so we might as well grab it
+
+		# Propogate the most recent command state
+		$newState = $cmdState;
+		$pullLast = time();
 	}
 
 	# Calculate the new state
 	$stateLast = $state;
-	if ($fan) {
-		if ($projector) {
-			$state = 'ON';
-		} else {
-			$state = 'OFF';
-		}
+	if ($exists{'FAN_CMD'}) {
+		$state = 'ON';
 	} else {
 		$state = 'OFF';
 	}
@@ -120,6 +150,11 @@ while (1) {
 		$forceUpdate = 1;
 	}
 
+	# Die if we don't see regular updates
+	if (time() - $pullLast > $PULL_TIMEOUT) {
+		die('No update on state socket in past ' . $PULL_TIMEOUT . " seconds. Exiting...\n");
+	}
+
 	# Update the fan state
 	if ($forceUpdate || $stateLast ne $state) {
 		if ($DEBUG) {
@@ -145,9 +180,6 @@ while (1) {
 		# Update the push time
 		$pushLast = time();
 	}
-
-	# Wait and loop
-	usleep($DELAY);
 }
 
 # Send the command
@@ -161,6 +193,6 @@ sub dim($) {
 	}
 
 	my $cmd = join(':', $args->{'channel'}, $args->{'time'}, $args->{'value'}, $args->{'delay'});
-	$sock->send($cmd)
-	  or die('Unable to write command to socket: ' . $CMD_FILE . ': ' . $cmd . ": ${!}\n");
+	$dmx_fh->send($cmd)
+	  or die('Unable to write command to socket: ' . $DMX_SOCK . ': ' . $cmd . ": ${!}\n");
 }

dmx/launchd/com.uberzach.ola.fan.plist

@@ -25,7 +25,6 @@
 	<key>ProgramArguments</key>
 	<array>
 		<string>/Users/tv/bin/video/dmx/fan.pl</string>
-		<string>0.5</string>
 	</array>
 </dict>
 </plist>

dmx/launchd/com.uberzach.ola.leds.plist

@@ -25,7 +25,6 @@
 	<key>ProgramArguments</key>
 	<array>
 		<string>/Users/tv/bin/video/dmx/leds.pl</string>
-		<string>0.25</string>
 	</array>
 </dict>
 </plist>

dmx/launchd/com.uberzach.ola.rope.plist

@@ -25,7 +25,6 @@
 	<key>ProgramArguments</key>
 	<array>
 		<string>/Users/tv/bin/video/dmx/rope.pl</string>
-		<string>0.25</string>
 	</array>
 </dict>
 </plist>

dmx/leds.pl

@@ -6,7 +6,6 @@ use IO::Socket::UNIX;
 use File::Temp qw( tempfile );
 
 # Prototypes
-sub mtime($);
 sub dim($);
 
 # User config
@@ -57,7 +56,7 @@ if ($ENV{'DEBUG'}) {
 # Command-line arguments
 my ($DELAY) = @ARGV;
 if (!$DELAY) {
-	$DELAY = 0.5;
+	$DELAY = $PULL_TIMEOUT / 2;
 }
 
 # Sanity check
@@ -97,8 +96,7 @@ undef($sub_fh);
 # State
 my $state      = 'INIT';
 my $stateLast  = $state;
-my $lights     = 0;
-my $updateLast = 0;
+my %exists     = ();
 my $pushLast   = 0;
 my $pullLast   = time();
 
@@ -121,12 +119,30 @@ while (1) {
 	foreach my $fh (@ready_clients) {
 
 		# Grab the inbound text
-		my $cmdState = undef();
-		$fh->recv($cmdState, $MAX_CMD_LEN);
-		$cmdState =~ s/^\s+//;
-		$cmdState =~ s/\s+$//;
+		my $text = undef();
+		$fh->recv($text, $MAX_CMD_LEN);
+
+		# Parse the string   
+		%exists = ();
+		my ($cmdState, $exists_text) = $text =~ /^(\w+)\s+\(([^\)]+)\)/;
+		if (!defined($cmdState) || !defined($exists_text)) {
+			print STDERR 'State parse error: ' . $text . "\n";
+			next;    
+		}
+		foreach my $exists (split(/\s*,\s*/, $exists_text)) {
+			my ($name, $value) = $exists =~ /(\w+)\:(0|1)/;
+			if (!defined($name) || !defined($value)) {
+				print STDERR 'State parse error (exists): ' . $text . "\n";
+				next;
+			}
+			$exists{$name} = $value;
+		}
 		if ($DEBUG) {
-			print STDERR 'Got state: ' . $cmdState . "\n";
+			my @exists_tmp = ();
+			foreach my $key (keys(%exists)) {
+				push(@exists_tmp, $key . ':' . $exists{$key});
+			}
+			print STDERR 'Got state: ' . $cmdState . ' (' . join(', ', @exists_tmp) . ")\n";
 		}
 
 		# Translate INIT to OFF
@@ -145,25 +161,9 @@ while (1) {
 		$pullLast = time();
 	}
 
-	# Monitor the LIGHTS file for presence
-	{
-		$lights = 0;
-		if (-e $DATA_DIR . 'LIGHTS') {
-			$lights = 1;
-		}
-		if ($DEBUG) {
-			print STDERR 'Lights: ' . $lights . "\n";
-		}
-
-		# Clear the override when the main state is "OFF"
-		if ($lights && $newState eq 'OFF') {
-			unlink($DATA_DIR . 'LIGHTS');
-		}
-	}
-
 	# Calculate the new state
 	$stateLast = $state;
-	if ($lights) {
+	if ($exists{'LIGHTS'}) {
 		if ($newState eq 'PLAY') {
 			$newState = 'PLAY_HIGH';
 		}
@@ -178,6 +178,8 @@ while (1) {
 	if (time() - $pullLast > $PUSH_TIMEOUT) {
 		$forceUpdate = 1;
 	}
+
+	# Die if we don't see regular updates
 	if (time() - $pullLast > $PULL_TIMEOUT) {
 		die('No update on state socket in past ' . $PULL_TIMEOUT . " seconds. Exiting...\n");
 	}
@@ -209,15 +211,6 @@ while (1) {
 	}
 }
 
-sub mtime($) {
-	my ($file) = @_;
-	my $mtime = 0;
-	if (-r $file) {
-		(undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), $mtime, undef(), undef(), undef()) = stat($file);
-	}
-	return $mtime;
-}
-
 # Send the command
 sub dim($) {
 	my ($args) = @_;

dmx/rope.pl

@@ -6,7 +6,6 @@ use IO::Socket::UNIX;
 use File::Temp qw( tempfile );
 
 # Prototypes
-sub mtime($);
 sub dim($);
 
 # User config
@@ -85,7 +84,7 @@ if ($ENV{'DEBUG'}) {
 # Command-line arguments
 my ($DELAY) = @ARGV;
 if (!$DELAY) {
-	$DELAY = 0.5;
+	$DELAY = $PULL_TIMEOUT / 2;
 }
 
 # Sanity check
@@ -125,8 +124,7 @@ undef($sub_fh);
 # State
 my $state      = 'INIT';
 my $stateLast  = $state;
-my $lights     = 0;
-my $updateLast = 0;
+my %exists     = ();
 my $pushLast   = 0;
 my $pullLast   = time();
 
@@ -147,12 +145,30 @@ while (1) {
 	foreach my $fh (@ready_clients) {
 
 		# Grab the inbound text
-		my $cmdState = undef();
-		$fh->recv($cmdState, $MAX_CMD_LEN);
-		$cmdState =~ s/^\s+//;
-		$cmdState =~ s/\s+$//;
+		my $text = undef();
+		$fh->recv($text, $MAX_CMD_LEN);
+
+		# Parse the string
+		%exists = ();
+		my ($cmdState, $exists_text) = $text =~ /^(\w+)\s+\(([^\)]+)\)/;
+		if (!defined($cmdState) || !defined($exists_text)) {
+			print STDERR 'State parse error: ' . $text . "\n";
+			next;
+		}
+		foreach my $exists (split(/\s*,\s*/, $exists_text)) {
+			my ($name, $value) = $exists =~ /(\w+)\:(0|1)/;
+			if (!defined($name) || !defined($value)) {
+				print STDERR 'State parse error (exists): ' . $text . "\n";
+				next;
+			}
+			$exists{$name} = $value;
+		}
 		if ($DEBUG) {
-			print STDERR 'Got state: ' . $cmdState . "\n";
+			my @exists_tmp = ();
+			foreach my $key (keys(%exists)) {
+				push(@exists_tmp, $key . ':' . $exists{$key});
+			}
+			print STDERR 'Got state: ' . $cmdState . ' (' . join(', ', @exists_tmp) . ")\n";
 		}
 
 		# Translate INIT to OFF
@@ -171,25 +187,9 @@ while (1) {
 		$pullLast = time();
 	}
 
-	# Monitor the LIGHTS file for presence
-	{
-		$lights = 0;
-		if (-e $DATA_DIR . 'LIGHTS') {
-			$lights = 1;
-		}
-		if ($DEBUG) {
-			print STDERR 'Lights: ' . $lights . "\n";
-		}
-
-		# Clear the override when the main state is "OFF"
-		if ($lights && $newState eq 'OFF') {
-			unlink($DATA_DIR . 'LIGHTS');
-		}
-	}
-
 	# Calculate the new state
 	$stateLast = $state;
-	if ($lights) {
+	if ($exists{'LIGHTS'}) {
 		if ($newState eq 'PLAY') {
 			$newState = 'PLAY_HIGH';
 		}
@@ -204,6 +204,8 @@ while (1) {
 	if (time() - $pushLast > $PUSH_TIMEOUT) {
 		$forceUpdate = 1;
 	}
+
+	# Die if we don't see regular updates
 	if (time() - $pullLast > $PULL_TIMEOUT) {
 		die('No update on state socket in past ' . $PULL_TIMEOUT . " seconds. Exiting...\n");
 	}
@@ -235,15 +237,6 @@ while (1) {
 	}
 }
 
-sub mtime($) {
-	my ($file) = @_;
-	my $mtime = 0;
-	if (-r $file) {
-		(undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), $mtime, undef(), undef(), undef()) = stat($file);
-	}
-	return $mtime;
-}
-
 # Send the command
 sub dim($) {
 	my ($args) = @_;

dmx/state.pl

@@ -20,6 +20,15 @@ my $CMD_FILE     = $DATA_DIR . 'STATE.socket';
 my $MAX_CMD_LEN  = 4096;
 my $RESET_CMD    = $ENV{'HOME'} . '/bin/video/dmx/reset.sh';
 my $PUSH_TIMEOUT = 20;
+my %MON_FILES    = (
+	'PLAYING'     => 'MTIME',
+	'GUI'         => 'MTIME',
+	'MOTION'      => 'MTIME',
+	'PROJECTOR'   => 'STATUS',
+	'PLAY_STATUS' => 'STATUS',
+	'LIGHTS'      => 'EXISTS',
+	'FAN_CMD'     => 'EXISTS',
+);
 
 # Debug
 my $DEBUG = 0;
@@ -62,10 +71,23 @@ my @subscribers = ();
 my $state      = 'INIT';
 my $stateLast  = $state;
 my $playing    = 0;
-my $projector  = 0;
 my $updateLast = 0;
 my $pushLast   = 0;
 
+# Init the file tracking structure
+my %files = ();
+foreach my $file (keys(%MON_FILES)) {
+	my %tmp = (
+		'name'   => $file,
+		'type'   => $MON_FILES{$file},
+		'path'   => $DATA_DIR . $file,
+		'update' => 0,
+		'status' => 0,
+		'last'   => 0,
+	);
+	$files{$file} = \%tmp;
+}
+
 # Loop forever
 while (1) {
 
@@ -113,72 +135,59 @@ while (1) {
 		$forceUpdate = 1;
 	}
 
-	# Monitor the PLAY_STATUS file for changes and state
-	{
-		my $mtime = mtime($DATA_DIR . 'PLAY_STATUS');
-		if ($mtime > $updateLast) {
-			$updateLast = $mtime;
+	# Monitor files of all types
+	foreach my $file (values(%files)) {
+		# Always record the previous status and clear the new one
+		$file->{'last'} = $file->{'status'};
+		$file->{'status'} = 0;
+
+		# Record the last update
+		if ($file->{'type'} eq 'STATUS' || $file->{'type'} eq 'MTIME') {
+			$file->{'update'} = mtime($file->{'path'});
+			if ($DEBUG) {
+				print STDERR 'Last change: ' . $file->{'name'} . ': ' . localtime($file->{'update'}) . "\n";
+			}
 		}
 
-		# Grab the PLAY_STATUS value
-		$playing = 0;
-		my $fh;
-		open($fh, $DATA_DIR . 'PLAY_STATUS')
-		  or die("Unable to open PLAY_STATUS\n");
-		my $text = <$fh>;
-		close($fh);
-		if ($text =~ /1/) {
-			$playing = 1;
-		}
-		if ($DEBUG) {
-			print STDERR 'Playing: ' . $playing . "\n";
-		}
-	}
-
-	# Monitor the PROJECTOR file for changes and state
-	{
-		my $mtime = mtime($DATA_DIR . 'PROJECTOR');
-		if ($mtime > $updateLast) {
-			$updateLast = $mtime;
+		# Grab the new status and save the old one
+		if ($file->{'type'} eq 'STATUS') {
+			my $fh;
+			open($fh, $file->{'path'})
+			  or die('Unable to open ' . $file->{'path'} . "\n");
+			my $text = <$fh>;
+			close($fh);
+			if ($text =~ /1/) {
+				$file->{'status'} = 1;
+			}
+			if ($DEBUG) {
+				print STDERR 'Status: ' . $file->{'name'} . ': ' . $file->{'status'} . "\n";
+			}
 		}
 
-		# Grab the PROJECTOR value
-		$projector = 0;
-		my $fh;
-		open($fh, $DATA_DIR . 'PROJECTOR')
-		  or die("Unable to open PROJECTOR\n");
-		my $text = <$fh>;
-		close($fh);
-		if ($text =~ /1/) {
-			$projector = 1;
-		}
-		if ($DEBUG) {
-			print STDERR 'Projector: ' . $projector . "\n";
+		# Check for the presence of a file
+		if ($file->{'type'} eq 'EXISTS') {
+			if (-e $file->{'path'}) {
+				$file->{'status'} = 1;
+			}
+			if ($DEBUG) {
+				print STDERR 'Exists: ' . $file->{'name'} . ': ' . $file->{'status'} . "\n";
+			}
 		}
 	}
 
-	# Monitor the GUI, PLAYING, and MOTION files for changes only
-	{
-		my $mtime = mtime($DATA_DIR . 'PLAYING');
-		if ($mtime > $updateLast) {
-			$updateLast = $mtime;
-		}
-		$mtime = mtime($DATA_DIR . 'GUI');
-		if ($mtime > $updateLast) {
-			$updateLast = $mtime;
-		}
-		$mtime = mtime($DATA_DIR . 'MOTION');
-		if ($mtime > $updateLast) {
-			$updateLast = $mtime;
+	# Set the global update timestamp
+	foreach my $file (values(%files)) {
+		if ($file->{'update'} > $updateLast) {
+			$updateLast = $file->{'update'};
 		}
 	}
 
 	# Calculate the new state
 	$stateLast = $state;
-	if ($projector) {
+	if ($files{'PROJECTOR'}->{'status'}) {
 
 		# We are always either playing or paused if the projector is on
-		if ($playing) {
+		if ($files{'PLAY_STATUS'}->{'status'}) {
 			$state = 'PLAY';
 		} else {
 			$state = 'PAUSE';
@@ -198,13 +207,43 @@ while (1) {
 		$state = 'OFF';
 	}
 
+	# Clear exists files when the main state is "OFF"
+	foreach my $file (values(%files)) {
+		if ($file->{'type'} eq 'EXISTS' && $file->{'status'} && $state eq 'OFF') {
+			unlink($file->{'path'});
+			$file->{'stauts'} = 0;
+			if ($DEBUG) {
+				print STDERR 'Clearing exists flag for: ' . $file->{'name'} . "\n";
+			}
+		}
+	}
+
+	# Append the status of all "exists" files
+	{
+		my @exists = ();
+		foreach my $file (values(%files)) {
+			if ($file->{'type'} eq 'EXISTS') {
+				push(@exists, $file->{'name'} . ':' . $file->{'status'});
+			}
+		}
+		$state .= ' (' . join(', ', @exists) . ')';
+	}
+
 	# Force updates on a periodic basis
 	if (time() - $pushLast > $PUSH_TIMEOUT) {
 		$forceUpdate = 1;
 	}
 
+	# Update on any status change
+	foreach my $file (values(%files)) {
+		if ($file->{'status'} != $file->{'last'}) {
+			$forceUpdate = 1;
+			last;
+		}
+	}
+
 	# Update the state
-	if ($forceUpdate || $stateLast ne $state) {
+	if ($forceUpdate || $state ne $stateLast) {
 		if ($DEBUG) {
 			print STDERR 'State: ' . $stateLast . ' => ' . $state . "\n";
 		}