Audio.pm 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use POSIX;
  5. use File::Basename;
  6. use IPC::System::Simple;
  7. use Time::HiRes qw( usleep sleep time );
  8. # Package name
  9. package Audio;
  10. # Config
  11. my $MEDIA_PATH = `~/bin/video/mediaPath`;
  12. # App config
  13. my $DATA_DIR = DMX::dataDir();
  14. my $QT_FILE = $DATA_DIR . 'QT_PLAYER';
  15. my $QT_SOCK = $QT_FILE . '.socket';
  16. my $WAIT_DELAY = 0.1;
  17. my $MAX_WAIT = 5 / $WAIT_DELAY;
  18. # Debug
  19. my $DEBUG = 0;
  20. if ($ENV{'DEBUG'}) {
  21. $DEBUG = 1;
  22. }
  23. # State
  24. my %FILES = ();
  25. my $SOCK = undef();
  26. # Send the provided arguments to the QT socket
  27. sub sendCmd(@) {
  28. # Connect the socket as needed
  29. if (!$SOCK) {
  30. $SOCK = DMX::clientSock($QT_SOCK);
  31. }
  32. # Ensure the data is compatible with the encoding scheme
  33. foreach my $part (@_) {
  34. if ($part =~ /\|/) {
  35. die('Invalid QT command component: ' . $part . "\n");
  36. }
  37. }
  38. # Build the command stirng
  39. my $str = join('|', @_);
  40. if ($DEBUG) {
  41. print STDERR 'Sending QT_PLAYER command: ' . $str . "\n";
  42. }
  43. # Send the command
  44. $SOCK->send($str)
  45. or die("Unable to send to QT socket\n");
  46. }
  47. # Execute the provided string with osascript
  48. sub runApplescript($) {
  49. my ($script) = @_;
  50. if ($DEBUG) {
  51. print STDERR 'AppleScript: ' . $script . "\n";
  52. }
  53. my $retval = IPC::System::Simple::capture('osascript', '-e', $script);
  54. $retval =~ s/[\r\n]$//;
  55. if ($DEBUG) {
  56. print STDERR "\tAppleScript result: " . $retval . "\n";
  57. }
  58. return $retval;
  59. }
  60. # Is the named document loaded?
  61. sub loaded($) {
  62. my ($name) = @_;
  63. parseList();
  64. return exists($FILES{$name});
  65. }
  66. # Load a document
  67. sub load($$) {
  68. my ($name, $path) = @_;
  69. # Unload as needed
  70. if (loaded($name)) {
  71. unload($name);
  72. }
  73. # Request load
  74. sendCmd('LOAD', $name, $path);
  75. # Wait for the load to register
  76. my $count = 0;
  77. while (!loaded($name)) {
  78. Time::HiRes::sleep($WAIT_DELAY);
  79. $count++;
  80. if ($count > $MAX_WAIT) {
  81. die('Unable to open file: ' . $name . "\n");
  82. }
  83. }
  84. }
  85. # Unload the named document
  86. sub unload($) {
  87. my ($name) = @_;
  88. if ($DEBUG) {
  89. print STDERR 'Audio::loadAudio(): ' . $name . "\n";
  90. }
  91. # Request unload
  92. sendCmd('UNLOAD', $name);
  93. # Wait for the unload to register
  94. my $count = 0;
  95. while (loaded($name)) {
  96. Time::HiRes::sleep($WAIT_DELAY);
  97. $count++;
  98. if ($count > $MAX_WAIT) {
  99. die('Unable to close file: ' . $name . "\n");
  100. }
  101. }
  102. }
  103. # Play the named document, waiting for completion
  104. sub play($) {
  105. my ($name) = @_;
  106. if ($DEBUG) {
  107. print STDERR 'Audio::play(): ' . $name . "\n";
  108. }
  109. # Ensure the file is loaded
  110. dieUnloaded($name);
  111. my @cmd = ('tell application "QuickTime Player"');
  112. push(@cmd, 'play document ' . $FILES{$name});
  113. push(@cmd, 'repeat while playing of document ' . $FILES{$name} . ' = true');
  114. push(@cmd, 'delay 0.1');
  115. push(@cmd, 'end repeat');
  116. push(@cmd, 'end tell');
  117. runApplescript(join("\n", @cmd));
  118. }
  119. # Play the named document and immediately return
  120. sub background($) {
  121. my ($name) = @_;
  122. if ($DEBUG) {
  123. print STDERR 'Audio::background(): ' . $name . "\n";
  124. }
  125. # Ensure the file is loaded
  126. dieUnloaded($name);
  127. runApplescript('tell application "QuickTime Player" to play document ' . $FILES{$name});
  128. }
  129. # Pause the named document
  130. sub pause($) {
  131. my ($name) = @_;
  132. if ($DEBUG) {
  133. print STDERR 'Audio::pause(): ' . $name . "\n";
  134. }
  135. # Ensure the file is loaded
  136. dieUnloaded($name);
  137. runApplescript('tell application "QuickTime Player" to pause document ' . $FILES{$name});
  138. }
  139. # Stop playback of the named document
  140. sub stop($) {
  141. my ($name) = @_;
  142. if ($DEBUG) {
  143. print STDERR "Audio::stopAudio()\n";
  144. }
  145. # Ensure the file is loaded
  146. dieUnloaded($name);
  147. # Stop and rewind
  148. runApplescript('tell application "QuickTime Player" to stop document ' . $FILES{$name});
  149. runApplescript('tell application "QuickTime Player" to set current time of document ' . $FILES{$name} . ' to 0');
  150. }
  151. # Is the named document playing?
  152. sub playing($) {
  153. my ($name) = @_;
  154. if ($DEBUG) {
  155. print STDERR 'Audio::playing(): ' . $name . "\n";
  156. }
  157. # Ensure the file is loaded
  158. dieUnloaded($name);
  159. # QT has a "playing" property but it is only true when rate == 1.0
  160. my $rate = rate($name);
  161. if ($rate > 0) {
  162. return 1;
  163. }
  164. return 0;
  165. }
  166. # Set or get the audio position
  167. sub position($$) {
  168. my ($name, $new) = @_;
  169. if ($DEBUG) {
  170. print STDERR 'Audio::position(): ' . $name . "\n";
  171. }
  172. # Ensure the file is loaded
  173. dieUnloaded($name);
  174. if ($new) {
  175. runApplescript('tell application "QuickTime Player" to set current time of document ' . $FILES{$name} . ' to ' . $new);
  176. } else {
  177. return runApplescript('tell application "QuickTime Player" to get current time of document ' . $FILES{$name});
  178. }
  179. }
  180. # Set or get the playback rate
  181. sub rate($$) {
  182. my ($name, $new) = @_;
  183. if ($DEBUG) {
  184. print STDERR 'Audio::rate(): ' . $name . "\n";
  185. }
  186. # Ensure the file is loaded
  187. dieUnloaded($name);
  188. if ($new) {
  189. runApplescript('tell application "QuickTime Player" to set rate of document ' . $FILES{$name} . ' to ' . $new);
  190. } else {
  191. return runApplescript('tell application "QuickTime Player" to get rate of document ' . $FILES{$name});
  192. }
  193. }
  194. # Set or get a document's volume
  195. sub volume($$) {
  196. my ($name, $new) = @_;
  197. if ($DEBUG) {
  198. print STDERR 'Audio::volume(): ' . $name . "\n";
  199. }
  200. # Ensure the file is loaded
  201. dieUnloaded($name);
  202. if ($new) {
  203. runApplescript('tell application "QuickTime Player" to set audio volume of document ' . $FILES{$name} . ' to ' . $new);
  204. } else {
  205. return runApplescript('tell application "QuickTime Player" to get audio volume of document ' . $FILES{$name});
  206. }
  207. }
  208. # Set or get the system output volume
  209. sub systemVolume($) {
  210. my ($new) = @_;
  211. if ($DEBUG) {
  212. print STDERR "Audio::systemVolume()\n";
  213. }
  214. if ($new) {
  215. runApplescript('set volume output volume ' . $new);
  216. } else {
  217. return runApplescript('get output volume of (get volume settings)');
  218. }
  219. }
  220. # Stop playback on all documents
  221. sub stopAll() {
  222. sendCmd('STOP');
  223. }
  224. # Reset the entire QT Player process
  225. sub reset() {
  226. sendCmd('RESET');
  227. }
  228. # Read and parse the qt_player file list
  229. sub parseList() {
  230. %FILES = ();
  231. open(my $fh, $QT_FILE)
  232. or die('Unable to open QT_PLAYER file: ' . $! . "\n");
  233. while (<$fh>) {
  234. my ($name, $handle) = $_ =~ /^([^|]+)\|\s*(\".+\")\s*$/;
  235. if (!$name || !$handle) {
  236. die('Invalid QT_PLAYER line: ' . $_);
  237. }
  238. $FILES{$name} = $handle;
  239. }
  240. close($fh);
  241. }
  242. sub dieUnloaded($) {
  243. my ($name) = @_;
  244. if (!loaded($name)) {
  245. die('File not loaded: ' . $name . "\n");
  246. }
  247. }
  248. # Always return true
  249. 1;