[ka-Map-users] Perl mapscript memory leak?

Stephen Woodbridge woodbri at swoodbridge.com
Wed Jun 28 12:58:06 EDT 2006


Steve Lime wrote:
> When an image goes out of scope Swig should call the destroy method for
> each imageObj. If you're feeling bold you could add a debug statement in that
> method in mapscript/swiginc/image.i to test for yourself.
> 
> How to MapScript and GD.pm interact in your script?
> 
> Steve

Steve here is the script:

#!/usr/bin/perl -w
#
###############################################################################
#
#  Copyright 2005 Where 2 Get It, Inc.
#  Author: Stephen Woodbridge
#          swoodbridge at where2getit.com
#          woodbri at swoodbridge.com
#
#  This file is called from the command line to pre-generate image tiles 
for an
#  application like kaMap! from DM Solutions.
#
#  $Id: $
#
###############################################################################
use strict;
use vars qw( $szMap $szBaseCacheDir %aszMapFiles $tileHeight $szMapName
              $metaWidth $tileWidth $anScales $bDebug $metaBuffer 
$metaHeight
              $szMapFile $szMapImageFormat $szImageExtension $szImageHeader
              $anInitLoc $szMapCacheDir $szFormat $szMapImageCreateFunction
              $szImageCreateFunction $szImageOutputFunction
            );

use CGI::Pretty qw(:standard);
use File::Path;
use POSIX;
use GD;

use mapscript;

use lib '.';
require('./tmap-config.pm');

###############################################################################

Usage() if !param('map') || !$aszMapFiles{param('map')};

my $dryrun = param('dryrun');
my $bForce = param('force');
my $DEBUG  = param('debug');

$| = 1; # keep stdout flushed even if writing to pipe


# for testing just do these scales instead of all
$anScales = [
#              50000000,
#              20000000,
#	      10000000,
#	       4000000,
#               1000000,
#	        500000,
		150000,
#		100000,
#		 50000,
#		 25000,
#		 15000,
#		  6000,
              ] if !$dryrun;

main();
exit;

