|
0
|
1 #!/usr/bin/perl
|
|
|
2
|
|
|
3 #-------------------------------------------------------------------------------
|
|
|
4 # Simple queue management program
|
|
|
5 # Attempts to keep 'numProc' processes running at the same time
|
|
|
6 #
|
|
|
7 # Proceses are defined in a file (one line per process)
|
|
|
8 #
|
|
|
9 # Every executed process creates two files: 'pid.stdout' and 'pid.stderr' where
|
|
|
10 # pid is the process ID. The files contain STDOUT and STDERR for that process.
|
|
|
11 #
|
|
|
12 # Pablo Cingolani
|
|
|
13 #-------------------------------------------------------------------------------
|
|
|
14
|
|
|
15 use strict;
|
|
|
16 use POSIX;
|
|
|
17
|
|
|
18
|
|
|
19 my($uptimeCmd) = "/usr/bin/uptime"; # Uptime command
|
|
|
20 my($maxUptime);
|
|
|
21 $| = 1; # Don't use buffers for STDIN/STDOUT
|
|
|
22
|
|
|
23 #-------------------------------------------------------------------------------
|
|
|
24 # Should a new process be run?
|
|
|
25 # Check some conditions before trying to run the next process
|
|
|
26 #-------------------------------------------------------------------------------
|
|
|
27 sub shouldRun() {
|
|
|
28 if( $maxUptime < 0 ) { return 1; } # Always true if $maxUptime is negative
|
|
|
29 my($utRes) = `$uptimeCmd`;
|
|
|
30 my($ut) = 0;
|
|
|
31 if( $utRes =~ /load average:\s+(\d+\.\d+),/ ) { $ut = $1; }
|
|
|
32 return $ut < $maxUptime;
|
|
|
33 }
|
|
|
34
|
|
|
35 #-------------------------------------------------------------------------------
|
|
|
36 # Print something 'printLog' style
|
|
|
37 #-------------------------------------------------------------------------------
|
|
|
38 sub printLog($) {
|
|
|
39 my($str) = @_;
|
|
|
40 my($now) = strftime "%Y-%m-%d %H:%M:%S", localtime;
|
|
|
41 print "$now\t$str\n";
|
|
|
42 }
|
|
|
43
|
|
|
44 #-------------------------------------------------------------------------------
|
|
|
45 # Main
|
|
|
46 #-------------------------------------------------------------------------------
|
|
|
47 # Usage: queue numProc File
|
|
|
48 my($maxNumProc, $sleepTime, $file);
|
|
|
49 ($maxNumProc, $maxUptime, $sleepTime, $file) = @ARGV;
|
|
|
50 if( $file eq '' ) {
|
|
|
51 print "Usage: queue.pl maxNumProc maxUptime sleepTime file\n";
|
|
|
52 print "Where:\n";
|
|
|
53 print "\tnumProc Number of simultaneous processes\n";
|
|
|
54 print "\tmaxUptime Maximum allowed uptime (otherwise, pause before launching the next process). Negative means don't care.\n";
|
|
|
55 print "\tsleepTime Number of seconds to sleep after running a process (zero means no sleep)\n";
|
|
|
56 print "\tfile File containing all commands to be executed (one per line)\n";
|
|
|
57 exit(10);
|
|
|
58 }
|
|
|
59
|
|
|
60 #---
|
|
|
61 # Read file and launch processes
|
|
|
62 #---
|
|
|
63 my($cmd);
|
|
|
64 my($startTime) = time();
|
|
|
65 my($numProc) = 0;
|
|
|
66 open BATCH, $file;
|
|
|
67 while( $cmd = <BATCH> ) {
|
|
|
68 chomp $cmd;
|
|
|
69
|
|
|
70 # Can we launch more processes?
|
|
|
71 if( $numProc < $maxNumProc ) {
|
|
|
72
|
|
|
73 my( $run ) = 0;
|
|
|
74
|
|
|
75 do {
|
|
|
76 # Should the next process run now? (don't run if CPU is too high)
|
|
|
77 if( shouldRun() ) {
|
|
|
78 my $retFork = fork();
|
|
|
79 $run = 1;
|
|
|
80
|
|
|
81 if( $retFork == 0 ) { # Child process
|
|
|
82 # Redirect STDOUT and STDERR to files
|
|
|
83 open STDOUT, '>', "$$.stdout" or die "Can't redirect STDOUT (PID=$$): $!";
|
|
|
84 open STDERR, '>', "$$.stderr" or die "Can't redirect STDERR (PID=$$): $!";
|
|
|
85 exec($cmd);
|
|
|
86 } elsif ($retFork == '' ) { # Error launching process
|
|
|
87 print STDERR "Error launching process:\t'$cmd'\n";
|
|
|
88 } else {
|
|
|
89 printLog("Executing (PID=$retFork):\t'$cmd'");
|
|
|
90 $numProc++;
|
|
|
91 }
|
|
|
92 } else { printLog("No running"); }
|
|
|
93
|
|
|
94 # Sleep before next process
|
|
|
95 if( $sleepTime > 0 ) {
|
|
|
96 printLog "Sleep $sleepTime seconds";
|
|
|
97 sleep($sleepTime);
|
|
|
98 }
|
|
|
99 } while( ! $run );
|
|
|
100 }
|
|
|
101
|
|
|
102 # Number of processes exceded? => Wait until one finishes
|
|
|
103 if( $numProc >= $maxNumProc ) {
|
|
|
104 # Wait for processes to die
|
|
|
105 my $deadPid = wait();
|
|
|
106 printLog "Process PID=$deadPid finished.";
|
|
|
107 $numProc--;
|
|
|
108 if( $numProc > 0 ) { print "There " . ($numProc > 1 ? "are" : "is" ) . " still $numProc processes running.\n"; }
|
|
|
109 }
|
|
|
110 }
|
|
|
111
|
|
|
112 #---
|
|
|
113 # Done, wait for the remining processes to die
|
|
|
114 #---
|
|
|
115 my($deadPid);
|
|
|
116 while( ($deadPid = wait()) >= 0 ) { # Wait for processes to die
|
|
|
117 $numProc--;
|
|
|
118 my($now) = localtime();
|
|
|
119 printLog "Process PID=$deadPid finished.";
|
|
|
120 if( $numProc > 0 ) { print "There " . ($numProc > 1 ? "are" : "is" ) . " still $numProc processes running.\n"; }
|
|
|
121 }
|
|
|
122
|
|
|
123 my($elapsed) = time() - $startTime;
|
|
|
124 print "All processes finished.\nElapsed time $elapsed seconds.\n";
|
|
|
125
|
|
|
126 close BATCH;
|
|
|
127
|
