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

Last change on this file since 1744 was 1744, checked in by say1, 23 years ago

about a billion changes to ImagePlug

  • Property svn:keywords set to Author Date Id Revision
File size: 8.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
34use strict;
35sub print_general_usage {
36 my ($plugin_name) = @_;
37
38 print STDERR "\n usage: plugin $plugin_name [options]\n\n";
39 print STDERR " -noscaleup Don't scale up small images when making thumbnails\n";
40 print STDERR " -thumbnailtype s Make thumbnails in format 's'\n";
41 print STDERR " -thumbnailsize n Make thumbnails of size nxn\n";
42 print STDERR " -convertto s Convert main inage to (gif|png|jpg)\n";
43 print STDERR "\n";
44}
45
46sub new {
47 my ($class) = @_;
48 my $plugin_name = shift (@_);
49 my $self = new BasPlug ("ImagePlug", @_);
50 # general options available to all plugins
51
52 if (!parsargv::parse(\@_,
53 q^noscaleup^, \$self->{'noscaleup'},
54 q^thumbnailtype/.*/gif^, \$self->{'thumbnailtype'},
55 q^converttotype/.*/^, \$self->{'converttotype'},
56 q^thumbnailsize/[0-9]*/100^, \$self->{'thumbnailsize'},
57 "allow_extra_options")) {
58
59 print STDERR "\nThe $plugin_name plugin uses an incorrect general option (general options are those\n";
60 print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
61 &print_general_usage($plugin_name);
62 die "\n";
63 }
64
65 return bless $self, $class;
66}
67
68sub get_default_process_exp {
69 my $self = shift (@_);
70
71 return q^(?i)(\.jpe?g|\.gif|\.png|\.bmp|\.tiff?)$^;
72}
73
74sub run_convert {
75 my $self = shift (@_);
76 my $filename = shift (@_);
77 my $file = shift (@_);
78 my $doc_obj = shift (@_);
79 my $section = $doc_obj->get_top_section();
80
81 if ($file eq "" || $filename eq "") {
82 return "";
83 }
84 if ($filename =~ m/thumbnail/) {
85 return "";
86 }
87 if ($filename =~ m/converted/) {
88 return "";
89 }
90 if ($filename =~ m/\..*\./) {
91 return "";
92 }
93
94 my $thumbSize = $self->{'thumbnailsize'};
95 if ($thumbSize eq "") { $thumbSize = 100; };
96 my $converttotype = $self->{'converttotype'};
97 my $thumbnailtype = $self->{'thumbnailtype'};
98 if ($thumbnailtype eq "") { $thumbnailtype = "gif"; };
99 my $originalfilename = ""; # only set if we do a conversion
100 my $thumbnailfilename = "";
101
102 my $type = "unknown";
103
104 #see if we need to convert ...
105 if ($converttotype ne "" && $filename =~ m/$converttotype$/)
106 {
107 $originalfilename = $filename;
108 $filename = &util::get_tmp_filename();
109 $filename = "$filename.$converttotype";
110 $self->{'tmp_filename'} = $filename;
111 if (-e $filename) {
112 print STDERR "File names to convert from and to are the same. choking in Imageplug on \"$filename\"\n";
113 return "";
114 }
115 my $result = "";
116 my $command = "convert -verbose $originalfilename $filename";
117 $result = `$command`;
118 print STDERR "$command\n"
119 if $self->{'verbosity'} > 2;
120 print STDERR "$result\n"
121 if $self->{'verbosity'} > 3;
122 $type = $converttotype;
123 }
124
125 #check that the thumbnail doesn't already exist ...
126 $thumbnailfilename = &util::get_tmp_filename();
127 $thumbnailfilename = $thumbnailfilename . ".thumbnail.$thumbnailtype";
128 $self->{'tmp_filename2'} = $thumbnailfilename;
129
130 #make the thumbnail
131 my $result = "";
132 my $command = "convert -verbose -geometry $thumbSize" . "x$thumbSize $filename $thumbnailfilename";
133 $result = `$command` ;
134 print STDERR "$command\n"
135 if $self->{'verbosity'} > 2;
136 print STDERR "$result\n"
137 if $self->{'verbosity'} > 3;
138
139 if ($result =~ m/=>.* ([0-9]+)x([0-9]+)=>([0-9]+)x([0-9]+)/m) {
140 $doc_obj->add_metadata ($section, "ImageHeight", $1);
141 $doc_obj->add_metadata ($section, "ImageWidth", $2);
142 $doc_obj->add_metadata ($section, "ThumbHeight", $3);
143 $doc_obj->add_metadata ($section, "ThumbWidth", $4);
144 }
145
146 my $size = "unknown";
147 if ($result =~ m/^[^\n]* ([0-9]+)b/) {
148 $size = $1;
149 }
150 if ($result =~ m/^[^\n]* ([0-9]+)kb/) {
151 $size = 1024 * $1;
152 }
153
154 if ($result =~ m/^[^\n]*JPE?G/i) {
155 $type = "jpeg";
156 }
157 if ($result =~ m/^[^\n]*GIF/i) {
158 $type = "gif";
159 }
160 if ($result =~ m/^[^\n]*PNG/i) {
161 $type = "png";
162 }
163 if ($result =~ m/^[^\n]*TIF?F/i) {
164 $type = "tiff";
165 }
166 if ($result =~ m/^[^\n]*BMP/i) {
167 $type = "bmp";
168 }
169
170 #if there's a leading directory name, eat it...
171 $file =~ s/^[^\/\\]*[\/\\]//;
172
173 $doc_obj->add_metadata ($section, "ImageType", $type);
174 $doc_obj->add_metadata ($section, "Image", "$file");
175 $doc_obj->add_metadata ($section, "ImageSize", $size);
176
177 #add the thumbnail as an associated file ...
178 if (-e "$thumbnailfilename") {
179 $doc_obj->associate_file("$thumbnailfilename","thumbnail.$thumbnailtype","image/$thumbnailtype",$section);
180 $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
181 $doc_obj->add_metadata ($section, "Thumb", "thumbnail.$thumbnailtype");
182 } else {
183 print STDERR "ImagePlug: couldn't find \"$thumbnailfilename\"\n";
184 }
185
186 #add the image as an associated file ...
187 $doc_obj->associate_file($filename,$file,"image/$type",$section);
188
189 return $type;
190}
191
192
193# The ImagePlug read() function. This function does all the right things
194# to make general options work for a given plugin. It calls the process()
195# function which does all the work specific to a plugin (like the old
196# read functions used to do). Most plugins should define their own
197# process() function and let this read() function keep control.
198#
199# ImagePlug overrides read() because there is no need to read the actual
200# text of the file in, because the contents of the file is not text...
201#
202# Return number of files processed, undef if can't process
203# Note that $base_dir might be "" and that $file might
204# include directories
205
206sub read {
207 my $self = shift (@_);
208 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
209
210 my $filename = &util::filename_cat($base_dir, $file);
211 print STDERR "ImagePlug: called on \"$filename\"\n"
212 if $self->{'verbosity'} > 1;
213 return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
214 if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
215 return undef;
216 }
217 my $plugin_name = ref ($self);
218 $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
219
220 # create a new document
221 my $doc_obj = new doc ($filename, "indexed_doc");
222
223 #run convert to get the thumbnail and extract size and type info
224 my $thumbnailfile = run_convert($self, $filename, $file, $doc_obj);
225
226 if (!defined $thumbnailfile)
227 {
228 print "ImagePlug: couldn't process \"$filename\"\n";
229 return 0;
230 }
231
232 #create an empty text string so we don't break downstream plugins
233 my $text = "";
234
235 # include any metadata passed in from previous plugins
236 # note that this metadata is associated with the top level section
237 my $section = $doc_obj->get_top_section();
238 $self->extra_metadata ($doc_obj, $section, $metadata);
239
240 # do plugin specific processing of doc_obj
241 return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
242
243 # do any automatic metadata extraction
244 $self->auto_extract_metadata ($doc_obj);
245
246 # add an OID
247 $doc_obj->set_OID();
248
249# $doc_obj->add_text($section, "<pre>\n$text\n</pre>");
250
251 # process the document
252 $processor->process($doc_obj);
253
254 if (defined $self->{'tmp_filename'} &&
255 -e $self->{'tmp_filename'}) {
256 util::rm($self->{'tmp_filename'})
257 }
258 if (defined $self->{'tmp_filename2'} &&
259 -e $self->{'tmp_filename2'}) {
260 util::rm($self->{'tmp_filename2'})
261 }
262
263 return 1; # processed the file
264}
265
266# do plugin specific processing of doc_obj
267sub process {
268 my $self = shift (@_);
269 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
270 my $outhandle = $self->{'outhandle'};
271
272 return 1;
273}
274
2751;
276
277
278
279
280
281
282
283
284
285
286
Note: See TracBrowser for help on using the repository browser.