Преглед изворни кода

Add timeouts to all AppleScript and open calls

Zachary Kotlarek пре 13 година
родитељ
комит
5e9504e9ae
2 измењених фајлова са 50 додато и 12 уклоњено
  1. 17 5
      dmx/Audio.pm
  2. 33 7
      dmx/qt_player.pl

+ 17 - 5
dmx/Audio.pm

@@ -4,7 +4,8 @@ use warnings;
 use POSIX;
 use POSIX;
 use File::Basename;
 use File::Basename;
 use IPC::System::Simple;
 use IPC::System::Simple;
-use Time::HiRes qw( usleep sleep time );
+use Time::Out;
+use Time::HiRes;
 
 
 # Package name
 # Package name
 package Audio;
 package Audio;
@@ -18,6 +19,7 @@ my $QT_SOCK    = 'QT_PLAYER';
 my $QT_FILE    = $DATA_DIR . $QT_SOCK;
 my $QT_FILE    = $DATA_DIR . $QT_SOCK;
 my $WAIT_DELAY = 0.1;
 my $WAIT_DELAY = 0.1;
 my $MAX_WAIT   = 5 / $WAIT_DELAY;
 my $MAX_WAIT   = 5 / $WAIT_DELAY;
+my $TIMEOUT_AS = 10;
 
 
 # Debug
 # Debug
 my $DEBUG = 0;
 my $DEBUG = 0;
@@ -62,10 +64,20 @@ sub runApplescript($) {
 		print STDERR 'AppleScript: ' . $script . "\n";
 		print STDERR 'AppleScript: ' . $script . "\n";
 	}
 	}
 
 
-	my $retval = IPC::System::Simple::capture('osascript', '-e', $script);
-	$retval =~ s/[\r\n]$//;
-	if ($DEBUG) {
-		print STDERR "\tAppleScript result: " . $retval . "\n";
+	# Die if operations take too long
+	my $retval = Time::Out::timeout $TIMEOUT_AS => sub {
+		return IPC::System::Simple::capture('osascript', '-e', $script);
+	};
+	if ($@) {
+		die("Applescript execution timed out\n");
+	}
+
+	# Clean up the return value
+	if (defined($retval)) {
+		$retval =~ s/[\r\n]$//;
+		if ($DEBUG) {
+			print STDERR "\tAppleScript result: " . $retval . "\n";
+		}
 	}
 	}
 
 
 	return $retval;
 	return $retval;

+ 33 - 7
dmx/qt_player.pl

@@ -3,6 +3,7 @@ use strict;
 use warnings;
 use warnings;
 use File::Basename;
 use File::Basename;
 use IPC::System::Simple;
 use IPC::System::Simple;
+use Time::Out qw( timeout );
 
 
 # Local modules
 # Local modules
 use Cwd qw(abs_path);
 use Cwd qw(abs_path);
@@ -22,13 +23,15 @@ sub unload($);
 sub stop();
 sub stop();
 sub printFiles();
 sub printFiles();
 sub cmdApp($$);
 sub cmdApp($$);
+sub openQT($);
 
 
 # App config
 # App config
-my $DATA_DIR    = DMX::dataDir();
-my $STATE_SOCK  = 'QT_PLAYER';
+my $DATA_DIR     = DMX::dataDir();
+my $STATE_SOCK   = 'QT_PLAYER';
 my $OUTPUT_FILE  = $DATA_DIR . $STATE_SOCK;
 my $OUTPUT_FILE  = $DATA_DIR . $STATE_SOCK;
-my $DELAY       = 5;
-my $MAX_CMD_LEN = 16384;
+my $DELAY        = 5;
+my $MAX_CMD_LEN  = 16384;
+my $TIMEOUT_OPEN = 10;
 
 
 # Debug
 # Debug
 my $DEBUG = 0;
 my $DEBUG = 0;
@@ -120,7 +123,7 @@ sub init() {
 	cmdApp('QuickTime Player', 'close every document');
 	cmdApp('QuickTime Player', 'close every document');
 	cmdApp('QuickTime Player', 'quit');
 	cmdApp('QuickTime Player', 'quit');
 	sleep(1);
 	sleep(1);
-	IPC::System::Simple::system('open', '-a', 'QuickTime Player');
+	openQT(undef());
 
 
 	# Always load and play the SILENCE file (for sanity and general init)
 	# Always load and play the SILENCE file (for sanity and general init)
 	load('SILENCE', 'DMX/Silence.wav');
 	load('SILENCE', 'DMX/Silence.wav');
@@ -157,8 +160,7 @@ sub load($$) {
 	my $count = Audio::runApplescript('tell application "QuickTime Player" to count items of every document');
 	my $count = Audio::runApplescript('tell application "QuickTime Player" to count items of every document');
 
 
 	# Open the file
 	# Open the file
-	# It would be nice to use AppleScript here, so we can get a more definitive name, but the open() call is borked
-	IPC::System::Simple::system('open', '-a', 'QuickTime Player', $path);
+	openQT($path);
 
 
 	# Wait for QT to load the new file
 	# Wait for QT to load the new file
 	# To avoid indefinate hangs this will give up after 5 seconds
 	# To avoid indefinate hangs this will give up after 5 seconds
@@ -233,10 +235,34 @@ sub printFiles() {
 # Request the specified action from the provided app, if it's already running
 # Request the specified action from the provided app, if it's already running
 sub cmdApp($$) {
 sub cmdApp($$) {
 	my ($app, $cmd) = @_;
 	my ($app, $cmd) = @_;
+
+	# Ask AppleScript to execute the provided command only if the specified app is already running
 	my @cmd = ('tell application "System Events"');
 	my @cmd = ('tell application "System Events"');
 	push(@cmd, 'if exists process "' . $app . '" then');
 	push(@cmd, 'if exists process "' . $app . '" then');
 	push(@cmd, 'tell application "' . $app . '" to ' . $cmd);
 	push(@cmd, 'tell application "' . $app . '" to ' . $cmd);
 	push(@cmd, 'end if');
 	push(@cmd, 'end if');
 	push(@cmd, 'end tell');
 	push(@cmd, 'end tell');
+
+	# Execute
 	Audio::runApplescript(join("\n", @cmd));
 	Audio::runApplescript(join("\n", @cmd));
 }
 }
+
+# Activate QT player, optionally loading a document
+# It would be nice to use AS here to get a more definitive document name, but the open() call is QT player is borked
+sub openQT($) {
+	my ($doc) = @_;
+	
+	# Build the open command
+	my @cmd = ('open', '-a', 'QuickTime Player');
+	if ($doc) {
+		push(@cmd, $doc);
+	}
+	
+	# Execute, dying on timeout
+	timeout $TIMEOUT_OPEN => sub {
+		IPC::System::Simple::system(@cmd);
+	};
+	if ($@) {
+		die("Open command timed out\n");
+	}
+}