sub Usage {
     die "Usage: precache.pl map=mapfile [dryrun=1] [force=1] 
[debug=1]\n  Where 'mapfile' is (" .
         join(', ', sort keys %aszMapFiles) . ")\n" .
         "  Using MS_VERSION: $mapscript::MS_VERSION \n";
}

sub LOCK_SH { 1 }
sub LOCK_EX { 2 }
sub LOCK_NB { 4 }
sub LOCK_UN { 8 }

sub min { return $_[0]<$_[1]?$_[0]:$_[1]; }
sub max { return $_[0]>$_[1]?$_[0]:$_[1]; }


###############################################################################
#  passed the following:
#
#  map: the name of the map to use.  This is handled by config.php.
#
#  t: top pixel position
#  l: left pixel position
#  s: scale
#  g: (optional) comma-delimited list of group names to draw
#  layers: (optional) comma-delimited list of layers to draw
#  force: optional.  If set, force redraw of the meta tile.  This was 
added to
#         help with invalid images sometimes being generated.
#  tileid: (optional) can be used instead of t+l to specify the tile coord.,
#          useful in regenerating the cache
#
###############################################################################

$mapscript::MS_VERSION =~ m/(\d+)\.(\d+)\.?(\d+)?/;
my $i = $1;
my $j = $2;
my $k = $3 || 0;
my $ms_ver = $i*10000+$j*100+$k;

die "Perl mapscript version ($mapscript::MS_VERSION) is not adequate, 
4.6.0 or better is required.\n"
     if ($ms_ver < 40600);

##  This function replaces all special characters in the given string.
#       e.g.    "http://my.host.com/cgi-bin/mywms?"
#       becomes "http___my_host_com_cgi_bin_mywms_"

sub normalizeString {
     my $szString = shift;
     $szString =~ s/\W/_/g;
     return $szString;
}

sub getAllGroupNames {
     my $oMap = shift;

     my %gn = ();
     my $nl = $oMap->{numlayers};
     for (my $i=0; $i<$nl; $i++) {
         my $l = $oMap->getLayer($i);
         $gn{$l->{group}} = 1;
     }
     return sort keys %gn;
}

sub getLayersIndexByGroup {
     my $oMap  = shift;
     my $gn    = shift;

     my @lay = ();
     my $nl = $oMap->{numlayers};
     for (my $i=0; $i<$nl; $i++) {
         my $l = $oMap->getLayer($i);
         push @lay, $i if $l->{group} eq $gn;
     }
     return wantarray?@lay:\@lay;
}


# The following parameters are set up as globals by tmap-config.pm
#  $szBaseCacheDir = $szBaseCacheDir.$szMap."/";
#  $szMapName      = $aszMapFiles{$szMap}->[0];
#  $szMapFile      = $aszMapFiles{$szMap}->[1];
#  $anScales       = $aszMapFiles{$szMap}->[2];
#  setOutputFormat($aszMapFiles{$szMap}->[3]);
#  $anInitLoc      = $aszMapFiles{$szMap}->[4];
#

sub main {

     if ($DEBUG) {
	print "szMap: $szMap\n";
	print "szBaseCacheDir: $szBaseCacheDir\n";
	print "aszMapFiles: " . join(', ', keys %aszMapFiles) . "\n";
	print "tileWidth: $tileWidth\n";
	print "tileHeight: $tileHeight\n";
	print "metaWidth: $metaWidth\n";
	print "metaHeight: $metaHeight\n";
	print "metaBuffer: $metaBuffer\n";
	print "szMapName: $szMapName\n";
	print "anScales: $anScales\n";
	print "bDebug: $bDebug\n";
	print "szMapFile: $szMapFile\n";
	print "szMapImageFormat: $szMapImageFormat\n";
	print "szImageExtension: $szImageExtension\n";
	print "szImageHeader: $szImageHeader\n";
	print "anInitLoc: $anInitLoc\n";
	print "szMapCacheDir: $szMapCacheDir\n";
	print "szFormat: $szFormat\n";
	print "szMapImageCreateFunction: $szMapImageCreateFunction\n";
	print "szImageCreateFunction: $szImageCreateFunction\n";
	print "szImageOutputFunction: $szImageOutputFunction\n";
     }

     my @inchesPerUnit = (1, 12, 63360.0, 39.3701, 39370.1, 4374754);

     my $oMap = new mapscript::mapObj($szMapFile);
     my $nLayers = $oMap->{numlayers};
     my $mapWidth = $metaWidth * $tileWidth;
     my $mapHeight = $metaHeight * $tileHeight;
     $oMap->setSize( $mapWidth, $mapHeight );

     # group all ungrouped layers in a group named __base__
     for (my $i=0; $i<$nLayers; $i++) {
         my $oLayer = $oMap->getLayer($i);
         if (!$oLayer->{group} || $oLayer->{group} eq '') {
             $oLayer->{group} = '__base__';
         }
     }
     my @Groups = getAllGroupNames($oMap);

     # modify map extents for max_extent metadata
     if ($oMap->getMetaData('max_extents') &&
         $oMap->getMetaData('max_extents') ne '') {
         my $MaxExtents = $oMap->getMetaData('max_extents');
         my @MaxExtents = split(/[\s,]+/, $MaxExtents);
         if (@MaxExtents == 4) {
             my $minx = min($MaxExtents[0], $MaxExtents[2]);
             my $miny = min($MaxExtents[1], $MaxExtents[3]);
             my $maxx = max($MaxExtents[0], $MaxExtents[2]);
             my $maxy = max($MaxExtents[1], $MaxExtents[3]);
             $oMap->setExtent($minx, $miny, $maxx, $maxy);
         }
     }

     my $dMinX = $oMap->{extent}->{minx};
     my $dMaxX = $oMap->{extent}->{maxx};
     my $dMinY = $oMap->{extent}->{miny};
     my $dMaxY = $oMap->{extent}->{maxy};

     my $nTotalTiles = 0;
     my $nTotalSecs  = 0;

     foreach my $scale (@{$anScales}) {
         my $t0 = time();

         $oMap->{extent}->{minx} = $dMinX;
         $oMap->{extent}->{maxx} = $dMaxX;
         $oMap->{extent}->{miny} = $dMinY;
         $oMap->{extent}->{maxy} = $dMaxY;

         my $cellSize = $scale / ( $oMap->{resolution} *
                                   $inchesPerUnit[$oMap->{units}] );

         print "\nProcessing scale=$scale, cellSize=$cellSize\n";
         print "  geo dimensions: $dMinX, $dMinY : $dMaxX, $dMaxY\n";

         my $pixMinX = $oMap->{extent}->{minx} / $cellSize;
         my $pixMaxX = $oMap->{extent}->{maxx} / $cellSize;
         my $pixMinY = $oMap->{extent}->{miny} / $cellSize;
         my $pixMaxY = $oMap->{extent}->{maxy} / $cellSize;

         print "  pix dimensions: $pixMinX, $pixMinY : $pixMaxX, 
$pixMaxY\n";

         #  create a 1 tile buffer and round to nearest metatile
         my $metaMinX = floor(($pixMinX - $tileWidth) / $mapWidth) * 
$mapWidth;
         my $metaMaxX = ceil(($pixMaxX + $tileWidth) / $mapWidth) * 
$mapWidth;
         my $metaMinY = -1 * ceil(($pixMaxY + $tileHeight) / $mapHeight) 
* $mapHeight;
         my $metaMaxY = -1 * floor(($pixMinY - $tileHeight) / 
$mapHeight) * $mapHeight;

         print "  meta dimensions: $metaMinX, $metaMinY : $metaMaxX, 
$metaMaxY\n";

         my $nWide = ($metaMaxX - $metaMinX)/$mapWidth;
         my $nHigh = ($metaMaxY - $metaMinY)/$mapHeight;

         my $nTiles = $nWide*$nHigh*$metaWidth*$metaHeight;
         print "  meta tiles: $nWide x $nHigh = ".($nWide*$nHigh)." meta 
tiles and $nTiles tiles\n";
         $nTotalTiles += $nTiles;

         $oMap->{scale} = $scale;
         my $geoWidth = 
$scale/($oMap->{resolution}*$inchesPerUnit[$oMap->{units}]);
         my $geoHeight = 
$scale/($oMap->{resolution}*$inchesPerUnit[$oMap->{units}]);

         foreach my $groupName (@Groups) {
             # determine if at least one layer in group is visible (due 
to scale)
             my $renderGroup = 0;

             # turn on/off layers depending on group
             for (my  $i=0; $i<$nLayers; $i++) {
                 my $oLayer = $oMap->getLayer($i);
                 if ($groupName eq $oLayer->{group}) {
                     $oLayer->{status} = $mapscript::MS_ON;
                     if ($oLayer->isVisible()) {
                         $renderGroup = 1;
                     }
                 }
                 else {
                     $oLayer->{status} = $mapscript::MS_OFF;
                 }
             }

             # get image format for the group (first layer)
             my @LayersIdx = getLayersIndexByGroup($oMap, $groupName);
             my $oLayer = $oMap->getLayer($LayersIdx[0]);
             my $imageformat = $oLayer->getMetaData('imageformat');
	    if (! $imageformat || ! length($imageformat)) {
             	$imageformat = $oMap->{imagetype};
             	setOutputFormat($imageformat);
	    }

             # check if tile_source is set to nocache
             my $tileSource = lc($oLayer->getMetaData('tile_source'));
             $renderGroup = 0 if $tileSource eq 'nocache';

             # for groups with visible layer(s), render tiles
             print "    Group: $groupName\n" if $renderGroup;
             if ($renderGroup && ! $dryrun) {
                 for (my $vertIndex = 0; $vertIndex < $nHigh; 
++$vertIndex) {
                     for (my $horizIndex = 0; $horizIndex < $nWide; 
++$horizIndex) {
                         my $top = $metaMinY + ($vertIndex * $mapHeight);
                         my $left = $metaMinX + ($horizIndex * $mapWidth);
                         my $metaLeft = floor( 
($left)/($tileWidth*$metaWidth) ) * $tileWidth * $metaWidth;
                         my $metaTop = floor( 
($top)/($tileHeight*$metaHeight) ) * $tileHeight *$metaHeight;
                         my $szMetaTileId = "t".$metaTop."l".$metaLeft;
                         $metaLeft -= $metaBuffer;
                         my $szGroupDir = normalizeString($groupName);
                         my $szLayerDir = "def";

                         # caching is done by scale value,
                         # then groups and layers and finally metatile
                         # and tile id. Create a new directory if necessary

                         my $szCacheDir = 
$szMapCacheDir."/".$scale."/".$szGroupDir."/".$szLayerDir."/".$szMetaTileId;
                         makeDirs($szCacheDir) if ! -d $szCacheDir;

                         # metatile is not rendered unless all tiles exist

                         my $renderMetaTile = 0;
                         my $szTileImg;
                         LOOP:
                         for($i = 0; $i < $metaWidth; ++$i) {
                             for($j = 0; $j < $metaHeight; ++$j) {
                                 my $tileTop = ($j * $tileHeight) + 
$metaBuffer;
                                 my $tileLeft = ($i*$tileWidth) + 
$metaBuffer;
                                 $szTileImg = $szCacheDir . "/t" . 
($metaTop + $tileTop) . "l" . ($metaLeft + $tileLeft) . $szImageExtension;
                                 if(! -f $szTileImg) {
                                     $renderMetaTile = 1;
                                     last LOOP;
                                 }
                             }
                         }

                         if ($renderMetaTile || $bForce) {
                              my $szMetaDir = $szCacheDir."/meta";
                              makeDirs($szMetaDir) if ! -d $szMetaDir;

                              #  Metatile width/height include
                              #  2x the metaBuffer value
                              $oMap->{width} = $tileWidth * $metaWidth + 
(2 * $metaBuffer);
                              $oMap->{height} = $tileHeight * 
$metaHeight + (2 * $metaBuffer);

                              # Tell MapServer to not render labels 
inside the
                              # metaBuffer area (new in 4.6)
                              # TODO: Until MapServer bugs 1353/1355 are
                              # resolved, we need to pass a negative 
value for
                              # "labelcache_map_edge_buffer"
 
$oMap->setMetaData("labelcache_map_edge_buffer", -$metaBuffer);
                              # draw the metatile

                              my $minx = $metaLeft * $geoWidth;
                              my $maxx = $minx + ($geoWidth * 
$oMap->{width});
                              my $maxy = -1 * $metaTop * $geoHeight;
                              my $miny = $maxy - ($geoHeight * 
$oMap->{height});
                              $oMap->setExtent($minx,$miny,$maxx,$maxy);
                              $oMap->selectOutputFormat($szMapImageFormat);
##                             $oMap->{outputformat}->{transparent} = 1;
                              my $szMetaImg = 
$szMetaDir."/t".$metaTop."l".$metaLeft.$szImageExtension;
                              my $oImg = $oMap->draw();
			     print "Saving: $szMetaImg\n" if $DEBUG;
			     if (! $oImg) {
			     	print "oMap->draw() Failed! setExtent($minx,$miny,$maxx,$maxy), 
scale=$scale, szMetaImg=$szMetaImg\n";
				die;
				next;
			     }
                              $oImg->save($szMetaImg);
                              my $oGDImg = 
ImageCreateFromFile($szMetaImg, $szFormat);

                              # draw individual tiles

                              for (my $i = 0; $i < $metaWidth; ++$i) {
                                 for (my $j = 0; $j < $metaHeight; ++$j) {
                                     my $tileTop = ($j * $tileHeight) + 
$metaBuffer;
                                     my $tileLeft = ($i * $tileWidth) + 
$metaBuffer;
                                     $szTileImg = $szCacheDir . "/t" . 
($metaTop + $tileTop) . "l" . ($metaLeft + $tileLeft) . $szImageExtension;
                                     if(! -f $szTileImg || $bForce) {
                                         my $oTile = 
ImageCreate($tileWidth, $tileHeight, $szFormat);
                                         # Allocate BG color for the tile
                                         # (in case the metatile has 
transparent BG)
                                         my $nTransparent = 
$oTile->colorAllocate(
                                             $oMap->{imagecolor}->{red},
                                             $oMap->{imagecolor}->{green},
                                             $oMap->{imagecolor}->{blue} 
    );
## 
$oTile->transparent($nTransparent);
	if ($DEBUG) {
	print "tileWidth: $tileWidth\n";
	print "tileHeight: $tileHeight\n";
	}
                                         $oTile->copy($oGDImg, 0, 0, 
$tileLeft, $tileTop, $tileWidth, $tileHeight);
                                         ImageOutput($oTile, $szTileImg, 
$szFormat);
                                         #undef $oTile;
                                     }
                                 }
                             }
                             #if ($oGDImg) {
                             #    undef $oGDImg;
                             #}
                             unlink($szMetaImg);
                         } # if renderMetaTile
                     } # for horizIndex
                 } # for vertIndex
             } # if renderGroup
         } # foreach group

         my $sec = (time() - $t0) || 1;
         print "  Generated $nTiles in $sec seconds (". $nTiles/$sec ." 
tps)\n";
         $nTotalSecs += $sec;
         print "  Total $nTotalTiles in $nTotalSecs seconds (". 
