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

Last change on this file since 4787 was 4787, checked in by deelkar, 12 years ago

clarify message

File size: 6.6 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,$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    my $ExtraInfo = "\nAdditional info about the Error(s):\n";
134
135    # <0 means that the process could not start
136    if ($retval < 0)
137    {
138        print STDERR "ERROR:\n";
139        print STDERR "  Could not run the following command:\n";
140        print STDERR "  $cmd\n";
141        print STDERR "  Please check your installation.\n";
142    } 
143    else
144    {
145        $retval = $retval >> 8;
146        if ($retval)
147        {
148            print STDERR "ERROR\n";
149            print STDERR "  The following command produced an error message:\n";
150            print STDERR "  $cmd\n";
151            print STDERR "  Debug output follows:\n";
152            open(ERR, $ErrorFile);
153            while(<ERR>)
154            {
155                print STDERR "  | $_";
156                if (grep(/preferences.xml/,$_))
157                {
158                    $ExtraInfo=$ExtraInfo."\n * Inkscape preference file corrupt. Delete ~/.inkscape/preferences.xml to continue";
159                }
160                if (grep(/infinite template recursion/,$_))
161                {
162                    $ExtraInfo=$ExtraInfo."\n * Tile too complex for Xmlstarlet, possibly an excessively long way";
163                }
164            }
165            close(ERR);
166            print STDERR $ExtraInfo."\n\n";
167        }
168        else
169        {
170            $ok = 1;
171        }
172    }
173   
174    killafile($ErrorFile);
175    return $ok;
176}
177
178#-----------------------------------------------------------------------------
179# Delete a file if it exists
180#-----------------------------------------------------------------------------
181sub killafile($){
182  my $file = shift();
183  unlink $file if(-f $file);
184}
185
186#-----------------------------------------------------------------------------
187# GET a URL and save contents to file
188#-----------------------------------------------------------------------------
189sub DownloadFile 
190{
191    my ($URL, $File, $UseExisting) = @_;
192
193    my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 1800);
194    $ua->agent("tilesAtHome");
195    $ua->env_proxy();
196
197    if(!$UseExisting) 
198    {
199        killafile($File);
200    }
201    # Note: mirror sets the time on the file to match the server time. This
202    # is important for the handling of JobTime later.
203                 $ua->mirror($URL, $File);
204
205    doneMessage(sprintf("done, %d bytes", -s $File));
206}
207
208#-----------------------------------------------------------------------------
209# Clean up temporary files before exit, then exit or return with error
210# depending on mode (loop, xy, ...)
211#-----------------------------------------------------------------------------
212sub cleanUpAndDie
213{
214    my ($Reason,$Mode,$Severity,$mainPID) = @_;
215
216    ## TODO: clean up *.tempdir too
217
218    print STDERR "\nExiting from $Reason\n" if ($Config{"Verbose"});
219
220    if (! $Config{"Debug"}) 
221    {
222        opendir (TEMPDIR, $Config{"WorkingDirectory"});
223        my @files = grep { /$mainPID/ } readdir(TEMPDIR); # FIXME: this will get files from other processes using the same Working Directory for low pids because the numbers will collide with tile coordinates
224        closedir (TEMPDIR);
225        while (my $file = shift @files)
226        {
227             print STDERR "deleting ".$Config{"WorkingDirectory"}."/".$file."\n" if ($Config{"Verbose"});
228             killafile($Config{"WorkingDirectory"}."/".$file);
229        }
230       
231    }
232   
233    return 0 if ($Mode eq "loop");
234    exit($Severity);
235}
236
2371;
238
Note: See TracBrowser for help on using the repository browser.