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

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

Move madeDir declaration to the right file

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