source: subversion/applications/rendering/tilesAtHome-dev/trunk/tilesGen.pl @ 23767

Last change on this file since 23767 was 22874, checked in by iknopf, 10 years ago

ticket #2972: existence of stopfile.txt should be analyzed during an idle loop

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Revision
File size: 40.6 KB
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
25use warnings;
26use strict;
27use lib './lib';
28use File::Copy;
29use File::Path;
30use File::Temp qw(tempfile);
31use File::Spec;
32use Scalar::Util qw(blessed);
33use IO::Socket;
34use Error qw(:try);
35use tahlib;
36use TahConf;
37use Tileset;
38use Server;
39use Request;
40use Upload;
41use SVG::Rasterize;
42use English '-no_match_vars';
43use POSIX;
44
45#---------------------------------
46
47# Read the config file
48my $Config = TahConf->getConfig();
49
50# Handle the command-line
51our $Mode = shift() || '';
52my $LoopMode = (($Mode eq "loop") or ($Mode eq "upload_loop")) ? 1 : 0;
53my $RenderMode = (($Mode eq "xy") or ($Mode eq "once") or ($Mode eq "loop") or ($Mode eq "localFile")) ? 1 : 0;
54my $UploadMode = (($Mode eq "upload") or ($Mode eq "upload_loop")) ? 1 : 0;
55my %EnvironmentInfo;
56
57# Override *nix locales
58delete $ENV{LC_ALL};
59delete $ENV{LC_NUMERIC};
60delete $ENV{LANG};
61$ENV{LANG} = 'C';
62
63if ($RenderMode)
64{   # need to check that we can render and stuff
65    %EnvironmentInfo = $Config->CheckConfig();
66}
67else
68{   # for uploading we need only basic settings
69    %EnvironmentInfo = $Config->CheckBasicConfig();
70}
71
72# set the progress indicator variables
73our $currentSubTask;
74my $progress = 0;
75our $progressJobs = 1;
76our $progressPercent = 0;
77
78my $LastTimeVersionChecked = 0;   # version is only checked when last time was more than 10 min ago
79## NOTE: Version Check will not be run in xy mode, but on subsequent upload.
80## this will fix issues with modified, locally used clients that never ever upload
81if ($UploadMode or $LoopMode)
82{
83    if (NewClientVersion())
84    {
85        UpdateClient();
86        if ($LoopMode) 
87        {
88            reExec(-1);
89        }
90        else
91        {
92            statusMessage("tilesGen.pl has changed. Please restart new version.",1,0);
93            exit;
94        }
95    }
96}
97elsif ($RenderMode and ClientModified())
98{
99    statusMessage("! tilesGen.pl differs from svn repository. DO NOT UPLOAD to t\@h server.",1,0);
100}
101
102#if (($Mode eq "loop") or ($Mode eq "once")) # only really needed for loop and once rendering mode
103#{
104#    my $Cmd = "perl runTests.pl";
105#    my $success = runCommand($Cmd,$PID);
106#    if (not $success)
107#    {
108#        if ($Config->get("Rasterizer") ne "Inkscape")
109#        {
110#            die "tests failed, try \"Inkscape\" as rasterizer.\n";
111# batik is known to mess up composite glyphs, which trips the fontcheck,
112# but there might be batik versions doing it right, so if they pass the test, we let them continue.
113#        }
114#        else
115#        {
116#            print STDERR " *** tests failed *** (non fatal).\n";
117#            talkInSleep(" *** Please upload failed images as instructed to make this warning go away *** ",30);
118#        }
119#    }
120#}
121
122# Get version number from version-control system, as integer
123my $Version = '$Revision: 22874 $';
124$Version =~ s/\$Revision:\s*(\d+)\s*\$/$1/;
125printf STDERR "This is version %d (%s) of tilesgen running on %s, ID: %s\n", 
126    $Version, $Config->get("ClientVersion"), $^O, GetClientId();
127
128# autotuning complexity setting
129my $complexity = 0;
130
131# filestat: Used by reExecIfRequired.
132# This gets set to filesize/mtime/ctime of this script, and reExecIfRequired
133# checks to see if those parameters have changed since the last time it ran
134# to decide if it should reExec
135my $filestat;
136reExecIfRequired(-1); # This will not actually reExec, only set $filestat
137
138if ($LoopMode) {
139    # if this is a re-exec, we want to capture some of our status
140    # information from the command line. this feature allows setting
141    # any numeric variable by specifying "variablename=value" on the
142    # command line after the keyword "reexec". Currently unsuitable
143    # for alphanumeric variables.
144   
145    if ((shift||'') eq "reexec") {
146        my $idleSeconds; my $idleFor;
147        while(my $evalstr = shift()) {
148            die("$evalstr does not match option=value") unless $evalstr =~ /^[A-Za-z]+=\d+/;
149            eval('$'.$evalstr);
150            print STDERR "$evalstr\n" if ($Config->get("Verbose") >= 10);
151        }
152        setIdle($idleSeconds, 1);
153        setIdle($idleFor, 0);
154    }
155}
156
157# Setup SVG::Rasterize
158if( $RenderMode || $Mode eq 'startBatik' || $Mode eq 'stopBatik' ){
159    $SVG::Rasterize::object = SVG::Rasterize->new({ debug => $Config->get("DEBUG") });
160    if( $Config->get("Rasterizer") ){
161        $SVG::Rasterize::object->engine( $Config->get("Rasterizer"));
162    }
163
164    my $rasterizer = ref($SVG::Rasterize::object->engine());
165
166    print STDERR "- rasterizing using $rasterizer\n";
167
168    # Set engine specific parameters
169    if( $SVG::Rasterize::object->engine()->isa('SVG::Rasterize::Engine::BatikAgent') )
170    {
171        $SVG::Rasterize::object->engine()->heapsize($Config->get("BatikJVMSize"));
172        $SVG::Rasterize::object->engine()->host('localhost');
173        $SVG::Rasterize::object->engine()->port($Config->get("BatikPort"));
174        $SVG::Rasterize::object->engine()->autostartstop(1);
175    }
176    elsif( $SVG::Rasterize::object->engine()->isa('SVG::Rasterize::Engine::Batik') )
177    {
178        my @customSearchPaths = ();
179        push(@customSearchPaths, $Config->get("BatikPath")) if $Config->get("BatikPath");
180        if( $^O eq 'MSWin32' ){
181            push(@customSearchPaths, 'c:\tilesAtHome', 'c:\tilesAtHome\batik');
182            push(@customSearchPaths, 'D:\Programme\batik');
183        }
184
185        $SVG::Rasterize::object->engine()->jar_searchpaths(
186            @customSearchPaths,
187            $SVG::Rasterize::object->engine()->jar_searchpaths()
188        );
189    }
190    elsif( $SVG::Rasterize::object->engine()->isa('SVG::Rasterize::Engine::Inkscape') )
191    {
192        if( $Config->get("InkscapePath") ){
193            # Add InkscapePath as first location to look
194            $SVG::Rasterize::object->engine()->jar_searchpaths(
195                $Config->get("InkscapePath"),
196                $SVG::Rasterize::object->engine()->jar_searchpaths()
197            );
198        }
199    }
200
201    # Check for broken rasterizer versions
202    my %brokenRasterizerVersions = (
203        'SVG::Rasterize::Engine::Inkscape' => {
204            "RenderStripes=0 will not work" => [0, 45, 1]
205        },
206        'SVG::Rasterize::Engine::Batik' => {
207            "Problems with black tiles reported" => [1, 6]
208        },
209        'SVG::Rasterize::Engine::BatikAgent' => {
210            "Problems with black tiles reported" => [1, 6]
211        }
212    );
213
214    try {
215        my @version = $SVG::Rasterize::object->engine()->version();
216        die if scalar(@version) == 0;
217
218        while( my( $reason, $ver ) = each %{$brokenRasterizerVersions{$rasterizer}} ){
219            my @brokenVersion = @{ $ver };
220
221            my $equal = 1;
222            if( $#brokenVersion == $#version ){
223                for( my $i=0; $i < @version; $i++ ){
224                    $equal = $version[$i] eq $brokenVersion[$i];
225                    last if ! $equal;
226                }
227            } else {
228                $equal = 0;
229            }
230
231            if( $equal ){
232                printf(STDERR "! You have a broken version (%s) of your rasterizer. %s\n", join('.', @version), $reason);
233                sleep 10;
234            }
235        }
236    } otherwise {
237        print STDERR "! Could not determine your rasterizer version\n";
238    };
239
240    if( $rasterizer eq "SVG::Rasterize::Engine::Inkscape" ){
241        print STDERR "* Take care to manually backup your inkscape user preferences\n"; 
242        print STDERR "  if you have knowingly changed them. \n";
243        print STDERR "  Some tilesets will cause inkscape to clobber that file!\n";
244#        print "  ~/.inkscape/preferences.xml\n";
245    }
246}
247
248# We need to keep parent PID so that child get the correct files after fork()
249my $parent_pid = $PID;
250my $upload_pid = -1;
251
252# keep track of the server time for current job
253my $JobTime;
254
255# Check the stylesheets for corruption and out of dateness, but only in loop mode
256# The existance check is to attempt to determine we're on a UNIX-like system
257
258## set all fault counters to 0;
259initFault("fatal");
260initFault("rasterizer");
261initFault("nodata");
262initFault("nodataROMA");
263initFault("nodataXAPI");
264initFault("renderer");
265initFault("utf8");
266initFault("upload");
267
268unlink("stopfile.txt") if $Config->get("AutoResetStopfile");
269
270# Be nice. Reduce program priority
271if( my $nice = $Config->get("Niceness") ){
272    if( $nice =~ /nice/ ){
273        $nice =~ s/nice\s*-n\s*//;
274        warn "You have Niceness set to a command, it should be only a number.\n";
275    }
276
277    if( $nice =~ /^\d+$/ ){
278        my $success=POSIX::nice($nice);
279        if( !defined($success) ){
280            printf STDERR "! WARNING: Unable to apply Niceness. Will run at normal priority";
281        }
282    }
283}
284
285#---------------------------------
286## Start processing
287
288if ($Mode eq "xy")
289{
290    # ----------------------------------
291    # "xy" as first argument means you want to specify a tileset to render
292    # ----------------------------------
293
294    my $X = shift();
295    my $Y = shift();
296    my $req = new Request;
297    if (not defined $X or not defined $Y)
298    { 
299        print STDERR "Usage: $0 xy <X> <Y> [<ZOOM> [<LAYERS>]]\n";
300        print STDERR "where <X> and <Y> are the tile coordinates and \n";
301        print STDERR "<ZOOM> is an optional zoom level (defaults to 12).\n";
302        print STDERR "<LAYERS> is a comma separated list (no spaces) of the layers to render.\n";
303        print STDERR "This overrides the layers specified in the configuration.\n";
304        exit;
305    }
306    my $Zoom = shift();
307    if (not defined $Zoom)
308    {
309       $Zoom = 12;
310       $currentSubTask = "warning";
311       statusMessage(" *** No zoomlevel specified! Assuming z12 *** ",1,0);
312    }
313
314    $req->ZXY($Zoom, $X, $Y);
315
316    my $Layers = shift();
317    if (not defined $Layers) {
318        if ($Zoom >= 12) {
319            $Layers = $Config->get("Layers");
320        }
321        elsif ($Zoom >= 6) {
322            $Layers = $Config->get("LowzoomLayers");
323        }
324        else {
325            $Layers = $Config->get("WorldLayers");
326        }
327    }
328    $req->layers_str($Layers);
329
330    my $tileset = Tileset->new($req);
331    my $tilestart = time();
332    $tileset->generate();
333    autotuneComplexity($tilestart, time(), $req->complexity);
334}
335#---------------------------------
336elsif ($Mode eq "loop") 
337{
338    # ----------------------------------
339    # Continuously process requests from server
340    # ----------------------------------
341
342    # this is the actual processing loop
343   
344    while(1) 
345    {
346        ## before we start (another) round of rendering we first check if something bad happened in the past.
347        checkFaults();
348
349        ## 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
350        checkDataFaults();
351
352        # look for stopfile and exit if found
353        checkForStopfile();
354
355        # Add a basic auto-updating mechanism.
356        if (NewClientVersion()) 
357        {
358            UpdateClient();
359            reExec($upload_pid);
360        }
361
362        reExecIfRequired($upload_pid); ## check for new version of tilesGen.pl and reExec if true
363
364        ### start processing here:
365        $progressJobs++;
366        # Render stuff if we get a job from server
367        ProcessRequestsFromServer();
368        # upload results
369        uploadTilesets();
370    }
371}
372#---------------------------------
373elsif ($Mode eq "upload") 
374{   # Upload mode
375    upload();
376}
377#---------------------------------
378elsif ($Mode eq "upload_loop")
379{
380    # Ignoring UploadToDirectory in upload_loop mode
381    if ($Config->get("UploadToDirectory") != 0) {
382        print STDERR "! WARNING: UploadToDirectory is set. Ignoring this in upload_loop mode.\n";
383        $Config->set("UploadToDirectory", 0);
384    }
385
386    while(1) 
387    {
388        my $startTime = time();
389        my $elapsedTime;
390
391        # before we start (another) round of uploads we first check
392        # if something bad happened in the past.
393        checkFaults();
394
395        # look for stopfile and exit if found
396        if (-e "stopfile.txt")
397        {
398            statusMessage("Stopfile found, exiting",1,0);
399            exit;
400        }
401
402        # Add a basic auto-updating mechanism.
403        if (NewClientVersion()) 
404        {
405            UpdateClient();
406            reExec(-1);
407        }
408
409        # check for new version of tilesGen.pl and reExec if true
410        reExecIfRequired(-1);
411
412        # uploading ZIP files here, returns 0 if nothing to do and -1 on error
413        my $files_uploaded = upload();
414           
415        if ($files_uploaded == 0) {
416            # no error, but no files uploaded
417            talkInSleep("waiting for new tileset files to upload",30);
418        }
419        else {
420            $elapsedTime = time() - $startTime;
421            statusMessage(sprintf("upload finished in  %d:%02d", 
422                                  $elapsedTime/60, $elapsedTime%60),1,0);
423            $progressJobs++;
424# if uploaded anything at all this is a reason to reset the faults.
425# should the error persist it will die early enough on the next batch upload attempt.
426            resetFault("upload");
427        }
428    } #end of infinite while loop
429}
430#---------------------------------
431elsif ($Mode eq "version") 
432{
433    exit(1);
434}
435#---------------------------------
436elsif ($Mode eq "stop")
437{
438    if (open F, '>', "stopfile.txt") 
439    {
440        close F;
441        statusMessage("stop signal was sent to the currently running tilesGen.pl",1,0);
442        statusMessage("please note that it may take quite a while for it to exit",1,0);
443        exit(0);
444    }
445    else
446    {
447        statusMessage("stop signal was NOT sent to the currently running tilesGen.pl - stopfile.txt could NOT be created",1,0);
448    }
449    exit(1);
450}
451#---------------------------------
452elsif ($Mode eq "update") 
453{
454    UpdateClient();
455}
456#---------------------------------
457elsif ($Mode eq "once") 
458{
459    # ----------------------------------
460    # Normal mode renders a single request from server and exits
461    # ----------------------------------
462
463    exit (1) if ClientModified(); # don't interact with server if client was modified!
464
465    my ($did_something, $message) = ProcessRequestsFromServer();
466   
467    if (! $did_something)
468    {
469        statusMessage("you may safely press Ctrl-C now if you want to exit tilesGen.pl",1,0);
470        talkInSleep($message, 60);
471    }
472    statusMessage("if you want to run this program continuously, use loop mode",1,0);
473    statusMessage("please run \"tilesGen.pl upload\" now",1,0);
474}
475#---------------------------------
476elsif ($Mode eq "startBatik")
477{
478    my $result = $SVG::Rasterize::object->engine()->start_agent();
479    if( $result ){
480        statusMessage("Started Batik agent", 0, 0);
481    } else {
482        statusMessage("Batik agent already running");
483    }
484}
485#---------------------------------
486elsif ($Mode eq "stopBatik")
487{
488    my $result = $SVG::Rasterize::object->engine()->stop_agent();
489    if( $result == 1 ){
490        statusMessage("Successfully sent stop message to Batik agent", 0, 0);
491    } elsif( $result == 0 ){
492        statusMessage("Could not contact Batik agent", 0, 0);
493    } else {
494        statusMessage($result, 0, 0);
495    }
496}
497elsif ($Mode eq "localFile")
498{
499    print STDERR "*** Local file rendering mode enabled, please do NOT use upload function ***\n";
500
501    my $DataFile = shift();
502
503    my (undef,$Zoom,$X,$Y,undef) = split (/[_.]/,$DataFile);
504
505    my $req = new Request;
506    $req->ZXY($Zoom, $X, $Y);
507
508    $currentSubTask = "info";
509    statusMessage("Trying file ".$DataFile,1,0);
510   
511    my $Layers = shift();
512    if (not defined $Layers) {
513        if ($Zoom >= 12) {
514            $Layers = $Config->get("Layers");
515        }
516        elsif ($Zoom >= 6) {
517            $Layers = $Config->get("LowzoomLayers");
518        }
519        else {
520            $Layers = $Config->get("WorldLayers");
521        }
522    }
523    $req->layers_str($Layers);
524   
525    my $tileset = Tileset->new($req);
526    my $tilestart = time();
527    $tileset->generate(0,$DataFile); # "0" means no download.
528
529}
530#---------------------------------
531else 
532{
533    # ----------------------------------
534    # "help" (or any other non understood parameter) as first argument tells how to use the program
535    # ----------------------------------
536    my $Bar = "-" x 78;
537    print "\n$Bar\nOpenStreetMap tiles\@home client\n$Bar\n";
538    print "Usage: \n";
539    print "Run continuously (preferred mode): $0 loop\n";
540    print "Specific area:\n  \"$0 xy <x> <y> [z [layers]]\"\n  (x and y coordinates of a\n";
541    print "zoom-12 (default) tile in the slippy-map coordinate system)\n";
542    print "See [[Slippy Map Tilenames]] on wiki.openstreetmap.org for details\n";
543    print "z is optional and can be used for low-zoom tilesets\n";
544    print "layers is a comma separated list (no spaces) of layers and overrides the config.\n";
545    print "Other modes:\n";
546    print "  $0 once - like loop, just quit after one job.\n";
547    print "  $0 upload - uploads any tiles\n";
548    print "  $0 upload_loop - uploads tiles in loop mode\n";
549    print "  $0 localFile data_<z>_<x>_<y>.osm [layers] - runs offline, rendering from given osm file\n";
550    print "  $0 startBatik - start batik agent\n";
551    print "  $0 stopBatik - stop batik agent\n";
552    print "  $0 version - prints out version string and exits\n";
553    print "\nGNU General Public license, version 2 or later\n$Bar\n";
554}
555
556
557#-----------------------------------------------------------------------------
558# forks to a new process when it makes sense,
559# uploads available tile data.
560# returns >=0 on success, -1 otherwise and dies if it could not fork
561#-----------------------------------------------------------------------------
562sub uploadTilesets
563{
564    my $Config = TahConf->getConfig();
565    if ($Config->get("ForkForUpload") and ($Mode eq "loop")) # makes no sense to fork upload if not looping.
566    {
567        # Upload is handled by another process, so that we can generate another tile at the same time.
568        # We still don't want to have two uploading process running at the same time, so we wait for the previous one to finish.
569        if ($upload_pid != -1)
570        {
571            statusMessage("Waiting for previous upload process to finish (this can take a while)",1,3);
572            waitpid($upload_pid, 0);
573            #FIXME: $upload_result is apparently never returned?! skip?
574            #$upload_result = $? >> 8;
575        }
576
577        $upload_pid = fork();
578        if ((not defined $upload_pid) or ($upload_pid == -1))
579        {   # exit if asked to fork but unable to
580            cleanUpAndDie("loop: could not fork, exiting","EXIT",4);
581        }
582        elsif ($upload_pid == 0)
583        {   # we are the child, so we run the upload and exit the thread
584            try {
585                upload();
586            }
587            otherwise {
588                exit 0;
589            };
590            exit 1;
591        }
592    }
593    else
594    {   ## no forking going on
595        try {
596            my $result = upload();
597
598            if ($result == -1)
599            {     # we got an error in the upload process
600                addFault("upload",1);
601            }
602            else
603            {     #reset fault counter if we uploaded successfully
604                resetFault("upload");
605            }
606        }
607        catch UploadError with {
608            my $err = shift();
609            if (!$err->value() eq "QueueFull") {
610                cleanUpAndDie("Error uploading tiles: " . $err->text(), "EXIT", 1);
611            }
612        };
613    }
614    # no error, just nothing to upload
615}
616
617#-----------------------------------------------------------------------------
618# upload() uploads all previously
619# zipped up tilesets. It returns the number of uploaded files or -1 on error
620#-----------------------------------------------------------------------------
621sub upload
622{
623    #upload all existing zip files
624    keepLog($PID,"upload","start","$progressJobs");
625
626    my $upload = new Upload;
627    my $files_uploaded = 0;
628    try {
629        $files_uploaded = $upload->uploadAllZips();
630        resetFault("upload");
631    }
632    catch UploadError with {
633        my $error = shift();
634        if ($error->value() eq "ServerError") {
635            statusMessage("Server error: " . $error->text(), 1, 0);
636            addFault("upload");
637            talkInSleep("Waiting before attempting new upload", 300) if ($LoopMode);
638        }
639        elsif ($error->value() eq "0") {
640            statusMessage("Upload error: " . $error->text(), 1, 0);
641            addFault("upload");
642            talkInSleep("Waiting before attempting new upload", 300) if ($LoopMode);
643        }
644        else {
645            $error->throw();
646        }
647    };
648
649    keepLog($PID, "upload", "stop", 0);
650    return $files_uploaded;
651}
652
653#-----------------------------------------------------------------------------
654# Ask the server what tileset needs rendering next
655#-----------------------------------------------------------------------------
656sub ProcessRequestsFromServer 
657{
658    my $Config = TahConf->getConfig();
659    if ($Config->get("LocalSlippymap"))
660    {
661        print STDERR "Config option LocalSlippymap is set. Downloading requests\n";
662        print STDERR "from the server in this mode would take them from the tiles\@home\n";
663        print STDERR "queue and never upload the results. Program aborted.\n";
664        cleanUpAndDie("ProcessRequestFromServer:LocalSlippymap set, exiting","EXIT",1);
665    }
666
667    my $req;
668    my $Server = Server->new();
669    do {
670        statusMessage("Retrieving next job", 0, 3);
671        try {
672            $req = $Server->fetchRequest();
673
674            # got request, now check that it's not too complex
675            if ($Config->get('MaxTilesetComplexity')) {
676                #the setting is enabled
677                if ($req->complexity() > $Config->get('MaxTilesetComplexity')) 
678                {
679                    # too complex!
680                    statusMessage("Ignoring too complex tile (" . $req->ZXY_str() . ", "
681                    . int($req->complexity()) . " > " . int($Config->get('MaxTilesetComplexity')). ")", 1, 3);
682                    eval {
683                        $Server->putRequestBack($req, "TooComplex");
684                    }; # ignoring exceptions
685                    $req = undef;  # set to undef, need another loop
686                    talkInSleep("Waiting before new tile is requested", 15); # to avoid re-requesting the same tile
687                }
688                elsif (not $req->complexity())
689                {
690                    # unknown complexity!
691                    if ($Config->get('MaxTilesetComplexity') < $Config->get('AT_average')) 
692                    {
693                        # we have a weak client so we do not trust unknown complexity
694                        statusMessage("Ignoring unknown complexity tile (" . $req->ZXY_str() . ", "
695                           . int($req->complexity()) . " > " . int($Config->get('MaxTilesetComplexity')). ")", 1, 3);
696                        eval {
697                            $Server->putRequestBack($req, "NoComplexity");
698                        }; # ignoring exceptions
699                        $req = undef;  # set to undef, need another loop
700                        talkInSleep("Waiting before new tile is requested", 15); # to avoid re-requesting the same tile
701                    }
702                }
703            }
704            # and now check whether we found it unrenderable before
705            if (defined $req and $req->is_unrenderable()) {
706                statusMessage("Ignoring unrenderable tile (" . $req->ZXY_str . ')', 1, 3);
707                eval {
708                    $Server->putRequestBack($req, "Unrenderable");
709                }; # ignoring exceptions
710                $req = undef;   # we need to loop yet again
711                talkInSleep("Waiting before new tile is requested", 15); # to avoid re-requesting the same tile
712            }
713            # check whether there are any layers requested
714            if (defined $req and scalar($req->layers()) == 0) {
715                my $layers;
716                if ($req->Z() >= 12) {
717                    $layers = $Config->get("Layers");
718                }
719                else {
720                    $layers = $Config->get("LowzoomLayers");
721                }
722                statusMessage("Tile request with no layers, assuming default layers ($layers)", 1, 3);
723                $req->layers_str($layers);
724            }
725            # check whether we can actually render the requested zoom level for all requested layers
726            if (defined $req) {
727                my $zoom = $req->Z();
728                foreach my $layer ($req->layers()) {
729                    if (($zoom < $Config->get("${layer}_MinZoom")) or ($zoom > $Config->get("${layer}_MaxZoom"))) {
730                        statusMessage("Zoom level $zoom is out of the configured range for Layer $layer. Ignoring tile.", 1, 3);
731                        eval {
732                            $Server->putRequestBack($req, "ZoomOutOfRange ($layer z$zoom)");
733                        };
734                        $req = undef;
735                        last; # don't check any more layers
736                    }
737                }
738            }
739        }
740        catch ServerError with {
741            my $err = shift();
742            if ($err->value() eq "PermError") {
743                cleanUpAndDie("Server: ".$err->text(), "EXIT", 1);
744            }
745            else {
746                talkInSleep("Server: ".$err->text(), 60);
747                checkForStopfile();    # ticket #2972: existence of stopfile.txt should be analyzed during an idle loop
748            }
749        };
750    } until ($req);
751
752    # Information text to say what's happening
753    statusMessage("Got work from the server: " . $req->layers_str() . ' (' . $req->ZXY_str() . ')', 0, 6);
754
755    try {
756        my $tileset = Tileset->new($req);
757        my $tilestart = time();
758        $tileset->generate();
759        autotuneComplexity($tilestart, time(), $req->complexity);
760
761        # successfully received data, reset data faults
762        resetFault("nodata");
763        resetFault("nodataROMA");
764        resetFault("nodataXAPI");
765
766        # successfully rendered, so reset renderer faults
767        resetFault("renderer");
768        resetFault("rasterizer");
769        resetFault("utf8");
770
771        # Rendered tileset, don't idle in next round
772        setIdle(0,0);
773    }
774    catch RequestError with {
775        my $err = shift();
776        cleanUpAndDie($err->text(), "EXIT", 1);
777    }
778    catch TilesetError with {
779        my $err = shift();
780        eval {
781            $Server->putRequestBack($req, $err->text()) unless $Mode eq 'xy';
782        }; # ignoring exceptions
783        statusMessage("\n ".$err->value." \n",1,10); #print only for debug (verbosity 10)
784        if ($err->value() eq "fatal") {
785            # $err->value() is "fatal" for fatal errors
786            cleanUpAndDie($err->text(), "EXIT", 1);
787        }
788        else {
789            # $err->value() contains the error category for non-fatal errors
790            addFault($err->value(), 1);
791            statusMessage($err->text(), 1, 0);
792        }
793        talkInSleep("Waiting before new tile is requested", 15); # to avoid re-requesting the same tile
794    };
795}
796#-----------------------------------------------------------------------------
797# autotunes the complexity variable to avoid too complex tiles
798#-----------------------------------------------------------------------------
799sub autotuneComplexity #
800{
801    my $start = shift();
802    my $stop = shift();
803    my $tilecomplexity = shift();
804    my $deltaT = $stop - $start;
805
806#    my $Config = TahConf->getConfig();
807    my $timeaim = $Config->get("AT_timeaim");
808    my $minimum = $Config->get("AT_minimum");
809    my $alpha = $Config->get("AT_alpha");
810
811    if($Mode eq "xy") {
812        statusMessage ("Tile took us ".$deltaT." seconds to render",1,3);
813    } else {
814        statusMessage ("Tile of complexity ".$tilecomplexity." took us ".$deltaT." seconds to render",1,3);
815    }
816
817    if(! $complexity) { # this is the first call of this function
818        if($Config->get('MaxTilesetComplexity')) {
819            $complexity = $Config->get('MaxTilesetComplexity');
820        } elsif (($tilecomplexity > 5472) && ($deltaT > 0)) {
821            $complexity = $tilecomplexity * $timeaim / $deltaT;
822        } else {
823            $complexity = 10 * $tilecomplexity;
824        }
825    }
826
827    # empty tiles might have size 0 or 5472. if that changes, change this magic number too.
828    if (($tilecomplexity > 5472) && ($deltaT > 0)) {
829        $complexity = $alpha * ($tilecomplexity * $timeaim / $deltaT) + (1-$alpha) * $complexity;
830    }
831    $complexity = $minimum if $complexity < $minimum;
832
833    statusMessage("Suggested complexity is currently: ".int($complexity)." ",1,6);
834
835    if($Config->get('MaxTilesetComplexity')) {
836        # if MaxTilesetComplexity is not set we still do our calculations
837        # but we don't limit the client. The hint on client exit has to be enough.
838        $Config->set('MaxTilesetComplexity', $complexity);
839    }
840}
841#-----------------------------------------------------------------------------
842# Gets latest copy of client from svn repository
843# returns 1 on perceived success.
844#-----------------------------------------------------------------------------
845sub UpdateClient
846{
847    my $Config = TahConf->getConfig();
848    my $Cmd = sprintf("\"%s\" %s",
849        $Config->get("Subversion"),
850        $Config->get("SubversionUpdateCmd"));
851
852    statusMessage("Updating the Client",1,0);
853    if (not $Config->get('AllowAutoUpdate'))
854    {
855        return cleanUpAndDie("Auto-Update disallowed, but required. Exiting.","EXIT",1);
856    }
857    runCommand($Cmd,$PID); # FIXME: evaluate output and handle locally changed files that need updating!
858
859    if (ClientModified())
860    {
861        return cleanUpAndDie("Auto-update failed","EXIT",1);
862    }
863    else
864    {
865        my $versionfile = "version.txt";
866        DownloadFile($Config->get("VersionCheckURL"), $versionfile ,0);
867        return 1;
868    }
869}
870
871#-----------------------------------------------------------------------------
872# Checks svn status for local code modifications
873# returns 1 if such modifications exist
874#-----------------------------------------------------------------------------
875sub ClientModified
876{
877    my $Cmd = sprintf("\"%s\" %s",
878        $Config->get("Subversion"),
879        "status -q --ignore-externals");
880
881    my $svn_status = `$Cmd`;
882
883    chomp $svn_status;
884
885    my @svn_externals = ("osmarender","png2tileinfo","maplint"); # FIXME: use svn command to automatically gather externals
886
887    foreach my $svn_external (@svn_externals)
888    {
889        $Cmd = sprintf("\"%s\" %s %s",
890        $Config->get("Subversion"),
891        "status -q --ignore-externals",
892        $svn_external);
893
894        $svn_status .= `$Cmd`;
895
896        chomp $svn_status;
897    }
898
899
900    #$svn_status =~ s/^M.*\n?//mg;  # FFS use a future date in version.txt instead of this line.
901    if ($svn_status ne '')
902    {
903        statusMessage("svn status did not come back clean, check your installation",1,0);
904        print STDERR $svn_status;
905    }
906    return ($svn_status ne '');
907}
908
909sub NewClientVersion 
910{
911    my $Config = TahConf->getConfig();
912    return 0 if (time() - $LastTimeVersionChecked < 600);
913    my $versionfile = "version.txt";
914    my $runningVersion;
915    if (open(VERFILE, "<", $versionfile))
916    {
917        $runningVersion = <VERFILE>;
918        chomp $runningVersion;
919        close VERFILE;
920    }
921    elsif (open(VERFILE, ">", $versionfile))
922    {
923        $runningVersion = 0; 
924        print VERFILE $runningVersion;
925        close VERFILE;
926    }
927    else
928    {
929        die("can't open $versionfile");
930    }
931    # return 0;
932
933    my $curVerFile = "newversion.txt";
934    my $currentVersion;
935   
936    DownloadFile($Config->get("VersionCheckURL"), $curVerFile ,0);
937    if (open(VERFILE, "<", $curVerFile))
938    {
939        $currentVersion = <VERFILE>;
940        chomp $runningVersion;
941        close VERFILE;
942        # rename($curVerFile,$versionfile); # if enabled, this assumes the client is immediately, and successfully updated afterwards!
943    }
944    if ($currentVersion)
945    {
946        $LastTimeVersionChecked = time();
947        if ($runningVersion > $currentVersion)
948        {
949            statusMessage("\n! WARNING: you cannot have a more current client than the server: $runningVersion > $currentVersion",1,0);
950            return 0;
951        }
952        elsif ($runningVersion == $currentVersion)
953        {
954            return 0; # no new version
955        }
956        else
957        {
958            return 1; # version on server is newer
959        }
960    }
961    else
962    {
963        statusMessage("! WARNING: Could not get version info from server!",1,0);
964        return 0;
965    }
966}
967
968
969#-----------------------------------------------------------------------------
970# Transform an OSM file (using osmarender) into SVG
971# returns 1 on success, 0 on failure
972#-----------------------------------------------------------------------------
973sub xml2svg 
974{
975    my $Config = TahConf->getConfig();
976    my($osmData, $bbox, $MapFeatures, $SVG, $zoom) = @_;
977    my $TSVG = "$SVG";
978    my $NoBezier = $Config->get("NoBezier") || $zoom <= 11;
979
980    if (!$NoBezier) 
981    {
982        $TSVG = "$SVG-temp.svg";
983    }
984
985    my $success = 0;
986    if ($Config->get("Osmarender") eq "XSLT")
987    {
988        my $XslFile;
989
990        $XslFile = "osmarender/xslt/osmarender.xsl";
991
992        my $Cmd = sprintf(
993          "\"%s\" tr --maxdepth %s %s -s osmfile=%s -s minlat=%s -s minlon=%s -s maxlat=%s -s maxlon=%s %s > \"%s\"",
994          $Config->get("XmlStarlet"),
995          $Config->get("XmlStarletMaxDepth"),
996          $XslFile,
997          $osmData,
998          $bbox->S, $bbox->W, $bbox->N, $bbox->E,
999          "$MapFeatures",
1000          $TSVG);
1001
1002        statusMessage("Transforming zoom level $zoom with XSLT",0,3);
1003        $success = runCommand($Cmd,$PID);
1004    }
1005    elsif($Config->get("Osmarender") eq "orp")
1006    {
1007        my $Cmd = sprintf("perl osmarender/orp/orp.pl -r %s -o %s -b %s,%s,%s,%s %s",
1008          $MapFeatures,
1009          $TSVG,
1010          $bbox->S, $bbox->W, $bbox->N, $bbox->E,
1011          $osmData);
1012
1013        statusMessage("Transforming zoom level $zoom with or/p",0,3);
1014        $success = runCommand($Cmd,$PID);
1015    }
1016    else
1017    {
1018        die "invalid Osmarender setting in config";
1019    }
1020    if (!$success) {
1021        statusMessage(sprintf("%s produced an error, aborting render.", $Config->get("Osmarender")),1,0);
1022        return cleanUpAndDie("xml2svg failed",$Mode,3);
1023    }
1024
1025    # look at temporary svg wether it really is a svg or just the
1026    # xmlstarlet dump and exit if the latter.
1027    open(SVGTEST, "<", $TSVG) || return;
1028    my $TestLine = <SVGTEST>;
1029    chomp $TestLine;
1030    close SVGTEST;
1031
1032    if (grep(!/</, $TestLine))
1033    {
1034       statusMessage("File $TSVG doesn't look like svg, aborting render.",1,0);
1035       return cleanUpAndDie("xml2svg failed",$Mode,3);
1036    }
1037#-----------------------------------------------------------------------------
1038# Process lines to Bezier curve hinting
1039#-----------------------------------------------------------------------------
1040    if (!$NoBezier) 
1041    {   # do bezier curve hinting
1042        my $Cmd = sprintf("perl ./lines2curves.pl %s > %s",
1043          $TSVG,
1044          $SVG);
1045        statusMessage("Beziercurvehinting zoom level $zoom",0,3);
1046        runCommand($Cmd,$PID);
1047#-----------------------------------------------------------------------------
1048# Sanitycheck for Bezier curve hinting, no output = bezier curve hinting failed
1049#-----------------------------------------------------------------------------
1050        my $filesize= -s $SVG;
1051        if (!$filesize) 
1052        {
1053            copy($TSVG,$SVG);
1054            statusMessage("Error on Bezier Curve hinting, rendering without bezier curves",1,0);
1055        }
1056    }
1057    else
1058    {   # don't do bezier curve hinting
1059        statusMessage("Bezier Curve hinting disabled.",0,3);
1060    }
1061    return 1;
1062}
1063
1064#-----------------------------------------------------------------------------
1065# A function to re-execute the program. 
1066#
1067# This function attempts to detect whether the perl script has changed
1068# since it was invoked initially, and if so, just runs the new version.
1069# This can be used to update the program while it is running (as it is
1070# sometimes hard to hit Ctrl-C at exactly the right moment!)
1071#-----------------------------------------------------------------------------
1072sub reExecIfRequired
1073{
1074    my $child_pid = shift();## FIXME: make more general
1075
1076    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
1077        $ctime,$blksize,$blocks) = stat($0);
1078    my $de = "$size/$mtime/$ctime";
1079    if (!defined($filestat))
1080    {
1081        $filestat = $de; 
1082        return;
1083    }
1084    elsif ($filestat ne $de)
1085    {
1086        reExec($child_pid);
1087    }
1088}
1089
1090#-----------------------------------------------------------------------------
1091# A function to re-execute the program. 
1092#
1093# This function restarts the program unconditionally.
1094#-----------------------------------------------------------------------------
1095sub reExec
1096{
1097    my $child_pid = shift();## FIXME: make more general
1098    my $Config = TahConf->getConfig();
1099    # until proven to work with other systems, only attempt a re-exec
1100    # on linux.
1101    return unless ($^O eq "linux" || $^O eq "cygwin" ||  $^O eq "darwin");
1102
1103    statusMessage("tilesGen.pl has changed, re-start new version",1,0);
1104    if ($Config->get("ForkForUpload") && $child_pid != -1)  ## FIXME: make more general
1105    {
1106        statusMessage("Waiting for child process (this can take a while)",1,0);
1107        waitpid($child_pid, 0);
1108    }
1109    exec "perl", $0, $Mode, "reexec", 
1110        "progressJobs=" . $progressJobs, 
1111        "idleSeconds=" . getIdle(1), 
1112        "idleFor=" . getIdle(0) or die("could not reExec");
1113}
1114
1115#------------------------------------------------------------
1116# check for faults and die when too many have occured
1117#------------------------------------------------------------
1118sub checkFaults
1119{
1120    if (getFault("fatal") > 0) {
1121        cleanUpAndDie("Fatal error occurred during loop, exiting","EXIT",1);
1122    }
1123    elsif (getFault("rasterizer") > 5) {
1124        cleanUpAndDie("Five times rasterizer failed, exiting","EXIT",1);
1125    }
1126    elsif (getFault("renderer") > 10) {
1127        cleanUpAndDie("rendering a tileset failed 10 times in a row, exiting","EXIT",1);
1128    }
1129    elsif (getFault("upload") > 50) {
1130        cleanUpAndDie("Five times the upload failed, perhaps the server doesn't like us, exiting","EXIT",1);
1131    }
1132}
1133
1134
1135#--------------------------------------------------------------------------------------
1136# check for faults with data downloads and add delays or die when too many have occured
1137#--------------------------------------------------------------------------------------
1138sub checkDataFaults
1139{
1140    my $sleepdelay = 1;
1141    if (getFault("nodata") > 0) { # check every network condition regardless of the other network outcomes
1142        my $numfaults=getFault("nodata");
1143        if ($numfaults > 25) {
1144            cleanUpAndDie("More than 25 times no data, perhaps the server doesn't like us, exiting","EXIT",1);
1145        }
1146        else {
1147            $sleepdelay=5*(2**$numfaults); # wait 10, 20, 40, 80, ... seconds. for a total of about 6 hours
1148            $sleepdelay=600 if ($sleepdelay > 600);
1149            talkInSleep($numfaults." times no data", $sleepdelay);
1150        }
1151    }
1152    if (getFault("nodataXAPI") > 0) {
1153        my $numfaults=getFault("nodataXAPI");
1154        if ($numfaults >= 20) {
1155            cleanUpAndDie("20 times no data from XAPI, perhaps the server doesn't like us, exiting","EXIT",1); # allow XAPI more leeway
1156        }
1157        else {
1158            $sleepdelay=5*(2**$numfaults); # wait 10, 20, 40, 80 seconds
1159            $sleepdelay=600 if ($sleepdelay > 600);
1160            talkInSleep($numfaults." times no XAPI data", $sleepdelay);
1161        }
1162    }
1163}
1164
1165
1166#--------------------------------------------------------------------------------------
1167# check for stopfile and exit if found
1168#--------------------------------------------------------------------------------------
1169sub checkForStopfile
1170{
1171    # look for stopfile and exit if found
1172    if (-e "stopfile.txt")
1173    {
1174        if ($Config->get("ForkForUpload") && $upload_pid != -1)
1175        {
1176            statusMessage("Waiting for previous upload process (this can take a while)",1,0);
1177            waitpid($upload_pid, 0);
1178        }
1179        print STDERR "We suggest that you set MaxTilesetComplexity to ".int($complexity)."\n";
1180        cleanUpAndDie("Stopfile found, exiting","EXIT",7); ## TODO: agree on an exit code scheme for different types of errors
1181    }
1182}
1183
1184
1185#sub fileUTF8ErrCheck moved to lib/tahlib.pm
Note: See TracBrowser for help on using the repository browser.