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

Last change on this file since 7243 was 6408, checked in by jmt12, 20 years ago

Added two new attributes for script arguments. HiddenGLI controls whether the argument will be visible at all in GLI, while ModeGLI defines the lowest detail mode under which the argument will be visible (only really for import and buildcol). Also ensured that the scripts were reporting their correct default process expressions, and further refined argument types by adding the catagory regexp for any regular expression (which can then be hidden under lower detail modes in GLI)

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