state.pl 8.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use IO::Select;
  5. use IO::Socket::UNIX;
  6. use File::Basename;
  7. use File::Temp qw( tempfile );
  8. # Local modules
  9. use Cwd qw(abs_path);
  10. use File::Basename qw(dirname);
  11. use lib dirname(abs_path($0));
  12. use DMX;
  13. # Prototypes
  14. sub mtime($);
  15. # User config
  16. my $STATE_TIMEOUT = 180;
  17. my $MEDIA_PATH = `~/bin/video/mediaPath`;
  18. my %MON_FILES = (
  19. 'GUI' => 'MTIME',
  20. 'MOTION' => 'MTIME',
  21. 'PROJECTOR' => 'STATUS',
  22. 'AMPLIFIER' => 'STATUS',
  23. 'PLAYING' => 'STATUS_PLAYING',
  24. 'NO_MOTION' => 'EXISTS',
  25. 'RAVE' => 'EXISTS',
  26. 'EFFECT' => 'EXISTS',
  27. 'FAN_CMD' => 'EXISTS_ON',
  28. 'LIGHTS' => 'EXISTS_ON',
  29. 'STEREO_CMD' => 'EXISTS_ON',
  30. 'AUDIO_AMP' => 'EXISTS_ON',
  31. 'AMPLIFIER_VOL' => 'STATUS_VALUE',
  32. 'AMPLIFIER_MODE' => 'STATUS_VALUE',
  33. 'AMPLIFIER_INPUT' => 'STATUS_VALUE',
  34. 'AUDIO' => 'STATUS_VALUE',
  35. $MEDIA_PATH . '/DMX/cmd/GARAGE_CMD' => 'EXISTS_CLEAR',
  36. );
  37. # App config
  38. my $SOCK_TIMEOUT = 5;
  39. my $DATA_DIR = DMX::dataDir();
  40. my $CMD_FILE = $DATA_DIR . 'STATE.socket';
  41. my $MAX_CMD_LEN = 4096;
  42. my $RESET_CMD = $ENV{'HOME'} . '/bin/video/dmx/reset.sh';
  43. my $PUSH_TIMEOUT = 20;
  44. # Debug
  45. my $DEBUG = 0;
  46. if ($ENV{'DEBUG'}) {
  47. $DEBUG = 1;
  48. }
  49. # Command-line arguments
  50. my ($DELAY) = @ARGV;
  51. if (!$DELAY) {
  52. $DELAY = 0.5;
  53. }
  54. # Socket init
  55. my $select = DMX::stateSocket($CMD_FILE);
  56. # Reset all dependents at starts
  57. system($RESET_CMD);
  58. # Subscribers
  59. my @subscribers = ();
  60. # State
  61. my $state = 'INIT';
  62. my $stateLast = $state;
  63. my $status = '';
  64. my $statusLast = $status;
  65. my $updateLast = 0;
  66. my $pushLast = 0;
  67. # Init the file tracking structure
  68. my %files = ();
  69. foreach my $file (keys(%MON_FILES)) {
  70. my %tmp = (
  71. 'name' => basename($file),
  72. 'type' => $MON_FILES{$file},
  73. 'path' => $DATA_DIR . $file,
  74. 'update' => 0,
  75. 'status' => 0,
  76. 'last' => 0,
  77. );
  78. # Allow absolute paths to override the $DATA_DIR path
  79. if ($file =~ /^\//) {
  80. $tmp{'path'} = $file;
  81. }
  82. # Record the directory name for folder monitoring
  83. $tmp{'dir'} = dirname($tmp{'path'});
  84. # Push a hash ref
  85. $files{$file} = \%tmp;
  86. }
  87. # Loop forever
  88. while (1) {
  89. # Provide a method to force updates even when the state does not change
  90. my $update = 0;
  91. # Check for queued commands
  92. my @ready_clients = $select->can_read($DELAY);
  93. foreach my $fh (@ready_clients) {
  94. # Grab the inbound text
  95. my $path = undef();
  96. $fh->recv($path, $MAX_CMD_LEN);
  97. $path =~ s/^\s+//;
  98. $path =~ s/\s+$//;
  99. if ($DEBUG) {
  100. print STDERR 'Got path: ' . $path . "\n";
  101. }
  102. # Only accept valid paths
  103. if (!-r $path) {
  104. print STDERR 'Invalid socket path: ' . $path . "\n";
  105. next;
  106. }
  107. # Open the new socket
  108. my $sub = IO::Socket::UNIX->new(
  109. 'Peer' => $path,
  110. 'Type' => SOCK_DGRAM,
  111. 'Timeout' => $SOCK_TIMEOUT
  112. );
  113. if (!$sub) {
  114. print STDERR 'Unable to open socket: ' . $path . ": ${@}\n";
  115. next;
  116. }
  117. # Add the socket to our subscriber list
  118. my %tmp = (
  119. 'path' => $path,
  120. 'socket' => $sub,
  121. );
  122. push(@subscribers, \%tmp);
  123. # Force an update
  124. $update = 1;
  125. }
  126. # Use opendir/readdir in each folder to ensure fresh results
  127. my %folders = ();
  128. foreach my $file (values(%files)) {
  129. if (!$folders{ $file->{'dir'} }) {
  130. my $dh = undef();
  131. if (opendir($dh, $file->{'dir'})) {
  132. if ($DEBUG) {
  133. print STDERR 'Refreshed folder: ' . $file->{'dir'} . "\n";
  134. }
  135. my @files = readdir($dh);
  136. closedir($dh);
  137. }
  138. $folders{ $file->{'dir'} } = 1;
  139. }
  140. }
  141. # Monitor files of all types
  142. foreach my $file (values(%files)) {
  143. # Always record the previous status and clear the new one
  144. $file->{'last'} = $file->{'status'};
  145. $file->{'status'} = 0;
  146. # Record the last update for STATUS and MTIME files
  147. if ($file->{'type'} =~ /^STATUS/ || $file->{'type'} =~ /^MTIME/) {
  148. $file->{'update'} = mtime($file->{'path'});
  149. if ($DEBUG) {
  150. print STDERR 'Last change: ' . $file->{'name'} . ': ' . localtime($file->{'update'}) . "\n";
  151. }
  152. }
  153. # Grab the state from STATUS files
  154. if ($file->{'type'} =~ /^STATUS/) {
  155. my $text = '';
  156. {
  157. if (!open(my $fh, $file->{'path'})) {
  158. warn('Unable to open ' . $file->{'path'} . "\n");
  159. } else {
  160. local $/;
  161. $text = <$fh>;
  162. close($fh);
  163. }
  164. }
  165. if ($file->{'type'} eq 'STATUS_PLAYING') {
  166. if ($text =~ /PlayStatus\:Playing/) {
  167. $file->{'status'} = 1;
  168. }
  169. } elsif ($file->{'type'} eq 'STATUS_VALUE') {
  170. $text =~ s/\n$//;
  171. $file->{'status'} = $text;
  172. } else {
  173. if ($text =~ /1/) {
  174. $file->{'status'} = 1;
  175. }
  176. }
  177. if ($DEBUG) {
  178. print STDERR 'Status: ' . $file->{'name'} . ': ' . $file->{'status'} . "\n";
  179. }
  180. }
  181. # Check for the presence of EXISTS files and record their last change
  182. if ($file->{'type'} =~ /^EXISTS/) {
  183. my $mtime = mtime($file->{'path'});
  184. if ($mtime > 0) {
  185. $file->{'status'} = 1;
  186. $file->{'update'} = $mtime;
  187. } elsif ($file->{'last'}) {
  188. $file->{'update'} = time();
  189. }
  190. if ($DEBUG) {
  191. print STDERR 'Exists: ' . $file->{'name'} . ': ' . $file->{'status'} . ':' . $file->{'update'} . "\n";
  192. }
  193. }
  194. }
  195. # Set the global update timestamp
  196. foreach my $file (values(%files)) {
  197. if ($file->{'update'} > $updateLast) {
  198. $updateLast = $file->{'update'};
  199. }
  200. }
  201. # Calculate the new state
  202. $stateLast = $state;
  203. if ($files{'PROJECTOR'}->{'status'}) {
  204. # We are always either playing or paused if the projector is on
  205. if ($files{'PLAYING'}->{'status'}) {
  206. $state = 'PLAY';
  207. } else {
  208. $state = 'PAUSE';
  209. }
  210. } else {
  211. # If the projector is off, check the timeouts
  212. my $timeSinceUpdate = time() - $updateLast;
  213. if ($timeSinceUpdate > $STATE_TIMEOUT) {
  214. $state = 'OFF';
  215. } elsif ($timeSinceUpdate < $STATE_TIMEOUT) {
  216. if ($files{'NO_MOTION'}->{'status'}) {
  217. $state = 'OFF';
  218. } else {
  219. $state = 'MOTION';
  220. }
  221. }
  222. }
  223. if ($state eq 'INIT') {
  224. $state = 'OFF';
  225. }
  226. # Clear EXISTS_ON files when the main state is "OFF" (and before we append their status)
  227. foreach my $file (values(%files)) {
  228. if ($file->{'type'} eq 'EXISTS_ON' && $file->{'status'} && $state eq 'OFF') {
  229. unlink($file->{'path'});
  230. $file->{'stauts'} = 0;
  231. if ($DEBUG) {
  232. print STDERR 'Clearing exists flag for: ' . $file->{'name'} . "\n";
  233. }
  234. }
  235. }
  236. # Calculate the new status
  237. $statusLast = $status;
  238. {
  239. my @statTime = ();
  240. foreach my $file (values(%files)) {
  241. push(@statTime, $file->{'name'} . ':' . $file->{'status'} . ':' . $file->{'update'});
  242. }
  243. $status = ' (' . join(', ', @statTime) . ')';
  244. }
  245. # Clear EXISTS_CLEAR files immediately (but after we append their status)
  246. foreach my $file (values(%files)) {
  247. if ($file->{'type'} eq 'EXISTS_CLEAR' && $file->{'status'}) {
  248. unlink($file->{'path'});
  249. $file->{'stauts'} = 0;
  250. if ($DEBUG) {
  251. print STDERR 'Clearing exists flag for: ' . $file->{'name'} . "\n";
  252. }
  253. }
  254. }
  255. # Force updates on a periodic basis
  256. if (time() - $pushLast > $PUSH_TIMEOUT) {
  257. $update = 1;
  258. }
  259. # Update on any status change
  260. foreach my $file (values(%files)) {
  261. if ($file->{'status'} ne $file->{'last'}) {
  262. $update = 1;
  263. last;
  264. }
  265. }
  266. # Force updates on any state change
  267. if ($stateLast ne $state || $statusLast ne $status) {
  268. if ($DEBUG) {
  269. print STDERR 'State change: ' . $stateLast . $statusLast . ' => ' . $state . $status . "\n";
  270. }
  271. $update = 1;
  272. }
  273. # Push the update
  274. if ($update) {
  275. # Note the push
  276. $pushLast = time();
  277. # Send notifications to all subscribers
  278. foreach my $sub (@subscribers) {
  279. # Drop subscribers that are not available
  280. if (!eval { $sub->{'socket'}->send($state . $status) }) {
  281. print STDERR 'Dropping bad socket from subscriber list: ' . $sub->{'path'} . "\n";
  282. my @new_subscribers = ();
  283. foreach my $new (@subscribers) {
  284. if ($new->{'socket'} eq $sub->{'socket'}) {
  285. next;
  286. }
  287. push(@new_subscribers, $new);
  288. }
  289. @subscribers = @new_subscribers;
  290. }
  291. }
  292. # Save the state and value to disk
  293. my ($fh, $tmp) = tempfile($DATA_DIR . 'STATE.XXXXXXXX', 'UNLINK' => 0);
  294. print $fh $state . "\n";
  295. close($fh);
  296. rename($tmp, $DATA_DIR . 'STATE');
  297. }
  298. }
  299. sub mtime($) {
  300. my ($file) = @_;
  301. my $mtime = 0;
  302. if (-r $file) {
  303. (undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), $mtime, undef(), undef(), undef()) = stat($file);
  304. }
  305. return $mtime;
  306. }