source: subversion/applications/rendering/tilesAtHome/lib/tahlib.pm @ 12207

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

minor changes, newline on error-exit

File size: 12.3 KB
Line 
1use strict;
2use TahConf;
3
4# =====================================================================
5# The following is duplicated from tilesGen.pl
6# =====================================================================
7my $lastmsglen = 0;
8
9my $idleFor = 0;
10my $idleSeconds = 0;
11
12my %faults; #variable to track non transient errors
13
14
15#-----------------------------------------------------------------------------
16# Prints status message without newline, overwrites previous message
17# (if $newline set, starts new line after message)
18# only prints something if $VerbosityTriggerLevel is >= Verbosity
19#-----------------------------------------------------------------------------
20sub statusMessage 
21{
22    my $Config = TahConf->getConfig();
23    my $currentSubTask = $main::currentSubTask;
24    my $progressJobs = $main::progressJobs;
25    my $progressPercent = $main::progressPercent;
26
27    my ($msg, $newline, $VerbosityTriggerLevel) = @_;
28   
29    my $toprint = sprintf("[#%d %3d%% %s] %s%s ", $progressJobs, $progressPercent+.5, $currentSubTask, $msg, ($newline) ? "" : "...");
30
31    if ($Config->get("Verbose") >= 10)
32    {
33        print STDERR "$toprint\n";
34        return;
35    }
36
37    return if ($Config->get("Verbose") < $VerbosityTriggerLevel); # don't print anything if we set verbosity below triggerlevel
38
39    my $curmsglen = length($toprint);
40    print STDERR "\r$toprint";
41    print STDERR " " x ($lastmsglen-$curmsglen);
42    if ($newline)
43    {
44        $lastmsglen = 0;
45        print STDERR "\n";
46    }
47    else
48    {
49        $lastmsglen = $curmsglen;
50    }
51
52}
53
54#-----------------------------------------------------------------------------
55# Used to display task completion. Only for verbose mode.
56#-----------------------------------------------------------------------------
57sub doneMessage
58{
59    my $Config = TahConf->getConfig();
60    my $msg = shift;
61   
62    $msg = "done" if ($msg eq "");
63   
64    if ($Config->get("Verbose") >= 10)
65    {
66        print STDERR "$msg\n";
67        return;
68    }
69}
70
71#-----------------------------------------------------------------------------
72# A sleep function with visible countdown
73#-----------------------------------------------------------------------------
74sub talkInSleep
75{
76    my $Config = TahConf->getConfig();
77    my ($message, $duration) = @_;
78   
79    if ($Config->get("Verbose") >= 10)
80    {
81        print STDERR "$message: sleeping $duration seconds\n";
82        sleep $duration;
83        return;
84    }
85
86    for (my $i = 0; $i< $duration; $i++)
87    {
88         statusMessage(sprintf("%s. Idle for %d (Total %d:%02d)", 
89                $message,
90                $duration - $i,
91                $idleFor/60, $idleFor%60,
92                ),0,3);
93        sleep 1;
94        $idleFor++;
95    }
96}
97
98sub setIdle
99{
100    my ($idle,$setTotal) = @_;
101    if ($setTotal)
102    {
103        $idleSeconds = $idle;
104    }
105    else
106    {
107        $idleFor = $idle;
108    }
109}
110
111sub getIdle
112{
113    my $getTotal = @_;
114    if ($getTotal)
115    {
116      return $idleSeconds;
117    }
118    else
119    {
120      return $idleFor;
121    }
122}
123
124
125#-----------------------------------------------------------------------------
126# fault handling
127#-----------------------------------------------------------------------------
128sub addFault
129{
130    my ($faulttype,$diff) = @_;
131    $diff = 1 if (not $diff);
132    $faults{$faulttype} += $diff;
133    return $faults{$faulttype};
134}
135
136sub getFault
137{
138    my ($faulttype) = @_;
139    return $faults{$faulttype};
140}
141
142sub resetFault
143{
144    my ($faulttype) = @_;
145    $faults{$faulttype} = 0;
146    return "0 but true";
147}
148
149#-----------------------------------------------------------------------------
150# Run a shell command. Suppress command's stderr output unless it terminates
151# with an error code.
152#
153# Return 1 if ok, 0 on error.
154#-----------------------------------------------------------------------------
155sub runCommand
156{
157    my $Config = TahConf->getConfig();
158    my ($cmd,$mainPID) = @_;
159
160    if ($Config->get("Verbose") >= 10)
161    {
162        my $retval = system($cmd);
163        return $retval == 0;
164    }
165
166    my $ErrorFile = $Config->get("WorkingDirectory")."/".$mainPID.".stderr";
167    # force inkscape and others into non-GUI mode, does not work for older version of inkscape
168    # local %ENV;
169    # delete $ENV{DISPLAY};
170    my $retval = system("$cmd 2> $ErrorFile");
171    my $ok = 0;
172    my $ExtraInfo = "\nAdditional info about the Error(s):\n";
173
174    # <0 means that the process could not start
175    if ($retval < 0)
176    {
177        print STDERR "ERROR:\n";
178        print STDERR "  Could not run the following command:\n";
179        print STDERR "  $cmd\n";
180        print STDERR "  Please check your installation.\n";
181    } 
182    else
183    {
184        # Technically the return value is ($retval >> 8) but if we only look
185        # at that we will miss the situations where the program died due to
186        # a signal. In that case $retval will be the signal that killed it.
187        # So any non-zero value is an error.
188
189        if ($retval)
190        {
191            print STDERR "ERROR\n";
192            print STDERR "  The following command produced an error message:\n";
193            print STDERR "  $cmd\n";
194            print STDERR "  Debug output follows:\n";
195            open(ERR, $ErrorFile);
196            while(<ERR>)
197            {
198                print STDERR "  | $_";
199                if (grep(/infinite template recursion/,$_))
200                {
201                    $ExtraInfo=$ExtraInfo."\n * Tile too complex for Xmlstarlet, possibly an excessively long way, or too many maplint errors";
202                }
203            }
204            close(ERR);
205            print STDERR $ExtraInfo."\n\n";
206        }
207        else
208        {
209            $ok = 1;
210        }
211    }
212
213    unlink($ErrorFile);
214    return $ok;
215}
216
217#-----------------------------------------------------------------------------
218# GET a URL and save contents to file
219#-----------------------------------------------------------------------------
220sub DownloadFile 
221{
222    my $Config = TahConf->getConfig();
223    my ($URL, $File, $UseExisting) = @_;
224
225    my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => $Config->get("DownloadTimeout"));
226    $ua->agent("tilesAtHome");
227    $ua->env_proxy();
228
229    if(!$UseExisting) 
230    {
231        unlink($File);
232    }
233    # Note: mirror sets the time on the file to match the server time. This
234    # is important for the handling of JobTime later.
235    my $res = $ua->mirror($URL, $File);
236
237    if ($res->is_success()) 
238    {
239        doneMessage(sprintf("downloaded %d bytes", -s $File));
240        return 1;
241    }
242    else
243    {
244        unlink($File) if (! $UseExisting);
245        doneMessage("failed with: ".$res->status_line);
246        return 0;
247    }
248}
249
250#-----------------------------------------------------------------------------
251# Merge multiple OSM files into one, making sure that elements are present in
252# the destination file only once even if present in more than one of the input
253# files.
254#
255# This has become necessary in the course of supporting maplint, which would
256# get upset about duplicate objects created by combining downloaded stripes.
257#-----------------------------------------------------------------------------
258sub mergeOsmFiles
259{
260    my $Config = TahConf->getConfig();
261    my ($destFile, $sourceFiles) = @_;
262    my $existing = {};
263
264    # If there's only one file, just copy the input to the output
265    if( scalar(@$sourceFiles) == 1 )
266    {
267      copy $sourceFiles->[0], $destFile;
268      unlink($sourceFiles->[0]) if (!$Config->get("Debug"));
269      return (1, "");
270    }
271   
272    open (DEST, "> $destFile");
273
274    print DEST qq(<?xml version="1.0" encoding="UTF-8"?>\n);
275    my $headerwritten = 0;
276    my $reason = "";
277
278    foreach my $sourceFile(@{$sourceFiles})
279    {
280        my $headerseen = 0;
281        my $footerseen = 0;
282
283        open(SOURCE, $sourceFile);
284        while(<SOURCE>)
285        {
286            next if /^\s*<\?xml/;
287            # We want to copy the version number, but only the first time (obviously)
288            # Handle where the input doesn't have a version
289            if (/^\s*<osm.*(?:version=([\d.'"]+))?/)
290            {
291              $headerseen = 1;
292              if( not $headerwritten )
293              {
294                my $version = $1 || "'".$Config->get("OSMVersion")."'";
295                print DEST qq(<osm version=$version generator="tahlib.pm mergeOsmFiles" xmlns:osmxapi="http://www.informationfreeway.org/osmxapi/0.5">\n);
296                $headerwritten = 1;
297              }
298              next;
299            }
300            if (/^\s*<\/osm>/)
301            {
302                $footerseen = 1;
303                last;
304            }
305            if (/^\s*<(node|segment|way|relation) id=['"](\d+)['"].*(.)>/)
306            {
307                my ($what, $id, $slash) = ($1, $2, $3);
308                my $key = substr($what, 0, 1) . $id;
309                if (defined($existing->{$key}))
310                {
311                    # object exists already. skip!
312                    next if ($slash eq "/");
313                    while(<SOURCE>)
314                    {
315                        last if (/^\s*<\/$what>/);
316                    }
317                    next;
318                }
319                else
320                {
321                    # object didn't exist, note
322                    $existing->{$key} = 1;
323                }
324            }
325            print DEST;
326        }
327        close(SOURCE);
328        unlink ($sourceFile) if (!$Config->get("Debug"));
329        if (($headerseen == 0) || ($footerseen == 0))
330        {
331            $reason = $reason . $sourceFile . " not well formed. ";
332        }
333    }
334    print DEST "</osm>\n";
335    close(DEST);
336    if ($reason != "")
337    {
338        return (0, $reason);
339    } else {
340        return (1, "");
341    }
342}
343
344
345#-----------------------------------------------------------------------------
346# write log about t@h progress
347#-----------------------------------------------------------------------------
348
349sub keepLog
350{
351    my $Config = TahConf->getConfig();
352    if ($Config->get("ProcessLog")) {
353        my ($Pid,$Process,$Action,$Message) = @_;
354        my $logFile = $Config->get("ProcessLogFile");
355        my $log = $Config->get("ProcessLog");
356        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
357        $year += 1900;
358       
359        open(my $fpLog, ">>$logFile");
360        if ($fpLog) {
361            print $fpLog sprintf("%04d-%02d-%02d %02d:%02d:%02d [%s] %s %s %s %s\n", $year, $mon+1, $mday, $hour, $min, $sec, $Config->get("ClientVersion"), $Pid, $Process, $Action, $Message);
362            close $fpLog;
363        }
364    }
365}
366
367#-----------------------------------------------------------------------------
368# Clean up temporary files before exit, then exit or return with error
369# depending on mode (loop, xy, ...)
370#-----------------------------------------------------------------------------
371sub cleanUpAndDie
372{
373    my $Config = TahConf->getConfig();
374    my ($Reason,$Mode,$Severity) = @_;
375
376    statusMessage ($Reason, 1,0);
377
378    return 0 if ($Mode eq "loop");
379
380    if ($main::StartedBatikAgent)
381    {
382        my $result = $SVG::Rasterize::object->engine()->stop_agent();
383        if( $result == 1 ){
384            statusMessage("Successfully sent stop message to Batik agent", 1, 0);
385        } elsif( $result == 0 ){
386            statusMessage("Could not contact Batik agent", 1, 0);
387        } else {
388            statusMessage($result, 1, 0);
389        }
390    }
391    exit($Severity);
392}
393
394
395#-------------------------------------------------------------
396# Get client ID from file or create one if file doesn't exist.
397#-------------------------------------------------------------
398sub GetClientId
399{
400    my $Config = TahConf->getConfig();
401    my $clientId = $Config->get("ClientID");
402    if (!$clientId)
403    {
404        my $idfile = $Config->get("WorkingDirectory") . "/client-id.txt";
405        if (open(idfile, "<", $idfile))
406        {
407            $clientId = <idfile>;
408            chomp $clientId;
409            close idfile;
410        }
411        elsif (open(idfile, ">", $idfile))
412        {
413            $clientId = int(rand(65535)); 
414            print idfile $clientId;
415            close idfile;
416        }
417        else
418        {
419            die("can't open $idfile");
420        }
421    }
422    return $clientId;
423}
424
425#-------------------------------------------------------------
426# Check wether directory is empty and return true if so.
427#-------------------------------------------------------------
428sub dirEmpty
429{
430    my ($path) = @_;
431    opendir DIR, $path;
432    while(my $entry = readdir DIR) 
433    {
434        next if($entry =~ /^\.\.?$/);
435        closedir DIR;
436        return 0; # if $entry not "." or ".."
437    }
438    closedir DIR;
439    return 1; 
440}
441
4421;
443
Note: See TracBrowser for help on using the repository browser.