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

Last change on this file since 5487 was 5487, checked in by martinvoosterhout, 12 years ago

Whoops, stupid typo in test.

File size: 10.8 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
12my %faults; #variable to track non transient errors
13
14#-----------------------------------------------------------------------------
15# Prints status message without newline, overwrites previous message
16# (if $newline set, starts new line after message)
17#-----------------------------------------------------------------------------
18sub statusMessage 
19{
20    my ($msg, $Verbose, $currentSubTask, $progressJobs, $progressPercent, $newline) = @_;
21
22    if ($Verbose)
23    {
24        print STDERR "$msg\n";
25        return;
26    }
27
28    my $toprint = sprintf("[#%d %3d%% %s] %s%s ", $progressJobs, $progressPercent+.5, $currentSubTask, $msg, ($newline) ? "" : "...");
29    my $curmsglen = length($toprint);
30    print STDERR "\r$toprint";
31    print STDERR " " x ($lastmsglen-$curmsglen);
32    if ($newline)
33    {
34        $lastmsglen = 0;
35        print STDERR "\n";
36    }
37    else
38    {
39        $lastmsglen = $curmsglen;
40    }
41
42}
43
44#-----------------------------------------------------------------------------
45# Used to display task completion. Only for verbose mode.
46#-----------------------------------------------------------------------------
47sub doneMessage
48{
49    my ($msg,$Verbose) = @_;
50    $msg = "done" if ($msg eq "");
51
52    if ($Verbose)
53    {
54        print STDERR "$msg\n";
55        return;
56    }
57}
58
59#-----------------------------------------------------------------------------
60# A sleep function with visible countdown
61#-----------------------------------------------------------------------------
62sub talkInSleep
63{
64    my ($message, $duration,$progstart,$Verbose) = @_;
65    if ($Verbose)
66    {
67        print STDERR "$message: sleeping $duration seconds\n";
68        sleep $duration;
69        return;
70    }
71
72    for (my $i = 0; $i< $duration; $i++)
73    {
74        my $totalseconds = time() - $progstart;
75        statusMessage(sprintf("%s. Idle for %d:%02d (%d%% idle) ", 
76                $message,
77                $idleFor/60, $idleFor%60,
78                $totalseconds ? $idleSeconds * 100 / $totalseconds : 100));
79        sleep 1;
80        $idleFor++;
81        $idleSeconds++;
82    }
83}
84
85sub setIdle
86{
87    my ($idle,$setTotal) = @_;
88    if ($setTotal)
89    {
90        $idleSeconds = $idle;
91    }
92    else
93    {
94        $idleFor = $idle;
95    }
96}
97
98sub getIdle
99{
100    my $getTotal = @_;
101    if ($getTotal)
102    {
103      return $idleSeconds;
104    }
105    else
106    {
107      return $idleFor;
108    }
109}
110
111
112#-----------------------------------------------------------------------------
113# fault handling
114#-----------------------------------------------------------------------------
115sub addFault
116{
117    my ($faulttype,$diff) = @_;
118    $diff = 1 if (not $diff);
119    $faults{$faulttype} += $diff;
120    return $faults{$faulttype};
121}
122
123sub getFault
124{
125    my ($faulttype) = @_;
126    return $faults{$faulttype};
127}
128
129sub resetFault
130{
131    my ($faulttype) = @_;
132    $faults{$faulttype} = 0;
133    return "0 but true";
134}
135
136#-----------------------------------------------------------------------------
137# Run a shell command. Suppress command's stderr output unless it terminates
138# with an error code.
139#
140# Return 1 if ok, 0 on error.
141#-----------------------------------------------------------------------------
142sub runCommand
143{
144    my ($cmd,$mainPID) = @_;
145
146    # $message is deprecated, issue statusmessage prior to exec.
147    # statusMessage($message, $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
148
149
150    if ($Config{Verbose})
151    {
152        my $retval = system($cmd);
153        return $retval == 0;
154    }
155
156    my $ErrorFile = $Config{WorkingDirectory}."/".$mainPID.".stderr";
157    my $retval = system("$cmd 2> $ErrorFile");
158    my $ok = 0;
159    my $ExtraInfo = "\nAdditional info about the Error(s):\n";
160
161    # <0 means that the process could not start
162    if ($retval < 0)
163    {
164        print STDERR "ERROR:\n";
165        print STDERR "  Could not run the following command:\n";
166        print STDERR "  $cmd\n";
167        print STDERR "  Please check your installation.\n";
168    } 
169    else
170    {
171        # Technically the return value is ($retval >> 8) but if we only look
172        # at that we will miss the situations where the program died due to
173        # a signal. In that case $retval will be the signal that killed it.
174        # So any non-zero value is an error.
175       
176        if ($retval)
177        {
178            print STDERR "ERROR\n";
179            print STDERR "  The following command produced an error message:\n";
180            print STDERR "  $cmd\n";
181            print STDERR "  Debug output follows:\n";
182            open(ERR, $ErrorFile);
183            while(<ERR>)
184            {
185                print STDERR "  | $_";
186                if (grep(/preferences.xml/,$_))
187                {
188                    $ExtraInfo=$ExtraInfo."\n * Inkscape preference file corrupt. Delete ~/.inkscape/preferences.xml to continue";
189                    addFault("fatal",1); ## this error is fatal because it needs human intervention before processing can continue
190                }
191                if (grep(/infinite template recursion/,$_))
192                {
193                    $ExtraInfo=$ExtraInfo."\n * Tile too complex for Xmlstarlet, possibly an excessively long way, or too many maplint errors";
194                }
195            }
196            close(ERR);
197            print STDERR $ExtraInfo."\n\n";
198        }
199        else
200        {
201            $ok = 1;
202        }
203    }
204   
205    killafile($ErrorFile);
206    return $ok;
207}
208
209#-----------------------------------------------------------------------------
210# Delete a file if it exists
211#-----------------------------------------------------------------------------
212sub killafile($){
213  my $file = shift();
214  unlink $file if(-f $file);
215}
216
217#-----------------------------------------------------------------------------
218# Create a directory and all its parent directories
219# (equivalent to a "mkdir -p" on Unix, but stores already-created dirs
220# in a hash to avoid unnecessary system calls)
221#-----------------------------------------------------------------------------
222sub MagicMkdir
223{
224    my $file = shift;
225    my @paths = split("/", $file);
226    pop(@paths);
227    my $dir = "";
228    foreach my $path(@paths)
229    {
230        if ($dir eq "") {
231                $dir .= $path; # how are paths with leading "/" handled now?
232        }else{
233                $dir .= "/".$path;
234        }
235
236        if (!defined($madeDir{$dir}))
237        {
238            mkdir $dir;
239            $madeDir{$dir}=1;
240        }
241    }
242}
243
244#-----------------------------------------------------------------------------
245# GET a URL and save contents to file
246#-----------------------------------------------------------------------------
247sub DownloadFile 
248{
249    my ($URL, $File, $UseExisting) = @_;
250
251    my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 1800);
252    $ua->agent("tilesAtHome");
253    $ua->env_proxy();
254
255    if(!$UseExisting) 
256    {
257        killafile($File);
258    }
259    # Note: mirror sets the time on the file to match the server time. This
260    # is important for the handling of JobTime later.
261        $ua->mirror($URL, $File);
262
263    doneMessage(sprintf("done, %d bytes", -s $File));
264}
265
266#-----------------------------------------------------------------------------
267# Merge multiple OSM files into one, making sure that elements are present in
268# the destination file only once even if present in more than one of the input
269# files.
270#
271# This has become necessary in the course of supporting maplint, which would
272# get upset about duplicate objects created by combining downloaded stripes.
273#-----------------------------------------------------------------------------
274sub mergeOsmFiles
275{
276    my ($destFile, $sourceFiles) = @_;
277    my $existing = {};
278
279    # If there's only one file, just copy the input to the output
280    if( scalar(@$sourceFiles) == 1 )
281    {
282      copy $sourceFiles->[0], $destFile;
283      killafile ($sourceFiles->[0]) if (!$Config{Debug});
284      return;
285    }
286   
287    open (DEST, "> $destFile");
288
289    print DEST qq(<?xml version="1.0" encoding="UTF-8"?>\n);
290    my $header = 0;
291
292    foreach my $sourceFile(@{$sourceFiles})
293    {
294        open(SOURCE, $sourceFile);
295        while(<SOURCE>)
296        {
297            next if /^\s*<\?xml/;
298            # We want to copy the version number, but only the first time (obviously)
299            # Handle where the input doesn't have a version
300            if (/^\s*<osm.*(?:version=([\d.'"]+))?/)
301            {
302              if( not $header )
303              {
304                my $version = $1 || "'".$Config{"OSMVersion"}."'";
305                print DEST qq(<osm version=$version generator="tilesGen mergeOsmFiles">\n);
306                $header = 1;
307              }
308              next;
309            }
310            last if (/^\s*<\/osm>/);
311            if (/^\s*<(node|segment|way|relation) id="(\d+)".*(.)>/)
312            {
313                my ($what, $id, $slash) = ($1, $2, $3);
314                my $key = substr($what, 0, 1) . $id;
315                if (defined($existing->{$key}))
316                {
317                    # object exists already. skip!
318                    next if ($slash eq "/");
319                    while(<SOURCE>)
320                    {
321                        last if (/^\s*<\/$what>/);
322                    }
323                    next;
324                }
325                else
326                {
327                    # object didn't exist, note
328                    $existing->{$key} = 1;
329                }
330            }
331            print DEST;
332        }
333        close(SOURCE);
334        killafile ($sourceFile) if (!$Config{Debug});
335    }
336    print DEST "</osm>\n";
337    close(DEST);
338}
339
340
341#-----------------------------------------------------------------------------
342# Clean up temporary files before exit, then exit or return with error
343# depending on mode (loop, xy, ...)
344#-----------------------------------------------------------------------------
345sub cleanUpAndDie
346{
347    my ($Reason,$Mode,$Severity,$mainPID) = @_;
348
349    ## TODO: clean up *.tempdir too
350
351    print STDERR "\n$Reason\n" if ($Config{"Verbose"});
352
353    if (! $Config{"Debug"}) 
354    {
355        opendir (TEMPDIR, $Config{"WorkingDirectory"});
356        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
357        closedir (TEMPDIR);
358        while (my $file = shift @files)
359        {
360             print STDERR "deleting ".$Config{"WorkingDirectory"}."/".$file."\n" if ($Config{"Verbose"});
361             killafile($Config{"WorkingDirectory"}."/".$file);
362        }
363       
364    }
365   
366    return 0 if ($Mode eq "loop");
367    print STDERR "\n$Reason\n" if (! $Config{"Verbose"}); #print error only once, and only if fatal.
368    exit($Severity);
369}
370
3711;
372
Note: See TracBrowser for help on using the repository browser.