PerlMagick and Moo
[email protected] (Rick Leir) Mon, 20 Jul 2015 11:35:24 -0400
| Newsgroups | perl.moose |
|---|---|
| Message-ID | <CAGitpvb4+Wy6OzuSgLj+z8Rf9bEFYawhNfJm+0uE7Cg-j_9qXw@mail.gmail.com> |
--001a113cf08c51abd3051b504908
Content-Type: text/plain; charset=UTF-8
Hi everyone,
I have been working on a web service for GM PerlMagick, and Moo was
suggested. The GM object is kept across requests, but the image memory is
freed (question below). Here is what it looks like:
package Something::Magick;
use Graphics::Magick;
use Dancer::Core::Types; # brings helper for types
use MooX::Types::MooseLike::Base; # InstanceOf
use MooX::Types::MooseLike;
# Moo def must follow other defs.
use Moo;
with 'MooX::Singleton';
has image => (
is => 'rw',
isa => InstanceOf['Graphics::Magick'],
lazy => 1,
builder => '_build_image'
);
# The lazy attribute says to Moo that this attribute will be built
(initialized)
# only when called the first time. It means that the connection to GmImage
won't be opened until necessary.
sub _build_image {
my ($self) = @_;
Graphics::Magick->new( );
}
sub BUILD {
my ($self) = @_;
$self->image( Graphics::Magick->new( ));
}
sub do_sequence {
my $self = shift;
my @seq = shift || 1;
my $Arrayofhashes = \$seq[0][0];
my $sizeminus1 = @$$Arrayofhashes - 1; #++++++++++++++ 3
for my $i ( 0 .. $sizeminus1 ) {
my $href = $seq[0][0][$i];
my $opname;
my $filepath;
my $gmparms;
while( my ($k, $v) = each %$href ) {
.... sanitize input ..
if( $k eq 'op') {
$opname = $v;
}
elsif( $k eq 'file') {
$v =~ s/^\/+//; # remove any leading /
$filepath = $v;
}
elsif( $k eq 'parms') {
$gmparms = $v;
}
}
..
if( $opname eq 'Read') {
my $status = $self->image->Read( $absolute);
warn "$status" if "$status";
} elsif( $opname eq 'Write') {
my $status = $self->image->Write( $absolute);
warn "$status" if "$status";
}
...
# some op other than read,write
# invoke it
my $status = $self->image->$opname( $gmparms);
warn "$status" if "$status";
}
# delete all the images but retain the Graphics::Magick object
# @$image = (); no
# @self->image = (); no
# @{self->image} = (); no
my $i = 0;
# while (defined ($self->image->[$i])) {
while ( $i < 10) {
if (defined ($self->image->[$i])) {
undef ($self->image->[$i]);
print "======== undef $i\n";
}
$i++;
}
}
My question is how can you delete all the images but retain the
Graphics::Magick object? I do not want to use the undef loop above. With
normal perlmagick, you would say
@$image = ();
( http://www.graphicsmagick.org/perl.html )
Should I learn more about Perl XS? TIA
--
Rick
--001a113cf08c51abd3051b504908
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
<div dir=3D"ltr">Hi everyone,
<br>
<br>I have been working on a web service for GM PerlMagick, and Moo was sug=
gested.=20
The GM object is kept across requests, but the image memory is freed=20
(question below). Here is what it looks like:
<br>package Something::Magick;
<br>
<br>use Graphics::Magick;
<br>
<br>use Dancer::Core::Types; # brings helper for types
<br>use MooX::Types::MooseLike::Base; # InstanceOf
<br>use MooX::Types::MooseLike;
<br>
<br># Moo def must follow other defs.
<br>use Moo;
<br>with 'MooX::Singleton';
<br>
<br>has image =3D> (
<br>=C2=A0 =C2=A0 is =3D> 'rw',
<br>=C2=A0 =C2=A0 isa =3D> InstanceOf['Graphics::Magick'],
<br>=C2=A0 =C2=A0 lazy =3D> 1,
<br>=C2=A0 =C2=A0 builder =3D> '_build_image'
<br>);
<br># The lazy attribute says to Moo that this attribute will be built (ini=
tialized)
<br># only when called the first time. It means that the connection to GmIm=
age won't be opened until necessary.
<br>
<br>sub _build_image {
<br>=C2=A0 =C2=A0 my ($self) =3D @_;
<br>=C2=A0 =C2=A0 Graphics::Magick->new( );
<br>}
<br>sub BUILD {
<br>=C2=A0 =C2=A0 my ($self) =3D @_;
<br>=C2=A0 =C2=A0 $self->image( Graphics::Magick->new( ));
<br>}
<br clear=3D"all"><br>sub do_sequence {
<br>=C2=A0 =C2=A0 my $self =3D shift;
<br>=C2=A0 =C2=A0 my @seq =3D shift || 1;
<br>
<br>=C2=A0 =C2=A0 my $Arrayofhashes =3D \$seq[0][0];
<br>=C2=A0 =C2=A0 my $sizeminus1 =3D @$$Arrayofhashes - 1; #++++++++++++++ =
3
<br>
<br>=C2=A0 =C2=A0 for my $i ( 0 .. $sizeminus1 ) {
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 my $href =3D $seq[0][0][$i]; =C2=A0 =C2=A0 =
=C2=A0
<br>
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 my $opname;
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 my $filepath;
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 my $gmparms;
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 while( my ($k, $v) =3D each %$href ) {
<br>.... sanitize input ..
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0if( $k eq 'op') {
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 $opname =3D $v;
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 }
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 elsif( $k eq 'file') =
{
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 $v =3D~ s/^\/+/=
/; =C2=A0# remove any leading /
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 $filepath =3D $=
v;
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 }
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 elsif( $k eq 'parms')=
{
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 $gmparms =3D $v=
;
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 }
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 }
<br>..
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0if( $opname eq &=
#39;Read') {
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 m=
y $status =3D $self->image->Read( $absolute);
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 w=
arn "$status" if "$status";
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 } elsif( $opnam=
e eq 'Write') {
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 m=
y $status =3D $self->image->Write( $absolute);
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 w=
arn "$status" if "$status";
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 }
<br>=C2=A0 ...
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0# some op other than read,writ=
e
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0# invoke it
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 my $status =3D =
$self->image->$opname( $gmparms);
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 warn "$sta=
tus" if "$status";
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 }
<br>
<br>=C2=A0 =C2=A0 # delete all the images but retain the Graphics::Magick o=
bject
<br>=C2=A0 =C2=A0 # @$image =3D (); =C2=A0no
<br>=C2=A0 =C2=A0 # @self->image =3D (); =C2=A0no
<br>=C2=A0 =C2=A0 # @{self->image} =3D (); =C2=A0no
<br>
<br>=C2=A0 =C2=A0 my $i =3D 0;
<br># =C2=A0 =C2=A0while (defined ($self->image->[$i])) {
<br>=C2=A0 =C2=A0 while ( $i < 10) {
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 if (defined ($self->image->[$i])) {
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 undef ($self->image->[$=
i]);
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 print "=3D=3D=3D=3D=3D=
=3D=3D=3D undef $i\n";
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 }
<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 $i++;
<br>=C2=A0 =C2=A0 }
<br>}
<br>My question is how can you delete all the images but retain the=20
Graphics::Magick object? I do not want to use the undef loop above. With
normal perlmagick, you would say=20
<br>=C2=A0 @$image =3D ();=20
<br>( <a href=3D"http://www.graphicsmagick.org/perl.html" target=3D"_blank"=
rel=3D"nofollow">http://www.graphicsmagick.org/perl.html</a> )
<br>
<br>Should I learn more about Perl XS?=C2=A0 TIA
<br>--=20
<br>Rick=20
<br> <br></div>
--001a113cf08c51abd3051b504908--