I am trying to get the Apache::Magick module from the O'Reilly book
"Writing Apache Modules with Perl and C" to work. The error I am
running into is:
Can't locate object method "OPEN" via package "Apache" (line 80)
The looks real simply:
open(STDOUT, "=" . fileno($fh));
Any thoughts on what is going wrong?
Sam
P.S. The whole Apache::Magick is attached, in case you want to look at
it.
package Apache::Magick;
use strict;
use Apache::Constants qw(:common);
use Image::Magick ();
use Apache::File ();
use File::Basename qw(fileparse);
use DirHandle ();
my %LegalArguments = map { $_ = 1 }
qw (adjoin background bordercolor colormap colorspace
colors compress density dispose delay dither
display font format iterations interlace
loop magick mattecolor monochrome page pointsize
preview_type quality scene subimage subrange
size tile texture treedepth undercolor);
my %LegalFilters = map { $_ = 1 }
qw(AddNoise Blur Border Charcoal Chop
Contrast Crop Colorize Comment CycleColormap
Despeckle Draw Edge Emboss Enhance Equalize Flip Flop
Frame Gamma Implode Label Layer Magnify Map Minify
Modulate Negate Normalize OilPaint Opaque Quantize
Raise ReduceNoise Rotate Sample Scale Segment Shade
Sharpen Shear Solarize Spread Swirl Texture Transparent
Threshold Trim Wave Zoom);
sub handler {
my $r = shift;
# get the name of the requested file
my $file = $r-filename;
# If the file exists and there are no transformation arguments
# just decline the transaction. It will be handled as usual.
return DECLINED unless $r-args || $r-path_info || !-r $r-finfo;
my $source;
my ($base, $directory, $extension) = fileparse($file, '\.\w+');
if (-r $r-finfo) { # file exists, so it becomes the source
$source = $file;
}
else { # file doesn't exist, so we search for it
return DECLINED unless -r $directory;
$source = find_image($r, $directory, $base);
}
unless ($source) {
$r-log_error("Couldn't find a replacement for $file");
return NOT_FOUND;
}
$r-send_http_header;
return OK if $r-header_only;
# Read the image
my $q = Image::Magick-new;
my $err = $q-Read($source);
# Conversion arguments are kept in the query string, and the
# image filter operations are kept in the path info
my(%arguments) = $r-args;
# Run the filters
foreach (split '/', $r-path_info) {
my $filter = ucfirst $_;
next unless $LegalFilters{$filter};
$err ||= $q-$filter(%arguments);
}
# Remove invalid arguments before the conversion
foreach (keys %arguments) {
delete $arguments{$_} unless $LegalArguments{$_};
}
# Create a temporary file name to use for conversion
my($tmpnam, $fh) = Apache::File-tmpfile;
# Write out the modified image
open(STDOUT, "=" . fileno($fh));
$extension =~ s/^\.//;
$err ||= $q-Write('filename' = "\U$extension\L:-", %arguments);
if ($err) {
unlink $tmpnam;
$r-log_error($err);
return SERVER_ERROR;
}
close $fh;
# At this point the conversion is all done!
# reopen for reading
$fh = Apache::File-new($tmpnam);
unless ($fh) {
$r-log_error("Couldn't open $tmpnam: $!");
return SERVER_ERROR;
}
# send the file
$r-send_fd($fh);
# clean up and go
unlink $tmpnam;
return OK;
}
sub find_image {
my ($r, $directory, $base) = @_;
my $dh = DirHandle-new($directory) or return;
my $source;
for my $entry ($dh-read) {
my $candidate = fileparse($entry, '\.\w+');
if ($base eq $candidate) {
# determine whether this is an image file
$source = join '', $directory, $entry;
my $subr = $r-lookup_file($source);
last if $subr-content_type =~ m:^image/:;
$source = "";
}
}
$dh-close;
return $source;
}
1;
__END__
