source: subversion/applications/rendering/tilesAtHome/tilesGen.pl @ 9696

Revision 9696, 77.9 KB checked in by deelkar, 6 years ago (diff)

make sure all needed variables are initialised before re-exec. fixes #1100

  • Property svn:executable set to *
  • Property svn:keywords set to Revision
Line 
1#!/usr/bin/perl
2#-------------------------------------------------------------
3# OpenStreetMap tiles@home
4#
5# Contact Deelkar or OJW on the Openstreetmap wiki for help using this program
6#-----------------------------------------------------------------------------
7# Copyright 2006, Oliver White, Etienne Cherdlu, Dirk-Lueder Kreie,
8# Sebastian Spaeth and others
9#
10# This program is free software; you can redistribute it and/or
11# modify it under the terms of the GNU General Public License
12# as published by the Free Software Foundation; either version 2
13# of the License, or (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
23#-----------------------------------------------------------------------------
24
25#---------------------------------
26use strict;
27use LWP::UserAgent;
28use Math::Trig;
29use File::Copy;
30use File::Temp qw(tempfile);
31use IO::Socket;
32use FindBin qw($Bin);
33use tahconfig;
34use tahlib;
35use tahproject;
36use English '-no_match_vars';
37use GD qw(:DEFAULT :cmp);
38use AppConfig qw(:argcount);
39use locale;
40use POSIX qw(locale_h);
41use Encode;
42
43#---------------------------------
44
45# Read the config file
46our $Config = AppConfig->new({
47                CREATE => 1,                      # Autocreate unknown config variables
48                GLOBAL => {
49                  DEFAULT  => undef,    # Create undefined Variables by default
50                  ARGCOUNT => ARGCOUNT_ONE, # Simple Values (no arrays, no hashmaps)
51                }
52              });
53
54$Config->define("help|usage!");
55$Config->define("nodownload=s");
56$Config->set("nodownload",0);
57$Config->file("config.defaults", "layers.conf", "tilesAtHome.conf", "authentication.conf"); #first read configs in order, each (possibly) overwriting settings from the previous
58$Config->args();              # overwrite config options with command line options
59$Config->file("general.conf");  # overwrite with hardcoded values that must not be changed
60ApplyConfigLogic($Config);
61
62# Handle the command-line
63my $Mode = shift();
64my $LoopMode = (($Mode eq "loop") or ($Mode eq "upload_loop")) ? 1 : 0;
65my $RenderMode = (($Mode eq "") or ($Mode eq "xy") or ($Mode eq "loop")) ? 1 : 0;
66my $UploadMode = (($Mode eq "upload") or ($Mode eq "upload_conditional") or ($Mode eq "upload_loop")) ? 1 : 0;
67my %EnvironmentInfo;
68
69# set the progress indicator variables
70my $currentSubTask;
71my $progress = 0;
72my $progressJobs = 0;
73my $progressPercent = 0;
74
75# keep track of time running
76my $progstart = time();
77
78if ($UploadMode)
79{
80    %EnvironmentInfo = CheckBasicConfig($Config);
81}
82else
83{
84    %EnvironmentInfo = CheckConfig($Config);
85}
86
87# Create the working directory if necessary
88mkdir $Config->get("WorkingDirectory") if(!-d $Config->get("WorkingDirectory"));
89
90my $LastTimeVersionChecked = 0;   # version is only checked when last time was more than 10 min ago
91if ($UploadMode or $RenderMode) {
92    if (NewClientVersion()) {
93        UpdateClient();
94        if ($LoopMode) {
95            reExec(-1);
96        } else {
97            print STDERR "tilesGen.pl has changed. Please restart new version.";
98            exit;
99        }
100    }
101}
102
103my $Layers = $Config->get("Layers");
104
105# Get version number from version-control system, as integer
106my $Version = '$Revision$';
107$Version =~ s/\$Revision:\s*(\d+)\s*\$/$1/;
108printf STDERR "This is version %d (%s) of tilesgen running on %s, ID: %s\n", 
109    $Version, $Config->get("ClientVersion"), $^O, GetClientId();
110
111# Keep track of unrenderable tiles.
112# This should not be saved, as they may render later.
113# there also might be false positives due to mangled inkscape preference file.
114my %unrenderable;
115
116my $dirent; 
117
118if ($LoopMode) {
119    # if this is a re-exec, we want to capture some of our status
120    # information from the command line. this feature allows setting
121    # any numeric variable by specifying "variablename=value" on the
122    # command line after the keyword "reexec". Currently unsuitable
123    # for alphanumeric variables.
124   
125    if (shift() eq "reexec") {
126        my $idleSeconds; my $idleFor;
127        while(my $evalstr = shift()) {
128            die("$evalstr does not match option=value") unless $evalstr =~ /^[A-Za-z]+=\d+/;
129            eval('$'.$evalstr);
130            print STDERR "$evalstr\n" if ($Config->get("Verbose"));
131        }
132        setIdle($idleSeconds, 1);
133        setIdle($idleFor, 0);
134    }
135}
136
137my ($EmptyLandImage, $EmptySeaImage, $BlackTileImage);
138my ($MapLandBackground, $MapSeaBackground, $BlackTileBackground);
139
140if ($RenderMode) {
141    # check GD
142    eval GD::Image->trueColor(1);
143    if ($@ ne '') {
144        print STDERR "please update your libgd to version 2 for TrueColor support";
145        cleanUpAndDie("init:libGD check failed, exiting","EXIT",4,$PID);
146    }
147
148    # Check the on disk image tiles havn't been corrupted.
149    # these are flagfiles that tell the server certain metainfo through their filesize.
150    if((-s "emptyland.png" != 67) or (-s "emptysea.png" != 69)) {
151        statusMessage("Corruption detected in empty land/sea tile", $currentSubTask, $progressJobs, $progressPercent,1);
152        UpdateClient();
153    }
154
155    # create a comparison blank image
156    $EmptyLandImage = new GD::Image(256,256);
157    $MapLandBackground = $EmptyLandImage->colorAllocate(248,248,248);
158    $EmptyLandImage->fill(127,127,$MapLandBackground);
159
160    $EmptySeaImage = new GD::Image(256,256);
161    $MapSeaBackground = $EmptySeaImage->colorAllocate(181,214,241);
162    $EmptySeaImage->fill(127,127,$MapSeaBackground);
163
164    # Some broken versions of Inkscape occasionally produce totally black
165    # output. We detect this case and throw an error when that happens.
166    $BlackTileImage = new GD::Image(256,256);
167    $BlackTileBackground = $BlackTileImage->colorAllocate(0,0,0);
168    $BlackTileImage->fill(127,127,$BlackTileBackground);
169}
170
171# We need to keep parent PID so that child get the correct files after fork()
172my $parent_pid = $PID;
173my $upload_pid = -1;
174
175my $upload_result = 0;
176
177# Subdirectory for the current job (layer & z12 tileset),
178# as used in sub GenerateTileset() and tileFilename()
179my $JobDirectory;
180
181# keep track of the server time for current job
182my $JobTime;
183
184# If batik agent was started automatically, turn it off at exit
185our $StartedBatikAgent = 0;
186
187# Check the stylesheets for corruption and out of dateness, but only in loop mode
188# The existance check is to attempt to determine we're on a UNIX-like system
189
190if( $RenderMode and -e "/dev/null" )
191{
192    my $svn = $Config->get("Subversion");
193    if( qx($svn status osmarender/*.x[ms]l 2>/dev/null) ne "" )
194    {
195        print STDERR "Custom changes in osmarender stylesheets. Examine the following output to fix:\n";
196        system($Config->get("Subversion")." status osmarender/*.x[ms]l");
197        cleanUpAndDie("init.osmarender_stylesheet_check repair failed","EXIT",4,$PID);
198    }
199}
200
201## set all fault counters to 0;
202resetFault("fatal");
203resetFault("inkscape");
204resetFault("nodata");
205resetFault("nodataXAPI");
206resetFault("renderer");
207resetFault("utf8");
208resetFault("upload");
209resetFault("requestUnrenderable");
210
211killafile("stopfile.txt") if $Config->get("AutoResetStopfile");
212
213
214## Start processing
215
216if ($Mode eq "xy")
217{
218    # ----------------------------------
219    # "xy" as first argument means you want to specify a tileset to render
220    # ----------------------------------
221
222    my $X = shift();
223    my $Y = shift();
224    if (not defined $X or not defined $Y)
225    { 
226        print STDERR "Usage: $0 xy <X> <Y> [<ZOOM>]\n";
227        print STDERR "where <X> and <Y> are the tile coordinates and \n";
228        print STDERR "<ZOOM> is an optional zoom level (defaults to 12).\n";
229        exit;
230    }
231    my $Zoom = shift();
232    if (not defined $Zoom)
233    {
234       $Zoom = 12;
235       statusMessage(" *** No zoomlevel specified! Assuming z12 *** ", "warning", $progressJobs, $progressPercent,1);
236    }
237    GenerateTileset($X, $Y, $Zoom);
238}
239elsif ($Mode eq "loop") 
240{
241    # ----------------------------------
242    # Continuously process requests from server
243    # ----------------------------------
244
245    # Start batik agent if it's not runnig
246    if ($Config->get("Batik") == "3" && !getBatikStatus())
247    {
248        startBatikAgent();
249        $StartedBatikAgent = 1;
250    }
251
252    # this is the actual processing loop
253   
254    while(1) 
255    {
256        ## before we start (another) round of rendering we first check if something bad happened in the past.
257        checkFaults();
258
259        ## note: Timeouts are cumulative so if there are X timeouts from api and Y timeouts from XAPI then we wait for each timeout, one after the other
260        checkDataFaults();
261
262        # look for stopfile and exit if found
263        if (-e "stopfile.txt")
264        {
265            if ($Config->get("ForkForUpload") && $upload_pid != -1)
266            {
267                statusMessage("Waiting for previous upload process", $currentSubTask, $progressJobs, $progressPercent,0);
268                waitpid($upload_pid, 0);
269            }
270            cleanUpAndDie("Stopfile found, exiting","EXIT",7,$PID); ## TODO: agree on an exit code scheme for different types of errors
271        }
272
273        # Add a basic auto-updating mechanism.
274        if (NewClientVersion()) 
275        {
276            UpdateClient();
277            reExec($upload_pid);
278        }
279
280        reExecIfRequired($upload_pid); ## check for new version of tilesGen.pl and reExec if true
281
282        ## start processing here:
283
284        my ($did_something, $message) = ProcessRequestsFromServer(); # Actually render stuff if job on server
285
286        $upload_result = compressAndUploadTilesets(); # upload if enough work done
287
288        if ($upload_result)  # we got an error in the upload process
289        {
290              addFault("upload",1); # we only track errors that occur multple times in a row
291        }
292        else
293        {
294              resetFault("upload"); #reset fault counter for uploads if once without error
295        }
296
297        if ($did_something == 0) 
298        {
299            talkInSleep($message, 60);
300        }
301        else
302        {
303            setIdle(0,0);
304        }
305    }
306}
307elsif ($Mode eq "upload" or $Mode eq "upload_conditional") 
308{
309    $currentSubTask = "warning";
310    statusMessage("don't run this parallel to another tilesGen.pl instance", $currentSubTask, $progressJobs, $progressPercent,1);
311    compressAndUpload();
312}
313elsif ($Mode eq "upload_loop")
314{
315    statusMessage("don't run this parallel to another tilesGen.pl instance", $currentSubTask, $progressJobs, $progressPercent,1);
316    my $startTime = time();
317    my $elapsedTime;
318    while(1) 
319    {
320        ## before we start (another) round of uploads we first check if something bad happened in the past.
321        checkFaults();
322
323        my $sleepdelay = 1;
324        # look for stopfile and exit if found
325        if (-e "stopfile.txt")
326        {
327            cleanUpAndDie("Stopfile found, exiting","EXIT",7,$PID); ## TODO: agree on an exit code scheme for different types of errors
328        }
329
330        # Add a basic auto-updating mechanism.
331        if (NewClientVersion()) 
332        {
333            UpdateClient();
334            reExec(-1);
335        }
336
337        reExecIfRequired(-1); ## check for new version of tilesGen.pl and reExec if true
338
339        if (countZips() > 0)
340        {
341            $upload_result = upload(); # only uploading ZIP files here
342           
343            if ($upload_result)  # we got an error in the upload process
344            {
345                addFault("upload",1); # we only track errors that occur multple times in a row
346            }
347            else
348            {
349                resetFault("upload"); #reset fault counter for uploads if once without error
350                statusMessage("upload finished", $currentSubTask, $progressJobs, $progressPercent,1);
351                $progressJobs++;
352            }
353            $startTime = time();
354        }
355        else
356        {
357            $elapsedTime = time() - $startTime;
358            statusMessage(sprintf("waiting for new ZIP files to upload   %d:%02d", $elapsedTime/60, $elapsedTime%60), $currentSubTask, $progressJobs, $progressPercent,0);
359            sleep(1);
360        }
361    }
362}
363elsif ($Mode eq "version") 
364{
365    exit(1);
366}
367elsif ($Mode eq "stop")
368{
369    if (open F, '>', "stopfile.txt") 
370    {
371        close F;
372        statusMessage("stop signal was sent to the currently running tilesGen.pl", $currentSubTask, $progressJobs, $progressPercent,1);
373        statusMessage("please note that it may take quite a while for it to exit", $currentSubTask, $progressJobs, $progressPercent,1);
374    }
375    else
376    {
377        statusMessage("stop signal was NOT sent to the currently running tilesGen.pl - stopfile.txt could NOT be created", $currentSubTask, $progressJobs, $progressPercent,1);
378    }
379 #   talkInSleep("you may safely press Ctrl-C now if you ran this as \"tilesGen.pl\" from the command line", 60);
380    exit(1);
381}
382elsif ($Mode eq "update") 
383{
384    UpdateClient();
385}
386elsif ($Mode eq "") 
387{
388    # ----------------------------------
389    # Normal mode downloads request from server
390    # ----------------------------------
391
392    my ($did_something, $message) = ProcessRequestsFromServer();
393   
394    if (! $did_something)
395    {
396        statusMessage("you may safely press Ctrl-C now if you ran this as \"tilesGen.pl\" from the command line.", $currentSubTask, $progressJobs, $progressPercent,1);
397        talkInSleep($message, 60);
398    }
399    statusMessage("if you want to run this program continuously, use loop mode", $currentSubTask, $progressJobs, $progressPercent,1);
400    statusMessage("please run \"tilesGen.pl upload\" now", $currentSubTask, $progressJobs, $progressPercent,1);
401}
402elsif ($Mode eq "startBatik")
403{
404    startBatikAgent();
405}
406elsif ($Mode eq "stopBatik")
407{
408    stopBatikAgent();
409}
410else {
411    # ----------------------------------
412    # "help" (or any other non understood parameter) as first argument tells how to use the program
413    # ----------------------------------
414    my $Bar = "-" x 78;
415    print "\n$Bar\nOpenStreetMap tiles\@home client\n$Bar\n";
416    print "Usage: \nNormal mode:\n  \"$0\", will download requests from server\n";
417    print "Specific area:\n  \"$0 xy <x> <y> [z]\"\n  (x and y coordinates of a zoom-12 (default) tile in the slippy-map coordinate system)\n  See [[Slippy Map Tilenames]] on wiki.openstreetmap.org for details\nz is optional and can be used for low-zoom tilesets\n";
418    print "Other modes:\n";
419    print "  $0 loop - runs continuously\n";
420    print "  $0 upload - uploads any tiles\n";
421    print "  $0 upload_loop - uploads tiles in loop mode\n";
422    print "  $0 startBatik - start batik agent\n";
423    print "  $0 stopBatik - stop batik agent\n";
424    print "  $0 version - prints out version string and exits\n";
425    print "\nGNU General Public license, version 2 or later\n$Bar\n";
426}
427
428sub countZips
429{
430    my $ZipCount = 0;
431    if (opendir(my $dp, $Config->get("WorkingDirectory")."uploadable"))
432    {
433        while(my $File = readdir($dp))
434        {
435            $ZipCount++ if ($File =~ /\.zip$/);
436        }
437        closedir($dp);
438    }
439    else 
440    {
441        mkdir $Config->get("WorkingDirectory")."uploadable";
442    }
443    return $ZipCount;
444}
445
446#-----------------------------------------------------------------------------
447# forks to a new process when it makes sense,
448# compresses all existing tileset dirs, uploads the resulting zip.
449# returns 0 on success, >0 otherwisse and dies if it could not fork
450#-----------------------------------------------------------------------------
451sub compressAndUploadTilesets
452{
453    if ($Config->get("ForkForUpload") and ($Mode eq "loop")) # makes no sense to fork upload if not looping.
454    {
455        # Upload is handled by another process, so that we can generate another tile at the same time.
456        # We still don't want to have two uploading process running at the same time, so we wait for the previous one to finish.
457        if ($upload_pid != -1)
458        {
459            statusMessage("Waiting for previous upload process to finish", $currentSubTask, $progressJobs, $progressPercent,0);
460            waitpid($upload_pid, 0);
461            $upload_result = $? >> 8;
462        }
463        compress(); #compress before fork so we don't get temp files mangled. Workaround for batik support.
464        $upload_pid = fork();
465        if ((not defined $upload_pid) or ($upload_pid == -1))
466        {
467            cleanUpAndDie("loop: could not fork, exiting","EXIT",4,$PID); # exit if asked to fork but unable to
468        }
469        elsif ($upload_pid == 0)
470        {
471            ## we are the child, so we run the upload
472            my $res = upload(); # upload if enough work done
473            exit($res);
474        }
475    }
476    else
477    {
478        ## no forking going on
479        return compressAndUpload();
480    }
481    return 0; # no error, just nothing to upload
482}
483
484#-----------------------------------------------------------------------------
485# compressAndUpload() is just a shorthand for calling compress() and
486# upload(). It returns 0 on success and >0 otherwise.
487#-----------------------------------------------------------------------------
488sub compressAndUpload
489{
490  my $error = 0;
491  $error += compress();
492  $error += upload();
493  return $error;
494}
495
496#-----------------------------------------------------------------------------
497# compress() calls the external compress.pl which zips up all existing
498# tileset directories. It returns 0 on success and >0 otherwise.
499#-----------------------------------------------------------------------------
500sub compress
501{
502    keepLog($PID,"compress","start","$progressJobs");
503
504    my $CompressScript = "perl $Bin/compress.pl $progressJobs";
505    my $retval = system($CompressScript);
506
507    keepLog($PID,"compress","stop","return=$retval");
508
509    return $retval;
510}
511
512#-----------------------------------------------------------------------------
513# upload() calls the external upload.pl which uploads all previously
514# zipped up tilesets. It returns 0 on success and >0 otherwise.
515#-----------------------------------------------------------------------------
516sub upload
517{
518    ## Run upload directly because it uses same messaging as tilesGen.pl,
519    ## no need to hide output at all.
520
521    keepLog($PID,"upload","start","$progressJobs");
522
523    my $UploadMode = ($Mode eq "upload_loop") ? "upload_loop" : "upload";
524    my $UploadScript = "perl $Bin/upload.pl $UploadMode $progressJobs";
525    my $retval = system($UploadScript);
526
527    keepLog($PID,"upload","stop","return=$retval");
528
529    return $retval;
530}
531
532#-----------------------------------------------------------------------------
533# Ask the server what tileset needs rendering next
534#-----------------------------------------------------------------------------
535sub ProcessRequestsFromServer 
536{
537    if ($Config->get("LocalSlippymap"))
538    {
539        print "Config option LocalSlippymap is set. Downloading requests\n";
540        print "from the server in this mode would take them from the tiles\@home\n";
541        print "queue and never upload the results. Program aborted.\n";
542        cleanUpAndDie("ProcessRequestFromServer:LocalSlippymap set, exiting","EXIT",1,$PID);
543    }
544   
545    my $ValidFlag;
546    my $Version;
547    my $TilesetLastModified; # Unix timestamp of tileset on server
548    my $TilesetComplexity;   # tileset complexity. still unused.
549    my $X;
550    my $Y;
551    my $Z;
552   
553    # ----------------------------------
554    # Download the request, and check it
555    # Note: to find out exactly what this server is telling you,
556    # add ?help to the end of the URL and view it in a browser.
557    # It will give you details of other help pages available,
558    # such as the list of fields that it's sending out in requests
559    # ----------------------------------
560
561    for (;;) 
562    {
563        my $Request = GetRequestFromServer($Config->get("RequestMethod"));
564
565        return (0, "Error reading request from server") unless ($Request);
566       
567        ($ValidFlag,$Version) = split(/\|/, $Request);
568       
569        # Check what format the results were in
570        # If you get this message, please do check for a new version, rather than
571        # commenting-out the test - it means the field order has changed and this
572        # program no longer makes sense!
573
574        ## it is also important that we check the field that we *think* has the version first, before attempting anything else.
575
576        if ($Version < 4 or $Version > 5)
577        {
578            print STDERR "\n";
579            print STDERR "Server is speaking a different version of the protocol to us.\n";
580            print STDERR "Check to see whether a new version of this program was released!\n";
581            cleanUpAndDie("ProcessRequestFromServer:Request API version mismatch, exiting \n".$Request,"EXIT",1,$PID);
582            ## No need to return, we exit the program at this point
583        }
584        elsif ($Version == 4)
585        {
586            ($ValidFlag,$Version,$X,$Y,$Z,$Layers) = split(/\|/, $Request);
587        }
588        elsif ($Version == 5)
589        {
590            ($ValidFlag,$Version,$X,$Y,$Z,$Layers,$TilesetLastModified,$TilesetComplexity) = split(/\|/, $Request);
591        }
592        else
593        {
594            die "Version is \"".$Version."\". This should not have happened.";
595        }
596       
597        # First field is always "OK" if the server has actually sent a request
598        if ($ValidFlag eq "XX")
599        {
600            if ($Request =~ /Invalid username/)
601            {
602                die "ERROR: Authentication failed - please check your username "
603                        . "and password in 'authentication.conf'.\n\n"
604                        . "! If this worked just yesterday, you now need to put your osm account e-mail and password there.";
605            }
606            elsif ($Request =~ /Invalid client version/)
607            {
608                die "ERROR: This client version (".$Config->get("ClientVersion").") was not accepted by the server.";  ## this should never happen as long as auto-update works
609            }
610            elsif ($ValidFlag ne "OK")
611            {
612                return (0, "Unknown server response");
613            }
614       
615        }
616        last unless ($unrenderable{"$X $Y $Z"});
617        $unrenderable{"$X $Y $Z"}++;
618
619        PutRequestBackToServer($X,$Y,$Z,"Unrenderable");
620
621        # make sure we don't loop like crazy should we get another or the same unrenderable tile back over and over again
622        my $UnrenderableBackoff = addFault("requestUnrenderable",1); 
623        $UnrenderableBackoff = int(1.8 ** $UnrenderableBackoff);
624        $UnrenderableBackoff = 300 if ($UnrenderableBackoff > 300);
625        talkInSleep("Ignoring unrenderable tile $X $Y $Z",$UnrenderableBackoff);
626    }
627   
628    # Information text to say what's happening
629    statusMessage("Got work from the server", $currentSubTask, $progressJobs, $progressPercent,0);
630   
631    resetFault("requestUnrenderable"); #reset if we actually start trying to render a tileset.
632
633    # Create the tileset requested
634    GenerateTileset($X, $Y, $Z);
635    return (1, "");
636}
637
638
639# actually get the request from the server
640sub GetRequestFromServer
641{
642    my $RequestMethod=shift();
643    my $LocalFilename = $Config->get("WorkingDirectory") . "request-" . $PID . ".txt";
644    killafile($LocalFilename); ## make sure no old request file is laying around.
645
646    my $Request;
647
648    if ($RequestMethod eq "POST")
649    {
650        my $URL = $Config->get("RequestURL");
651   
652        my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 360);
653
654        $ua->protocols_allowed( ['http'] );
655        $ua->agent("tilesAtHome");
656        $ua->env_proxy();
657        push @{ $ua->requests_redirectable }, 'POST';
658
659        my $res = $ua->post($URL,
660          Content_Type => 'form-data',
661          Content => [ user => $Config->get("UploadUsername"),
662                       passwd => $Config->get("UploadPassword"),
663                       version => $Config->get("ClientVersion"),
664                       layers => $Layers,
665                       layerspossible => $Config->get("LayersCapability"),
666                       client_id => GetClientId() ]);
667     
668        if(!$res->is_success())
669        {
670            print $res->content if ($Config->get("Debug"));
671            return 0;
672        }
673        else
674        {
675            print $res->content if ($Config->get("Debug"));
676            $Request = $res->content;  ## FIXME: check single line returned. grep?
677            chomp $Request;
678        }
679
680    }
681    else
682    {
683        return 0;
684    }
685    return $Request;
686}
687
688#-----------------------------------------------------------------------------
689# this is called when the client encounters errors in processing a tileset,
690# it's designed to tell the server the tileset will not be returned because
691# of said error
692#-----------------------------------------------------------------------------
693sub PutRequestBackToServer 
694{
695    ## TODO: will not be called in some libGD abort situations
696    my ($X,$Y,$Z,$Cause) = @_;
697
698    ## do not do this if called in xy mode!
699    return if($Mode eq "xy");
700   
701    my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 360);
702
703    $ua->protocols_allowed( ['http'] );
704    $ua->agent("tilesAtHomeZip");
705    $ua->env_proxy();
706    push @{ $ua->requests_redirectable }, 'POST';
707
708    statusMessage("Putting Job ".$X." ".$Y." ".$Z." back to server", $currentSubTask, $progressJobs, $progressPercent,1);
709    my $res = $ua->post($Config->get("ReRequestURL"),
710              Content_Type => 'form-data',
711              Content => [ x => $X,
712                           y => $Y,
713                           min_z => $Z,
714                           user => $Config->get("UploadUsername"),
715                           passwd => $Config->get("UploadPassword"),
716                           version => $Config->get("ClientVersion"),
717                           cause => $Cause,
718                           client_uuid => GetClientId() ]);
719
720    if(!$res->is_success())
721    {
722        return (0, "Error reading response from server");
723    }
724   
725    talkInSleep("Waiting before new tile is requested", 10);
726}
727
728#-----------------------------------------------------------------------------
729# Render a tile (and all subtiles, down to a certain depth)
730#-----------------------------------------------------------------------------
731sub GenerateTileset ## TODO: split some subprocesses to own subs
732{
733    my ($X, $Y, $Zoom) = @_;
734   
735    keepLog($PID,"GenerateTileset","start","x=$X,y=$Y,z=$Zoom for layers $Layers");
736   
737    my ($N, $S) = Project($Y, $Zoom);
738    my ($W, $E) = ProjectL($X, $Zoom);
739   
740    $progress = 0;
741    $progressPercent = 0;
742    $progressJobs++;
743    $currentSubTask = "jobinit";
744   
745    statusMessage(sprintf("Doing tileset $X,$Y (zoom $Zoom) (area around %f,%f)", ($N+$S)/2, ($W+$E)/2), $currentSubTask, $progressJobs, $progressPercent, 1);
746   
747    my $maxCoords = (2 ** $Zoom - 1);
748   
749    if ( ($X < 0) or ($X > $maxCoords) or ($Y < 0) or ($Y > $maxCoords) )
750    {
751        #maybe do something else here
752        die("\n Coordinates out of bounds (0..$maxCoords)\n");
753    }
754   
755    $currentSubTask = "Preproc";
756   
757    # Adjust requested area to avoid boundary conditions
758    my $N1 = $N + ($N-$S)*$Config->get("BorderN");
759    my $S1 = $S - ($N-$S)*$Config->get("BorderS");
760    my $E1 = $E + ($E-$W)*$Config->get("BorderE");
761    my $W1 = $W - ($E-$W)*$Config->get("BorderW");
762
763    # TODO: verify the current system cannot handle segments/ways crossing the
764    # 180/-180 deg meridian and implement proper handling of this case, until
765    # then use this workaround:
766
767    if($W1 <= -180) {
768      $W1 = -180; # api apparently can handle -180
769    }
770    if($E1 > 180) {
771      $E1 = 180;
772    }
773
774    my $bbox = sprintf("%f,%f,%f,%f",
775      $W1, $S1, $E1, $N1);
776
777    #------------------------------------------------------
778    # Download data
779    #------------------------------------------------------
780    my $DataFile = $Config->get("WorkingDirectory")."data-$PID.osm";
781   
782    killafile($DataFile);
783    my $URLS = sprintf("%s%s/map?bbox=%s",
784      $Config->get("APIURL"),$Config->get("OSMVersion"),$bbox);
785    if ($Zoom < 12) 
786    {
787        # FIXME: zoom 12 hardcoded: assume lowzoom layer now!
788        # only in xy mode since in loop mode a different method that does not depend on hardcoded zoomlevel will be used, where the layer is set by the server.
789        $Layers="lowzoom" if ($Mode eq "xy");
790       
791        # Get the predicates for lowzoom, and build the URLS for them
792        my $predicates = $Config->get($Layers."_Predicates");
793        # strip spaces in predicates because that is the separator used below
794        $predicates =~ s/\s+//g;
795        $URLS="";
796        foreach my $predicate (split(/,/,$predicates)) {
797            $URLS = $URLS . sprintf("%s%s/%s[bbox=%s] ",
798                $Config->get("XAPIURL"),$Config->get("OSMVersion"),$predicate,$bbox);
799        }
800    }
801    my @tempfiles;
802    push(@tempfiles, $DataFile);
803    my $filelist = [];
804    my $i=0;
805    foreach my $URL (split(/ /,$URLS)) 
806    {
807        ++$i;
808        my $partialFile = $Config->get("WorkingDirectory")."data-$PID-$i.osm";
809        push(@{$filelist}, $partialFile);
810        push(@tempfiles, $partialFile);
811        statusMessage("Downloading: Map data for $Layers to $partialFile", $currentSubTask, $progressJobs, $progressPercent,0);
812        print "Download\n$URL\n" if ($Config->get("Debug"));
813        my $res = DownloadFile($URL, $partialFile, 0);
814
815        if (! $res)
816        {
817            if ($Zoom < 12)
818            {
819                statusMessage("No data here...", $currentSubTask, $progressJobs, $progressPercent, 1);
820                # if loop was requested just return  or else exit with an error.
821                # (to enable wrappers to better handle this situation
822                # i.e. tell the server the job hasn't been done yet)
823                PutRequestBackToServer($X,$Y,$Zoom,"NoData");
824                foreach my $file(@tempfiles) { killafile($file); }
825                addFault("nodataXAPI",1);
826                return cleanUpAndDie("GenerateTileset: no data!",$Mode,1,$PID);
827            }
828            elsif ($Config->get("FallBackToXAPI"))
829            {
830                statusMessage("No data here, trying OSMXAPI", $currentSubTask, $progressJobs, $progressPercent, 1);
831                $bbox = $URL;
832                $bbox =~ s/.*bbox=//;
833                $URL=sprintf("%s%s/%s[bbox=%s] ",
834                    $Config->get("XAPIURL"),
835                    $Config->get("OSMVersion"),
836                    "*",
837                    $bbox);
838                statusMessage("Downloading: Map data for $Layers to $partialFile", $currentSubTask, $progressJobs, $progressPercent,0);
839                print "Download\n$URL\n" if ($Config->get("Debug"));
840                my $res = DownloadFile($URL, $partialFile, 0);
841                if (! $res)
842                {
843                    statusMessage("No data on OSMXAPI either...", $currentSubTask, $progressJobs, $progressPercent, 1);
844                    PutRequestBackToServer($X,$Y,$Zoom,"NoData");
845                    foreach my $file(@tempfiles) { killafile($file); }
846                    addFault("nodataXAPI",1);
847                    return cleanUpAndDie("GenerateTileset: no data! (OSMXAPI)",$Mode,1,$PID);
848                }
849                else
850                {
851                    resetFault("nodataXAPI"); #reset to zero if data downloaded
852                }
853            }
854            else
855            {
856                statusMessage("No data here, trying smaller slices", $currentSubTask, $progressJobs, $progressPercent, 1);
857                my $slice=(($E1-$W1)/10); # A chunk is one tenth of the width
858                for (my $j = 1 ; $j<=10 ; $j++)
859                {
860                    $URL = sprintf("%s%s/map?bbox=%f,%f,%f,%f", 
861                      $Config->get("APIURL"),$Config->get("OSMVersion"), ($W1+($slice*($j-1))), $S1, ($W1+($slice*$j)), $N1); 
862                    $partialFile = $Config->get("WorkingDirectory")."data-$PID-$i-$j.osm";
863                    push(@{$filelist}, $partialFile);
864                    push(@tempfiles, $partialFile);
865                    statusMessage("Downloading: Map data to $partialFile (slice $j of 10)", $currentSubTask, $progressJobs, $progressPercent,0);
866                    print "Download\n$URL\n" if ($Config->get("Debug"));
867                    $res = DownloadFile($URL, $partialFile, 0);
868
869                    if (! $res)
870                    {
871                        statusMessage("No data here (sliced)...", $currentSubTask, $progressJobs, $progressPercent, 1);
872                        PutRequestBackToServer($X,$Y,$Zoom,"NoData");
873                        foreach my $file(@tempfiles) { killafile($file); }
874                        addFault("nodata",1);
875                        return cleanUpAndDie("GenerateTileset: no data! (sliced).",$Mode,1,$PID);
876                    }
877                    else
878                    {
879                        resetFault("nodata"); #reset to zero if data downloaded
880                    }
881                }
882                print STDERR "\n";
883            }
884        }
885        else
886        {
887            if ($Zoom < 12) ## FIXME: hardcoded zoom
888            {
889                resetFault("nodataXAPI"); #reset to zero if data downloaded
890            }
891            else 
892            {
893                resetFault("nodata"); #reset to zero if data downloaded
894            }
895        }
896    }
897
898    mergeOsmFiles($DataFile, $filelist);
899
900    if ($Config->get("KeepDataFile"))
901    {
902        copy($DataFile, $Config->get("WorkingDirectory") . "/" . "data.osm");
903    }
904 
905    # Get the server time for the data so we can assign it to the generated image (for tracking from when a tile actually is)
906    $JobTime = [stat $DataFile]->[9];
907   
908    # Check for correct UTF8 (else inkscape will run amok later)
909    # FIXME: This doesn't seem to catch all string errors that inkscape trips over.
910    statusMessage("Checking for UTF-8 errors in $DataFile", $currentSubTask, $progressJobs, $progressPercent, 0);
911    if (fileUTF8ErrCheck($DataFile))
912    {
913        statusMessage("found incorrect UTF-8 chars in $DataFile, job $X $Y  $Zoom", $currentSubTask, $progressJobs, $progressPercent, 1);
914        PutRequestBackToServer($X,$Y,$Zoom,"BadUTF8");
915        addFault("utf8",1);
916        return cleanUpAndDie("GenerateTileset:UTF8 test failed",$Mode,1,$PID);
917    }
918    resetFault("utf8"); #reset to zero if no UTF8 errors found.
919
920    #------------------------------------------------------
921    # Handle all layers, one after the other
922    #------------------------------------------------------
923
924    foreach my $layer(split(/,/, $Layers))
925    {
926        #reset progress for each layer
927        $progress=0;
928        $progressPercent=0;
929        $currentSubTask = $layer;
930       
931        $JobDirectory = sprintf("%s%s_%d_%d_%d.tmpdir",
932                                $Config->get("WorkingDirectory"),
933                                $Config->get($layer."_Prefix"),
934                                $Zoom, $X, $Y);
935        mkdir $JobDirectory unless -d $JobDirectory;
936
937        my $maxzoom = $Config->get($layer."_MaxZoom");
938        my $layerDataFile;
939
940        # Faff around
941        for (my $i = $Zoom ; $i <= $maxzoom ; $i++) 
942        {
943            killafile($Config->get("WorkingDirectory")."output-$parent_pid-z$i.svg");
944        }
945       
946        my $Margin = " " x ($Zoom - 8);
947        printf "%03d %s%d,%d: %1.2f - %1.2f, %1.2f - %1.2f\n", $Zoom, $Margin, $X, $Y, $S,$N, $W,$E if ($Config->get("Debug"));
948       
949       
950        #------------------------------------------------------
951        # Go through preprocessing steps for the current layer
952        #------------------------------------------------------
953        my @ppchain = ($PID);
954        # config option may be empty, or a comma separated list of preprocessors
955        foreach my $preprocessor(split /,/, $Config->get($layer."_Preprocessor"))
956        {
957            my $inputFile = sprintf("%sdata-%s.osm", 
958                $Config->get("WorkingDirectory"),
959                join("-", @ppchain));
960            push(@ppchain, $preprocessor);
961            my $outputFile = sprintf("%sdata-%s.osm", 
962                $Config->get("WorkingDirectory"),
963                join("-", @ppchain));
964
965            if (-f $outputFile)
966            {
967                # no action; files for this preprocessing step seem to have been created
968                # by another layer already!
969            }
970            elsif ($preprocessor eq "maplint")
971            {
972                # Pre-process the data file using maplint
973                # TODO may put this into a subroutine of its own
974                my $Cmd = sprintf("%s \"%s\" tr %s %s > \"%s\"",
975                        $Config->get("Niceness"),
976                        $Config->get("XmlStarlet"),
977                        "maplint/lib/run-tests.xsl",
978                        "$inputFile",
979                        "tmp.$PID");
980                statusMessage("Running maplint", $currentSubTask, $progressJobs, $progressPercent,0);
981                runCommand($Cmd,$PID);
982                $Cmd = sprintf("%s \"%s\" tr %s %s > \"%s\"",
983                        $Config->get("Niceness"),
984                        $Config->get("XmlStarlet"),
985                        "maplint/lib/convert-to-tags.xsl",
986                        "tmp.$PID",
987                        "$outputFile");
988                statusMessage("Creating tags from maplint", $currentSubTask, $progressJobs, $progressPercent,0);
989                runCommand($Cmd,$PID);
990                killafile("tmp.$PID");
991            }
992            elsif ($preprocessor eq "close-areas")
993            {
994                my $Cmd = sprintf("%s perl close-areas.pl $X $Y $Zoom < %s > %s",
995                        $Config->get("Niceness"),
996                        "$inputFile",
997                        "$outputFile");
998                statusMessage("Running close-areas", $currentSubTask, $progressJobs, $progressPercent,0);
999                runCommand($Cmd,$PID);
1000            }
1001            else
1002            {
1003                die "Invalid preprocessing step '$preprocessor'";
1004            }
1005## Uncomment to have the output files checked for validity
1006#            if( $preprocessor ne "maplint" )
1007#            {
1008#              runCommand( qq(xmllint --dtdvalid http://dev.openstreetmap.org/~kleptog/tilesAtHome-0.3.dtd --noout $outputFile), $PID );
1009#            }
1010            push(@tempfiles, $outputFile);
1011        }
1012
1013        #------------------------------------------------------
1014        # Preprocessing finished, start rendering
1015        #------------------------------------------------------
1016
1017        #$layerDataFile = sprintf("%sdata-%s.osm", $Config->get("WorkingDirectory"), join("-", @ppchain));
1018        $layerDataFile = sprintf("data-%s.osm", join("-", @ppchain)); # Don't put working directory here, the path is relative to the rulesfile
1019       
1020        # Add bounding box to osmarender
1021        # then set the data source
1022        # then transform it to SVG
1023        if ($Config->get("Fork")) 
1024        {
1025            my $minimum_zoom = $Zoom;
1026            my $increment = 2 * $Config->get("Fork");
1027            my @children_pid;
1028            my $error = 0;
1029            for (my $i = 0; $i < 2 * $Config->get("Fork") - 1; $i ++) 
1030            {
1031                my $pid = fork();
1032                if (not defined $pid) 
1033                {
1034                    cleanUpAndDie("GenerateTileset: could not fork, exiting","EXIT",4,$PID); # exit if asked to fork but unable to
1035                }
1036                elsif ($pid == 0) 
1037                {
1038                    for (my $i = $minimum_zoom ; $i <= $maxzoom; $i += $increment) 
1039                    {
1040                        if (GenerateSVG($layerDataFile, $layer, $X, $Y, $i, $N, $S, $W, $E)) # if true then error occured
1041                        {
1042                             exit(1);
1043                        }
1044                    }
1045                    exit(0);
1046                }
1047                else
1048                {
1049                    push(@children_pid, $pid);
1050                    $minimum_zoom ++;
1051                }
1052            }
1053            for (my $i = $minimum_zoom ; $i <= $maxzoom; $i += $increment) 
1054            {
1055                if (GenerateSVG($layerDataFile, $layer, $X, $Y, $i, $N, $S, $W, $E))
1056                {
1057                    $error = 1;
1058                    last;
1059                }
1060            }
1061            foreach (@children_pid) 
1062            {
1063                waitpid($_, 0);
1064                $error |= $?;
1065            }
1066            if ($error) 
1067            {
1068                foreach my $file(@tempfiles) { killafile($file) if (!$Config->get("Debug")); }
1069                PutRequestBackToServer($X,$Y,$Zoom,"RenderFailure");
1070                addFault("renderer",1);
1071                return 0;
1072            }
1073        }
1074        else
1075        {
1076            for (my $i = $Zoom ; $i <= $maxzoom; $i++)
1077            {
1078                if (GenerateSVG($layerDataFile, $layer, $X, $Y, $i, $N, $S, $W, $E))
1079                {
1080                    foreach my $file(@tempfiles) { killafile($file) if (!$Config->get("Debug")); }
1081                    PutRequestBackToServer($X,$Y,$Zoom,"RenderFailure");
1082                    addFault("renderer",1);
1083                    return 0;
1084                }
1085            }
1086        }
1087       
1088        # Find the size of the SVG file
1089        my ($ImgH,$ImgW,$Valid) = getSize($Config->get("WorkingDirectory")."output-$parent_pid-z$maxzoom.svg");
1090
1091        # Render it as loads of recursive tiles
1092        my ($success,$empty) = RenderTile($layer, $X, $Y, $Y, $Zoom, $Zoom, $N, $S, $W, $E, 0,0,$ImgW,$ImgH,$ImgH,0);
1093        if (!$success)
1094        {
1095            addFault("renderer",1);
1096            return cleanUpAndDie("GenerateTileset: could not render tileset",$Mode,1,$PID);
1097        }
1098        else
1099        {
1100            resetFault("renderer");
1101        }
1102        # Clean-up the SVG files
1103        for (my $i = $Zoom ; $i <= $maxzoom; $i++) 
1104        {
1105            killafile($Config->get("WorkingDirectory")."output-$parent_pid-z$i.svg") if (!$Config->get("Debug"));
1106        }
1107
1108        #if $empty then the next zoom level was empty, so we only upload one tile unless RenderFullTileset is set.
1109        if ($empty == 1 && $Config->get("GatherBlankTiles")) 
1110        {
1111            my $Filename=sprintf("%s_%s_%s_%s.png",$Config->get($layer."_Prefix"), $Zoom, $X, $Y);
1112            my $oldFilename = sprintf("%s/%s",$JobDirectory, $Filename); 
1113            my $newFilename = sprintf("%s%s",$Config->get("WorkingDirectory"),$Filename);
1114            rename($oldFilename, $newFilename);
1115            rmdir($JobDirectory);
1116        }
1117        else
1118        {
1119            # This directory is now ready for upload.
1120            # How should errors in renaming be handled?
1121            my $Dir = $JobDirectory;
1122            $Dir =~ s|\.tmpdir|.dir|;
1123            rename $JobDirectory, $Dir;
1124        }
1125
1126    }
1127
1128    foreach my $file(@tempfiles) { killafile($file) if (!$Config->get("Debug")); }
1129
1130    keepLog($PID,"GenerateTileset","stop","x=$X,y=$Y,z=$Zoom for layers $Layers");
1131
1132    return 1;
1133}
1134
1135#-----------------------------------------------------------------------------
1136# Generate SVG for one zoom level
1137#   $layerDataFile - name of the OSM data file
1138#   $X, $Y - which tileset (Always the tilenumbers of the base zoom. i.e. z12)
1139#   $Zoom - which zoom currently is processsed
1140#   $N, $S, $W, $E - bounds of the tile
1141#-----------------------------------------------------------------------------
1142sub GenerateSVG 
1143{
1144    my ($layerDataFile, $layer, $X, $Y, $Zoom, $N, $S, $W, $E) = @_;
1145    # Create a new copy of rules file to allow background update
1146    # don't need layer in name of file as we'll
1147    # process one layer after the other
1148    my $error = 0;
1149    my $source = $Config->get($layer."_Rules.".$Zoom);
1150    my $TempFeatures = $Config->get("WorkingDirectory")."map-features-$PID-z$Zoom.xml";
1151    copy($source, $TempFeatures)
1152        or die "Cannot make copy of $source";
1153
1154    # Update the rules file  with details of what to do (where to get data, what bounds to use)
1155    AddBounds($TempFeatures,$W,$S,$E,$N);
1156    SetDataSource($layerDataFile, $TempFeatures);
1157
1158    # Render the file
1159    if (! xml2svg(
1160            $TempFeatures,
1161            $Config->get("WorkingDirectory")."output-$parent_pid-z$Zoom.svg",
1162            $Zoom))
1163    {
1164        $error = 1;
1165    }
1166    # Delete temporary rules file
1167    killafile($TempFeatures) if (! $Config->get("Debug"));
1168    return $error;
1169}
1170
1171#-----------------------------------------------------------------------------
1172# Render a tile
1173#   $X, $Y - which tileset (Always the tilenumbers at $ZOrig)
1174#   $Ytile, $Zoom - which tilestripe
1175#   $ZOrig, the lowest zoom level which called tileset generation (i.e. z12 for "normal" operation)
1176#   $N, $S, $W, $E - bounds of the tile
1177#   $ImgX1,$ImgY1,$ImgX2,$ImgY2 - location of the tile in the SVG file
1178#   $ImageHeight - Height of the entire SVG in SVG units
1179#   $empty - put forward "empty" tilestripe information.
1180#-----------------------------------------------------------------------------
1181sub RenderTile 
1182{
1183    my ($layer, $X, $Y, $Ytile, $Zoom, $ZOrig, $N, $S, $W, $E, $ImgX1,$ImgY1,$ImgX2,$ImgY2,$ImageHeight,$SkipEmpty) = @_;
1184
1185    return (1,1) if($Zoom > $Config->get($layer."_MaxZoom"));
1186   
1187    # no need to render subtiles if empty
1188    return (1,$SkipEmpty) if($SkipEmpty == 1);
1189
1190    # Render it to PNG
1191    printf "Tilestripe %s (%s,%s): Lat %1.3f,%1.3f, Long %1.3f,%1.3f, X %1.1f,%1.1f, Y %1.1f,%1.1f\n",       $Ytile,$X,$Y,$N,$S,$W,$E,$ImgX1,$ImgX2,$ImgY1,$ImgY2 if ($Config->get("Debug")); 
1192    my $Width = 256 * (2 ** ($Zoom - $ZOrig));  # Pixel size of tiles 
1193    my $Height = 256; # Pixel height of tile
1194
1195    # svg2png returns true if all tiles extracted were empty. this might break
1196    # if a higher zoom tile would contain data that is not rendered at the
1197    # current zoom level.
1198    my ($success,$empty) = svg2png($Zoom, $ZOrig, $layer, $Width, $Height,$ImgX1,$ImgY1,$ImgX2,$ImgY2,$ImageHeight,$X,$Y,$Ytile);
1199    if (!$success)
1200    {
1201       return (0,$empty);
1202    }
1203    if ($empty and !$Config->get($layer."_RenderFullTileset")) 
1204    {
1205        $SkipEmpty=1;
1206    }
1207
1208    # Get progress percentage
1209    if($SkipEmpty == 1) 
1210    {
1211        # leap forward because this tile and all higher zoom tiles of it are "done" (empty).
1212        for (my $j = $Config->get($layer."_MaxZoom"); $j >= $Zoom ; $j--)
1213        {
1214            $progress += 2 ** ($Config->get($layer."_MaxZoom")-$j);
1215        }
1216    }
1217    else
1218    {
1219        $progress += 1;
1220    }
1221
1222    if (($progressPercent=$progress*100/(2**($Config->get($layer."_MaxZoom")-$ZOrig+1)-1)) == 100)
1223    {
1224        statusMessage("Finished $X,$Y for layer $layer", $currentSubTask, $progressJobs, $progressPercent, 1);
1225    }
1226    else
1227    {
1228        if ($Config->get("Verbose"))
1229        {
1230            printf STDERR "Job No. %d %1.1f %% done.\n",$progressJobs, $progressPercent;
1231        }
1232        else
1233        {
1234            statusMessage("Working", $currentSubTask, $progressJobs, $progressPercent,0);
1235        }
1236    }
1237   
1238    # Sub-tiles
1239    my $MercY2 = ProjectF($N); # get mercator coordinates for North border of tile
1240    my $MercY1 = ProjectF($S); # get mercator coordinates for South border of tile
1241    my $MercYC = 0.5 * ($MercY1 + $MercY2); # get center of tile in mercator
1242    my $LatC = ProjectMercToLat($MercYC); # reproject centerline to latlon
1243
1244    my $ImgYCP = ($MercYC - $MercY1) / ($MercY2 - $MercY1); 
1245    my $ImgYC = $ImgY1 + ($ImgY2 - $ImgY1) * $ImgYCP;       # find mercator coordinates for bottom/top of subtiles
1246
1247    my $YA = $Ytile * 2;
1248    my $YB = $YA + 1;
1249
1250    if ($Config->get("Fork") && $Zoom >= $ZOrig && $Zoom < ($ZOrig + $Config->get("Fork")))
1251    {
1252        my $pid = fork();
1253        if (not defined $pid) 
1254        {
1255            cleanUpAndDie("RenderTile: could not fork, exiting","EXIT",4,$PID); # exit if asked to fork but unable to
1256        }
1257        elsif ($pid == 0) 
1258        {
1259            # we are the child process and can't talk to our parent other than through exit codes
1260            ($success,$empty) = RenderTile($layer, $X, $Y, $YA, $Zoom+1, $ZOrig, $N, $LatC, $W, $E, $ImgX1, $ImgYC, $ImgX2, $ImgY2,$ImageHeight,$SkipEmpty);
1261            if ($success)
1262            {
1263                exit(0);
1264            }
1265            else
1266            {
1267                exit(1);
1268            }
1269        }
1270        else
1271        {
1272            ($success,$empty) = RenderTile($layer, $X, $Y, $YB, $Zoom+1, $ZOrig, $LatC, $S, $W, $E, $ImgX1, $ImgY1, $ImgX2, $ImgYC,$ImageHeight,$SkipEmpty);
1273            waitpid($pid,0);
1274            my $ChildExitValue = $?; # we don't want the details, only if it exited normally or not.
1275            if ($ChildExitValue or !$success)
1276            {
1277                return (0,$SkipEmpty);
1278            }
1279        }
1280        if ($Zoom == $ZOrig)
1281        {
1282            $progressPercent=100 if (! $Config->get("Debug")); # workaround for not correctly updating %age in fork, disable in debug mode
1283            statusMessage("Finished $X,$Y for layer $layer", $currentSubTask, $progressJobs, $progressPercent, 1);
1284        }
1285    }
1286    else
1287    {
1288        ($success,$empty) = RenderTile($layer, $X, $Y, $YA, $Zoom+1, $ZOrig, $N, $LatC, $W, $E, $ImgX1, $ImgYC, $ImgX2, $ImgY2,$ImageHeight,$SkipEmpty);
1289        return (0,$empty) if (!$success);
1290        ($success,$empty) = RenderTile($layer, $X, $Y, $YB, $Zoom+1, $ZOrig, $LatC, $S, $W, $E, $ImgX1, $ImgY1, $ImgX2, $ImgYC,$ImageHeight,$SkipEmpty);
1291        return (0,$empty) if (!$success);
1292    }
1293
1294    return (1,$SkipEmpty); ## main call wants to know wether the entire tileset was empty so we return 1 for success and 1 if the tile was empty
1295}
1296
1297
1298#-----------------------------------------------------------------------------
1299# Gets latest copy of client from svn repository
1300# returns 1 on perceived success.
1301#-----------------------------------------------------------------------------
1302sub UpdateClient #
1303{
1304    my $Cmd = sprintf("%s\"%s\" %s",
1305        $Config->get("i18n") ? "LC_ALL=C " : "",
1306        $Config->get("Subversion"),
1307        $Config->get("SubversionUpdateCmd"));
1308
1309    statusMessage("Updating the Client", $currentSubTask, $progressJobs, $progressPercent,1);
1310    runCommand($Cmd,$PID); # FIXME: evaluate output and handle locally changed files that need updating!
1311    ## FIXME TODO: Implement and check output from svn status, too.
1312
1313    $Cmd = sprintf("%s\"%s\" %s",
1314        $Config->get("i18n") ? "LC_ALL=C " : "",
1315        $Config->get("Subversion"),
1316        "status -q --ignore-externals");
1317
1318    my $svn_status = `$Cmd`;
1319
1320    chomp $svn_status;
1321
1322    if ($svn_status eq '')
1323    {
1324        my $versionfile = "version.txt";
1325        DownloadFile($Config->get("VersionCheckURL"), $versionfile ,0);
1326        return 1;
1327    }
1328    else
1329    {
1330        statusMessage("svn status did not come back clean, check your installation",$currentSubTask, $progressJobs, $progressPercent,1);
1331        print STDERR $svn_status;
1332        return cleanUpAndDie("Auto-update failed","EXIT",1,$PID);
1333    }
1334}
1335
1336sub NewClientVersion 
1337{
1338    return 0 if (time() - $LastTimeVersionChecked < 600);
1339    my $versionfile = "version.txt";
1340    my $runningVersion;
1341    if (open(versionfile, "<", $versionfile))
1342    {
1343        $runningVersion = <versionfile>;
1344        chomp $runningVersion;
1345        close versionfile;
1346    }
1347    elsif (open(versionfile, ">", $versionfile))
1348    {
1349        $runningVersion = 0; 
1350        print versionfile $runningVersion;
1351        close versionfile;
1352    }
1353    else
1354    {
1355        die("can't open $versionfile");
1356    }
1357    # return 0;
1358
1359    my $curVerFile = "newversion.txt";
1360    my $currentVersion;
1361   
1362    DownloadFile($Config->get("VersionCheckURL"), $curVerFile ,0);
1363    if (open(versionfile, "<", $curVerFile))
1364    {
1365        $currentVersion = <versionfile>;
1366        chomp $runningVersion;
1367        close versionfile;
1368        # rename($curVerFile,$versionfile); # FIXME: This assumes the client is immediately, and successfully updated afterwards!
1369    }
1370    if ($currentVersion)
1371    {
1372        $LastTimeVersionChecked = time();
1373        if ($runningVersion > $currentVersion)
1374        {
1375            print "\n! WARNNG: you cannot have a more current client than the server: $runningVersion > $currentVersion\n";
1376            return 0;
1377        }
1378        elsif ($runningVersion == $currentVersion)
1379        {
1380            return 0; # no new version
1381        }
1382        else
1383        {
1384            return 1; # version on server is newer
1385        }
1386    }
1387    else
1388    {
1389        print "\n! WARNING: Could not get version info from server!\n";
1390        return 0;
1391    }
1392}
1393
1394
1395#-----------------------------------------------------------------------------
1396# Transform an OSM file (using osmarender) into SVG
1397#-----------------------------------------------------------------------------
1398sub xml2svg 
1399{
1400    my($MapFeatures, $SVG, $zoom) = @_;
1401    my $TSVG = "$SVG";
1402    my $NoBezier = $Config->get("NoBezier") || $zoom <= 11;
1403
1404    if (!$NoBezier) 
1405    {
1406        $TSVG = "$SVG-temp.svg";
1407    }
1408
1409    my $success = 0;
1410    if ($Config->get("Osmarender") eq "XSLT")
1411    {
1412        my $XslFile;
1413
1414        $XslFile = "osmarender/osmarender.xsl";
1415
1416        my $Cmd = sprintf("%s \"%s\" tr --maxdepth %s %s %s > \"%s\"",
1417          $Config->get("Niceness"),
1418          $Config->get("XmlStarlet"),
1419          $Config->get("XmlStarletMaxDepth"),
1420          $XslFile,
1421          "$MapFeatures",
1422          $TSVG);
1423
1424        statusMessage("Transforming zoom level $zoom with XSLT", $currentSubTask, $progressJobs, $progressPercent,0);
1425        $success = runCommand($Cmd,$PID);
1426    }
1427    elsif($Config->get("Osmarender") eq "orp")
1428    {
1429        chdir "orp";
1430        my $Cmd = sprintf("%s perl orp.pl -r %s -o %s",
1431          $Config->get("Niceness"),
1432          $MapFeatures,
1433          $TSVG);
1434
1435        statusMessage("Transforming zoom level $zoom with or/p", $currentSubTask, $progressJobs, $progressPercent,0);
1436        $success = runCommand($Cmd,$PID);
1437        chdir "..";
1438    }
1439    else
1440    {
1441        die "invalid Osmarender setting in config";
1442    }
1443    if (!$success) {
1444        statusMessage(sprintf("%s produced an error, aborting render.", $Config->get("Osmarender")), 
1445                      $currentSubTask, $progressJobs, $progressPercent, 1);
1446        return cleanUpAndDie("xml2svg failed",$Mode,3,$PID);
1447    }
1448
1449    # look at temporary svg wether it really is a svg or just the
1450    # xmlstarlet dump and exit if the latter.
1451    open(SVGTEST, "<", $TSVG) || return;
1452    my $TestLine = <SVGTEST>;
1453    chomp $TestLine;
1454    close SVGTEST;
1455
1456    if (grep(!/</, $TestLine))
1457    {
1458       statusMessage("File $TSVG doesn't look like svg, aborting render.", $currentSubTask, $progressJobs, $progressPercent,1);
1459       return cleanUpAndDie("xml2svg failed",$Mode,3,$PID);
1460    }
1461#-----------------------------------------------------------------------------
1462# Process lines to Bezier curve hinting
1463#-----------------------------------------------------------------------------
1464    if (!$NoBezier) 
1465    {   # do bezier curve hinting
1466        my $Cmd = sprintf("%s perl ./lines2curves.pl %s > %s",
1467          $Config->get("Niceness"),
1468          $TSVG,
1469          $SVG);
1470        statusMessage("Beziercurvehinting zoom level $zoom", $currentSubTask, $progressJobs, $progressPercent,0);
1471        runCommand($Cmd,$PID);
1472#-----------------------------------------------------------------------------
1473# Sanitycheck for Bezier curve hinting, no output = bezier curve hinting failed
1474#-----------------------------------------------------------------------------
1475        my $filesize= -s $SVG;
1476        if (!$filesize) 
1477        {
1478            copy($TSVG,$SVG);
1479            statusMessage("Error on Bezier Curve hinting, rendering without bezier curves", $currentSubTask, $progressJobs, $progressPercent,0);
1480        }
1481        killafile($TSVG) if (!$Config->get("Debug"));
1482    }
1483    else
1484    {   # don't do bezier curve hinting
1485        statusMessage("Bezier Curve hinting disabled.", $currentSubTask, $progressJobs, $progressPercent,0);
1486    }
1487    return 1;
1488}
1489
1490
1491#-----------------------------------------------------------------------------
1492# Render a SVG file
1493# $ZOrig - the lowest zoom level of the tileset
1494# $X, $Y - tilemnumbers of the tileset
1495# $Ytile - the actual tilenumber in Y-coordinate of the zoom we are processing
1496#-----------------------------------------------------------------------------
1497sub svg2png
1498{
1499    my($Zoom, $ZOrig, $layer, $SizeX, $SizeY, $X1, $Y1, $X2, $Y2, $ImageHeight, $X, $Y, $Ytile) = @_;
1500   
1501    my $TempFile;
1502    my $stdOut;
1503    my $TempDir = $Config->get("WorkingDirectory") . $PID . "/"; # avoid upload.pl looking at the wrong PNG (Regression caused by batik support)
1504    if (! -e $TempDir ) 
1505    {
1506        mkdir($TempDir) or cleanUpAndDie("cannot create working directory $TempDir","EXIT",3,$PID);
1507    }
1508    elsif (! -d $TempDir )
1509    {
1510        cleanUpAndDie("could not use $TempDir: is not a directory","EXIT",3,$PID);
1511    }
1512    (undef, $TempFile) = tempfile($PID."_part-XXXXXX", DIR => $TempDir, SUFFIX => ".png", OPEN => 0);
1513    (undef, $stdOut) = tempfile("$PID-XXXXXX", DIR => $Config->get("WorkingDirectory"), SUFFIX => ".stdout", OPEN => 0);
1514
1515   
1516    my $Cmd = "";
1517   
1518    my $Left = $X1;
1519    my $Top = $ImageHeight - $Y2;
1520    my $Width = $X2 - $X1;
1521    my $Height = $Y2 - $Y1;
1522   
1523    my $svgFile = "output-$parent_pid-z$Zoom.svg";
1524
1525    if ($Config->get("Batik") == "1") # batik as jar
1526    {
1527        $Cmd = sprintf("%s%s java -Xms256M -Xmx%s -jar %s -w %d -h %d -a %f,%f,%f,%f -m image/png -d \"%s\" \"%s%s\" > %s", 
1528        $Config->get("i18n") ? "LC_ALL=C " : "",
1529        $Config->get("Niceness"),
1530        $Config->get("BatikJVMSize"),
1531        $Config->get("BatikPath"),
1532        $SizeX,
1533        $SizeY,
1534        $Left,$Top,$Width,$Height,
1535        $TempFile,
1536        $Config->get("WorkingDirectory"),
1537        $svgFile,
1538        $stdOut);
1539    }
1540    elsif ($Config->get("Batik") == "2") # batik as executable (wrapper of some sort, i.e. on gentoo)
1541    {
1542        $Cmd = sprintf("%s%s \"%s\" -w %d -h %d -a %f,%f,%f,%f -m image/png -d \"%s\" \"%s%s\" > %s",
1543        $Config->get("i18n") ? "LC_ALL=C " : "",
1544        $Config->get("Niceness"),
1545        $Config->get("BatikPath"),
1546        $SizeX,
1547        $SizeY,
1548        $Left,$Top,$Width,$Height,
1549        $TempFile,
1550        $Config->get("WorkingDirectory"),
1551        $svgFile,
1552        $stdOut);
1553    }
1554    elsif ($Config->get("Batik") == "3") # agent
1555    {
1556        $Cmd = sprintf("svg2png\nwidth=%d\nheight=%d\narea=%f,%f,%f,%f\ndestination=%s\nsource=%s%s\nlog=%s\n\n", 
1557        $SizeX,
1558        $SizeY,
1559        $Left,$Top,$Width,$Height,
1560        $TempFile,
1561        $Config->get("WorkingDirectory"),
1562        $svgFile,
1563        $stdOut);
1564    }
1565    else
1566    {
1567        my $locale = $Config->get("InkscapeLocale");
1568        my $oldLocale;
1569        if ($locale ne "0") {
1570                $oldLocale=setlocale(LC_ALL, $locale);
1571        } 
1572
1573        $Cmd = sprintf("%s%s \"%s\" -z -w %d -h %d --export-area=%f:%f:%f:%f --export-png=\"%s\" \"%s%s\" > %s", 
1574        $Config->get("i18n") ? "LC_ALL=C " : "",
1575        $Config->get("Niceness"),
1576        $Config->get("Inkscape"),
1577        $SizeX,
1578        $SizeY,
1579        $X1,$Y1,$X2,$Y2,
1580        $TempFile,
1581        $Config->get("WorkingDirectory"),
1582        $svgFile,
1583        $stdOut);
1584
1585        if ($locale ne "0") {
1586                setlocale(LC_ALL, $oldLocale);
1587        } 
1588    }
1589   
1590    # stop rendering the current job when inkscape fails
1591    statusMessage("Rendering", $currentSubTask, $progressJobs, $progressPercent,0);
1592    print STDERR "\n$Cmd\n" if ($Config->get("Debug"));
1593
1594
1595    my $commandResult = $Config->get("Batik") == "3"?sendCommandToBatik($Cmd) eq "OK":runCommand($Cmd,$PID);
1596    if (!$commandResult or ! -e $TempFile )
1597    {
1598        statusMessage("$Cmd failed", $currentSubTask, $progressJobs, $progressPercent, 1);
1599        if ($Config->get("Batik") == "3" && !getBatikStatus())
1600        {
1601            statusMessage("Batik agent is not running, use $0 startBatik to start batik agent\n", $currentSubTask, $progressJobs, $progressPercent, 1);
1602        }
1603        ## TODO: check this actually gets the correct coords
1604        PutRequestBackToServer($X,$Y,$ZOrig,"BadSVG");
1605        addFault("inkscape",1);
1606        $unrenderable{"$X $Y $ZOrig"}++;
1607        cleanUpAndDie("svg2png failed",$Mode,3,$PID);
1608        return (0,0);
1609    }
1610    resetFault("inkscape"); # reset to zero if inkscape succeeds at least once
1611    killafile($stdOut) if (not $Config->get("Debug"));
1612   
1613    my $ReturnValue = splitImageX($TempFile, $layer, $ZOrig, $X, $Y, $Zoom, $Ytile); # returns true if tiles were all empty
1614   
1615    killafile($TempFile) if (not $Config->get("Debug"));
1616    rmdir ($TempDir);
1617    return (1,$ReturnValue); #return true if empty
1618}
1619
1620
1621sub writeToFile 
1622{
1623    open(my $fp, ">", shift()) || return;
1624    print $fp shift();
1625    close $fp;
1626}
1627
1628#-----------------------------------------------------------------------------
1629# Add bounding-box information to an osm-map-features file
1630#-----------------------------------------------------------------------------
1631sub AddBounds 
1632{
1633    my ($Filename,$W,$S,$E,$N,$Size) = @_;
1634   
1635    # Read the old file
1636    open(my $fpIn, "<", "$Filename");
1637    my $Data = join("",<$fpIn>);
1638    close $fpIn;
1639    die("no such $Filename") if(! -f $Filename);
1640   
1641    # Change some stuff
1642    my $BoundsInfo = sprintf(
1643      "<bounds minlat=\"%f\" minlon=\"%f\" maxlat=\"%f\" maxlon=\"%f\" />",
1644      $S, $W, $N, $E);
1645   
1646    $Data =~ s/(<!--bounds_mkr1-->).*(<!--bounds_mkr2-->)/$1\n<!-- Inserted by tilesGen -->\n$BoundsInfo\n$2/s;
1647   
1648    # Save back to the same location
1649    open(my $fpOut, ">$Filename");
1650    print $fpOut $Data;
1651    close $fpOut;
1652}
1653
1654#-----------------------------------------------------------------------------
1655# Set data source file name in map-features file
1656#-----------------------------------------------------------------------------
1657sub SetDataSource 
1658{
1659    my ($Datafile, $Rulesfile) = @_;
1660
1661    # Read the old file
1662    open(my $fpIn, "<", "$Rulesfile");
1663    my $Data = join("",<$fpIn>);
1664    close $fpIn;
1665    die("no such $Rulesfile") if(! -f $Rulesfile);
1666
1667    $Data =~ s/(  data=\").*(  scale=\")/$1$Datafile\"\n$2/s;
1668
1669    # Save back to the same location
1670    open(my $fpOut, ">$Rulesfile");
1671    print $fpOut $Data;
1672    close $fpOut;
1673}
1674
1675#-----------------------------------------------------------------------------
1676# Get the width and height (in SVG units, must be pixels) of an SVG file
1677#-----------------------------------------------------------------------------
1678sub getSize($)
1679{
1680    my $SVG = shift();
1681    open(my $fpSvg,"<",$SVG);
1682    while(my $Line = <$fpSvg>)
1683    {
1684        if($Line =~ /height=\"(.*)px\" width=\"(.*)px\"/)
1685        {
1686            close $fpSvg;
1687            return(($1,$2,1));
1688        }
1689    }
1690    close $fpSvg;
1691    return((0,0,0));
1692}
1693
1694#-----------------------------------------------------------------------------
1695# Temporary filename to store a tile
1696#-----------------------------------------------------------------------------
1697sub tileFilename 
1698{
1699    my($layer,$X,$Y,$Zoom) = @_;
1700    return(sprintf($Config->get("LocalSlippymap") ? "%s/%s/%d/%d/%d.png" : "%s/%s_%d_%d_%d.png",
1701        $Config->get("LocalSlippymap") ? $Config->get("LocalSlippymap") : $JobDirectory,
1702        $Config->get($layer."_Prefix"),
1703        $Zoom,
1704        $X,
1705        $Y));
1706}
1707
1708## sub mergeOsmFiles moved to tahlib.pm
1709
1710#-----------------------------------------------------------------------------
1711# Split a tileset image into tiles
1712#-----------------------------------------------------------------------------
1713sub splitImageX 
1714{
1715    my ($File, $layer, $ZOrig, $X, $Y, $Z, $Ytile) = @_;
1716 
1717    # Size of tiles
1718    my $Pixels = 256;
1719 
1720    # Number of tiles
1721    my $Size = 2 ** ($Z - $ZOrig);
1722
1723    # Assume the tileset is empty by default
1724    my $allempty=1;
1725 
1726    # Load the tileset image
1727    statusMessage(sprintf("Splitting %s (%d x 1)", $File, $Size), $currentSubTask, $progressJobs, $progressPercent, 0);
1728    my $Image = newFromPng GD::Image($File);
1729    if( not defined $Image )
1730    {
1731        print STDERR "\nERROR: Failed to read in file $File\n";
1732        PutRequestBackToServer($X,$Y,$ZOrig,"MissingFile");
1733        cleanUpAndDie("SplitImageX:MissingFile encountered, exiting","EXIT",4,$PID);
1734    }
1735 
1736    # Use one subimage for everything, and keep copying data into it
1737    my $SubImage = new GD::Image($Pixels,$Pixels);
1738 
1739    # For each subimage
1740    for(my $xi = 0; $xi < $Size; $xi++)
1741    {
1742        # Get a tiles'worth of data from the main image
1743        $SubImage->copy($Image,
1744          0,                   # Dest X offset
1745          0,                   # Dest Y offset
1746          $xi * $Pixels,       # Source X offset
1747          0,                   # Source Y offset # always 0 because we only cut from one row
1748          $Pixels,             # Copy width
1749          $Pixels);            # Copy height
1750
1751        # Decide what the tile should be called
1752        my $Filename = tileFilename($layer, $X * $Size + $xi, $Ytile, $Z);
1753        MagicMkdir($Filename) if ($Config->get("LocalSlippymap"));
1754   
1755        # Temporary filename
1756        my $Filename2_suffix = ".cut";
1757        my $Filename2 = $Filename.$Filename2_suffix;
1758        my $Basename = $Filename;   # used for statusMessage()
1759        $Basename =~ s|.*/||;
1760
1761        # Check for black tile output
1762        if (not ($SubImage->compare($BlackTileImage) & GD_CMP_IMAGE)) 
1763        {
1764            print STDERR "\nERROR: Your inkscape has just produced a totally black tile. This usually indicates a broken Inkscape, please upgrade.\n";
1765            PutRequestBackToServer($X,$Y,$ZOrig,"BlackTile");
1766            cleanUpAndDie("SplitImageX:BlackTile encountered, exiting","EXIT",4,$PID);
1767        }
1768        # Detect empty tile here:
1769        elsif (not($SubImage->compare($EmptyLandImage) & GD_CMP_IMAGE)) # libGD comparison returns true if images are different. (i.e. non-empty Land tile) so return the opposite (false) if the tile doesn''t look like an empty land tile
1770        {
1771            copy("emptyland.png", $Filename);
1772            # Change the tile to a zero-length file if it's as blank as the parent
1773            # We keep the ones at level 15 so the server fallback never has to go more than 3 levels.
1774            if( $Z > 12 and $Z != 15 and not $Config->get("LocalSlippymap") )
1775            {
1776                my $upfile = tileFilename($layer, ($X * $Size + $xi)>>1, $Ytile>>1, $Z-1);
1777                my $upsize = -e $upfile ? -s $upfile : -1;
1778                if( $upsize == 0 or $upsize == -s "emptyland.png" )
1779                { open my $fh, ">$Filename" }
1780            }
1781        }
1782        elsif (not($SubImage->compare($EmptySeaImage) & GD_CMP_IMAGE)) # same for Sea tiles
1783        {
1784            copy("emptysea.png",$Filename);
1785            # Change the tile to a zero-length file if it's as blank as the parent
1786            if( $Z > 12 and $Z != 15 and not $Config->get("LocalSlippymap") )
1787            {
1788                my $upfile = tileFilename($layer, ($X * $Size + $xi)>>1, $Ytile>>1, $Z-1);
1789                my $upsize = -e $upfile ? -s $upfile : -1;
1790                if( $upsize == 0 or $upsize == -s "emptysea.png" )
1791                { open my $fh, ">$Filename" }
1792            }
1793#            $allempty = 0; # TODO: enable this line if/when serverside empty tile methods is implemented. Used to make sure we                                     generate all blank seatiles in a tileset.
1794        }
1795        else
1796        {
1797            # If at least one tile is not empty set $allempty false:
1798            $allempty = 0;
1799   
1800            if ($Config->get($layer."_Transparent")) 
1801            {
1802                $SubImage->transparent($SubImage->colorAllocate(248,248,248));
1803            }
1804            else 
1805            {
1806                $SubImage->transparent(-1);
1807            }
1808
1809            # Store the tile
1810            statusMessage(" -> $Basename", $currentSubTask, $progressJobs, $progressPercent,0) if ($Config->get("Verbose"));
1811            WriteImage($SubImage,$Filename);
1812#-----------------------------------------------------------------------------
1813# Run pngcrush on each split tile, then delete the temporary cut file
1814#-----------------------------------------------------------------------------
1815            my $Redirect = ">/dev/null";
1816            my $Cmd;
1817            if ($^O eq "MSWin32")
1818            {
1819                $Redirect = "";
1820            }
1821
1822            if ($Config->get($layer."_Transparent"))
1823            {
1824                rename($Filename, $Filename2);
1825            }
1826            elsif ($Config->get("PngQuantizer") eq "pngnq") {
1827                if ($EnvironmentInfo{"pngnq"})
1828                {
1829                    $Cmd = sprintf("%s \"%s\" -e .png%s -s1 -n256 %s %s",
1830                                   $Config->get("Niceness"),
1831                                   $Config->get("pngnq"),
1832                                   $Filename2_suffix,
1833                                   $Filename,
1834                                   $Redirect);
1835
1836                    statusMessage("ColorQuantizing $Basename", $currentSubTask, $progressJobs, $progressPercent,0);
1837                    if(runCommand($Cmd,$PID))
1838                    {
1839                        unlink($Filename);
1840                    }
1841                    else
1842                    {
1843                        statusMessage("ColorQuantizing $Basename with ".$Config->get("PngQuantizer")." failed",
1844                                      $currentSubTask, $progressJobs, $progressPercent,1);
1845                        rename($Filename, $Filename2);
1846                    }
1847                }
1848                else
1849                {
1850                    statusMessage("ColorQuantizing $Basename with \"".$Config->get("PngQuantizer")."\" failed, pngnq not installed?",
1851                                  $currentSubTask, $progressJobs, $progressPercent,1);
1852                    rename($Filename, $Filename2);
1853                }
1854            } else {
1855                rename($Filename, $Filename2);
1856            }
1857
1858            if ($Config->get("PngOptimizer") eq "pngcrush")
1859            {
1860                $Cmd = sprintf("%s \"%s\" -q %s %s %s",
1861                  $Config->get("Niceness"),
1862                  $Config->get("Pngcrush"),
1863                  $Filename2,
1864                  $Filename,
1865                  $Redirect);
1866            }
1867            elsif ($Config->get("PngOptimizer") eq "optipng")
1868            {
1869                $Cmd = sprintf("%s \"%s\" %s -out %s %s", #no quiet, because it even suppresses error output
1870                  $Config->get("Niceness"),
1871                  $Config->get("Optipng"),
1872                  $Filename2,
1873                  $Filename,
1874                  $Redirect);
1875            }
1876            else
1877            {
1878                cleanUpAndDie("SplitImageX:PngOptimizer not configured, exiting (should not happen, update from svn, and check config file)","EXIT",4,$PID);
1879            }
1880            statusMessage("Optimizing $Basename", $currentSubTask, $progressJobs, $progressPercent,0);
1881            if(runCommand($Cmd,$PID))
1882            {
1883                unlink($Filename2);
1884            }
1885            else
1886            {
1887                statusMessage("Optimizing $Basename with ".$Config->get("PngOptimizer")." failed", $currentSubTask, $progressJobs, $progressPercent,1);
1888                rename($Filename2, $Filename);
1889            }
1890        }
1891        # Assign the job time to this file
1892        utime $JobTime, $JobTime, $Filename;
1893    }
1894    undef $SubImage;
1895    undef $Image;
1896    # tell the rendering queue wether the tiles are empty or not
1897    return $allempty;
1898}
1899
1900#-----------------------------------------------------------------------------
1901# Write a GD image to disk
1902#-----------------------------------------------------------------------------
1903sub WriteImage 
1904{
1905    my ($Image, $Filename) = @_;
1906   
1907    # Get the image as PNG data
1908    my $png_data = $Image->png;
1909   
1910    # Store it
1911    open (my $fp, ">$Filename") || cleanUpAndDie("WriteImage:could not open file for writing, exiting","EXIT",3,$PID);
1912    binmode $fp;
1913    print $fp $png_data;
1914    close $fp;
1915}
1916
1917# sub MagicMkdir moved to tahlib.pm
1918
1919#-----------------------------------------------------------------------------
1920# A function to re-execute the program. 
1921#
1922# This function attempts to detect whether the perl script has changed
1923# since it was invoked initially, and if so, just runs the new version.
1924# This can be used to update the program while it is running (as it is
1925# sometimes hard to hit Ctrl-C at exactly the right moment!)
1926#-----------------------------------------------------------------------------
1927sub reExecIfRequired
1928{
1929    my $child_pid = shift();## FIXME: make more general
1930
1931    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
1932        $ctime,$blksize,$blocks) = stat($0);
1933    my $de = "$size/$mtime/$ctime";
1934    if (!defined($dirent))
1935    {
1936        $dirent = $de; 
1937        return;
1938    }
1939    elsif ($dirent ne $de)
1940    {
1941        reExec($child_pid);
1942    }
1943}
1944
1945#-----------------------------------------------------------------------------
1946# A function to re-execute the program. 
1947#
1948# This function restarts the program unconditionally.
1949#-----------------------------------------------------------------------------
1950sub reExec
1951{
1952    my $child_pid = shift();## FIXME: make more general
1953    # until proven to work with other systems, only attempt a re-exec
1954    # on linux.
1955    return unless ($^O eq "linux" || $^O eq "cygwin");
1956
1957    statusMessage("tilesGen.pl has changed, re-start new version", $currentSubTask, $progressJobs, $progressPercent, 1);
1958    if ($Config->get("ForkForUpload") && $child_pid != -1)  ## FIXME: make more general
1959    {
1960        statusMessage("Waiting for child process", $currentSubTask, $progressJobs, $progressPercent,0);
1961        waitpid($child_pid, 0);
1962    }
1963    exec "perl", $0, $Mode, "reexec", 
1964        "progressJobs=" . $progressJobs, 
1965        "idleSeconds=" . getIdle(1), 
1966        "idleFor=" . getIdle(0), 
1967        "progstart=$progstart" or die("could not reExec");
1968}
1969
1970
1971sub startBatikAgent
1972{
1973    if (getBatikStatus()) {
1974        statusMessage("BatikAgent is already running\n", $currentSubTask, $progressJobs, $progressPercent,0);
1975        return;
1976    }
1977
1978    statusMessage("Starting BatikAgent\n", $currentSubTask, $progressJobs, $progressPercent,0);
1979    my $Cmd;
1980    if ($^O eq "linux" || $^O eq "cygwin") 
1981    {
1982        $Cmd = sprintf("%s%s java -Xms256M -Xmx%s -cp %s org.tah.batik.ServerMain -p %d > /dev/null&", 
1983          $Config->get("i18n") ? "LC_ALL=C " : "",
1984          $Config->get("Niceness"),
1985          $Config->get("BatikJVMSize"),
1986          $Config->get("BatikClasspath"),
1987          $Config->get("BatikPort")
1988        );
1989    }
1990    elsif ($^O eq "MSWin32")
1991    {
1992        $Cmd = sprintf("%s java -Xms256M -Xmx%s -cp %s org.tah.batik.ServerMain -p %d > /dev/null&", 
1993           "start /B /LOW",
1994           $Config->get("BatikJVMSize"),
1995           $Config->get("BatikClasspath"),
1996           $Config->get("BatikPort")
1997         );
1998    }
1999    else ## just try the linux variant and hope for the best
2000    {
2001        $Cmd = sprintf("%s%s java -Xms256M -Xmx%s -cp %s org.tah.batik.ServerMain -p %d > /dev/null&", 
2002          $Config->get("i18n") ? "LC_ALL=C " : "",
2003          $Config->get("Niceness"),
2004          $Config->get("BatikJVMSize"),
2005          $Config->get("BatikClasspath"),
2006          $Config->get("BatikPort") 
2007         );
2008        statusMessage("Could not determine Operating System ".$^O.", please report to tilesathome mailing list", $currentSubTask, $progressJobs, $progressPercent,1);
2009    }
2010   
2011    system($Cmd);
2012
2013    for (my $i = 0; $i < 10; $i++) {
2014        sleep(1);
2015        if (getBatikStatus()) {
2016            statusMessage("BatikAgent started succesfully");
2017            return;
2018        }
2019    }
2020    print STDERR "Unable to start BatikAgent with this command:\n";
2021    print STDERR "$Cmd\n";
2022}
2023
2024sub stopBatikAgent
2025{
2026    if (!getBatikStatus()) {
2027        statusMessage("BatikAgent is not running\n", $currentSubTask, $progressJobs, $progressPercent,0);
2028        return;
2029    }
2030
2031    sendCommandToBatik("stop\n\n");
2032    statusMessage("Send stop command to BatikAgent\n", $currentSubTask, $progressJobs, $progressPercent,0);
2033}
2034
2035sub sendCommandToBatik
2036{
2037    (my $command) = @_;
2038
2039    my $sock = new IO::Socket::INET( PeerAddr => 'localhost', PeerPort => $Config->get("BatikPort"), Proto => 'tcp');
2040    return "ERROR" unless $sock;   
2041
2042    print $sock $command;
2043    flush $sock;
2044    my $reply = <$sock>;
2045    $reply =~ s/\n//;
2046    close($sock);
2047
2048    return $reply;
2049}
2050
2051sub getBatikStatus
2052{
2053    return sendCommandToBatik("status\n\n") eq "OK";
2054}
2055
2056
2057#------------------------------------------------------------
2058# check for faults and die when too many have occured
2059#------------------------------------------------------------
2060sub checkFaults
2061{
2062    if (getFault("fatal") > 0) {
2063        cleanUpAndDie("Fatal error occurred during loop, exiting","EXIT",1,$PID);
2064    }
2065    elsif (getFault("inkscape") > 5) {
2066        cleanUpAndDie("Five times inkscape failed, exiting","EXIT",1,$PID);
2067    }
2068    elsif (getFault("renderer") > 10) {
2069        cleanUpAndDie("rendering a tileset failed 10 times in a row, exiting","EXIT",1,$PID);
2070    }
2071    elsif (getFault("upload") > 5) {
2072        cleanUpAndDie("Five times the upload failed, perhaps the server doesn't like us, exiting","EXIT",1,$PID);
2073    }
2074}
2075
2076
2077#--------------------------------------------------------------------------------------
2078# check for faults with data downloads and add delays or die when too many have occured
2079#--------------------------------------------------------------------------------------
2080sub checkDataFaults
2081{
2082    my $sleepdelay = 1;
2083    if (getFault("nodata") > 0) { # check every network condition regardless of the other network outcomes
2084        my $numfaults=getFault("nodata");
2085        if ($numfaults > 5) {
2086            cleanUpAndDie("More than five times no data, perhaps the server doesn't like us, exiting","EXIT",1,$PID);
2087        }
2088        else {
2089            $sleepdelay=16*(4**$numfaults); # wait 64, 256, 1024, 4096, 16384 seconds. for a total of about 6 hours
2090            $sleepdelay=int($sleepdelay)+1;
2091            talkInSleep($numfaults." times no data", $sleepdelay);
2092        }
2093    }
2094    if (getFault("nodataXAPI") > 0) {
2095        my $numfaults=getFault("nodataXAPI");
2096        if ($numfaults >= 20) {
2097            cleanUpAndDie("20 times no data from XAPI, perhaps the server doesn't like us, exiting","EXIT",1,$PID); # allow XAPI more leeway
2098        }
2099        else {
2100            $sleepdelay=16*(2**$numfaults); # wait 32, 64, 128, 256, 512, 1024, 4096, 8192, 14400, 14400, 14400... seconds.
2101            $sleepdelay=int($sleepdelay)+1;
2102            $sleepdelay=14400 if ($sleepdelay > 14400);
2103            talkInSleep($numfaults." times no XAPI data", $sleepdelay);
2104        }
2105    }
2106}
2107
2108#--------------------------------------------------------------------------------------
2109# check for utf-8 faults in file and return false if UTF-8 clean, otherwise return the
2110# number of the first line where an utf-8 error occured
2111#--------------------------------------------------------------------------------------
2112
2113sub fileUTF8ErrCheck
2114{
2115    my $DataFile = shift();
2116    open(OSMDATA, $DataFile) || die ("could not open $DataFile for UTF-8 check");
2117    my @toCheck = <OSMDATA>;
2118    close(OSMDATA);
2119    my $line=0;
2120    while (my $osmline = shift @toCheck)
2121    {
2122        $line++;
2123        eval { decode("utf8",$osmline, Encode::FB_CROAK) };
2124        if ($@)
2125        {
2126            return $line; # returns the line the error occured on
2127        }
2128    }
2129    return 0;
2130}
2131
Note: See TracBrowser for help on using the repository browser.