GD
view release on metacpan or search on metacpan
#endif
#include "const-c.inc"
typedef gdImagePtr GD__Image;
typedef gdFontPtr GD__Font;
typedef PerlIO * InputStream;
#ifdef PERL_OBJECT
# ifdef WIN32
#define GDIMAGECREATEFROMPNG(x) gdImageCreateFromPng((FILE*)x)
#define GDIMAGECREATEFROMXBM(x) gdImageCreateFromXbm((FILE*)x)
#define GDIMAGECREATEFROMJPEG(x) gdImageCreateFromJpeg((FILE*)x)
#define GDIMAGECREATEFROMGIF(x) gdImageCreateFromGif((FILE*)x)
#define GDIMAGECREATEFROMWBMP(x) gdImageCreateFromWBMP((FILE*)x)
#define GDIMAGECREATEFROMBMP(x) gdImageCreateFromBmp((FILE*)x)
#define GDIMAGECREATEFROMTIFF(x) gdImageCreateFromTiff((FILE*)x)
#define GDIMAGECREATEFROMGD(x) gdImageCreateFromGd((FILE*)x)
#define GDIMAGECREATEFROMGD2(x) gdImageCreateFromGd2((FILE*)x)
#define GDIMAGECREATEFROMGD2PART(x,a,b,c,d) gdImageCreateFromGd2Part((FILE*)x,a,b,c,d)
#define GDIMAGECREATEFROMWEBP(x) gdImageCreateFromWebp((FILE*)x)
#define GDIMAGECREATEFROMHEIF(x) gdImageCreateFromHeif((FILE*)x)
#define GDIMAGECREATEFROMAVIF(x) gdImageCreateFromAvif((FILE*)x)
# endif
#else
# ifdef USE_PERLIO
#define GDIMAGECREATEFROMPNG(x) gdImageCreateFromPng(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMXBM(x) gdImageCreateFromXbm(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMJPEG(x) gdImageCreateFromJpeg(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGIF(x) gdImageCreateFromGif(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMWBMP(x) gdImageCreateFromWBMP(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMBMP(x) gdImageCreateFromBmp(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMTIFF(x) gdImageCreateFromTiff(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGD(x) gdImageCreateFromGd(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGD2(x) gdImageCreateFromGd2(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGD2PART(x,a,b,c,d) gdImageCreateFromGd2Part(PerlIO_findFILE(x),a,b,c,d)
#define GDIMAGECREATEFROMWEBP(x) gdImageCreateFromWebp(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMHEIF(x) gdImageCreateFromHeif(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMAVIF(x) gdImageCreateFromAvif(PerlIO_findFILE(x))
# else
#define GDIMAGECREATEFROMPNG(x) gdImageCreateFromPng(x)
#define GDIMAGECREATEFROMXBM(x) gdImageCreateFromXbm(x)
#define GDIMAGECREATEFROMJPEG(x) gdImageCreateFromJpeg(x)
#define GDIMAGECREATEFROMGIF(x) gdImageCreateFromGif(x)
#define GDIMAGECREATEFROMWBMP(x) gdImageCreateFromWBMP(x)
#define GDIMAGECREATEFROMBMP(x) gdImageCreateFromBmp(x)
#define GDIMAGECREATEFROMTIFF(x) gdImageCreateFromTiff(x)
#define GDIMAGECREATEFROMGD(x) gdImageCreateFromGd(x)
#define GDIMAGECREATEFROMGD2(x) gdImageCreateFromGd2(x)
#define GDIMAGECREATEFROMGD2PART(x,a,b,c,d) gdImageCreateFromGd2Part(x,a,b,c,d)
#define GDIMAGECREATEFROMWEBP(x) gdImageCreateFromWebp(x)
CODE:
RETVAL = gdImageFile(image, filename);
OUTPUT:
RETVAL
#endif
#ifdef HAVE_PNG
GD::Image
gd_newFromPng(packname="GD::Image", filehandle, ...)
char * packname
InputStream filehandle
PROTOTYPE: $$;$
PREINIT:
dMY_CXT;
int truecolor = truecolor_default;
CODE:
PERL_UNUSED_ARG(packname);
RETVAL = (GD__Image) GDIMAGECREATEFROMPNG(filehandle);
if (!RETVAL)
croak("gdImageCreateFromPng error");
if (items > 2) truecolor = (int)SvIV(ST(2));
gd_chkimagefmt(RETVAL, truecolor);
OUTPUT:
RETVAL
GD::Image
gdnewFromPngData(packname="GD::Image", imageData, ...)
char * packname
SV * imageData
PROTOTYPE: $$;$
PREINIT:
gdIOCtx* ctx;
char* data;
STRLEN len;
dMY_CXT;
int truecolor = truecolor_default;
CODE:
PERL_UNUSED_ARG(packname);
data = SvPV(imageData,len);
ctx = newDynamicCtx(data,len);
RETVAL = (GD__Image) gdImageCreateFromPngCtx(ctx);
(ctx->gd_free)(ctx);
if (!RETVAL)
croak("gdImageCreateFromPngCtx error");
if (items > 2) truecolor = (int)SvIV(ST(2));
gd_chkimagefmt(RETVAL, truecolor);
OUTPUT:
RETVAL
#endif
#ifdef HAVE_GD2
GD::Image
gdnewFromGdData(packname="GD::Image", imageData)
GD::Image image
PROTOTYPE: $;$
PREINIT:
CODE:
{
void* data;
int size;
int level;
if (items > 1) {
level = (int)SvIV(ST(1));
data = (void *) gdImagePngPtrEx(image,&size,level);
if (!data)
croak("gdImagePngPtrEx error");
} else {
data = (void *) gdImagePngPtr(image,&size);
if (!data)
croak("gdImagePngPtr error");
}
RETVAL = newSVpvn((char*) data,size);
gdFree(data);
}
OUTPUT:
RETVAL
#endif
#ifdef HAVE_JPEG
demos/brushes.pl view on Meta::CPAN
$red = $im->colorAllocate(255, 0, 0);
# allocate green
$green = $im->colorAllocate(0,255,0);
# allocate yellow
$yellow = $im->colorAllocate(255,250,205);
# Get an image from a png file
open (TILE,"./tile.png") || die;
$tile = newFromPng GD::Image(TILE);
close TILE;
# use it as a paintbrush
$im->setBrush($tile);
$im->arc(100,100,100,150,0,360,gdBrushed);
# use it as a tiling pattern to fill a rectangle
$im->setTile($tile);
$im->filledRectangle(150,150,250,250,gdTiled);
$im->rectangle(150,150,250,250,$black);
GD::Image->trueColor(0);
=item B<$image = GD::Image-E<gt>newPalette([$width,$height])>
=item B<$image = GD::Image-E<gt>newTrueColor([$width,$height])>
The newPalette() and newTrueColor() methods can be used to explicitly
create an palette based or true color image regardless of the
current setting of trueColor().
=item B<$image = GD::Image-E<gt>newFromPng($file, [$truecolor])>
=item B<$image = GD::Image-E<gt>newFromPngData($data, [$truecolor])>
The newFromPng() method will create an image from a PNG file read in
through the provided filehandle or file path. The filehandle must
previously have been opened on a valid PNG file or pipe. If
successful, this call will return an initialized image which you can
then manipulate as you please. If it fails, which usually happens if
the thing at the other end of the filehandle is not a valid PNG file,
the call returns undef. Notice that the call doesn't automatically
close the filehandle for you. But it does call C<binmode(FILEHANDLE)>
for you, on platforms where this matters.
You may use any of the following as the argument:
1) a simple filehandle, such as STDIN
2) a filehandle glob, such as *PNG
3) a reference to a glob, such as \*PNG
4) an IO::Handle object
5) the pathname of a file
In the latter case, newFromPng() will attempt to open the file for you
and read the PNG information from it.
Example1:
open (PNG,"barnswallow.png") || die;
$myImage = GD::Image->newFromPng(\*PNG) || die;
close PNG;
Example2:
$myImage = GD::Image->newFromPng('barnswallow.png');
To get information about the size and color usage of the information,
you can call the image query methods described below. Images created
by reading PNG images will be truecolor if the image file itself is
truecolor. To force the image to be palette-based, pass a value of 0
in the optional $truecolor argument.
The newFromPngData() method will create a new GD::Image initialized
with the PNG format B<data> contained in C<$data>.
=item B<$image = GD::Image-E<gt>newFromJpeg($file, [$truecolor])>
=item B<$image = GD::Image-E<gt>newFromJpegData($data, [$truecolor])>
These methods will create an image from a JPEG file. They work just
like newFromPng() and newFromPngData(), and will accept the same
filehandle and pathname arguments.
Images created by reading JPEG images will always be truecolor. To
force the image to be palette-based, pass a value of 0 in the optional
$truecolor argument.
=item B<$image = GD::Image-E<gt>newFromGif($file, [$truecolor])>
=item B<$image = GD::Image-E<gt>newFromGifData($data)>
These methods will create an image from a GIF file. They work just
like newFromPng() and newFromPngData(), and will accept the same
filehandle and pathname arguments.
Images created from GIFs are always 8-bit palette images. To convert
to truecolor, you must create a truecolor image and then perform a
copy.
=item B<$image = GD::Image-E<gt>newFromXbm($file, [$truecolor])>
This works in exactly the same way as C<newFromPng>, but reads the
contents of an X Bitmap (black & white) file:
open (XBM,"coredump.xbm") || die;
$myImage = GD::Image->newFromXbm(\*XBM) || die;
close XBM;
There is no newFromXbmData() function, because there is no
corresponding function in the gd library.
=item B<$image = GD::Image-E<gt>newFromWBMP($file)>
This works in exactly the same way as C<newFromPng>, but reads the
contents of a Wireless Application Protocol Bitmap (WBMP) file:
open (WBMP,"coredump.wbmp") || die;
$myImage = GD::Image->newFromWBMP(\*WBMP) || die;
close WBMP;
There is no newFromWBMPData() function, because there is no
corresponding function in the gd library.
=item B<$image = GD::Image-E<gt>newFromBmp($file)>
This works in exactly the same way as C<newFromPng>, but reads the
contents of a Windows Bitmap (BMP) file:
open (BMP,"coredump.bmp") || die;
$myImage = GD::Image->newFromBmp(\*BMP) || die;
close BMP;
There is no newFromBmpData() function, because there is no
corresponding function in the gd library.
=item B<$image = GD::Image-E<gt>newFromGd($file)>
making PNG backgrounds transparent for displaying on the Web. Only
one color can be transparent at any time. To disable transparency,
specify -1 for the index.
If you call this method without any parameters, it will return the
current index of the transparent color, or -1 if none.
Example:
open(PNG,"test.png");
$im = GD::Image->newFromPng(PNG);
$white = $im->colorClosest(255,255,255); # find white
$im->transparent($white);
binmode STDOUT;
print $im->png;
=back
=head2 Special Colors
GD implements a number of special colors that can be used to achieve
=item B<$image-E<gt>filledRectangle($x1,$y1,$x2,$y2,$color)>
=item B<$image-E<gt>setTile($otherimage)>
This draws a rectangle filled with the specified color. You can use a
real color, or the special fill color gdTiled to fill the polygon
with a pattern.
Example:
# read in a fill pattern and set it
$tile = GD::Image->newFromPng('happyface.png');
$myImage->setTile($tile);
# draw the rectangle, filling it with the pattern
$myImage->filledRectangle(10,10,150,200,gdTiled);
=item B<$image-E<gt>openPolygon($polygon,$color)>
This draws a polygon with the specified color. The polygon must be
created first (see below). The polygon must have at least three
vertices. If the last vertex doesn't close the polygon, the method
lib/GD/Image.pm view on Meta::CPAN
=head1 SYNOPSIS
See L<GD>
=head1 DESCRIPTION
Supported Image formats:
=over 4
=item Png
=item Gif
=item Jpeg
=item Tiff
=item Xbm
=item WBMP
lib/GD/Image.pm view on Meta::CPAN
sub height {
my $self = shift;
my @bounds = $self->getBounds;
$bounds[1];
}
sub _image_type {
my $data = shift;
my $magic = substr($data,0,4);
return 'Png' if $magic eq "\x89PNG";
return 'Jpeg' if ((substr($data,0,3) eq "\377\330\377") &&
ord(substr($data,3,1)) >= 0xc0);
return 'Gif' if $magic eq "GIF8";
return 'Gd2' if $magic eq "gd2\000";
return 'Tiff' if $magic eq "\x4d\x4d\x00\x2a" or
$magic eq "\x49\x49\x2a\x00" or
$magic eq "IIN1";
return 'Bmp' if $magic eq "BMF\000";
return 'Webp' if $magic eq "RIFF" and substr($data,8,4) eq "WEBP";
if (substr($data,4,4) eq "ftyp") { #possibly ISOBMFF-compliant container like HEIF which us used for AVIF and HEIC
lib/GD/Image.pm view on Meta::CPAN
sub clone {
croak("Usage: clone(\$image)") unless @_ == 1;
my $self = shift;
my ($x,$y) = $self->getBounds;
my $new = $self->new($x,$y);
return unless $new;
$new->copy($self,0,0,0,0,$x,$y);
return $new;
}
sub newFromPng {
croak("Usage: newFromPng(class,filehandle,[truecolor])") unless @_>=2;
my($class) = shift;
my($f) = shift;
my $fh = $class->_make_filehandle($f);
binmode($fh);
$class->_newFromPng($fh,@_);
}
sub newFromJpeg {
croak("Usage: newFromJpeg(class,filehandle,[truecolor])") unless @_>=2;
my($class) = shift;
my($f) = shift;
my $fh = $class->_make_filehandle($f);
binmode($fh);
$class->_newFromJpeg($fh,@_);
}
lib/GD/Image_pm.PL view on Meta::CPAN
See L<GD>
=head1 DESCRIPTION
Supported Image formats:
=over 4
!NO!SUBS!
print OUT "=item Png\n\n" if $DEFINES =~ /HAVE_PNG/;
print OUT "=item Gif\n\n" if $DEFINES =~ /HAVE_GIF/;
print OUT "=item Gd\n\n=item Gd2\n\n" if $DEFINES =~ /HAVE_GD2/;
print OUT "=item Jpeg\n\n" if $DEFINES =~ /HAVE_JPEG/;
print OUT "=item Tiff\n\n" if $DEFINES =~ /HAVE_TIFF/;
print OUT "=item Xpm\n\n" if $DEFINES =~ /HAVE_XPM/;
print OUT "=item Xbm\n\n" if 1 or $DEFINES =~ /HAVE_XBM/;
print OUT "=item WBMP\n\n" if 1 or $DEFINES =~ /HAVE_WBMP/;
print OUT "=item BMP\n\n" if $DEFINES =~ /HAVE_BMP/;
print OUT "=item GifAnim\n\n" if $DEFINES =~ /HAVE_GIFANIM/;
print OUT "=item Webp\n\n" if $DEFINES =~ /HAVE_WEBP/;
lib/GD/Image_pm.PL view on Meta::CPAN
print OUT << '!NO!SUBS!';
=back
Unsupported Image formats:
=over 4
!NO!SUBS!
print OUT "=item Png\n\n" if $DEFINES !~ /HAVE_PNG/;
print OUT "=item Gif\n\n" if $DEFINES !~ /HAVE_GIF/;
print OUT "=item Gd\n\n=item Gd2\n\n" if $DEFINES !~ /HAVE_GD2/;
print OUT "=item Jpeg\n\n" if $DEFINES !~ /HAVE_JPEG/;
print OUT "=item Tiff\n\n" if $DEFINES !~ /HAVE_TIFF/;
print OUT "=item Xpm\n\n" if $DEFINES !~ /HAVE_XPM/;
print OUT "=item GifAnim\n\n" if $DEFINES !~ /HAVE_GIFANIM/;
print OUT "=item Webp\n\n" if $DEFINES !~ /HAVE_WEBP/;
print OUT "=item Heif\n\n" if $DEFINES !~ /HAVE_HEIF/;
print OUT "=item Avif\n\n" if $DEFINES !~ /HAVE_AVIF/;
print OUT "=item BMP\n\n" if $DEFINES !~ /HAVE_BMP/;
lib/GD/Image_pm.PL view on Meta::CPAN
sub height {
my $self = shift;
my @bounds = $self->getBounds;
$bounds[1];
}
sub _image_type {
my $data = shift;
my $magic = substr($data,0,4);
return 'Png' if $magic eq "\x89PNG";
return 'Jpeg' if ((substr($data,0,3) eq "\377\330\377") &&
ord(substr($data,3,1)) >= 0xc0);
return 'Gif' if $magic eq "GIF8";
return 'Gd2' if $magic eq "gd2\000";
return 'Tiff' if $magic eq "\x4d\x4d\x00\x2a" or
$magic eq "\x49\x49\x2a\x00" or
$magic eq "IIN1";
return 'Bmp' if $magic eq "BMF\000";
return 'Webp' if $magic eq "RIFF" and substr($data,8,4) eq "WEBP";
if (substr($data,4,4) eq "ftyp") { #possibly ISOBMFF-compliant container like HEIF which us used for AVIF and HEIC
lib/GD/Image_pm.PL view on Meta::CPAN
my $new = $self->new($x,$y);
return unless $new;
$new->copy($self,0,0,0,0,$x,$y);
return $new;
}
!NO!SUBS!
if ($DEFINES =~ /HAVE_PNG/) {
print OUT <<'!NO!SUBS!'
sub newFromPng {
croak("Usage: newFromPng(class,filehandle,[truecolor])") unless @_>=2;
my($class) = shift;
my($f) = shift;
my $fh = $class->_make_filehandle($f);
binmode($fh);
$class->_newFromPng($fh,@_);
}
!NO!SUBS!
}
if ($DEFINES =~ /HAVE_GD2/) {
print OUT <<'!NO!SUBS!'
sub newFromGd {
croak("Usage: newFromGd(class,filehandle)") unless @_==2;
my($class,$f) = @_;
my $gd = $image->gd;
my $image2 = GD::Image->newFromGdData($gd);
ok(!$image->compare($image2) & GD_CMP_IMAGE(),'round trip gd');
my $gd2 = $image->gd2;
$image2 = GD::Image->newFromGd2Data($gd2);
ok(!$image->compare($image2) & GD_CMP_IMAGE(),'round trip gd2');
}
else {
# GD 2.3.2 disabled the old GD and GD2 formats by default
my $png = $image->png;
my $image2 = GD::Image->newFromPngData($png);
ok(!$image->compare($image2) & GD_CMP_IMAGE(),'round trip png');
my $gif = $image->gif;
$image2 = GD::Image->newFromGifData($gif);
ok(!$image->compare($image2) & GD_CMP_IMAGE(),'round trip gif');
}
}
sub catch_libgd_error {
diag("ignore corrupt png error messages...");
SKIP: {
skip "No PNG support", 2 unless defined &GD::Image::newFromPng;
my $image = eval { GD::Image->newFromPng("test_data/images/corrupt.png") };
is($image, undef);
ok($@, 'caught corrupt png');
}
}
sub test_cve2019_6977 {
my $img1 = GD::Image->new(0xfff, 0xfff, 1);
my $img2 = GD::Image->new(0xfff, 0xfff, 0);
$img2->colorAllocate(0, 0, 0);
$img2->setPixel (0, 0, 255);
t/autodetect.t view on Meta::CPAN
# skip "No GD2 support", 1 unless defined &GD::Image::newFromGd2;
# my $gd2 = GD::Image->new("t/test_data/tile.gd2");
# ok defined($gd2), "gd2 detected";
#}
SKIP: {
skip "No GIF support", 1 unless defined &GD::Image::newFromGif;
my $gif = GD::Image->new("t/test_data/tile.gif");
ok defined($gif), "gif detected";
}
SKIP: {
skip "No PNG support", 1 unless defined &GD::Image::newFromPng;
my $png = GD::Image->new("t/test_data/tile.png");
ok defined($png), "png detected";
}
SKIP: {
skip "No JPEG support", 1 unless defined &GD::Image::newFromJpeg;
my $jpeg = GD::Image->new("t/test_data/tile.jpeg");
ok defined($jpeg), "jpeg detected";
}
SKIP: {
skip "No TIFF support", 1 unless defined &GD::Image::newFromTiff;
# GH #47
use strict;
use GD;
use Test::More 'no_plan';
use Test::NoWarnings;
SKIP: {
skip "No PNG support", 1 unless defined &GD::Image::newFromPng;
# Use of uninitialized value $pkg
my $image = GD::Image->newFromPng('t/test_data/tile.png');
f();
}
sub f
{
my $image = GD::Image->newFromPng('t/test_data/tile.png');
}
( run in 0.652 second using v1.01-cache-2.11-cpan-0a6323c29d9 )