state.pl 7.6 KB

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