$nTotalTiles/$nTotalSecs . " tps) so far\n";
     } # foreach scale
} # end main

## ImageOutput($oGDImg, $file, $fmt);

sub ImageOutput {
     my $oGDImg = shift;
     my $file   = shift;
     my $fmt    = shift;
     open(IMG, ">$file") || die "Failed to open '$file' for write : $!\n";
     binmode IMG;
     if ($fmt eq "DITHERED") {
         print IMG $oGDImg->png;
     } elsif ($fmt eq "PNG24") {
         print IMG $oGDImg->png;
     } elsif ($fmt eq "ALPHA") {
         print IMG $oGDImg->png;
     } elsif ($fmt eq "GIF") {
         print IMG $oGDImg->gif;
     } elsif ($fmt eq "JPEG") {
         print IMG $oGDImg->jpeg;
     } elsif ($fmt eq "PNG") {
         print IMG $oGDImg->png;
     }
     close(IMG);
}

## $oGDImg = MapImageCreate($szMetaImg, $fmt);

sub ImageCreateFromFile {
     my $file     = shift;
     my $szFormat = shift;
     my $oGDImg;

     print "ImageCreateFromFile($file, $szFormat)\n" if $DEBUG;

     if ($szFormat eq "DITHERED") {
         $oGDImg = GD::Image->newFromPng($file);
     } elsif ($szFormat eq "PNG24") {
         $oGDImg = GD::Image->newFromPng($file);
     } elsif ($szFormat eq "ALPHA") {
         $oGDImg = GD::Image->newFromPng($file);
     } elsif ($szFormat eq "GIF") {
         $oGDImg = GD::Image->newFromGif($file);
     } elsif ($szFormat eq "JPEG") {
         $oGDImg = GD::Image->newFromJpeg($file);
     } elsif ($szFormat eq "PNG") {
         $oGDImg = GD::Image->newFromPng($file);
     }

     print "    (w,h) = (" . $oGDImg->width . ", " . $oGDImg->height . ")\n"
     	if $DEBUG;

     return $oGDImg;
}

sub ImageCreate {
     my $w        = shift;
     my $h        = shift;
     my $szFormat = shift;
     my $oGDImg;

     if ($szFormat eq "DITHERED") {
         $oGDImg = GD::Image->new($w, $h, 0);
     } elsif ($szFormat eq "PNG24") {
         $oGDImg = GD::Image->new($w, $h, 1);
     } elsif ($szFormat eq "ALPHA") {
         $oGDImg = GD::Image->new($w, $h, 1);
     } elsif ($szFormat eq "GIF") {
         $oGDImg = GD::Image->new($w, $h, 0);
     } elsif ($szFormat eq "JPEG") {
         $oGDImg = GD::Image->new($w, $h, 1);
     } elsif ($szFormat eq "PNG") {
         $oGDImg = GD::Image->new($w, $h, 0);
     }
     if ($DEBUG) {
     	print "ImageCreate($w, $h, $szFormat)\n";
     	my ($wid, $hgt) = $oGDImg->getBounds();
     	print "    oGDImg->getBounds($wid, $hgt)\n";
     }
     return $oGDImg;
}


More information about the ka-Map-users mailing list