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

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

Jeffrey's new parsing modifications, committed approx 6 July, 15.16

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