serial.pl 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use File::Basename;
  5. use File::Temp qw( tempfile );
  6. use IO::Select;
  7. use IO::Socket::UNIX;
  8. use Device::SerialPort;
  9. use Time::HiRes qw( usleep sleep time );
  10. use IPC::System::Simple qw( system capture );
  11. # Local modules
  12. use Cwd qw(abs_path);
  13. use File::Basename qw(dirname);
  14. use lib dirname(abs_path($0));
  15. use DMX;
  16. # Prototypes
  17. sub sendQuery($$);
  18. sub clearBuffer($);
  19. sub collectUntil($$);
  20. sub parseHDMI($$);
  21. sub parseHDMILine($$$);
  22. # Device parameters
  23. my ($DEV, $PORT, $BLUETOOTH, $BAUD, $DBITS, $SBITS, $PARITY, $CRLF, $DELIMITER, %CMDS, %STATUS_CMDS);
  24. if (basename($0) =~ /PROJECTOR/i) {
  25. $DEV = 'Projector';
  26. $PORT = '/dev/tty.usbserial-A5006xbj';
  27. $BLUETOOTH = 0;
  28. $CRLF = "\r\n";
  29. $DELIMITER = ':';
  30. %CMDS = (
  31. 'INIT' => '',
  32. 'ON' => 'PWR ON',
  33. 'OFF' => 'PWR OFF',
  34. 'STATUS' => 'PWR?',
  35. 'DYNAMIC' => 'CMODE 06',
  36. 'LIVING_ROOM' => 'CMODE 0C',
  37. 'NATURAL' => 'CMODE 07',
  38. 'THEATER' => 'CMODE 05',
  39. 'THEATER_BLACK_1' => 'CMODE 09',
  40. 'THEATER_BLACK_2' => 'CMODE 0A',
  41. 'XV' => 'CMODE 0B',
  42. 'COLOR' => 'CMODE?',
  43. 'HDMI_1' => 'SOURCE 30',
  44. 'HDMI_2' => 'SOURCE A0',
  45. 'VGA' => 'SOURCE 20',
  46. 'INPUT' => 'SOURCE?',
  47. 'LAMP' => 'LAMP?',
  48. );
  49. %STATUS_CMDS = (
  50. 'STATUS' => { 'MATCH' => [ qr/^PWR=/, qr/PWR=01/ ] },
  51. 'COLOR' => { 'EVAL' => [ qr/^CMODE=[0-9A-Z]{2}$/i, 'if ($a =~ /06$/i) { $a = "DYNAMIC" } elsif ($a =~ /0C$/i) { $a = "LIVING_ROOM" } elsif ($a =~ /07$/i) { $a = "NATURAL" } elsif ($a =~ /05$/i) { $a = "THEATER" } elsif ($a =~ /09$/i) { $a = "THEATER_BLACK_1" } elsif ($a =~ /0A$/i) { $a = "THEATER_BLACK_2" } elsif ($a =~ /0B$/i) { $a = "XV" }' ] },
  52. 'INPUT' => { 'EVAL' => [ qr/^SOURCE=[0-9A-Z]{2}$/i, 'if ($a =~ /30$/i) { $a = "HDMI_1" } elsif ($a =~ /A0$/i) { $a = "HDMI_2" } elsif ($a =~ /20$/i) { $a = "VGA" }' ] },
  53. 'LAMP' => { 'REPLACE' => qr/^LAMP=(\d+)$/i },
  54. );
  55. } elsif (basename($0) =~ /AMPLIFIER/i) {
  56. $DEV = 'Amplifier';
  57. $PORT = '/dev/tty.usbserial-AM01C96Q';
  58. $BLUETOOTH = 0;
  59. $CRLF = "\r";
  60. $DELIMITER = "\r";
  61. %CMDS = (
  62. 'INIT' => '',
  63. 'ON' => 'PWON',
  64. 'OFF' => 'PWSTANDBY',
  65. 'STATUS' => 'PW?',
  66. 'VOL' => 'MV?',
  67. 'VOL+' => 'MVUP',
  68. 'VOL-' => 'MVDOWN',
  69. 'MUTE' => 'MUON',
  70. 'UNMUTE' => 'MUOFF',
  71. 'INPUT' => 'SI?',
  72. 'TV' => 'SITV',
  73. 'GAME' => 'SIDVD',
  74. 'MODE' => 'MS?',
  75. 'SURROUND' => 'MSDOLBY DIGITAL',
  76. 'STEREO' => 'MS7CH STEREO',
  77. 'INPUT' => 'SI?',
  78. 'INPUT_MODE' => 'SD?',
  79. 'INPUT_AUTO' => 'SDAUTO',
  80. 'INPUT_ANALOG' => 'SDANALOG',
  81. 'INPUT_EXT' => 'SDEXT.IN-1',
  82. );
  83. %STATUS_CMDS = (
  84. 'STATUS' => { 'MATCH' => [ qr/^PW/, qr/$CMDS{'ON'}/ ] },
  85. 'MODE' => { 'EVAL' => [ qr/^MS/, 'if ($a =~ /STEREO/i) { $a = "STEREO" } elsif ($a =~ /MS(?:DOLBY|DTS)/i) { $a = "SURROUND" }' ] },
  86. 'VOL' => { 'EVAL' => [ qr/^MV/, '$a =~ s/^MV//; if (length($a) > 2) { $a =~ s/(\d\d)(\d)/$1.$2/ }' ] },
  87. 'INPUT' => { 'EVAL' => [ qr/^SI/, 'my $done = 0; foreach my $cmd (keys(%CMDS)) { if ($a eq $CMDS{$cmd}) { $a = $cmd; $done = 1; last; } } if (!$done) { $a =~ s/^SI/UNKNOWN-/; }' ] },
  88. );
  89. } elsif (basename($0) =~ /TV/i) {
  90. $DEV = 'TV';
  91. $PORT = '/dev/tty.usbserial-A501JRBK';
  92. $BLUETOOTH = 0;
  93. $CRLF = "\r";
  94. $DELIMITER = "\r";
  95. %CMDS = (
  96. 'INIT' => 'RSPW1 ',
  97. 'ON' => 'POWR1 ',
  98. 'OFF' => 'POWR0 ',
  99. 'STATUS' => 'POWR? ',
  100. 'MUTE' => 'MUTE1 ',
  101. 'UNMUTE' => 'MUTE2 ',
  102. 'INPUT' => 'IAVD? ',
  103. 'TV' => 'ITVD0 ',
  104. 'PLEX' => 'IAVD7 ',
  105. 'VOL' => 'VOLM? ',
  106. 'CH+' => 'CHUP1 ',
  107. 'CH-' => 'CHDW1 ',
  108. 'CC' => 'CLCP1 ',
  109. 'VOL0' => 'VOLM0 ',
  110. 'VOL1' => 'VOLM1 ',
  111. 'VOL2' => 'VOLM2 ',
  112. 'VOL3' => 'VOLM3 ',
  113. 'VOL4' => 'VOLM4 ',
  114. 'VOL5' => 'VOLM5 ',
  115. 'VOL6' => 'VOLM6 ',
  116. 'VOL7' => 'VOLM7 ',
  117. 'VOL8' => 'VOLM8 ',
  118. 'VOL9' => 'VOLM9 ',
  119. 'VOL10' => 'VOLM10 ',
  120. 'VOL11' => 'VOLM11 ',
  121. 'VOL12' => 'VOLM12 ',
  122. 'VOL13' => 'VOLM13 ',
  123. 'VOL14' => 'VOLM14 ',
  124. 'VOL15' => 'VOLM15 ',
  125. 'VOL16' => 'VOLM16 ',
  126. 'VOL17' => 'VOLM17 ',
  127. 'VOL18' => 'VOLM18 ',
  128. 'VOL19' => 'VOLM19 ',
  129. 'VOL20' => 'VOLM20 ',
  130. 'VOL21' => 'VOLM21 ',
  131. 'VOL22' => 'VOLM22 ',
  132. 'VOL23' => 'VOLM23 ',
  133. 'VOL24' => 'VOLM24 ',
  134. 'VOL25' => 'VOLM25 ',
  135. 'VOL26' => 'VOLM26 ',
  136. 'VOL27' => 'VOLM27 ',
  137. 'VOL28' => 'VOLM28 ',
  138. 'VOL29' => 'VOLM29 ',
  139. 'VOL30' => 'VOLM30 ',
  140. 'VOL31' => 'VOLM31 ',
  141. 'VOL32' => 'VOLM32 ',
  142. 'VOL33' => 'VOLM33 ',
  143. 'VOL34' => 'VOLM34 ',
  144. 'VOL35' => 'VOLM35 ',
  145. 'VOL36' => 'VOLM36 ',
  146. 'VOL37' => 'VOLM37 ',
  147. 'VOL38' => 'VOLM38 ',
  148. 'VOL39' => 'VOLM39 ',
  149. 'VOL40' => 'VOLM40 ',
  150. 'VOL41' => 'VOLM41 ',
  151. 'VOL42' => 'VOLM42 ',
  152. 'VOL43' => 'VOLM43 ',
  153. 'VOL44' => 'VOLM44 ',
  154. 'VOL45' => 'VOLM45 ',
  155. 'VOL46' => 'VOLM46 ',
  156. 'VOL47' => 'VOLM47 ',
  157. 'VOL48' => 'VOLM48 ',
  158. 'VOL49' => 'VOLM49 ',
  159. 'VOL50' => 'VOLM50 ',
  160. 'VOL51' => 'VOLM51 ',
  161. 'VOL52' => 'VOLM52 ',
  162. 'VOL53' => 'VOLM53 ',
  163. 'VOL54' => 'VOLM54 ',
  164. 'VOL55' => 'VOLM55 ',
  165. 'VOL56' => 'VOLM56 ',
  166. 'VOL57' => 'VOLM57 ',
  167. 'VOL58' => 'VOLM58 ',
  168. 'VOL59' => 'VOLM59 ',
  169. 'VOL60' => 'VOLM60 ',
  170. );
  171. %STATUS_CMDS = (
  172. 'STATUS' => { 'MATCH' => [ qr/\d/, qr/1/ ] },
  173. 'VOL' => { 'EVAL' => [ qr/\d/, '' ] },
  174. 'INPUT' => { 'EVAL' => [ qr/(\d|ERR)/, 'if ($a =~ /7/i) { $a = "PLEX" } elsif ($a =~ /\d/i) { $a = "OTHER" } else { $a = "TV" }' ] },
  175. );
  176. } elsif (basename($0) =~ /HDMI/i) {
  177. $DEV = 'HDMI';
  178. $PORT = '/dev/tty.usbserial-AL0096TO';
  179. $BLUETOOTH = 0;
  180. $BAUD = 38400;
  181. $CRLF = "\r";
  182. $DELIMITER = "\r>";
  183. %CMDS = (
  184. 'INIT' => '',
  185. 'STATUS' => 'VS',
  186. 'SOURCE' => 'VS',
  187. 'SOURCE_2' => 'VS',
  188. 'GAININ' => 'VS',
  189. 'GAINOUT' => 'VS',
  190. 'IN1' => 'VS',
  191. 'IN2' => 'VS',
  192. 'OUT1' => 'VS',
  193. 'OUT2' => 'VS',
  194. 'EQ' => 'VS',
  195. 'REBOOT' => 'REBOOT',
  196. 'INFO' => 'PI',
  197. 'PLEX' => 'AVI=1,1',
  198. 'GAME' => 'AVI=2,1',
  199. 'PLEX2' => 'AVI=1,2',
  200. 'GAME2' => 'AVI=2,2',
  201. 'BEEPOFF' => 'BEEP=0',
  202. 'BEEPON' => 'BEEP=1',
  203. 'ASCII' => 'TI=0',
  204. 'BINARY' => 'TI=167',
  205. 'UNLOCK' => 'LCK=0',
  206. 'LOCK' => 'LCK=167',
  207. 'ENABLE1' => 'AVOEN=1',
  208. 'ENABLE2' => 'AVOEN=2',
  209. 'DISABLE1' => 'AVODIS=1',
  210. 'DISABLE2' => 'AVODIS=2',
  211. 'EDID1' => 'CE=1,1',
  212. 'EDID2' => 'CE=1,2',
  213. 'GAININ1' => 'IVG=1',
  214. 'GAININ2' => 'IVG=2',
  215. 'GAININ3' => 'IVG=3',
  216. 'GAININ4' => 'IVG=4',
  217. 'GAININ5' => 'IVG=5',
  218. 'GAININ6' => 'IVG=6',
  219. 'GAININ7' => 'IVG=7',
  220. 'GAININ8' => 'IVG=8',
  221. 'GAINOUT1' => 'OVG=1',
  222. 'GAINOUT2' => 'OVG=2',
  223. 'GAINOUT3' => 'OVG=3',
  224. 'GAINOUT4' => 'OVG=4',
  225. 'GAINOUT5' => 'OVG=5',
  226. 'GAINOUT6' => 'OVG=6',
  227. 'GAINOUT7' => 'OVG=7',
  228. 'GAINOUT8' => 'OVG=8',
  229. 'EQ1' => 'EQ=1',
  230. 'EQ2' => 'EQ=2',
  231. 'EQ3' => 'EQ=3',
  232. 'EQ4' => 'EQ=4',
  233. 'EQ5' => 'EQ=5',
  234. 'EQ6' => 'EQ=6',
  235. 'EQ7' => 'EQ=7',
  236. 'EQ8' => 'EQ=8',
  237. );
  238. %STATUS_CMDS = (
  239. 'SOURCE' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("SOURCE", $a);' ] },
  240. 'SOURCE_2' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("SOURCE_2", $a);' ] },
  241. #'IN1' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("IN1", $a);' ] },
  242. #'IN2' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("IN2", $a);' ] },
  243. #'OUT1' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("OUT1", $a);' ] },
  244. #'OUT2' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("OUT2", $a);' ] },
  245. #'EQ' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("EQ", $a);' ] },
  246. #'GAININ' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("GAININ", $a);' ] },
  247. #'GAINOUT' => { 'EVAL' => [ qr/EGO Switch - 2-Bus/, '$a = parseHDMI("GAINOUT", $a);' ] },
  248. );
  249. } else {
  250. die("No device specified\n");
  251. }
  252. # App config
  253. my $DATA_DIR = DMX::dataDir();
  254. my $CMD_FILE = uc($DEV);
  255. my $BT_CHECK = $ENV{'HOME'} . '/bin/btcheck';
  256. my $BYTE_TIMEOUT = 50;
  257. my $SILENCE_TIMEOUT = $BYTE_TIMEOUT * 10;
  258. # Debug
  259. my $DEBUG = 0;
  260. if ($ENV{'DEBUG'}) {
  261. $DEBUG = $ENV{'DEBUG'};
  262. print STDERR "Debug enabled\n";
  263. }
  264. # Command-line arguments
  265. my ($DELAY) = @ARGV;
  266. if (!$DELAY) {
  267. $DELAY = 1;
  268. }
  269. # Sanity check
  270. if (!-r $PORT) {
  271. die('Serial port not available: ' . $PORT . "\n");
  272. } elsif (!-d $DATA_DIR) {
  273. die('Data directory not available: ' . $DATA_DIR . "\n");
  274. }
  275. # Wait for the serial port to become available
  276. if ($BLUETOOTH) {
  277. system($BT_CHECK, $DEV);
  278. if ($? != 0) {
  279. sleep($DELAY);
  280. die('Bluetooth device "' . $DEV . "\" not available\n");
  281. }
  282. }
  283. # Socket init
  284. my $select = DMX::selectSock($CMD_FILE);
  285. # Port init
  286. my $port = new Device::SerialPort($PORT)
  287. or die('Unable to open serial connection: ' . $PORT . ": ${!}\n");
  288. if ($BAUD) {
  289. $port->baudrate($BAUD);
  290. }
  291. if ($DBITS) {
  292. $port->databits($DBITS);
  293. }
  294. if ($SBITS) {
  295. $port->stopbits($SBITS);
  296. }
  297. if ($PARITY) {
  298. $port->parity($PARITY);
  299. }
  300. $port->read_const_time($BYTE_TIMEOUT);
  301. # Init (clear any previous state)
  302. sendQuery($port, $CMDS{'INIT'});
  303. # State
  304. my $lastStatus = 0;
  305. my %STATUS = ();
  306. foreach my $cmd (keys(%STATUS_CMDS)) {
  307. my %tmp = ('status' => 0, 'last' => '');
  308. $tmp{'path'} = $DATA_DIR . uc($DEV);
  309. if ($cmd ne 'STATUS') {
  310. $tmp{'path'} .= '_' . uc($cmd);
  311. }
  312. if (-r $tmp{'path'}) {
  313. unlink($tmp{'path'});
  314. }
  315. $STATUS{$cmd} = \%tmp;
  316. }
  317. # Loop forever
  318. while (1) {
  319. # Calculate our next timeout
  320. # Hold on select() but not more than $DELAY after our last update
  321. my $timeout = ($lastStatus + $DELAY) - time();
  322. if ($timeout < 0) {
  323. $timeout = 0;
  324. }
  325. if ($DEBUG > 1) {
  326. print STDERR 'Waiting for commands with timeout: ' . $timeout . "\n";
  327. }
  328. # Check for queued commands
  329. my @ready_clients = $select->can_read($timeout);
  330. foreach my $fh (@ready_clients) {
  331. # Ensure we won't block on recv()
  332. $fh->blocking(0);
  333. # Grab the inbound text
  334. while (defined($fh->recv(my $text, DMX::maxCmdLen()))) {
  335. # Clean the input data
  336. $text =~ s/^\s+//;
  337. $text =~ s/\s+$//;
  338. if ($DEBUG) {
  339. print STDERR 'Got command: ' . $text . "\n";
  340. }
  341. # Only accept valid commands
  342. my $cmd = undef();
  343. foreach my $name (keys(%CMDS)) {
  344. if ($name eq $text) {
  345. $cmd = $name;
  346. last;
  347. }
  348. }
  349. # Send commands to serial device
  350. if ($cmd) {
  351. if ($DEBUG) {
  352. print STDERR 'Sending command: ' . $cmd . "\n";
  353. }
  354. my $result = sendQuery($port, $CMDS{$cmd});
  355. if ($DEBUG && $result) {
  356. print STDERR "\tGot result: " . $result . "\n";
  357. }
  358. }
  359. }
  360. }
  361. # Read periodic data, but not too frequently
  362. if (time() > $lastStatus + $DELAY) {
  363. # Record the last status update time
  364. $lastStatus = time();
  365. foreach my $cmd (keys(%STATUS_CMDS)) {
  366. # Save the previous status
  367. $STATUS{$cmd}->{'last'} = $STATUS{$cmd}->{'status'};
  368. # Less typing
  369. my $scmd = $STATUS_CMDS{$cmd};
  370. # Query
  371. if (!defined($CMDS{$cmd})) {
  372. die('No such command: ' . $cmd . "\n");
  373. }
  374. my $result = sendQuery($port, $CMDS{$cmd});
  375. # On read error wait a short while for the device to recover
  376. if (!defined($result) || $result eq '' || !($result =~ /[[:print:]]/)) {
  377. print STDERR 'Read error. Delaying ' . (4 * $DELAY) . " seconds\n";
  378. sleep(4 * $DELAY);
  379. next;
  380. }
  381. # Process the (non-empty) result as requested
  382. if ($scmd->{'MATCH'}) {
  383. if ($result =~ $scmd->{'MATCH'}[0]) {
  384. if ($result =~ $scmd->{'MATCH'}[1]) {
  385. $STATUS{$cmd}->{'status'} = 1;
  386. } else {
  387. $STATUS{$cmd}->{'status'} = 0;
  388. }
  389. }
  390. } elsif ($scmd->{'REPLACE'}) {
  391. if ($result =~ $scmd->{'REPLACE'}) {
  392. $STATUS{$cmd}->{'status'} = $result;
  393. $STATUS{$cmd}->{'status'} =~ s/$scmd->{'REPLACE'}/$1/;
  394. }
  395. } elsif ($scmd->{'EVAL'}) {
  396. my $a = $result;
  397. if ($result =~ $scmd->{'EVAL'}[0]) {
  398. eval($scmd->{'EVAL'}[1]);
  399. $STATUS{$cmd}->{'status'} = $a;
  400. }
  401. } else {
  402. die('Invalid status match type "' . (keys(%{$scmd}))[0] . '" in command: ' . $cmd . "\n");
  403. }
  404. # Ensure the data is clean
  405. $STATUS{$cmd}->{'status'} =~ s/[^\w\.\-]/_/g;
  406. # If something has changed, save the state to disk
  407. # (if the output file does not exist, something has changed)
  408. if ($STATUS{$cmd}->{'status'} ne $STATUS{$cmd}->{'last'} || !-r $STATUS{$cmd}->{'path'}) {
  409. if ($DEBUG) {
  410. print STDERR 'New ' . uc($DEV) . ' status: ' . $cmd . ' => ' . $STATUS{$cmd}->{'status'} . "\n";
  411. }
  412. my ($fh, $tmp) = tempfile($STATUS{$cmd}->{'path'} . '.XXXXXXXX', 'UNLINK' => 0);
  413. print $fh $STATUS{$cmd}->{'status'} . "\n";
  414. close($fh);
  415. rename($tmp, $STATUS{$cmd}->{'path'});
  416. }
  417. }
  418. }
  419. }
  420. # Cleanup
  421. undef($select);
  422. $port->close();
  423. undef($port);
  424. exit(0);
  425. sub sendQuery($$) {
  426. my ($port, $query) = @_;
  427. # Enforce an inter-command delay
  428. usleep($SILENCE_TIMEOUT);
  429. # Read until the queue is clear (i.e. no data available)
  430. # Since we don't have flow control this always causes one read timeout
  431. $port->lookclear();
  432. clearBuffer($port);
  433. # Send the command
  434. my $bytes = $port->write($query . $CRLF);
  435. if ($DEBUG) {
  436. print STDERR "\tWrote (" . $bytes . '): ' . $query . "\n";
  437. }
  438. # Wait for a reply (delimited or timeout)
  439. return collectUntil($port, $DELIMITER);
  440. }
  441. sub clearBuffer($) {
  442. my ($port) = @_;
  443. my $byte = 1;
  444. while (length($byte) > 0) {
  445. $byte = $port->read(1);
  446. if ($DEBUG && length($byte)) {
  447. print STDERR "\tIgnored: " . $byte . "\n";
  448. }
  449. }
  450. }
  451. sub collectUntil($$) {
  452. my ($port, $delim) = @_;
  453. my $char = substr($delim, 0, 1);
  454. # This byte-by-byte reading is not efficient, but it's safe
  455. # Allow reading forever as long as we don't exceed the silence timeout
  456. my $count = 0;
  457. my $string = '';
  458. my $end = undef();
  459. while ($count < $SILENCE_TIMEOUT / $BYTE_TIMEOUT) {
  460. my $byte = $port->read(1);
  461. if (length($byte)) {
  462. $count = 0;
  463. $string .= $byte;
  464. if ($DEBUG > 1) {
  465. print STDERR "\tRead: " . $byte . "\n";
  466. }
  467. if (defined($end)) {
  468. $end .= $byte;
  469. if ($end eq $delim) {
  470. last;
  471. } elsif ($end ne substr($delim, 0, length($end))) {
  472. undef($end);
  473. }
  474. } elsif ($byte eq $char) {
  475. if (length($delim) == 1) {
  476. last;
  477. } else {
  478. $end = $byte;
  479. }
  480. }
  481. } else {
  482. $count++;
  483. }
  484. }
  485. # Return undef if there was no data (as opposed to just a delimiter and/or whitespace)
  486. if (length($string) < 1) {
  487. if ($DEBUG) {
  488. print STDERR "Read: <NO DATA>\n";
  489. }
  490. return undef();
  491. }
  492. # Translate CRLF and CR to LF
  493. $string =~ s/\r\n/\n/g;
  494. $string =~ s/\r/\n/g;
  495. # Strip the trailing delimiter
  496. $string =~ s/${char}$//;
  497. # Strip leading or trailing whitespace
  498. $string =~ s/^\s+//;
  499. $string =~ s/\s+$//;
  500. # Return our clean string
  501. if ($DEBUG) {
  502. print STDERR 'Read: ' . $string . "\n";
  503. }
  504. return $string;
  505. }
  506. sub parseHDMI($$) {
  507. my ($type, $raw) = @_;
  508. my %data = (
  509. 'SOURCE' => 0,
  510. 'SOURCE_2' => 0,
  511. 'IN1' => 0,
  512. 'IN2' => 0,
  513. 'HDCP1' => 0,
  514. 'HDCP2' => 0,
  515. 'OUT1' => 0,
  516. 'OUT2' => 0,
  517. 'GAININ' => 0,
  518. 'GAINOUT' => 0,
  519. 'EQ' => 0,
  520. 'RC' => 0,
  521. );
  522. my $section = undef();
  523. foreach my $line (split(/(\r|\n)+/, $raw)) {
  524. if ($line =~ /^=/ || $line eq 'EGO Switch - 2-Bus') {
  525. $section = undef();
  526. next;
  527. } elsif ($line =~ /^\s*$/) {
  528. next;
  529. } elsif ($line =~ /^RC ID - (\d+)\s*$/) {
  530. $data{'RC'} = $1;
  531. } elsif ((defined($section) && $section eq 'OUT') || $line =~ /Output:/) {
  532. $section = 'OUT';
  533. parseHDMILine(\%data, $section, $line);
  534. } elsif ((defined($section) && $section eq 'IN') || $line =~ /Input:/) {
  535. $section = 'IN';
  536. parseHDMILine(\%data, $section, $line);
  537. }
  538. }
  539. return $data{$type};
  540. }
  541. sub parseHDMILine($$$) {
  542. my ($data, $dir, $line) = @_;
  543. my ($port, $plug, $eq, $gain, $hdcp, $source) = $line =~
  544. /^\D+(\d+)\s+(\S+)\s+(EQ\:\d+|on|off)\s+VCO\:(\d+)\s+(\S+)(?:\s+(\S.*\S))?\s*$/;
  545. if (!defined($port) || $port < 1 || $port > 2) {
  546. warn('Could not parse HDMI line: ' . $line . "\n");
  547. next;
  548. }
  549. if ($plug eq 'Plugged') {
  550. $data->{$dir . $port} = 1;
  551. }
  552. if ($eq) {
  553. if ($dir eq 'OUT') {
  554. if ($eq eq 'on') {
  555. $data->{'OUT' . $port} = 1;
  556. } else {
  557. $data->{'OUT' . $port} = 0;
  558. }
  559. } else {
  560. ($data->{'EQ'}) = $eq =~ /EQ:(\d+)/;
  561. }
  562. }
  563. if ($gain) {
  564. $data->{'GAIN' . $dir} = $gain;
  565. }
  566. if ($hdcp) {
  567. $data->{'HDCP' . $port} = $hdcp;
  568. }
  569. if (defined($source) && $source =~ /Source of Output (\d(?:,\d)?)/i) {
  570. my $target = $1;
  571. my $name = 'PLEX';
  572. if ($port == 2) {
  573. $name = 'GAME';
  574. }
  575. if ($target =~ /1/) {
  576. $data->{'SOURCE'} = $name;
  577. }
  578. if ($target =~ '2') {
  579. $data->{'SOURCE_2'} = $name;
  580. }
  581. }
  582. }