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

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

provide better output in debug mode

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