source: documented-example-collections/trunk/gsarch-e/index/assoc/45AF2323.dir/ImagePlug.pm@ 18738

Last change on this file since 18738 was 18738, checked in by oranfry, 15 years ago

the rest of the documented example collections

  • Property svn:executable set to *
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
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 = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
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
108 return bless $self, $class;
109}
110
111sub get_default_process_exp {
112 my $self = shift (@_);
113
114 return q^(?i)(\\.jpe?g|\\.gif|\\.png|\\.bmp|\\.xbm|\\.tif?f)$^;
115}
116
117# this makes no sense for images
118sub block_cover_image
119{
120 my $self =shift (@_);
121 my ($filename) = @_;
122
123 return;
124}
125# Create the thumbnail and screenview images, and discover the Image's
126# size, width, and height using the convert utility.
127
128sub run_convert {
129 my $self = shift (@_);
130 my $filename = shift (@_); # filename with full path
131 my $file = shift (@_); # filename without path
132 my $doc_obj = shift (@_);
133 my $section = $doc_obj->get_top_section();
134
135 my $verbosity = $self->{'verbosity'};
136 my $outhandle = $self->{'outhandle'};
137
138 # check the filename is okay
139 return 0 if ($file eq "" || $filename eq "");
140
141# Code now extended to quote filenames in 'convert' commnads
142# Allows spaces in filenames, but note needs spaces to be escaped in URL as well
143# if ($filename =~ m/ /) {
144# print $outhandle "ImagePlug: \\"$filename\\" contains a space. choking.\\n";
145# return undef;
146# }
147
148 my $minimumsize = $self->{'minimumsize'};
149 if (defined $minimumsize && (-s $filename < $minimumsize)) {
150 print $outhandle "ImagePlug: \\"$filename\\" too small, skipping\\n"
151 if ($verbosity > 1);
152 }
153
154
155 # Convert the image to a new type (if required).
156 my $converttotype = $self->{'converttotype'};
157 my $originalfilename = ""; # only set if we do a conversion
158 my $type = "unknown";
159
160 if ($converttotype ne "" && $filename !~ m/$converttotype$/) {
161 $originalfilename = $filename;
162 $filename = &util::get_tmp_filename() . ".$converttotype";
163 $self->{'tmp_filename'} = $filename;
164
165 my $command = "convert -interlace plane -verbose \\"$originalfilename\\" \\"$filename\\"";
166 print $outhandle "$command\\n" if ($verbosity > 2);
167 my $result = '';
168 $result = `$command`;
169 print $outhandle "RESULT = $result\\n" if ($verbosity > 2);
170
171 $type = $converttotype;
172 $file =~ s/\\..*$/\\.$type/;
173 }
174
175
176 # Add the image metadata
177 my $url = $file;
178
179 ##not know why it is required at the first place, it seems all works fine without it, so I comment it out
180 ##$url =~ s/ /%20/g;
181
182 $doc_obj->add_metadata ($section, "Image", $url);
183
184 # Also want to set filename as 'Source' metadata to be
185 # consistent with other plugins
186 $doc_obj->add_metadata ($section, "Source", $url);
187
188 my ($image_type, $image_width, $image_height, $image_size)
189 = &identify($filename, $outhandle, $verbosity);
190
191 if ($image_type ne " ") {
192 $type = $image_type;
193 }
194
195 $doc_obj->add_metadata ($section, "FileFormat", $type);
196 $doc_obj->add_metadata ($section, "FileSize", $image_size);
197
198 $doc_obj->add_metadata ($section, "ImageType", $image_type);
199 $doc_obj->add_metadata ($section, "ImageWidth", $image_width);
200 $doc_obj->add_metadata ($section, "ImageHeight", $image_height);
201 $doc_obj->add_metadata ($section, "ImageSize", $image_size);
202
203 $doc_obj->add_metadata ($section, "srclink",
204 "<a href=\\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\\">");
205 $doc_obj->add_metadata ($section, "/srclink", "</a>");
206
207 $doc_obj->add_metadata ($section, "srcicon", "<img src=\\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\\" width=100>");
208
209
210 # Add the image as an associated file
211 $doc_obj->associate_file($filename,$file,"image/$type",$section);
212
213
214 # Make the thumbnail image
215 my $thumbnailsize = $self->{'thumbnailsize'} || 100;
216 my $thumbnailtype = $self->{'thumbnailtype'} || 'gif';
217
218 my $thumbnailfile = &util::get_tmp_filename() . ".$thumbnailtype";
219 $self->{'tmp_filename2'} = $thumbnailfile;
220
221 # Generate the thumbnail with convert
222 my $command = "convert -interlace plane -verbose -geometry $thumbnailsize"
223 . "x$thumbnailsize \\"$filename\\" \\"$thumbnailfile\\"";
224 print $outhandle "THUMBNAIL: $command\\n" if ($verbosity > 2);
225 my $result = '';
226 $result = `$command 2>&1` ;
227 print $outhandle "THUMB RESULT: $result\\n" if ($verbosity > 2);
228
229 # Add the thumbnail as an associated file ...
230 if (-e "$thumbnailfile") {
231 $doc_obj->associate_file("$thumbnailfile", "thumbnail.$thumbnailtype",
232 "image/$thumbnailtype",$section);
233 $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
234 $doc_obj->add_metadata ($section, "Thumb", "thumbnail.$thumbnailtype");
235
236 $doc_obj->add_metadata ($section, "thumbicon", "<img src=\\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Thumb]\\" width=[ThumbWidth] height=[ThumbHeight]>");
237 }
238
239 # Extract Thumnail metadata from convert output
240 if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
241 $doc_obj->add_metadata ($section, "ThumbWidth", $1);
242 $doc_obj->add_metadata ($section, "ThumbHeight", $2);
243 }
244
245 # Make a screen-sized version of the picture if requested
246 if ($self->{'screenviewsize'}) {
247
248 # To do: if the actual image smaller than the screenview size,
249 # we should use the original !
250
251 my $screenviewsize = $self->{'screenviewsize'};
252 my $screenviewtype = $self->{'screenviewtype'} || 'jpeg';
253 my $screenviewfilename = &util::get_tmp_filename() . ".$screenviewtype";
254 $self->{'tmp_filename3'} = $screenviewfilename;
255
256 # make the screenview image
257 my $command = "convert -interlace plane -verbose -geometry $screenviewsize"
258 . "x$screenviewsize \\"$filename\\" \\"$screenviewfilename\\"";
259 print $outhandle "$command\\n" if ($verbosity > 2);
260 my $result = "";
261 $result = `$command 2>&1` ;
262 print $outhandle "$result\\n" if ($verbosity > 3);
263
264 # get screenview dimensions, size and type
265 if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
266 $doc_obj->add_metadata ($section, "ScreenWidth", $1);
267 $doc_obj->add_metadata ($section, "ScreenHeight", $2);
268 }
269 else {
270 $doc_obj->add_metadata ($section, "ScreenWidth", $image_width);
271 $doc_obj->add_metadata ($section, "ScreenHeight", $image_height);
272 }
273
274 #add the screenview as an associated file ...
275 if (-e "$screenviewfilename") {
276 $doc_obj->associate_file("$screenviewfilename", "screenview.$screenviewtype",
277 "image/$screenviewtype",$section);
278 $doc_obj->add_metadata ($section, "ScreenType", $screenviewtype);
279 $doc_obj->add_metadata ($section, "Screen", "screenview.$screenviewtype");
280
281 $doc_obj->add_metadata ($section, "screenicon", "<img src=\\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Screen]\\" width=[ScreenWidth] height=[ScreenHeight]>");
282 } else {
283 print $outhandle "ImagePlug: couldn't find \\"$screenviewfilename\\"\\n";
284 }
285 }
286
287 return $type;
288
289
290}
291
292
293
294# Discover the characteristics of an image file with the ImageMagick
295# "identify" command.
296
297sub identify {
298 my ($image, $outhandle, $verbosity) = @_;
299
300 # Use the ImageMagick "identify" command to get the file specs
301 my $command = "identify \\"$image\\" 2>&1";
302 print $outhandle "$command\\n" if ($verbosity > 2);
303 my $result = '';
304 $result = `$command`;
305 print $outhandle "$result\\n" if ($verbosity > 3);
306
307 # Read the type, width, and height
308 my $type = 'unknown';
309 my $width = 'unknown';
310 my $height = 'unknown';
311
312 my $image_safe = quotemeta $image;
313 if ($result =~ /^$image_safe (\\w+) (\\d+)x(\\d+)/) {
314 $type = $1;
315 $width = $2;
316 $height = $3;
317 }
318
319 # Read the size
320 my $size = "unknown";
321 if ($result =~ m/^.* ([0-9]+)b/) {
322 $size = $1;
323 }
324 elsif ($result =~ m/^.* ([0-9]+)(\\.([0-9]+))?kb?/) {
325 $size = 1024 * $1;
326 if (defined($2)) {
327 $size = $size + (1024 * $2);
328 # Truncate size (it isn't going to be very accurate anyway)
329 $size = int($size);
330 }
331 }
332
333 print $outhandle "file: $image:\\t $type, $width, $height, $size\\n"
334 if ($verbosity > 2);
335
336 # Return the specs
337 return ($type, $width, $height, $size);
338}
339
340
341# The ImagePlug read() function.
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 #check process and block exps, smart block, etc
356 my ($block_status,$filename) = $self->read_block(@_);
357 return $block_status if ((!defined $block_status) || ($block_status==0));
358
359 print STDERR "<Processing n='$file' p='ImagePlug'>\\n" if ($gli);
360 print $outhandle "ImagePlug processing $file\\n"
361 if $self->{'verbosity'} > 1;
362
363 # None of this works very well on Windows 95/98...
364 if ($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT()) {
365 if ($gli) {
366 print STDERR "<ProcessingError n='$file' r='Windows 95/98 not supported'>\\n";
367 }
368 print $outhandle "ImagePlug: Windows 95/98 not supported\\n";
369 return -1;
370 }
371
372 # None of this is going to work very well without ImageMagick...
373 if ($self->{'imagemagick_not_installed'}) {
374 if ($gli) {
375 print STDERR "<ProcessingError n='$file' r='ImageMagick not installed'>\\n";
376 }
377 print $outhandle "ImagePlug: ImageMagick not installed\\n";
378 return -1;
379 }
380
381 #if there's a leading directory name, eat it...
382 $file =~ s/^.*[\\/\\\\]//;
383
384 # create a new document
385 my $doc_obj = new doc ($filename, "indexed_doc");
386 $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
387 $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
388
389 #run convert to get the thumbnail and extract size and type info
390 my $result = run_convert($self, $filename, $file, $doc_obj);
391
392 if (!defined $result)
393 {
394 if ($gli) {
395 print STDERR "<ProcessingError n='$file'>\\n";
396 }
397 print $outhandle "ImagePlug: couldn't process \\"$filename\\"\\n";
398 return -1; # error during processing
399 }
400
401
402 #create an empty text string so we don't break downstream plugins
403 my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
404
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_utf8_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
437 if (defined $self->{'tmp_filename2'} &&
438 -e $self->{'tmp_filename2'}) {
439 &util::rm($self->{'tmp_filename2'})
440 }
441 if (defined $self->{'tmp_filename3'} &&
442 -e $self->{'tmp_filename3'}) {
443 &util::rm($self->{'tmp_filename3'})
444 }
445
446 $self->{'num_processed'}++;
447
448 return 1;
449}
450
451# do plugin specific processing of doc_obj
452sub process {
453 my $self = shift (@_);
454 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
455 my $outhandle = $self->{'outhandle'};
456
457 return 1;
458}
459
4601;
461
462
463
464
465
466
467
468
469
470
471
Note: See TracBrowser for help on using the repository browser.