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

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

merge auto-update changes from unstable

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