[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 mapserver-dev
mailing list