Zachary Kotlarek 14 лет назад
Родитель
Сommit
1f99b2e25a
2 измененных файлов с 96 добавлено и 0 удалено
  1. 95 0
      Run.pm
  2. 1 0
      transmission.pl

+ 95 - 0
Run.pm

@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+#-----------------------------------------------------------------------------
+## @file Run.pm
+#  @brief A module for running perl scripts in threaded environment
+#  @see Run.pm
+
+## @class Run
+
+
+# Package
+package Run;
+
+# Globals
+my $DEBUG = 0;
+
+#----------------------------------------------------------------------
+## @fn runAndWar(@)
+#  @brief Run and warn
+#  @param args array
+#  @return 1 is successful, 0 if not
+sub runAndWarn(@) {
+	my (@args) = (@_);
+	if ($DEBUG) {
+		print STDERR "Run::runAndWarn()\n";
+	}
+
+	# Run
+	my $res = Run::run(@args);
+
+	# Die on any error
+	if ($res == -1) {
+		warn('Unable to execute program: ' . join(' ', @args) . ': ' . $! . "\n");
+		return 0;
+	} elsif ($res & 127) {
+		warn('Child exited on signal: ' . join(' ', @args) . ': ' . ($res & 127) . "\n");
+		return 0;
+	} elsif ($res != 0) {
+		warn('Child exited with non-zero value: ' . join(' ', @args) . ': ' . ($res >> 8) . "\n");
+		return 0;
+	}
+
+	# If we get here, all is well
+	return 1;
+}
+
+#----------------------------------------------------------------------
+## @fn runAndCheck(@)
+#  @brief Run and check
+#  @param args
+#  @return 1 if successful, 0 if not
+sub runAndCheck(@) {
+	my (@args) = (@_);
+	if ($DEBUG) {
+		print STDERR "Run::runAndCheck()\n";
+	}
+
+	# Run
+	my $res = Run::run(@args);
+
+	# Die on any error
+	if ($res == -1) {
+		die('Unable to execute program: ' . join(' ', @args) . ': ' . $! . "\n");
+	} elsif ($res & 127) {
+		die('Child exited on signal: ' . join(' ', @args) . ': ' . ($res & 127) . "\n");
+	} elsif ($res != 0) {
+		die('Child exited with non-zero value: ' . join(' ', @args) . ': ' . ($res >> 8) . "\n");
+	}
+
+	# If we get here, all is well
+	return 1;
+}
+
+#----------------------------------------------------------------------
+## @fn run(@)
+#  @brief Run
+#  @param args arry
+#  @return results
+sub run(@) {
+	my (@args) = (@_);
+	if ($DEBUG) {
+		print STDERR 'Run::run: ' . join(' ', @args) . "\n";
+	}
+
+	# Run
+	system { $args[0] } @args;
+
+	# Return the result
+	return $?;
+}
+
+# Packages must return true
+return 1;

+ 1 - 0
transmission.pl

@@ -9,6 +9,7 @@ use File::Temp qw/ :mktemp /;
 use File::Basename;
 use FindBin qw($Bin);
 use lib $Bin;
+use Run;
 use Fetch;
 
 # Prototypes