source: trunk/gsdl/perllib/plugins/ImagePlug.pm@ 10606

Last change on this file since 10606 was 10254, checked in by kjdon, 19 years ago

added 'use strict' to all plugins, and made modifications (mostly adding 'my') to make them compile

  • Property svn:keywords set to Author Date Id Revision
File size: 14.8 KB
Line 
1###########################################################################
2#
3# ImagePlug.pm -- simple text plugin
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package ImagePlug;
27
28use BasPlug;
29
30use strict;
31no strict 'refs'; # allow filehandles to be variables and viceversa
32
33sub BEGIN {
34 @ImagePlug::ISA = ('BasPlug');
35}
36
37my $arguments =
38 [ { 'name' => "process_exp",
39 'desc' => "{BasPlug.process_exp}",
40 'type' => "regexp",
41 'deft' => &get_default_process_exp(),
42 'reqd' => "no" },
43 { 'name' => "noscaleup",
44 'desc' => "{ImagePlug.noscaleup}",
45 'type' => "flag",
46 'reqd' => "no" },
47 { 'name' => "thumbnailsize",
48 'desc' => "{ImagePlug.thumbnailsize}",
49 'type' => "int",
50 'deft' => "100",
51 'range' => "1,",
52 'reqd' => "no" },
53 { 'name' => "thumbnailtype",
54 'desc' => "{ImagePlug.thumbnailtype}",
55 'type' => "string",
56 'deft' => "gif",
57 'reqd' => "no" },
58 { 'name' => "screenviewsize",
59 'desc' => "{ImagePlug.screenviewsize}",
60 'type' => "int",
61 'deft' => "0",
62 'range' => "1,",
63 'reqd' => "no" },
64 { 'name' => "screenviewtype",
65 'desc' => "{ImagePlug.screenviewtype}",
66 'type' => "string",
67 'deft' => "jpg",
68 'reqd' => "no" },
69 { 'name' => "converttotype",
70 'desc' => "{ImagePlug.converttotype}",
71 'type' => "string",
72 'deft' => "",
73 'reqd' => "no" },
74 { 'name' => "minimumsize",
75 'desc' => "{ImagePlug.minimumsize}",
76 'type' => "int",
77 'deft' => "100",
78 'range' => "1,",
79 'reqd' => "no" } ];
80
81my $options = { 'name' => "ImagePlug",
82 'desc' => "{ImagePlug.desc}",
83 'abstract' => "no",
84 'inherits' => "yes",
85 'args' => $arguments };
86
87
88
89sub new {
90 my ($class) = shift (@_);
91 my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
92 push(@$pluginlist, $class);
93
94 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
95 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
96
97 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs);
98
99 # Check that ImageMagick is installed and available on the path (except for Windows 95/98)
100 if (!($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT())) {
101 my $result = `identify 2>&1`;
102 if ($? == -1 || $? == 256) { # Linux and Windows return different values for "program not found"
103 $self->{'imagemagick_not_installed'} = 1;
104 }
105 }
106
107 return bless $self, $class;
108}
109
110sub get_default_process_exp {
111 my $self = shift (@_);
112
113 return q^(?i)(\.jpe?g|\.gif|\.png|\.bmp|\.xbm|\.tif?f)$^;
114}
115
116# this makes no sense for images
117sub block_cover_image
118{
119 my $self =shift (@_);
120 my ($filename) = @_;
121
122 return;
123}
124# Create the thumbnail and screenview images, and discover the Image's
125# size, width, and height using the convert utility.
126
127sub run_convert {
128 my $self = shift (@_);
129 my $filename = shift (@_); # filename with full path
130 my $file = shift (@_); # filename without path
131 my $doc_obj = shift (@_);
132 my $section = $doc_obj->get_top_section();
133
134 my $verbosity = $self->{'verbosity'};
135 my $outhandle = $self->{'outhandle'};
136
137 # check the filename is okay
138 return 0 if ($file eq "" || $filename eq "");
139
140# Code now extended to quote filenames in 'convert' commnads
141# Allows spaces in filenames, but note needs spaces to be escaped in URL as well
142# if ($filename =~ m/ /) {
143# print $outhandle "ImagePlug: \"$filename\" contains a space. choking.\n";
144# return undef;
145# }
146
147 my $minimumsize = $self->{'minimumsize'};
148 if (defined $minimumsize && (-s $filename < $minimumsize)) {
149 print $outhandle "ImagePlug: \"$filename\" too small, skipping\n"
150 if ($verbosity > 1);
151 }
152
153
154 # Convert the image to a new type (if required).
155 my $converttotype = $self->{'converttotype'};
156 my $originalfilename = ""; # only set if we do a conversion
157 my $type = "unknown";
158
159
160 if ($converttotype ne "" && $filename =~ m/$converttotype$/) {
161
162 $originalfilename = $filename;
163 $filename = &util::get_tmp_filename() . ".$converttotype";
164 $self->{'tmp_filename'} = $filename;
165
166 my $command = "convert -interlace plane -verbose \"$originalfilename\" \"$filename\"";
167 print $outhandle "$command\n" if ($verbosity > 2);
168 my $result = '';
169 $result = `$command`;
170 print $outhandle "RESULT = $result\n" if ($verbosity > 2);
171
172 $type = $converttotype;
173 }
174
175
176 # Add the image metadata
177 my $url = $file;
178 $url =~ s/ /%20/g;
179
180 $doc_obj->add_metadata ($section, "Image", $url);
181
182 # Also want to set filename as 'Source' metadata to be
183 # consistent with other plugins
184 $doc_obj->add_metadata ($section, "Source", $url);
185
186 my ($image_type, $image_width, $image_height, $image_size)
187 = &identify($filename, $outhandle, $verbosity);
188
189 if ($image_type ne " ") {
190 $type = $image_type;
191 }
192
193 $doc_obj->add_metadata ($section, "FileFormat", $type);
194 $doc_obj->add_metadata ($section, "FileSize", $image_size);
195
196 $doc_obj->add_metadata ($section, "ImageType", $image_type);
197 $doc_obj->add_metadata ($section, "ImageWidth", $image_width);
198 $doc_obj->add_metadata ($section, "ImageHeight", $image_height);
199 $doc_obj->add_metadata ($section, "ImageSize", $image_size);
200
201 $doc_obj->add_metadata ($section, "srclink",
202 "<a href=\"_httpcollection_/index/assoc/[assocfilepath]/[Image]\">");
203 $doc_obj->add_metadata ($section, "/srclink", "</a>");
204
205 $doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpcollection_/index/assoc/[assocfilepath]/[Image]\" width=100>");
206
207
208 # Add the image as an associated file
209 $doc_obj->associate_file($filename,$file,"image/$type",$section);
210
211
212 # Make the thumbnail image
213 my $thumbnailsize = $self->{'thumbnailsize'} || 100;
214 my $thumbnailtype = $self->{'thumbnailtype'} || 'gif';
215
216 my $thumbnailfile = &util::get_tmp_filename() . ".$thumbnailtype";
217 $self->{'tmp_filename2'} = $thumbnailfile;
218
219 # Generate the thumbnail with convert
220 my $command = "convert -interlace plane -verbose -geometry $thumbnailsize"
221 . "x$thumbnailsize \"$filename\" \"$thumbnailfile\"";
222 print $outhandle "THUMBNAIL: $command\n" if ($verbosity > 2);
223 my $result = '';
224 $result = `$command 2>&1` ;
225 print $outhandle "THUMB RESULT: $result\n" if ($verbosity > 2);
226
227 # Add the thumbnail as an associated file ...
228 if (-e "$thumbnailfile") {
229 $doc_obj->associate_file("$thumbnailfile", "thumbnail.$thumbnailtype",
230 "image/$thumbnailtype",$section);
231 $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
232 $doc_obj->add_metadata ($section, "Thumb", "thumbnail.$thumbnailtype");
233
234 $doc_obj->add_metadata ($section, "thumbicon", "<img src=\"_httpcollection_/index/assoc/[assocfilepath]/[Thumb]\" width=[ThumbWidth] height=[ThumbHeight]>");
235 }
236
237 # Extract Thumnail metadata from convert output
238 if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
239 $doc_obj->add_metadata ($section, "ThumbWidth", $1);
240 $doc_obj->add_metadata ($section, "ThumbHeight", $2);
241 }
242
243 # Make a screen-sized version of the picture if requested
244 if ($self->{'screenviewsize'}) {
245
246 # To do: if the actual image smaller than the screenview size,
247 # we should use the original !
248
249 my $screenviewsize = $self->{'screenviewsize'};
250 my $screenviewtype = $self->{'screenviewtype'} || 'jpeg';
251 my $screenviewfilename = &util::get_tmp_filename() . ".$screenviewtype";
252 $self->{'tmp_filename3'} = $screenviewfilename;
253
254 # make the screenview image
255 my $command = "convert -interlace plane -verbose -geometry $screenviewsize"
256 . "x$screenviewsize \"$filename\" \"$screenviewfilename\"";
257 print $outhandle "$command\n" if ($verbosity > 2);
258 my $result = "";
259 $result = `$command 2>&1` ;
260 print $outhandle "$result\n" if ($verbosity > 3);
261
262 # get screenview dimensions, size and type
263 if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
264 $doc_obj->add_metadata ($section, "ScreenWidth", $1);
265 $doc_obj->add_metadata ($section, "ScreenHeight", $2);
266 }
267 else {
268 $doc_obj->add_metadata ($section, "ScreenWidth", $image_width);
269 $doc_obj->add_metadata ($section, "ScreenHeight", $image_height);
270 }
271
272 #add the screenview as an associated file ...
273 if (-e "$screenviewfilename") {
274 $doc_obj->associate_file("$screenviewfilename", "screenview.$screenviewtype",
275 "image/$screenviewtype",$section);
276 $doc_obj->add_metadata ($section, "ScreenType", $screenviewtype);
277 $doc_obj->add_metadata ($section, "Screen", "screenview.$screenviewtype");
278
279 $doc_obj->add_metadata ($section, "screenicon", "<img src=\"_httpcollection_/index/assoc/[assocfilepath]/[Screen]\" width=[ScreenWidth] height=[ScreenHeight]>");
280 } else {
281 print $outhandle "ImagePlug: couldn't find \"$screenviewfilename\"\n";
282 }
283 }
284
285 return $type;
286
287
288}
289
290
291
292# Discover the characteristics of an image file with the ImageMagick
293# "identify" command.
294
295sub identify {
296 my ($image, $outhandle, $verbosity) = @_;
297
298 # Use the ImageMagick "identify" command to get the file specs
299 my $command = "identify \"$image\" 2>&1";
300 print $outhandle "$command\n" if ($verbosity > 2);
301 my $result = '';
302 $result = `$command`;
303 print $outhandle "$result\n" if ($verbosity > 3);
304
305 # Read the type, width, and height
306 my $type = 'unknown';
307 my $width = 'unknown';
308 my $height = 'unknown';
309
310 my $image_safe = quotemeta $image;
311 if ($result =~ /^$image_safe (\w+) (\d+)x(\d+)/) {
312 $type = $1;
313 $width = $2;
314 $height = $3;
315 }
316
317 # Read the size
318 my $size = "unknown";
319 if ($result =~ m/^.* ([0-9]+)b/) {
320 $size = $1;
321 }
322 elsif ($result =~ m/^.* ([0-9]+)(\.([0-9]+))?kb?/) {
323 $size = 1024 * $1;
324 if (defined($2)) {
325 $size = $size + (1024 * $2);
326 # Truncate size (it isn't going to be very accurate anyway)
327 $size = int($size);
328 }
329 }
330
331 print $outhandle "file: $image:\t $type, $width, $height, $size\n"
332 if ($verbosity > 2);
333
334 # Return the specs
335 return ($type, $width, $height, $size);
336}
337
338
339# The ImagePlug read() function. This function does all the right things
340# to make general options work for a given plugin. It calls the process()
341# function which does all the work specific to a plugin (like the old
342# read functions used to do). Most plugins should define their own
343# process() function and let this read() function keep control.
344#
345# ImagePlug overrides read() because there is no need to read the actual
346# text of the file in, because the contents of the file is not text...
347#
348# Return number of files processed, undef if can't process
349# Note that $base_dir might be "" and that $file might
350# include directories
351
352sub read {
353 my $self = shift (@_);
354 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
355
356 my $outhandle = $self->{'outhandle'};
357
358 my $filename = &util::filename_cat($base_dir, $file);
359 return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
360 if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
361 return undef;
362 }
363
364 print STDERR "<Processing n='$file' p='ImagePlug'>\n" if ($gli);
365 print $outhandle "ImagePlug processing $file\n"
366 if $self->{'verbosity'} > 1;
367
368 # None of this works very well on Windows 95/98...
369 if ($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT()) {
370 if ($gli) {
371 print STDERR "<ProcessingError n='$file' r='Windows 95/98 not supported'>\n";
372 }
373 print $outhandle "ImagePlug: Windows 95/98 not supported\n";
374 return -1;
375 }
376
377 # None of this is going to work very well without ImageMagick...
378 if ($self->{'imagemagick_not_installed'}) {
379 if ($gli) {
380 print STDERR "<ProcessingError n='$file' r='ImageMagick not installed'>\n";
381 }
382 print $outhandle "ImagePlug: ImageMagick not installed\n";
383 return -1;
384 }
385
386 #if there's a leading directory name, eat it...
387 $file =~ s/^.*[\/\\]//;
388
389 # create a new document
390 my $doc_obj = new doc ($filename, "indexed_doc");
391 $doc_obj->set_OIDtype ($processor->{'OIDtype'});
392 $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
393
394 #run convert to get the thumbnail and extract size and type info
395 my $result = run_convert($self, $filename, $file, $doc_obj);
396
397 if (!defined $result)
398 {
399 if ($gli) {
400 print STDERR "<ProcessingError n='$file'>\n";
401 }
402 print $outhandle "ImagePlug: couldn't process \"$filename\"\n";
403 return -1; # error during processing
404 }
405
406 #create an empty text string so we don't break downstream plugins
407 my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}");
408 # include any metadata passed in from previous plugins
409 # note that this metadata is associated with the top level section
410 my $section = $doc_obj->get_top_section();
411 $self->extra_metadata ($doc_obj, $section, $metadata);
412
413 # do plugin specific processing of doc_obj
414 unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
415 print STDERR "<ProcessingError n='$file'>\n" if ($gli);
416 return -1;
417 }
418
419 # do any automatic metadata extraction
420 $self->auto_extract_metadata ($doc_obj);
421
422 # if we haven't found any Title so far, assign one
423 # this was shifted to here from inside read()
424 $self->title_fallback($doc_obj,$section,$file);
425 # add an OID
426 $doc_obj->set_OID();
427 $doc_obj->add_text($section, $text);
428
429 # process the document
430 $processor->process($doc_obj);
431
432 # clean up temporary files - we do this here instead of in
433 # run_convert becuase associated files aren't actually copied
434 # until after process has been run.
435 if (defined $self->{'tmp_filename'} &&
436 -e $self->{'tmp_filename'}) {
437 &util::rm($self->{'tmp_filename'})
438 }
439 if (defined $self->{'tmp_filename2'} &&
440 -e $self->{'tmp_filename2'}) {
441 &util::rm($self->{'tmp_filename2'})
442 }
443 if (defined $self->{'tmp_filename3'} &&
444 -e $self->{'tmp_filename3'}) {
445 &util::rm($self->{'tmp_filename3'})
446 }
447
448 $self->{'num_processed'}++;
449
450 return 1;
451}
452
453# do plugin specific processing of doc_obj
454sub process {
455 my $self = shift (@_);
456 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
457 my $outhandle = $self->{'outhandle'};
458
459 return 1;
460}
461
4621;
463
464
465
466
467
468
469
470
471
472
473
Note: See TracBrowser for help on using the repository browser.