Image::Magick - size limitation?
From: Sergei Shelukhin (raven_at_at_home.domonet.ru)
Date: 07/19/04
- Next message: Joe Smith: "Re: bytes.pm problem"
- Previous message: Sergei Shelukhin: "Re: bytes.pm problem"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Date: Mon, 19 Jul 2004 08:15:23 +0400
I am using the following script to manage image database. I understand it is
primitive, but it's ok for me for this case.
Don't mind Common:: stuff - Common::trim trims a line, Common::connect
connects to local MyySQL database, Common::isLoggedIn checks if the cookie
is valid and thus checks the access.
You are free to comment on ugly code if you so desire (I'd appreciate that
but that's not the important part atm ;)), but the problem is as follows.
Some images get corrupted. It doesn't seem to be POST data size limit cause
thumbnails actually come out right, e.g. everything gets uploaded normally.
Bigger images, on the other hand, get cut, so, the upper part of the image
is ok, and lower part from some point down consists of transparent or white
space (depends on the format).
Is it Image::Magick bug (I am using one of the early versions), or is it
MySQL blob database field size limitation? In any case, how do I correct
this, without switching to images stored on disk, and is it possible at all?
;)
#!/usr/bin/perl
use strict;
use DBI;
use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;
use lib qw(/usr/local/apache/lib/perl);
use common;
use Image::Magick;
my $db;
my %names;
############################################################################
###############
sub display_image
{
my ($id, $show_thumbnail) = @_;
my $col_name = (defined ($show_thumbnail) ? "Thumb" : "Pic");
my ($mime_type, $data);
($mime_type, $data) = $db->selectrow_array ("SELECT mime_type, $col_name
FROM Picture WHERE PictureId = ?",undef, $id);
croak "Cannot find image $id" unless defined ($mime_type);
print header (-type => $mime_type, -Content_Length => length ($data)),$data;
}
############################################################################
###############
sub display_gallery
{
print '<table cellpadding="5" cellspacing="0" border="1" style="text-align:
center;"><tr><td width="100">Thumbnail</td><td width="75">ID</td><td
width="200">Alias</td><td> </td></tr>';
my $query = $db->prepare ("SELECT * FROM Picture ORDER BY PictureId");
$query->execute ();
while ( my $row = $query->fetchrow_hashref() )
{
print "<tr><td><a href=\"pict.pl?id=$$row{PictureId}\"><img
src=\"pict.pl?id=$$row{PictureId}&t=1\" alt=\"click to
enlarge\"></a></td><td>$$row{PictureId}</td><td>$$row{Alias}</td><td><form
action=\"pict.pl\" method=\"POST\"><input type=\"hidden\" name=\"delid\"
value=\"$$row{PictureId}\"><input type=\"submit\" name=\"delete\"
value=\"Delete\"></form></td></tr>";
}
print '</table><br /><p>Upload new picture:</p><FORM ACTION="pict.pl"
ENCTYPE="multipart/form-data" METHOD="POST"><p>Alias: <INPUT TYPE="text"
NAME="alias">; force width: <INPUT TYPE="text" size="5" maxlength="3"
NAME="fw">; force height: <INPUT TYPE="text" size="5" maxlength="3"
NAME="fh">;<br /> thumbnail width: <INPUT TYPE="text" size="5" maxlength="3"
NAME="tw">; thumbnail height: <INPUT TYPE="text" size="5" maxlength="3"
NAME="th">; file: <INPUT TYPE="file" NAME="img"> <INPUT TYPE="submit"
Name="upload" VALUE="Upload"></p></FORM></body></html>';
$query->finish ();
}
############################################################################
###############
sub delete_picture
{
my ($delid) = @_;
if ( defined $delid )
{
$db->do("DELETE FROM Picture WHERE PictureId = ?",undef,$delid);
}
}
############################################################################
###############
sub process_form
{
my ($name,$image,$fwidth,$fheight,$twidth,$theight) =
($names{"alias"},$names{"img"},$names{"fw"},$names{"fh"},$names{"tw"},$names
{"th"});
my @errors = ();
$image = "" unless defined ($image);
$name = Common::trim ($name);
push (@errors, "Alias cannot be empty") if $name eq "";
push (@errors, "Please upload some image") if $image eq "";
for my $error (@errors)
{
print "<p>$error</p>";
}
return if ($#errors >= 0);
if (my ($row) = $db->selectrow_array("SELECT Alias FROM Picture WHERE Alias
= ?",undef,$name ) )
{
print "<p>Picture with this alias already exists</p>";
return;
}
my $mime_type = uploadInfo ($image)->{'Content-Type'};
my ($full, $thumb) = read_image_file
($image,$fwidth,$fheight,$twidth,$theight);
$db->do ("INSERT INTO Picture (Alias,Pic,Thumb,mime_type)
VALUES(?,?,?,?)",undef,$name,$full,$thumb,$mime_type);
}
############################################################################
###############
sub read_image_file
{
my ($fh, $fwidth, $fheight, $twidth, $theight) = @_;
my $img = new Image::Magick;
my $full;
my $err;
$fwidth = (($fwidth > 1024)?1024:$fwidth) if defined $fwidth;
$fheight = (($fheight > 1024)?1024:$fheight) if defined $fheight;
$twidth = 100 if (!defined $twidth or !$twidth);
$theight = 100 if (!defined $theight or !$theight);
#print $twidth."x".$theight;
(read ($fh, $full, -s $fh) == -s $fh) or croak "Can't read image file";
$err = $img->BlobToImage ($full);
croak "Can't convert image data: $err" if $err;
if ( defined $fwidth && defined $fheight )
{
$err = $img->Scale (width => $fwidth, height => $fheight);
croak "Can't convert image data: $err" if $err;
}
$full = $img->ImageToBlob ();
$err = $img->Scale (geometry => "$twidth"."x"."$theight");
croak "Can't scale image file: $err" if $err;
my $thumb = $img->ImageToBlob ();
return ($full, $thumb);
}
############################################################################
###############
$db = Common::connect ();
my @pnames = param();
%names = {};
foreach my $name (@pnames)
{
$names{$name} = param($name);
}
my $cookie = cookie("RTJ-master-session");
if ( !defined $names{id} )
{
die "You are not authorized to view this page" unless (
Common::isLoggedIn($cookie,$db) );
print header ();
print "<html><head><title>Available Images</title></head><body>";
# print "cookie: $cookie";
process_form() if defined $names{upload};
delete_picture($names{delid}) if defined $names{delete};
display_gallery();
}
else
{
display_image($names{id},$names{t});
}
$db->disconnect ();
- Next message: Joe Smith: "Re: bytes.pm problem"
- Previous message: Sergei Shelukhin: "Re: bytes.pm problem"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Relevant Pages
|
|
