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

Last change on this file since 3590 was 3540, checked in by kjdon, 22 years ago

added John T's changes into CVS - added info to enable retrieval of usage info in xml

  • Property svn:keywords set to Author Date Id Revision
File size: 13.6 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
34
35my $arguments = [ { 'name' => "process_exp",
36 'desc' => "A perl regular expression to match against filenames. Matching filenames will be processed by this plugin. Each plugin has its own default process_exp. e.g HTMLPlug defaults to '(?i)\.html?\$' i.e. all documents ending in .htm or .html (case-insensitive).",
37 'type' => "string",
38 'deft' => q^(?i)(\.jpe?g|\.gif|\.png|\.bmp|\.xbm|\.tif?f)$^,
39 'reqd' => "no" },
40 { 'name' => "noscaleup",
41 'desc' => "Don't scale up small images when making thumbnails.",
42 'type' => "flag",
43 'reqd' => "no" },
44 { 'name' => "thumbnailsize",
45 'desc' => "Make thumbnails of size nxn.",
46 'type' => "int",
47 'reqd' => "no" },
48 { 'name' => "thumbnailtype",
49 'desc' => "Make thumbnails in format 's'.",
50 'type' => "string",
51 'reqd' => "no" },
52 { 'name' => "screenviewsize",
53 'desc' => "If set, makes an image of size n for screen display and sets Screen, ScreenSize, ScreenWidth and ScreenHeight metadata. By default it is not set.",
54 'type' => "int",
55 'reqd' => "no" },
56 { 'name' => "screenviewtype",
57 'desc' => "If -screenviewsize is set, this sets the screen display image type. Defaults to jpg.",
58 'type' => "string",
59 'deft' => "jpg",
60 'reqd' => "no" },
61 { 'name' => "convertto",
62 'desc' => "Convert main image to.",
63 'type' => "string",
64 'reqd' => "no" },
65 { 'name' => "minimumsize",
66 'desc' => "Ignore images smaller than n bytes.",
67 'type' => "int",
68 'reqd' => "no" } ];
69
70my $options = { 'name' => "ImagePlug",
71 'desc' => "",
72 'inherits' => "yes",
73 'args' => $arguments };
74
75
76sub print_usage {
77 my ($plugin_name) = @_;
78
79 print STDERR "
80 usage: plugin ImagePlug [options]
81
82 -noscaleup Don't scale up small images when making thumbnails
83
84 -thumbnailsize n Make thumbnails of size nxn
85
86 -thumbnailtype s Make thumbnails in format 's'
87
88 -screenviewsize n If set, makes an image of size n for screen display
89 and sets Screen, ScreenSize, ScrrenWidth and Screeneight
90 metadata. By default it is not set.
91
92 -screenviewtype s If -screenviewsize is set, this sets the screen display
93 image type. Defaults to jpg.
94
95 -convertto s Convert main inage to (gif|png|jpg)
96
97 -minimumsize n Ignore images smaller than n bytes
98
99"
100}
101
102
103sub new {
104 my ($class) = @_;
105 my $plugin_name = shift (@_);
106 my $self = new BasPlug ("ImagePlug", @_);
107
108 # 14-05-02 To allow for proper inheritance of arguments - John Thompson
109 my $option_list = $self->{'option_list'};
110 push( @{$option_list}, $options );
111
112 if (!parsargv::parse(\@_,
113 q^noscaleup^, \$self->{'noscaleup'},
114 q^converttotype/.*/^, \$self->{'converttotype'},
115 q^minimumsize/[0-9]*/100^, \$self->{'minimumsize'},
116
117 q^thumbnailsize/[0-9]*/100^, \$self->{'thumbnailsize'},
118 q^thumbnailtype/.*/gif^, \$self->{'thumbnailtype'},
119 q^screenviewsize/[0-9]*/0^, \$self->{'screenviewsize'},
120 q^screenviewtype/.*/jpg^, \$self->{'screenviewtype'},
121 "allow_extra_options")) {
122
123 print STDERR "\nImagePlug uses an incorrect option.\n";
124 print STDERR "Check your collect.cfg configuration file.\n";
125 &print_usage($plugin_name);
126 die "\n";
127 }
128
129 return bless $self, $class;
130}
131
132
133sub get_default_process_exp {
134 my $self = shift (@_);
135
136 return q^(?i)(\.jpe?g|\.gif|\.png|\.bmp|\.xbm|\.tif?f)$^;
137}
138
139
140# Create the thumbnail and screenview images, and discover the Image's
141# size, width, and height using the convert utility.
142
143sub run_convert {
144 my $self = shift (@_);
145 my $filename = shift (@_); # filename with full path
146 my $file = shift (@_); # filename without path
147 my $doc_obj = shift (@_);
148 my $section = $doc_obj->get_top_section();
149
150 my $verbosity = $self->{'verbosity'};
151 my $outhandle = $self->{'outhandle'};
152
153 # check the filename is okay
154 return 0 if ($file eq "" || $filename eq "");
155
156# Code now extended to quote filenames in 'convert' commnads
157# Allows spaces in filenames, but note needs spaces to be escaped in URL as well
158# if ($filename =~ m/ /) {
159# print $outhandle "ImagePlug: \"$filename\" contains a space. choking.\n";
160# return undef;
161# }
162
163 my $minimumsize = $self->{'minimumsize'};
164 if (defined $minimumsize && (-s $filename < $minimumsize)) {
165 print $outhandle "ImagePlug: \"$filename\" too small, skipping\n"
166 if ($verbosity > 1);
167 }
168
169 # Convert the image to a new type (if required).
170 my $converttotype = $self->{'converttotype'};
171 my $originalfilename = ""; # only set if we do a conversion
172 my $type = "unknown";
173
174 if ($converttotype ne "" && $filename =~ m/$converttotype$/) {
175
176 $originalfilename = $filename;
177 $filename = &util::get_tmp_filename() . ".$converttotype";
178 $self->{'tmp_filename'} = $filename;
179
180 my $command = "convert -interlace plane -verbose \"$originalfilename\" \"$filename\"";
181 print $outhandle "$command\n" if ($verbosity > 2);
182 my $result = '';
183 $result = `$command`;
184 print $outhandle "$result\n" if ($verbosity > 3);
185
186 $type = $converttotype;
187 }
188
189 # Add the image metadata
190 my $url = $file;
191 $url =~ s/ /%20/g;
192
193 $doc_obj->add_metadata ($section, "Image", $url);
194
195 # Also want to set filename as 'Source' metadata to be
196 # consistent with other plugins
197 $doc_obj->add_metadata ($section, "Source", $url);
198
199 my ($image_type, $image_width, $image_height, $image_size)
200 = &identify($filename, $outhandle, $verbosity);
201
202 $doc_obj->add_metadata ($section, "ImageType", $image_type);
203 $doc_obj->add_metadata ($section, "ImageWidth", $image_width);
204 $doc_obj->add_metadata ($section, "ImageHeight", $image_height);
205 $doc_obj->add_metadata ($section, "ImageSize", $image_size);
206
207 # Add the image as an associated file
208 $doc_obj->associate_file($filename,$file,"image/$type",$section);
209
210 # Make the thumbnail image
211 my $thumbnailsize = $self->{'thumbnailsize'} || 100;
212 my $thumbnailtype = $self->{'thumbnailtype'} || 'gif';
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 "$command\n" if ($verbosity > 2);
220 my $result = '';
221 $result = `$command 2>&1` ;
222 print $outhandle "$result\n" if ($verbosity > 3);
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
232 # Extract Thumnail metadata from convert output
233 if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
234 $doc_obj->add_metadata ($section, "ThumbWidth", $1);
235 $doc_obj->add_metadata ($section, "ThumbHeight", $2);
236 }
237
238 # Make a screen-sized version of the picture if requested
239 if ($self->{'screenviewsize'}) {
240
241 # To do: if the actual image smaller than the screenview size,
242 # we should use the original !
243
244 my $screenviewsize = $self->{'screenviewsize'};
245 my $screenviewtype = $self->{'screenviewtype'} || 'jpeg';
246 my $screenviewfilename = &util::get_tmp_filename() . ".$screenviewtype";
247 $self->{'tmp_filename3'} = $screenviewfilename;
248
249 # make the screenview image
250 my $command = "convert -interlace plane -verbose -geometry $screenviewsize"
251 . "x$screenviewsize \"$filename\" \"$screenviewfilename\"";
252 print $outhandle "$command\n" if ($verbosity > 2);
253 my $result = "";
254 $result = `$command 2>&1` ;
255 print $outhandle "$result\n" if ($verbosity > 3);
256
257 # get screenview dimensions, size and type
258 if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
259 $doc_obj->add_metadata ($section, "ScreenWidth", $1);
260 $doc_obj->add_metadata ($section, "ScreenHeight", $2);
261 }
262
263 #add the screenview as an associated file ...
264 if (-e "$screenviewfilename") {
265 $doc_obj->associate_file("$screenviewfilename", "screenview.$screenviewtype",
266 "image/$screenviewtype",$section);
267 $doc_obj->add_metadata ($section, "ScreenType", $screenviewtype);
268 $doc_obj->add_metadata ($section, "Screen", "screenview.$screenviewtype");
269 } else {
270 print $outhandle "ImagePlug: couldn't find \"$screenviewfilename\"\n";
271 }
272 }
273
274 return $type;
275}
276
277
278# Discover the characteristics of an image file with the ImageMagick
279# "identify" command.
280
281sub identify {
282 my ($image, $outhandle, $verbosity) = @_;
283
284 # Use the ImageMagick "identify" command to get the file specs
285 my $command = "identify $image 2>&1";
286 print $outhandle "$command\n" if ($verbosity > 2);
287 my $result = '';
288 $result = `$command`;
289 print $outhandle "$result\n" if ($verbosity > 3);
290
291 # Read the type, width, and height
292 my $type = 'unknown';
293 my $width = 'unknown';
294 my $height = 'unknown';
295
296 if ($result =~ /^$image (\w+) (\d+)x(\d+)/) {
297 $type = $1;
298 $width = $2;
299 $height = $3;
300 }
301
302 # Read the size
303 my $size = "unknown";
304 if ($result =~ m/^.* ([0-9]+)b/) {
305 $size = $1;
306 } elsif ($result =~ m/^.* ([0-9]+)kb/) {
307 $size = 1024 * $1;
308 }
309
310 print $outhandle "file: $image:\t $type, $width, $height, $size\n"
311 if ($verbosity > 2);
312
313 # Return the specs
314 return ($type, $width, $height, $size);
315}
316
317
318# The ImagePlug read() function. This function does all the right things
319# to make general options work for a given plugin. It calls the process()
320# function which does all the work specific to a plugin (like the old
321# read functions used to do). Most plugins should define their own
322# process() function and let this read() function keep control.
323#
324# ImagePlug overrides read() because there is no need to read the actual
325# text of the file in, because the contents of the file is not text...
326#
327# Return number of files processed, undef if can't process
328# Note that $base_dir might be "" and that $file might
329# include directories
330
331sub read {
332 my $self = shift (@_);
333 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
334
335 my $outhandle = $self->{'outhandle'};
336
337 my $filename = &util::filename_cat($base_dir, $file);
338 return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
339 if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
340 return undef;
341 }
342 print $outhandle "ImagePlug processing \"$filename\"\n"
343 if $self->{'verbosity'} > 1;
344
345 #if there's a leading directory name, eat it...
346 $file =~ s/^.*[\/\\]//;
347
348 # create a new document
349 my $doc_obj = new doc ($filename, "indexed_doc");
350 $doc_obj->set_OIDtype ($processor->{'OIDtype'});
351
352 #run convert to get the thumbnail and extract size and type info
353 my $result = run_convert($self, $filename, $file, $doc_obj);
354
355 if (!defined $result)
356 {
357 print "ImagePlug: couldn't process \"$filename\"\n";
358 return 0;
359 }
360
361 #create an empty text string so we don't break downstream plugins
362 my $text = "Dummy text to sidestep display bug.";
363
364 # include any metadata passed in from previous plugins
365 # note that this metadata is associated with the top level section
366 my $section = $doc_obj->get_top_section();
367 $self->extra_metadata ($doc_obj, $section, $metadata);
368
369 # do plugin specific processing of doc_obj
370 return undef unless defined ($self->process (\$text, $pluginfo, $base_dir,
371 $file, $metadata, $doc_obj));
372
373 # do any automatic metadata extraction
374 $self->auto_extract_metadata ($doc_obj);
375
376 # add an OID
377 $doc_obj->set_OID();
378 $doc_obj->add_text($section, $text);
379
380 # process the document
381 $processor->process($doc_obj);
382
383 # clean up temporary files - we do this here instead of in
384 # run_convert becuase associated files aren't actually copied
385 # until after process has been run.
386 if (defined $self->{'tmp_filename'} &&
387 -e $self->{'tmp_filename'}) {
388 &util::rm($self->{'tmp_filename'})
389 }
390 if (defined $self->{'tmp_filename2'} &&
391 -e $self->{'tmp_filename2'}) {
392 &util::rm($self->{'tmp_filename2'})
393 }
394 if (defined $self->{'tmp_filename3'} &&
395 -e $self->{'tmp_filename3'}) {
396 &util::rm($self->{'tmp_filename3'})
397 }
398
399 $self->{'num_processed'}++;
400
401 return 1;
402}
403
404# do plugin specific processing of doc_obj
405sub process {
406 my $self = shift (@_);
407 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
408 my $outhandle = $self->{'outhandle'};
409
410 return 1;
411}
412
4131;
Note: See TracBrowser for help on using the repository browser.