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

Last change on this file since 11526 was 11523, checked in by deelkar, 11 years ago

don't die if there is a server error on upload

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