Reputation: 21
Image::Magick module is installed.
I do see the perldoc if I type:
perldoc Image::Magick
While trying to use it with a Dancer2 application I don't get any results.
A simple test script does compile but except my hello
I don't get to see any results or warnings? What am I doing wrong?
#!/usr/bin/perl
use strict;
use warnings;
use Image::Magick;
print "hello!\n";
my $image = Image::Magick->new;
$image->Set(size=>'100x100');
$image->ReadImage('xc:white');
$image->Set('pixel[49,49]'=>'red');
$image->Write("cool.jpeg");
Below I provide the relevant parts of the code for the Dancer2 app. On my local (OS X) system everything works fine. On the server the Image::Magick part is not functioning.
As per request the way I use Image::Magick with Dancer2..
package myDancer;
use Dancer2;
use Dancer2::Plugin::Database;
use Dancer2::Plugin::Auth::Extensible;
use Data::Dumper;
use Image::Size;
use Image::Magick;
use File::Basename;
use File::Spec;
use FindBin;
use File::Copy qw(move);
# --below relevant code--
# UPLOAD-----------
get '/upload' => require_login sub {
template 'upload', {}, { layout => 'cms' };
};
post '/upload' => require_login sub {
my $data = request->upload('file');
return 'Error' if not defined $data;
my $upload_dir = path( config->{appdir}, "public/images/uploads" );
debug( "Line 79: ", $upload_dir );
# full path with file-name
# $data->basename is the name provided with uploaded file
my $path = path( $upload_dir, $data->basename );
if ( -e $path ) {
return "$path already exists";
}
$data->link_to($path);
redirect '/fm/uploaded';
};
#---------------------------------------------------------------------
#
# What have we uploaded?
#
#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
get '/fm/uploaded' => require_login sub {
my $upload_dir = path( config->{appdir}, "public/images/uploads/*.jpeg" );
debug( "Line: 102 - Full path used for uploaded: ",
$upload_dir );
my @images = glob($upload_dir);
my @glob_uploaded;
for my $record (@images) {
my ( $w, $h ) = imgsize($record);
push(
@glob_uploaded,
{
photo_name => basename($record),
width => $w,
height => $h,
}
);
}
my $message = <<'MESSAGE';
Just a message
MESSAGE
template 'fm/uploads',
{ forklifts => \@glob_uploaded, message => $message },
{ layout => "cms" };
};
get '/fm/new-image/:photo_name' => require_login sub {
# my $curdir = File::Spec->rel2abs('.');
my $upload_dir = path( config->{appdir}, "public/images/uploads" );
debug( "Line 137: ", $upload_dir );
#---------------------------------------------------------------------
#
# What is the latest id?
# And add 1 to this id.
#
#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
my $sql = <<'SQL';
select seq from sqlite_sequence where name = ?
SQL
my $sth = database->prepare($sql);
$sth->execute('images');
my $current = $sth->fetchall_arrayref();
my $current_plus_one = $current->[0][0] + 1;
my $new_name = &TimeStamp . "-" . $current_plus_one . ".jpeg";
debug( "line: 154 - new_name: ", $new_name );
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
#---------------------------------------------------------------------
my $photo_name = route_parameters->get('photo_name');
debug( "line 159 - photo_name ", $photo_name );
my $pathFoto =
path( config->{appdir}, "public/images/uploads/$photo_name" );
# my $pathFoto = "$upload_dir . $photo_name";
debug( "line 164: pathFoto", $pathFoto );
if ( -e $pathFoto ) {
print "File exists.\n"; # Debug
template 'fm/new-image', { photo => $new_name, sh_note => $photo_name },
{ layout => 'cms' };
}
else {
print "File doesn't exist.\n"; # Debug
redirect '/fm/forklift'; # TODO
}
};
#---------------------------------------------------------------------
#
# Adding the new image to the database together with meta-data
#
#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
post '/fm/new-image' => require_login sub {
my $new_name = body_parameters->get('photo_name')
or die "missing content parameter";
my $caption = body_parameters->get('caption');
my $location = body_parameters->get('location');
my $short_note = body_parameters->get('sh_note');
my $note = body_parameters->get('note');
database->quick_insert(
'images',
{
photo_name => $new_name,
caption => $caption,
note => $note,
sh_note => $short_note,
location => $location,
}
);
my $curdir = path( config->{appdir}, "public/images/" );
debug( "line: 205 - check path: ", $curdir );
my $old_image_location_lg =
path( config->{appdir}, "public/images/uploads/$short_note" );
debug( "line: 209 - check path: ", $old_image_location_lg );
my $magick = new Image::Magick;
$magick->Read($old_image_location_lg);
$magick->Write( path( config->{appdir}, "public/images/lg/$new_name" ) );
$magick->Resize( gravity => 'Center' );
$magick->Scale( geometry => '3%x3%' );
$magick->Write( path( config->{appdir}, "public/images/tn/$new_name" ) );
unlink $old_image_location_lg;
redirect '/fm/recent-images';
};
####################################################### TIMESTAMP #######
# perldoc -q time
# perldoc -f localtime
sub TimeStamp {
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
( 0, 0, 0, 0, 0, 0, 0, 0, 0 );
( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
localtime(time);
$year += 1900;
$mon += 1;
$sec = sprintf( "%02d", $sec );
$min = sprintf( "%02d", $min );
$hour = sprintf( "%02d", $hour );
$mon = sprintf( "%02d", $mon );
$mday = sprintf( "%02d", $mday );
my $timestamp =
"$year" . "-" . "$mon" . "-" . "$mday" . "-" . "$hour" . "-" . "$min";
return $timestamp;
}
####################################################### TIMESTAMP #######
true;
Upvotes: 1
Views: 233
Reputation: 137
I tested your code and in the directory where my perl file is, it generated a new jpeg file.
I can suggest checking if your file and directory have the needed permissions for writing new files.
P.S. I am using FreeBSD 13
Upvotes: 2