state.pl 9.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414
  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. 'MOTION' => 'MTIME',
  20. 'PROJECTOR' => 'STATUS',
  21. 'AMPLIFIER' => 'STATUS',
  22. 'GUI' => 'STATUS_GUI',
  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. 'AUDIO_STATE' => 'STATUS_VALUE',
  36. 'PROJECTOR_COLOR' => 'STATUS_VALUE',
  37. 'PROJECTOR_INPUT' => 'STATUS_VALUE',
  38. 'COLOR' => 'STATUS_VALUE',
  39. 'RIFF' => 'STATUS_VALUE',
  40. $MEDIA_PATH . '/DMX/cmd/GARAGE_CMD' => 'EXISTS_CLEAR',
  41. );
  42. my %EXTRAS = (
  43. 'PLAYING' => {
  44. 'URL' => qr/^\<li\>Filename\:(.+)$/m,
  45. 'YEAR' => qr/^\<li\>Year\:(\d+)/m,
  46. 'SERIES' => qr/^\<li\>Show Title\:(.+)$/m,
  47. 'SEASON' => qr/^\<li\>Season\:(\d+)/m,
  48. 'EPISODE' => qr/^\<li\>Episode\:(\d+)/m,
  49. 'TITLE' => qr/^\<li\>Title\:(.+)$/m,
  50. 'LENGTH' => qr/^\<li\>Duration\:([\d\:]+)/m,
  51. 'POSITION' => qr/^\<li\>Time\:([\d\:]+)/m,
  52. 'SIZE' => qr/^\<li\>File size\:(\d+)/m,
  53. 'TYPE' => qr/^\<li\>Type\:(.+)$/m,
  54. }
  55. );
  56. # App config
  57. my $SOCK_TIMEOUT = 5;
  58. my $DATA_DIR = DMX::dataDir();
  59. my $CMD_FILE = $DATA_DIR . 'STATE.socket';
  60. my $MAX_CMD_LEN = 4096;
  61. my $RESET_CMD = $ENV{'HOME'} . '/bin/video/dmx/reset.sh';
  62. my $PUSH_TIMEOUT = 20;
  63. # Debug
  64. my $DEBUG = 0;
  65. if ($ENV{'DEBUG'}) {
  66. $DEBUG = 1;
  67. }
  68. # Command-line arguments
  69. my ($DELAY) = @ARGV;
  70. if (!$DELAY) {
  71. $DELAY = 0.5;
  72. }
  73. # Socket init
  74. my $select = DMX::stateSocket($CMD_FILE);
  75. # Reset all dependents at starts
  76. system($RESET_CMD);
  77. # Subscribers
  78. my @subscribers = ();
  79. # State
  80. my $state = 'INIT';
  81. my $stateLast = $state;
  82. my $status = '';
  83. my $statusLast = $status;
  84. my $updateLast = 0;
  85. my $pushLast = 0;
  86. # Add the extras to the main file list
  87. foreach my $file (keys(%EXTRAS)) {
  88. foreach my $extra (keys(%{ $EXTRAS{$file} })) {
  89. $MON_FILES{ $file . '_' . $extra } = 'NONE';
  90. }
  91. }
  92. # Init the file tracking structure
  93. my %files = ();
  94. foreach my $file (keys(%MON_FILES)) {
  95. my %tmp = (
  96. 'name' => basename($file),
  97. 'type' => $MON_FILES{$file},
  98. 'path' => $DATA_DIR . $file,
  99. 'update' => 0,
  100. 'status' => 0,
  101. 'last' => 0,
  102. );
  103. # Allow absolute paths to override the $DATA_DIR path
  104. if ($file =~ /^\//) {
  105. $tmp{'path'} = $file;
  106. }
  107. # Record the directory name for folder monitoring
  108. $tmp{'dir'} = dirname($tmp{'path'});
  109. # Push a hash ref
  110. $files{$file} = \%tmp;
  111. }
  112. # Loop forever
  113. while (1) {
  114. # Provide a method to force updates even when the state does not change
  115. my $update = 0;
  116. # Check for queued commands
  117. my @ready_clients = $select->can_read($DELAY);
  118. foreach my $fh (@ready_clients) {
  119. # Grab the inbound text
  120. my $path = undef();
  121. $fh->recv($path, $MAX_CMD_LEN);
  122. $path =~ s/^\s+//;
  123. $path =~ s/\s+$//;
  124. if ($DEBUG) {
  125. print STDERR 'Got path: ' . $path . "\n";
  126. }
  127. # Only accept valid paths
  128. if (!-r $path) {
  129. print STDERR 'Invalid socket path: ' . $path . "\n";
  130. next;
  131. }
  132. # Open the new socket
  133. my $sub = IO::Socket::UNIX->new(
  134. 'Peer' => $path,
  135. 'Type' => SOCK_DGRAM,
  136. 'Timeout' => $SOCK_TIMEOUT
  137. );
  138. if (!$sub) {
  139. print STDERR 'Unable to open socket: ' . $path . ": ${@}\n";
  140. next;
  141. }
  142. # Add the socket to our subscriber list
  143. my %tmp = (
  144. 'path' => $path,
  145. 'socket' => $sub,
  146. );
  147. push(@subscribers, \%tmp);
  148. # Force an update
  149. $update = 1;
  150. }
  151. # Use opendir/readdir in each folder to ensure fresh results
  152. my %folders = ();
  153. foreach my $file (values(%files)) {
  154. if (!$folders{ $file->{'dir'} }) {
  155. my $dh = undef();
  156. if (opendir($dh, $file->{'dir'})) {
  157. if ($DEBUG) {
  158. print STDERR 'Refreshed folder: ' . $file->{'dir'} . "\n";
  159. }
  160. my @files = readdir($dh);
  161. closedir($dh);
  162. }
  163. $folders{ $file->{'dir'} } = 1;
  164. }
  165. }
  166. # Monitor files of all types
  167. foreach my $file (values(%files)) {
  168. # Skip "NONE" files -- they are data stores handled in other actions
  169. if ($file->{'type'} eq 'NONE') {
  170. next;
  171. }
  172. # Always record the previous status and clear the new one
  173. $file->{'last'} = $file->{'status'};
  174. $file->{'status'} = 0;
  175. # Record the last update for STATUS and MTIME files
  176. if ($file->{'type'} =~ /^STATUS/ || $file->{'type'} =~ /^MTIME/) {
  177. $file->{'update'} = mtime($file->{'path'});
  178. if ($DEBUG) {
  179. print STDERR 'Last change: ' . $file->{'name'} . ': ' . localtime($file->{'update'}) . "\n";
  180. }
  181. }
  182. # Grab the state from STATUS files
  183. if ($file->{'type'} =~ /^STATUS/) {
  184. my $text = '';
  185. {
  186. if (!open(my $fh, $file->{'path'})) {
  187. warn('Unable to open ' . $file->{'path'} . "\n");
  188. } else {
  189. local $/;
  190. $text = <$fh>;
  191. close($fh);
  192. }
  193. }
  194. # Record the main status for the file
  195. if ($file->{'type'} eq 'STATUS_PLAYING') {
  196. if ($text =~ /PlayStatus\:Playing/) {
  197. $file->{'status'} = 1;
  198. }
  199. } elsif ($file->{'type'} eq 'STATUS_GUI') {
  200. if (!($text =~ /ActiveWindowName\:Fullscreen video/)) {
  201. $file->{'status'} = 1;
  202. }
  203. } elsif ($file->{'type'} eq 'STATUS_VALUE') {
  204. $text =~ s/\n$//;
  205. $file->{'status'} = $text;
  206. } else {
  207. if ($text =~ /1/) {
  208. $file->{'status'} = 1;
  209. }
  210. }
  211. if ($DEBUG) {
  212. print STDERR 'Status: ' . $file->{'name'} . ': ' . $file->{'status'} . "\n";
  213. }
  214. # Handle extras, if any
  215. if ($EXTRAS{ $file->{'name'} }) {
  216. foreach my $extra (keys(%{ $EXTRAS{ $file->{'name'} } })) {
  217. my $name = $file->{'name'} . '_' . $extra;
  218. $files{$name}{'last'} = $files{$name}{'status'};
  219. $files{$name}{'status'} = '';
  220. $files{$name}{'update'} = $file->{'update'};
  221. if ($text =~ $EXTRAS{ $file->{'name'} }{$extra}) {
  222. $files{$name}{'status'} = $1;
  223. }
  224. if ($DEBUG) {
  225. print STDERR 'Status (extra): ' . $name . ': ' . $files{$name}{'status'} . "\n";
  226. }
  227. }
  228. }
  229. }
  230. # Check for the presence of EXISTS files and record their last change
  231. if ($file->{'type'} =~ /^EXISTS/) {
  232. my $mtime = mtime($file->{'path'});
  233. if ($mtime > 0) {
  234. $file->{'status'} = 1;
  235. $file->{'update'} = $mtime;
  236. } elsif ($file->{'last'}) {
  237. $file->{'update'} = time();
  238. }
  239. if ($DEBUG) {
  240. print STDERR 'Exists: ' . $file->{'name'} . ': ' . $file->{'status'} . ':' . $file->{'update'} . "\n";
  241. }
  242. }
  243. }
  244. # Set the global update timestamp
  245. foreach my $file (values(%files)) {
  246. if ($file->{'update'} > $updateLast) {
  247. $updateLast = $file->{'update'};
  248. }
  249. }
  250. # Calculate the new state
  251. $stateLast = $state;
  252. if ($files{'PROJECTOR'}->{'status'}) {
  253. # We are always either playing or paused if the projector is on
  254. # When we're playing "Audio" assume we are paused
  255. if ($files{'PLAYING'}->{'status'} && $files{'PLAYING_TYPE'}->{'status'} ne 'Audio') {
  256. $state = 'PLAY';
  257. } else {
  258. $state = 'PAUSE';
  259. }
  260. } else {
  261. # If the projector is off, check the timeouts
  262. my $timeSinceUpdate = time() - $updateLast;
  263. if ($timeSinceUpdate > $STATE_TIMEOUT) {
  264. $state = 'OFF';
  265. } elsif ($timeSinceUpdate < $STATE_TIMEOUT) {
  266. if ($files{'NO_MOTION'}->{'status'}) {
  267. $state = 'OFF';
  268. } else {
  269. $state = 'MOTION';
  270. }
  271. }
  272. }
  273. if ($state eq 'INIT') {
  274. $state = 'OFF';
  275. }
  276. # Clear EXISTS_ON files when the main state is "OFF" (and before we append their status)
  277. foreach my $file (values(%files)) {
  278. if ($file->{'type'} eq 'EXISTS_ON' && $file->{'status'} && $state eq 'OFF') {
  279. unlink($file->{'path'});
  280. $file->{'stauts'} = 0;
  281. if ($DEBUG) {
  282. print STDERR 'Clearing exists flag for: ' . $file->{'name'} . "\n";
  283. }
  284. }
  285. }
  286. # Calculate the new status
  287. $statusLast = $status;
  288. {
  289. my @statTime = ();
  290. foreach my $file (values(%files)) {
  291. my $text = $file->{'status'};
  292. $text =~ s/\s/ /g;
  293. $text =~ s/\,/_/g;
  294. $text =~ s/\:/-/g;
  295. push(@statTime, $file->{'name'} . ':' . $text . ':' . $file->{'update'});
  296. }
  297. $status = ' (' . join(', ', @statTime) . ')';
  298. }
  299. # Clear EXISTS_CLEAR files immediately (but after we append their status)
  300. foreach my $file (values(%files)) {
  301. if ($file->{'type'} eq 'EXISTS_CLEAR' && $file->{'status'}) {
  302. unlink($file->{'path'});
  303. $file->{'stauts'} = 0;
  304. if ($DEBUG) {
  305. print STDERR 'Clearing exists flag for: ' . $file->{'name'} . "\n";
  306. }
  307. }
  308. }
  309. # Force updates on a periodic basis
  310. if (time() - $pushLast > $PUSH_TIMEOUT) {
  311. $update = 1;
  312. }
  313. # Update on any status change
  314. foreach my $file (values(%files)) {
  315. if ($file->{'status'} ne $file->{'last'}) {
  316. $update = 1;
  317. last;
  318. }
  319. }
  320. # Force updates on any state change
  321. if ($stateLast ne $state || $statusLast ne $status) {
  322. if ($DEBUG) {
  323. print STDERR 'State change: ' . $stateLast . $statusLast . ' => ' . $state . $status . "\n";
  324. }
  325. $update = 1;
  326. }
  327. # Push the update
  328. if ($update) {
  329. # Note the push
  330. $pushLast = time();
  331. # Send notifications to all subscribers
  332. foreach my $sub (@subscribers) {
  333. # Drop subscribers that are not available
  334. if (!eval { $sub->{'socket'}->send($state . $status) }) {
  335. print STDERR 'Dropping bad socket from subscriber list: ' . $sub->{'path'} . "\n";
  336. my @new_subscribers = ();
  337. foreach my $new (@subscribers) {
  338. if ($new->{'socket'} eq $sub->{'socket'}) {
  339. next;
  340. }
  341. push(@new_subscribers, $new);
  342. }
  343. @subscribers = @new_subscribers;
  344. }
  345. }
  346. # Save the state and value to disk
  347. my ($fh, $tmp) = tempfile($DATA_DIR . 'STATE.XXXXXXXX', 'UNLINK' => 0);
  348. print $fh $state . "\n";
  349. close($fh);
  350. rename($tmp, $DATA_DIR . 'STATE');
  351. }
  352. }
  353. sub mtime($) {
  354. my ($file) = @_;
  355. my $mtime = 0;
  356. if (-r $file) {
  357. (undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), undef(), $mtime, undef(), undef(), undef()) = stat($file);
  358. }
  359. return $mtime;
  360. }