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

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

remove hotfix

  • Property svn:executable set to *
  • Property svn:keywords set to Revision
File size: 36.1 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: 11432 $';
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 = $upload->uploadAllZips();
553
554    keepLog($PID,"upload","stop",0);
555
556    return $files_uploaded;
557}
558
559#-----------------------------------------------------------------------------
560# Ask the server what tileset needs rendering next
561#-----------------------------------------------------------------------------
562sub ProcessRequestsFromServer 
563{
564    my $Config = TahConf->getConfig();
565    if ($Config->get("LocalSlippymap"))
566    {
567        print "Config option LocalSlippymap is set. Downloading requests\n";
568        print "from the server in this mode would take them from the tiles\@home\n";
569        print "queue and never upload the results. Program aborted.\n";
570        cleanUpAndDie("ProcessRequestFromServer:LocalSlippymap set, exiting","EXIT",1);
571    }
572
573    if ($Config->get("CreateTilesetFile"))
574    {
575        print "Config option CreateTilesetFile is set. We can not upload Tileset\n";
576        print "files, yet. Downloading requests\n";
577        print "from the server in this mode would take them from the tiles\@home\n";
578        print "queue and never upload the results. Please use xy mode. Program aborted.\n";
579        cleanUpAndDie("ProcessRequestFromServer:CreateTilesetFile set, exiting","EXIT",1);
580    }
581
582    my $req;
583    my $Server = Server->new();
584    do {
585        statusMessage("Retrieving next job", 0, 3);
586        try {
587            $req = $Server->fetchRequest();
588
589            # got request, now check that it's not too complex
590            if ($Config->get('MaxTilesetComplexity')) {
591                #the setting is enabled
592                if ($req->complexity() > $Config->get('MaxTilesetComplexity')) {
593                    # too complex!
594                    statusMessage("Ignoring too complex tile (" . $req->ZXY_str() . ", "
595                    . int($req->complexity()) . " > " . int($Config->get('MaxTilesetComplexity')). ")", 1, 3);
596                    eval {
597                        $Server->putRequestBack($req, "TooComplex");
598                    }; # ignoring exceptions
599                    $req = undef;  # set to undef, need another loop
600                    talkInSleep("Waiting before new tile is requested", 15); # to avoid re-requesting the same tile
601                }
602            }
603            # and now check whether we found it unrenderable before
604            if (defined $req and $req->is_unrenderable()) {
605                statusMessage("Ignoring unrenderable tile (" . $req->ZXY_str . ')', 1, 3);
606                eval {
607                    $Server->putRequestBack($req, "Unrenderable");
608                }; # ignoring exceptions
609                $req = undef;   # we need to loop yet again
610                talkInSleep("Waiting before new tile is requested", 15); # to avoid re-requesting the same tile
611            }
612            # check whether there are any layers requested
613            if (defined $req and scalar($req->layers()) == 0) {
614                statusMessage("Ignoring tile request with no layers", 1, 3);
615                eval {
616                    $Server->putRequestBack($req, "NoLayersRequested");
617                }; # ignoring exceptions
618                $req = undef;
619                talkInSleep("Waiting before new tile is requested", 15);
620            }
621            # check whether we can actually render the requested zoom level for all requested layers
622            if (defined $req) {
623                my $zoom = $req->Z();
624                foreach my $layer ($req->layers()) {
625                    if (($zoom < $Config->get("${layer}_MinZoom")) or ($zoom > $Config->get("${layer}_MaxZoom"))) {
626                        statusMessage("Zoom level $zoom is out of the configured range for Layer $layer. Ignoring tile.", 1, 3);
627                        eval {
628                            $Server->putRequestBack($req, "ZoomOutOfRange ($layer z$zoom)");
629                        };
630                        $req = undef;
631                        last; # don't check any more layers
632                    }
633                }
634            }
635        }
636        catch ServerError with {
637            my $err = shift();
638            if ($err->value() eq "PermError") {
639                cleanUpAndDie($err->text(), "EXIT", 1);
640            }
641            else {
642                talkInSleep($err->text(), 60);
643            }
644        };
645    } until ($req);
646
647    # Information text to say what's happening
648    statusMessage("Got work from the server: " . $req->layers_str() . ' (' . $req->ZXY_str() . ')', 0, 6);
649
650    try {
651        my $tileset = Tileset->new($req);
652        my $tilestart = time();
653        $tileset->generate();
654        autotuneComplexity($tilestart, time(), $req->complexity);
655
656        # successfully received data, reset data faults
657        resetFault("nodata");
658        resetFault("nodataROMA");
659        resetFault("nodataXAPI");
660
661        # successfully rendered, so reset renderer faults
662        resetFault("renderer");
663        resetFault("inkscape");
664        resetFault("utf8");
665
666        # Rendered tileset, don't idle in next round
667        setIdle(0,0);
668    }
669    catch RequestError with {
670        my $err = shift();
671        cleanUpAndDie($err->text(), "EXIT", 1);
672    }
673    catch TilesetError with {
674        my $err = shift();
675        eval {
676            $Server->putRequestBack($req, $err->text()) unless $Mode eq 'xy';
677        }; # ignoring exceptions
678        if ($err->value() eq "fatal") {
679            # $err->value() is "fatal" for fatal errors
680            cleanUpAndDie($err->text(), "EXIT", 1);
681        }
682        else {
683            # $err->value() contains the error category for non-fatal errors
684            addFault($err->value(), 1);
685            statusMessage($err->text(), 1, 0);
686        }
687        talkInSleep("Waiting before new tile is requested", 15); # to avoid re-requesting the same tile
688    };
689}
690#-----------------------------------------------------------------------------
691# autotunes the complexity variable to avoid too complex tiles
692#-----------------------------------------------------------------------------
693sub autotuneComplexity #
694{
695    my $start = shift();
696    my $stop = shift();
697    my $tilecomplexity = shift();
698    my $deltaT = $stop - $start;
699
700    my $timeaim = $Config->get("AT_timeaim");
701    my $minimum = $Config->get("AT_minimum");
702    my $alpha = $Config->get("AT_alpha");
703
704    if(! $complexity) {
705        if($Config->get('MaxTilesetComplexity')) {
706            $complexity = $Config->get('MaxTilesetComplexity');
707        } else {
708            $complexity = $tilecomplexity;
709        }
710    }
711
712    statusMessage("Tile of complexity ".$tilecomplexity." took us ".$deltaT." seconds to render",1,3);
713    if (($tilecomplexity > 0) && ($deltaT > 0)) {
714        $complexity = $alpha * ($tilecomplexity * $timeaim / $deltaT) + (1-$alpha) * $complexity;
715    }
716    $complexity = $minimum if $complexity < $minimum;
717    statusMessage("Suggested complexity is currently: ".int($complexity)." ",1,6);
718    if($Config->get('MaxTilesetComplexity')) {
719        # if MaxTilesetComplexity is not set we still do our calculations
720        # but we don't limit the client. The hint on client exit has to be enough.
721        $Config->set('MaxTilesetComplexity', $complexity);
722    }
723}
724#-----------------------------------------------------------------------------
725# Gets latest copy of client from svn repository
726# returns 1 on perceived success.
727#-----------------------------------------------------------------------------
728sub UpdateClient #
729{
730    my $Config = TahConf->getConfig();
731    my $Cmd = sprintf("\"%s\" %s",
732        $Config->get("Subversion"),
733        $Config->get("SubversionUpdateCmd"));
734
735    statusMessage("Updating the Client",1,0);
736    runCommand($Cmd,$PID); # FIXME: evaluate output and handle locally changed files that need updating!
737    ## FIXME TODO: Implement and check output from svn status, too.
738
739    $Cmd = sprintf("\"%s\" %s",
740        $Config->get("Subversion"),
741        "status -q --ignore-externals");
742
743    my $svn_status = `$Cmd`;
744
745    chomp $svn_status;
746    # $svn_status =~ s/^M.*\n?//mg; # FFS use a future date in version.txt instead of this line.
747
748    if (1 || $svn_status eq '')
749    {
750        my $versionfile = "version.txt";
751        DownloadFile($Config->get("VersionCheckURL"), $versionfile ,0);
752        return 1;
753    }
754    else
755    {
756        statusMessage("svn status did not come back clean, check your installation",1,0);
757        print STDERR $svn_status;
758        return cleanUpAndDie("Auto-update failed","EXIT",1);
759    }
760}
761
762sub NewClientVersion 
763{
764    my $Config = TahConf->getConfig();
765    return 0 if (time() - $LastTimeVersionChecked < 600);
766    my $versionfile = "version.txt";
767    my $runningVersion;
768    if (open(VERFILE, "<", $versionfile))
769    {
770        $runningVersion = <VERFILE>;
771        chomp $runningVersion;
772        close VERFILE;
773    }
774    elsif (open(VERFILE, ">", $versionfile))
775    {
776        $runningVersion = 0; 
777        print VERFILE $runningVersion;
778        close VERFILE;
779    }
780    else
781    {
782        die("can't open $versionfile");
783    }
784    # return 0;
785
786    my $curVerFile = "newversion.txt";
787    my $currentVersion;
788   
789    DownloadFile($Config->get("VersionCheckURL"), $curVerFile ,0);
790    if (open(VERFILE, "<", $curVerFile))
791    {
792        $currentVersion = <VERFILE>;
793        chomp $runningVersion;
794        close VERFILE;
795        # rename($curVerFile,$versionfile); # FIXME: This assumes the client is immediately, and successfully updated afterwards!
796    }
797    if ($currentVersion)
798    {
799        $LastTimeVersionChecked = time();
800        if ($runningVersion > $currentVersion)
801        {
802            statusMessage("\n! WARNNG: you cannot have a more current client than the server: $runningVersion > $currentVersion",1,0);
803            return 0;
804        }
805        elsif ($runningVersion == $currentVersion)
806        {
807            return 0; # no new version
808        }
809        else
810        {
811            return 1; # version on server is newer
812        }
813    }
814    else
815    {
816        statusMessage(" ! WARNING: Could not get version info from server!",1,0);
817        return 0;
818    }
819}
820
821
822#-----------------------------------------------------------------------------
823# Transform an OSM file (using osmarender) into SVG
824# returns 1 on success, 0 on failure
825#-----------------------------------------------------------------------------
826sub xml2svg 
827{
828    my $Config = TahConf->getConfig();
829    my($osmData, $bbox, $MapFeatures, $SVG, $zoom) = @_;
830    my $TSVG = "$SVG";
831    my $NoBezier = $Config->get("NoBezier") || $zoom <= 11;
832
833    if (!$NoBezier) 
834    {
835        $TSVG = "$SVG-temp.svg";
836    }
837
838    my $success = 0;
839    if ($Config->get("Osmarender") eq "XSLT")
840    {
841        my $XslFile;
842
843        $XslFile = "osmarender/xslt/osmarender.xsl";
844
845        my $Cmd = sprintf(
846          "\"%s\" tr --maxdepth %s %s -s osmfile=%s -s minlat=%s -s minlon=%s -s maxlat=%s -s maxlon=%s %s > \"%s\"",
847          $Config->get("XmlStarlet"),
848          $Config->get("XmlStarletMaxDepth"),
849          $XslFile,
850          $osmData,
851          $bbox->S, $bbox->W, $bbox->N, $bbox->E,
852          "$MapFeatures",
853          $TSVG);
854
855        statusMessage("Transforming zoom level $zoom with XSLT",0,3);
856        $success = runCommand($Cmd,$PID);
857    }
858    elsif($Config->get("Osmarender") eq "orp")
859    {
860        my $Cmd = sprintf("perl osmarender/orp/orp.pl -r %s -o %s -b %s,%s,%s,%s %s",
861          $MapFeatures,
862          $TSVG,
863          $bbox->S, $bbox->W, $bbox->N, $bbox->E,
864          $osmData);
865
866        statusMessage("Transforming zoom level $zoom with or/p",0,3);
867        $success = runCommand($Cmd,$PID);
868    }
869    else
870    {
871        die "invalid Osmarender setting in config";
872    }
873    if (!$success) {
874        statusMessage(sprintf("%s produced an error, aborting render.", $Config->get("Osmarender")),1,0);
875        return cleanUpAndDie("xml2svg failed",$Mode,3);
876    }
877
878    # look at temporary svg wether it really is a svg or just the
879    # xmlstarlet dump and exit if the latter.
880    open(SVGTEST, "<", $TSVG) || return;
881    my $TestLine = <SVGTEST>;
882    chomp $TestLine;
883    close SVGTEST;
884
885    if (grep(!/</, $TestLine))
886    {
887       statusMessage("File $TSVG doesn't look like svg, aborting render.",1,0);
888       return cleanUpAndDie("xml2svg failed",$Mode,3);
889    }
890#-----------------------------------------------------------------------------
891# Process lines to Bezier curve hinting
892#-----------------------------------------------------------------------------
893    if (!$NoBezier) 
894    {   # do bezier curve hinting
895        my $Cmd = sprintf("perl ./lines2curves.pl %s > %s",
896          $TSVG,
897          $SVG);
898        statusMessage("Beziercurvehinting zoom level $zoom",0,3);
899        runCommand($Cmd,$PID);
900#-----------------------------------------------------------------------------
901# Sanitycheck for Bezier curve hinting, no output = bezier curve hinting failed
902#-----------------------------------------------------------------------------
903        my $filesize= -s $SVG;
904        if (!$filesize) 
905        {
906            copy($TSVG,$SVG);
907            statusMessage("Error on Bezier Curve hinting, rendering without bezier curves",1,0);
908        }
909    }
910    else
911    {   # don't do bezier curve hinting
912        statusMessage("Bezier Curve hinting disabled.",0,3);
913    }
914    return 1;
915}
916
917
918#-----------------------------------------------------------------------------
919# Get the width and height (in SVG units, must be pixels) of an SVG file
920#-----------------------------------------------------------------------------
921sub getSize($)
922{
923    my $SVG = shift();
924    open(my $fpSvg,"<",$SVG);
925    while(my $Line = <$fpSvg>)
926    {
927        if($Line =~ /height=\"(.*)px\" width=\"(.*)px\"/)
928        {
929            close $fpSvg;
930            return(($1,$2,1));
931        }
932    }
933    close $fpSvg;
934    return((0,0,0));
935}
936
937#-----------------------------------------------------------------------------
938# A function to re-execute the program. 
939#
940# This function attempts to detect whether the perl script has changed
941# since it was invoked initially, and if so, just runs the new version.
942# This can be used to update the program while it is running (as it is
943# sometimes hard to hit Ctrl-C at exactly the right moment!)
944#-----------------------------------------------------------------------------
945sub reExecIfRequired
946{
947    my $child_pid = shift();## FIXME: make more general
948
949    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
950        $ctime,$blksize,$blocks) = stat($0);
951    my $de = "$size/$mtime/$ctime";
952    if (!defined($filestat))
953    {
954        $filestat = $de; 
955        return;
956    }
957    elsif ($filestat ne $de)
958    {
959        reExec($child_pid);
960    }
961}
962
963#-----------------------------------------------------------------------------
964# A function to re-execute the program. 
965#
966# This function restarts the program unconditionally.
967#-----------------------------------------------------------------------------
968sub reExec
969{
970    my $child_pid = shift();## FIXME: make more general
971    my $Config = TahConf->getConfig();
972    # until proven to work with other systems, only attempt a re-exec
973    # on linux.
974    return unless ($^O eq "linux" || $^O eq "cygwin" ||  $^O eq "darwin");
975
976    statusMessage("tilesGen.pl has changed, re-start new version",1,0);
977    if ($Config->get("ForkForUpload") && $child_pid != -1)  ## FIXME: make more general
978    {
979        statusMessage("Waiting for child process (this can take a while)",1,0);
980        waitpid($child_pid, 0);
981    }
982    exec "perl", $0, $Mode, "reexec", 
983        "progressJobs=" . $progressJobs, 
984        "idleSeconds=" . getIdle(1), 
985        "idleFor=" . getIdle(0) or die("could not reExec");
986}
987
988#------------------------------------------------------------
989# check for faults and die when too many have occured
990#------------------------------------------------------------
991sub checkFaults
992{
993    if (getFault("fatal") > 0) {
994        cleanUpAndDie("Fatal error occurred during loop, exiting","EXIT",1);
995    }
996    elsif (getFault("rasterizer") > 5) {
997        cleanUpAndDie("Five times rasterizer failed, exiting","EXIT",1);
998    }
999    elsif (getFault("renderer") > 10) {
1000        cleanUpAndDie("rendering a tileset failed 10 times in a row, exiting","EXIT",1);
1001    }
1002    elsif (getFault("upload") > 50) {
1003        cleanUpAndDie("Five times the upload failed, perhaps the server doesn't like us, exiting","EXIT",1);
1004    }
1005}
1006
1007
1008#--------------------------------------------------------------------------------------
1009# check for faults with data downloads and add delays or die when too many have occured
1010#--------------------------------------------------------------------------------------
1011sub checkDataFaults
1012{
1013    my $sleepdelay = 1;
1014    if (getFault("nodata") > 0) { # check every network condition regardless of the other network outcomes
1015        my $numfaults=getFault("nodata");
1016        if ($numfaults > 25) {
1017            cleanUpAndDie("More than 25 times no data, perhaps the server doesn't like us, exiting","EXIT",1);
1018        }
1019        else {
1020            $sleepdelay=5*(2**$numfaults); # wait 10, 20, 40, 80, ... seconds. for a total of about 6 hours
1021            $sleepdelay=600 if ($sleepdelay > 600);
1022            talkInSleep($numfaults." times no data", $sleepdelay);
1023        }
1024    }
1025    if (getFault("nodataXAPI") > 0) {
1026        my $numfaults=getFault("nodataXAPI");
1027        if ($numfaults >= 20) {
1028            cleanUpAndDie("20 times no data from XAPI, perhaps the server doesn't like us, exiting","EXIT",1); # allow XAPI more leeway
1029        }
1030        else {
1031            $sleepdelay=5*(2**$numfaults); # wait 10, 20, 49, 80 seconds
1032            $sleepdelay=600 if ($sleepdelay > 600);
1033            talkInSleep($numfaults." times no XAPI data", $sleepdelay);
1034        }
1035    }
1036}
1037
1038#--------------------------------------------------------------------------------------
1039# check for utf-8 faults in file and return false if UTF-8 clean, otherwise return the
1040# number of the first line where an utf-8 error occured
1041#--------------------------------------------------------------------------------------
1042
1043sub fileUTF8ErrCheck
1044{
1045    my $DataFile = shift();
1046    open(OSMDATA, $DataFile) || die ("could not open $DataFile for UTF-8 check");
1047    my @toCheck = <OSMDATA>;
1048    close(OSMDATA);
1049    my $line=0;
1050    while (my $osmline = shift @toCheck)
1051    {
1052        $line++;
1053        eval { decode("utf8",$osmline, Encode::FB_CROAK) };
1054        if ($@)
1055        {
1056            return $line; # returns the line the error occured on
1057        }
1058    }
1059    return 0;
1060}
1061
Note: See TracBrowser for help on using the repository browser.