DMX.pm 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use File::Temp;
  5. use IO::Select;
  6. use IO::Socket::UNIX;
  7. # Package name
  8. package DMX;
  9. # Debug
  10. my $DEBUG = 0;
  11. if ($ENV{'DEBUG'}) {
  12. $DEBUG = 1;
  13. }
  14. # Config
  15. my $SOCK_TIMEOUT = 5;
  16. my $MAX_CMD_LEN = 1024;
  17. my $TEMP_DIR = `getconf DARWIN_USER_TEMP_DIR`;
  18. chomp($TEMP_DIR);
  19. my $DATA_DIR = $TEMP_DIR . 'plexMonitor/';
  20. my $DMX_SOCK = $DATA_DIR . 'DMX.socket';
  21. my $SUB_SOCK = $DATA_DIR . 'STATE.socket';
  22. my %CHANNEL_ADJ = (
  23. '13' => 1.00,
  24. '14' => 1.14,
  25. '15' => 1.19,
  26. );
  27. # Sanity check
  28. if (!-d $DATA_DIR) {
  29. die('Data directory not available: ' . $DATA_DIR . "\n");
  30. }
  31. # State
  32. my $DMX_FH = undef();
  33. my $SELECT = undef();
  34. # Data directory
  35. sub dataDir() {
  36. return $DATA_DIR;
  37. }
  38. # Generic client socket
  39. sub clientSock($) {
  40. my ($path) = @_;
  41. my $sock = IO::Socket::UNIX->new(
  42. 'Peer' => $path,
  43. 'Type' => IO::Socket::UNIX::SOCK_DGRAM,
  44. 'Timeout' => $SOCK_TIMEOUT,
  45. ) or die('Unable to open client socket: ' . $path . ": ${@}\n");
  46. return $sock;
  47. }
  48. # DMX socket init
  49. sub dmxSock() {
  50. if (!defined($DMX_FH)) {
  51. $DMX_FH = clientSock($DMX_SOCK);
  52. }
  53. return $DMX_FH;
  54. }
  55. # Subscribe to state updates
  56. sub stateSubscribe($) {
  57. my ($STATE_SOCK) = @_;
  58. my $sub_fh = IO::Socket::UNIX->new(
  59. 'Peer' => $SUB_SOCK,
  60. 'Type' => IO::Socket::UNIX::SOCK_DGRAM,
  61. 'Timeout' => $SOCK_TIMEOUT
  62. ) or die('Unable to open state subscription socket: ' . $SUB_SOCK . ": ${@}\n");
  63. $sub_fh->send($STATE_SOCK)
  64. or die('Unable to subscribe: ' . $! . "\n");
  65. shutdown($sub_fh, 2);
  66. undef($sub_fh);
  67. }
  68. # State client socket init
  69. sub stateSocket($) {
  70. my ($STATE_SOCK) = @_;
  71. if (-e $STATE_SOCK) {
  72. unlink($STATE_SOCK);
  73. }
  74. my $state_fh = IO::Socket::UNIX->new(
  75. 'Local' => $STATE_SOCK,
  76. 'Type' => IO::Socket::UNIX::SOCK_DGRAM,
  77. ) or die('Unable to open state client socket: ' . $STATE_SOCK . ": ${@}\n");
  78. $SELECT = IO::Select->new($state_fh)
  79. or die('Unable to select state client socket: ' . $STATE_SOCK . ": ${!}\n");
  80. return $SELECT;
  81. }
  82. # Parse the state->client comm string
  83. sub parseState($$) {
  84. my ($text, $exists) = @_;
  85. my $cmdState = undef();
  86. my $exists_text = undef();
  87. # Parse the string
  88. my %tmp = ();
  89. %{$exists} = ();
  90. ($cmdState, $exists_text) = $text =~ /^(\w+)(?:\s+\(([^\)]+)\))?/;
  91. if (!defined($cmdState)) {
  92. print STDERR 'State parse error: ' . $text . "\n";
  93. next;
  94. }
  95. if (defined($exists_text)) {
  96. foreach my $exists_val (split(/\s*,\s*/, $exists_text)) {
  97. my ($name, $value) = $exists_val =~ /(\w+)\:(\d+)/;
  98. if (!defined($name) || !defined($value)) {
  99. print STDERR 'State parse error (exists): ' . $text . "\n";
  100. next;
  101. }
  102. $exists->{$name} = $value;
  103. }
  104. }
  105. if ($DEBUG) {
  106. my @exists_tmp = ();
  107. foreach my $key (keys(%{$exists})) {
  108. push(@exists_tmp, $key . ':' . $exists->{$key});
  109. }
  110. print STDERR 'Got state: ' . $cmdState . ' (' . join(', ', @exists_tmp) . ")\n";
  111. }
  112. # Translate INIT to OFF
  113. if ($cmdState eq 'INIT') {
  114. $cmdState = 'OFF';
  115. }
  116. # Return
  117. return $cmdState;
  118. }
  119. sub dim($) {
  120. my ($args) = @_;
  121. if (!defined($args->{'delay'})) {
  122. $args->{'delay'} = 0;
  123. }
  124. if (!defined($args->{'channel'}) || !defined($args->{'time'}) || !defined($args->{'value'})) {
  125. die('Invalid command for socket: ' . join(', ', keys(%{$args})) . ': ' . join(', ', values(%{$args})) . "\n");
  126. }
  127. # Silently skip invalid channels
  128. if ($args->{'channel'} < 0) {
  129. return;
  130. }
  131. # Adjust for the color curve (for channels where we have such data)
  132. my $value = $args->{'value'};
  133. if ($CHANNEL_ADJ{ $args->{'channel'} }) {
  134. $value *= $CHANNEL_ADJ{ $args->{'channel'} };
  135. }
  136. # 8-bit values
  137. $value = int($value);
  138. if ($value > 255) {
  139. $value = 255;
  140. } elsif ($value < 0) {
  141. $value = 0;
  142. }
  143. # We only deal in ints
  144. my $time = int($args->{'time'});
  145. my $delay = int($args->{'delay'});
  146. my $cmd = join(':', $args->{'channel'}, $time, $value, $delay);
  147. dmxSock();
  148. $DMX_FH->send($cmd)
  149. or die('Unable to write command to DMX socket: ' . $cmd . ": ${!}\n");
  150. }
  151. sub printDataset($) {
  152. my ($data_set) = @_;
  153. my $sum = 0;
  154. foreach my $data (@{$data_set}) {
  155. $sum += $data->{'value'};
  156. my $str = $data->{'channel'} . ' => ' . int($data->{'value'}) . ' @ ' . $data->{'time'};
  157. if ($data->{'delay'}) {
  158. $str .= ' (Delay: ' . $data->{'delay'} . ')';
  159. }
  160. print STDERR "\t" . $str . "\n";
  161. }
  162. print STDERR "\tTotal: " . int($sum) . "\n";
  163. }
  164. sub applyDataset($$$) {
  165. my ($data_set, $state, $file) = @_;
  166. if (!defined($state)) {
  167. $state = 'NULL';
  168. }
  169. # Debug
  170. if ($DEBUG) {
  171. print STDERR 'State: ' . $state . "\n";
  172. printDataset($data_set);
  173. }
  174. # Send the dim command
  175. my @values = ();
  176. foreach my $data (@{$data_set}) {
  177. dim($data);
  178. my $str = $data->{'channel'} . ' => ' . $data->{'value'} . ' @ ' . $data->{'time'};
  179. if ($data->{'delay'}) {
  180. $str .= ' (Delay: ' . $data->{'delay'} . ')';
  181. }
  182. push(@values, $str);
  183. }
  184. # Save the state and value to disk
  185. if (length($file)) {
  186. my ($fh, $tmp) = File::Temp::tempfile($file . '.XXXXXXXX', 'UNLINK' => 0);
  187. print $fh 'State: ' . $state . "\n" . join("\n", @values) . "\n";
  188. close($fh);
  189. rename($tmp, $file);
  190. }
  191. }
  192. sub readState($$$) {
  193. my ($delay, $exists, $valid) = @_;
  194. my $cmdState = undef();
  195. # Wait for state updates
  196. my @ready_clients = $SELECT->can_read($delay);
  197. foreach my $fh (@ready_clients) {
  198. # Ensure we won't block on recv()
  199. $fh->blocking(0);
  200. # Grab the inbound text
  201. while (defined($fh->recv(my $text, $MAX_CMD_LEN))) {
  202. # Parse the string
  203. my $state = parseState($text, $exists);
  204. # Ignore invalid states
  205. if (defined($valid)) {
  206. if (!defined($valid->{$state})) {
  207. print STDERR 'Invalid state: ' . $state . "\n";
  208. next;
  209. }
  210. }
  211. # Propogate valid states
  212. if ($state) {
  213. $cmdState = $state;
  214. }
  215. }
  216. }
  217. # Return the final valid state
  218. return $cmdState;
  219. }
  220. # Always return true
  221. 1;