root/gsdl/trunk/perllib/plugins/ImagePlug.pm @ 15177

Revision 15177, 15.6 KB (checked in by ak19, 12 years ago)

On Linux, image file sizes can be given in the form 3.4e+02kb (3.4 x 1 x 102=340kb). The modifications to ImagePlug?.pm now match this and store the size when given in this form rather than the size defaulting to the unknown string.

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