source: subversion/applications/rendering/tilesAtHome/tahlib.pm @ 2634

Last change on this file since 2634 was 2634, checked in by deelkar, 13 years ago

move sub killafile to tahlib.pm

File size: 4.4 KB
Line 
1use strict; 
2
3# =====================================================================
4# The following is duplicated from tilesGen.pl
5# =====================================================================
6my %Config = ReadConfig("tilesAtHome.conf", "general.conf", "authentication.conf", "layers.conf");
7my $lastmsglen = 0;
8
9my $idleFor = 0;
10my $idleSeconds = 0;
11
12#-----------------------------------------------------------------------------
13# Prints status message without newline, overwrites previous message
14# (if $newline set, starts new line after message)
15#-----------------------------------------------------------------------------
16sub statusMessage 
17{
18    my ($msg, $Verbose, $currentSubTask, $progressJobs, $progressPercent, $newline) = @_;
19
20    if ($Verbose)
21    {
22        print STDERR "$msg\n";
23        return;
24    }
25
26    my $toprint = sprintf("[#%d %3d%% %s] %s%s ", $progressJobs, $progressPercent+.5, $currentSubTask, $msg, ($newline) ? "" : "...");
27    my $curmsglen = length($toprint);
28    print STDERR "\r$toprint";
29    print STDERR " " x ($lastmsglen-$curmsglen);
30    if ($newline)
31    {
32        $lastmsglen = 0;
33        print STDERR "\n";
34    }
35    else
36    {
37        $lastmsglen = $curmsglen;
38    }
39
40}
41
42#-----------------------------------------------------------------------------
43# Used to display task completion. Only for verbose mode.
44#-----------------------------------------------------------------------------
45sub doneMessage
46{
47    my ($msg,$Verbose) = @_;
48    $msg = "done" if ($msg eq "");
49
50    if ($Verbose)
51    {
52        print STDERR "$msg\n";
53        return;
54    }
55}
56
57#-----------------------------------------------------------------------------
58# A sleep function with visible countdown
59#-----------------------------------------------------------------------------
60sub talkInSleep
61{
62    my ($message, $duration,$progstart,$idleFor,$idleSeconds,$Verbose) = @_;
63    if ($Verbose)
64    {
65        print STDERR "$message: sleeping $duration seconds\n";
66        sleep $duration;
67        return;
68    }
69
70    for (my $i = 0; $i< $duration; $i++)
71    {
72        my $totalseconds = time() - $progstart;
73        statusMessage(sprintf("%s. Idle for %d:%02d (%d%% idle) ", 
74                $message,
75                $idleFor/60, $idleFor%60,
76                $totalseconds ? $idleSeconds * 100 / $totalseconds : 100));
77        sleep 1;
78        $idleFor++;
79        $idleSeconds++;
80    }
81}
82
83sub setIdle
84{
85    my ($idle,$setTotal) = @_;
86    if ($setTotal)
87    {
88        $idleSeconds = $idle;
89    }
90    else
91    {
92        $idleFor = $idle;
93    }
94}
95
96sub getIdle
97{
98    my $getTotal = @_;
99    if ($getTotal)
100    {
101      return $idleSeconds;
102    }
103    else
104    {
105      return $idleFor;
106    }
107}
108
109
110#-----------------------------------------------------------------------------
111# Run a shell command. Suppress command's stderr output unless it terminates
112# with an error code.
113#
114# Return 1 if ok, 0 on error.
115#-----------------------------------------------------------------------------
116sub runCommand
117{
118    my ($cmd,$mainPID) = @_;
119
120    # $message is deprecated, issue statusmessage prior to exec.
121    # statusMessage($message, $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
122
123
124    if ($Config{Verbose})
125    {
126        my $retval = system($cmd);
127        return ($retval<0) ? 0 : ($retval>>8) ? 0 : 1;
128    }
129
130    my $ErrorFile = $Config{WorkingDirectory}."/".$mainPID.".stderr";
131    my $retval = system("$cmd 2> $ErrorFile");
132    my $ok = 0;
133
134    # <0 means that the process could not start
135    if ($retval < 0)
136    {
137        print STDERR "ERROR:\n";
138        print STDERR "  Could not run the following command:\n";
139        print STDERR "  $cmd\n";
140        print STDERR "  Please check your installation.\n";
141    } 
142    else
143    {
144        $retval = $retval >> 8;
145        if ($retval)
146        {
147            print STDERR "ERROR\n";
148            print STDERR "  The following command produced an error message:\n";
149            print STDERR "  $cmd\n";
150            print STDERR "  Debug output follows:\n";
151            open(ERR, $ErrorFile);
152            while(<ERR>)
153            {
154                print STDERR "  | $_";
155            }
156            close(ERR);
157        }
158        else
159        {
160            $ok = 1;
161        }
162    }
163   
164    killafile($ErrorFile);
165    return $ok;
166}
167
168#-----------------------------------------------------------------------------
169# Delete a file if it exists
170#-----------------------------------------------------------------------------
171sub killafile($){
172  my $file = shift();
173  unlink $file if(-f $file);
174}
175
1761;
177
Note: See TracBrowser for help on using the repository browser.