| Subject: | Imager leaks memory somehow |
Imager runs out of memory over time. Might be a
GC problem or related to freetype.
#!perl -w
# Requires:
# - perl module Imager version 0.39
# http://www.eecs.umich.edu/~addi/perl/Imager/
# - the C library FreeType 2.0.5
# http://www.freetype.org
# - Perl version 5 or superior
# David Cerezo Sánchez (2002)
use Imager qw(:all);
use DBI;
# Dictionary file
$wordfile = 'words.spanish';
# Minimun length of a word
$min_length = 5;
# Maximun length of a word
$max_length = 10;
# Maximun number of generated graphic files
$max_graphics = 500;
# Array of randomly selected words from $file
@words = ();
# List of the chars that will be used to generate random strings
@chars = ("A" .. "Z", "a" .. "z", 0 .. 9);
@chars2 = ("a" .. "f");
# Maximun width
$maxWidth = 240;
# Maximun height
$maxHeight = 60;
# Font type file
$fontType = "\.ttf";
# Dir file where fonts are to be found
$fontDir = "./fonts/";
# Background color
$bgColor = Imager::Color->new("#CCCCCC");
# Filters
my %filters = (
a=>{type => 'mosaic', size => 3},
b=>{type => 'gaussian', stddev => 1.5},
c=>{type => 'noise', amount => 30, subtype => 1},
d=>{type => 'noise', amount => 30},
e=>{type => 'unsharpmask'},
f=>{},
);
if (!(i_has_format("ft2")))
{
print("No FreeType2 library\n");
exit(0);
}
if (!(i_has_format("jpeg")))
{
printf("No JPEG support\n");
exit(0);
}
# Preloading Fonts
i_init_fonts();
@fonts = ();
$i = 0;
opendir (DIRHNDL, $fontDir)
or die "Please, install fonts in the fonts/ directory: $!";
@flist = readdir(DIRHNDL);
closedir(DIRHNDL);
foreach(@flist)
{
next if ($_ eq "." || $_ eq "..");
if (/$fontType/io)
{
$fontnames[$i] = "$fontDir$_";
$i++;
}
}
# Initialize the font kernel
i_init_fonts();
# Preloading Fonts
@fonts = ();
$i = 0;
foreach (@fontnames)
{
$fonts[$i] = Imager::Font->new (file => $_, aa => 1);
$fonts[$i] or errorLoadingFont();
$i++;
}
$i = 0;
# Loading colors
@colors = ();
$colors[0] = Imager::Color->new("#FF0000");
$colors[1] = Imager::Color->new("#00FF00");
$colors[2] = Imager::Color->new("#0000FF");
flush STDOUT;
print "Selecting words\n";
%hashInserted = ();
open (FILE, "< $wordfile")
or die "Cannot open $wordfile: $!";
$numLines += tr/\n/\n/ while sysread(FILE, $_, 2 ** 16);
close (FILE);
open (FILE, "< $wordfile")
or die "Cannot open $wordfile: $!";
open (INDEX, "+> $wordfile.idx")
or die "Can't open $wordfile.idx: $!";
buildIndex(*FILE, *INDEX)
if -z "$wordfile.idx";
while ($i < $max_graphics)
{
srand;
$random = int(rand($numLines)) + 1;
$line = lineIndex(*FILE, *INDEX, $random);
if ( (length($line)) > $min_length && (length($line)-1) <= $max_length && ! $hashInserted{$line})
{
$hashInserted{$line} = 1;
push(@words, trim($line));
$i++;
}
}
close (FILE);
close (INDEX);
$i = 0;
while ($i < $max_graphics)
{
generate();
}
sub generate
{
while ($i < $max_graphics)
{
$img = Imager->new(xsize => $maxWidth, ysize => $maxHeight, channels => 3);
$filename = join("", @chars[ map { rand @chars } (1..32) ]);
srand;
$currentSize = 70;
$currentFont = $fonts[ rand @fonts ];
$currentColor = $colors[ rand @colors ];
$currentX = 0;
@bbox = $currentFont->bounding_box(string => $words[$i], size => $currentSize, canon => 1);
while ($bbox[2] > $maxWidth || $bbox[3] > $maxHeight)
{
$currentSize -= 1;
@bbox = $currentFont->bounding_box(string => $words[$i], size => $currentSize, canon => 1);
}
if ($bbox[2] < ($maxWidth-10))
{
$currentX = int (($maxWidth-$bbox[2])/2);
}
print "$i: $words[$i] => size: $currentSize \n";
$img->box(color=>$bgColor,
xmin=>0,
ymin=>0,
xmax=>$maxWidth,
ymax=>$maxHeight,
filled=>1);
$img->string(font => $currentFont,
text => $words[$i],
x => $currentX,
y => 50,
size => $currentSize,
color => $currentColor,
aa => 1);
$img->filter(%{$filters{join("", @chars2[map {rand @chars2 } (1) ])}});
$img->write(file => "imagout/$filename.gif", type => 'gif')
|| print "failed: ",$img->{ERRSTR},"\n";
$img = "";
$i++;
if (($i % 10) eq 0) {
print "$i\n";
return;
}
}
}
sub buildIndex
{
my $dataFile = shift;
my $indexFile = shift;
my $offset = 0;
while (<$dataFile>)
{
print $indexFile pack("N", $offset);
$offset = tell($dataFile);
}
}
sub lineIndex
{
my $dataFile = shift;
my $indexFile = shift;
my $lineNumber = shift;
my $size;
my $iOffset;
my $entry;
my $dOffset;
$size = length(pack("N", 0));
$iOffset = $size * ($lineNumber - 1);
seek($indexFile, $iOffset, 0) or return;
read($indexFile, $entry, $size);
$dOffset = unpack("N", $entry);
seek($dataFile, $dOffset, 0);
return scalar(<$dataFile>);
}
sub trim($)
{
$_ = shift;
s/^\s*//;
s/\s*$//;
return $_;
}
sub errorLoadingFont()
{
print Imager::_error_as_msg(),"\n";
$i--;
}