source: trunk/gsdl/perllib/classify/Collage.pm@ 9142

Last change on this file since 9142 was 9142, checked in by davidb, 19 years ago

Revision to Collaging so only documents with associated files that
match the list of imageType filename extension go into the classifier.

  • Property svn:keywords set to Author Date Id Revision
File size: 7.9 KB
Line 
1##########################################################################
2#
3# Collage.pm --
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 Collage;
27
28use BasClas;
29use sorttools;
30
31sub BEGIN {
32 @ISA = ('BasClas');
33}
34
35my $arguments =
36 [ { 'name' => "buttonname",
37 'desc' => "{BasClas.buttonname}",
38 'type' => "string",
39 'deft' => "Collage",
40 'reqd' => "no" },
41 { 'name' => "geometry",
42 'desc' => "{Collage.geometry}",
43 'type' => "string",
44 'deft' => "600x300",
45 'reqd' => "no" },
46 { 'name' => "verbosity",
47 'desc' => "{BasClas.verbosity}",
48 'type' => "string",
49 'deft' => "5",
50 'reqd' => "no" },
51 { 'name' => "maxDepth",
52 'desc' => "{Collage.maxDepth}",
53 'type' => "string",
54 'deft' => "500"},
55# { 'name' => "maxDownloads",
56# 'desc' => "{BasClas.maxDownloads}",
57# 'type' => "string",
58# 'deft' => "",
59# 'reqd' => "no" },
60 { 'name' => "maxDisplay",
61 'desc' => "{Collage.maxDisplay}",
62 'type' => "string",
63 'deft' => "25",
64 'reqd' => "no" },
65 { 'name' => "imageType",
66 'desc' => "{Collage.imageType}",
67 'type' => "string",
68 'deft' => ".jpg%%.png",
69 'reqd' => "no" },
70 { 'name' => "bgcolor",
71 'desc' => "{Collage.bgcolor}",
72 'type' => "string",
73 'deft' => "#96c29a",
74 'reqd' => "no" },
75 { 'name' => "refreshDelay",
76 'desc' => "{Collage.refreshDelay}",
77 'type' => "string",
78 'deft' => "1500",
79 'reqd' => "no" },
80 { 'name' => "isJava2",
81 'desc' => "{Collage.isJava2}",
82 'type' => "string",
83 'deft' => "auto",
84 'reqd' => "no" },
85 { 'name' => "imageMustNotHave",
86 'desc' => "{Collage.imageMustNotHave}",
87 'type' => "string",
88 'deft' => "hl=%%x=%%gt=%%gc=%%.pr",
89 'reqd' => "no" },
90 { 'name' => "caption",
91 'desc' => "{Collage.caption}",
92 'type' => "string",
93 'deft' => "",
94 'reqd' => "no" }
95 ];
96
97
98
99
100my $options = { 'name' => "Collage",
101 'desc' => "{Collage.desc}",
102 'abstract' => "no",
103 'inherits' => "Yes",
104 'args' => $arguments };
105
106
107sub new {
108 my $class = shift (@_);
109 my $self = new BasClas($class, @_);
110
111 my $option_list = $self->{'option_list'};
112 push( @{$option_list}, $options );
113
114 if ($self->{'info_only'}) {
115 # created from classinfo.pl - don't need to parse the arguments
116 return bless $self, $class;
117 }
118
119 my ($title, $geometry, $verbosity, $maxDepth, $imageType, $bgcolor, $refreshDelay, $isJava2, $caption, $maxDisplay, $maxDownloads, $list);
120
121 if (!parsargv::parse(\@_,
122 q^buttonname/.*/Collage^, \$title,
123 q^geometry/.*/600x300^, \$geometry,
124 q^verbosity/.*/3^, \$verbosity,
125 q^maxDepth/.*/500^, \$maxDepth,
126# q^maxDownloads/.*/^, \$maxDownloads,
127 q^maxDisplay/.*/25^, \$maxDisplay,
128 q^imageType/.*/.jpg%.png^, \$imageType,
129 q^bgcolor/.*/\#96c29a^, \$bgcolor,
130 q^refreshDelay/.*/1200^, \$refreshDelay,
131 q^isJava2/.*/auto^, \$isJava2,
132 q^imageMustNotHave/.*/hl=\%x=\%gt=\%gc=\%.pr^, \$imageMustNotHave,
133 q^caption/.*/ ^, \$caption,
134 "allow_extra_options")) {
135
136 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n";
137 $self->print_txt_usage(""); # Use default resource bundle
138 die "\n";
139 }
140
141 if (!$title) {
142 $title = 'Collage';
143 }
144
145 $self->{'list'} = $list;
146 $self->{'title'} = $title;
147 $self->{'geometry'} = $geometry;
148 $self->{'verbosity'} = $verbosity;
149 $self->{'maxDepth'} = $maxDepth;
150 $self->{'maxDownloads'} = $maxDownloads;
151 $self->{'maxDisplay'} = $maxDisplay;
152 $self->{'imageType'} = $imageType;
153 $self->{'bgcolor'} = $bgcolor;
154 $self->{'refreshDelay'} = $refreshDelay;
155 $self->{'isJava2'} = $isJava2;
156# $self->{'imageMustNotHave'} = $imageMustNotHave;
157 $self->{'caption'} = $caption;
158 return bless $self, $class;
159}
160
161sub init {
162 my $self = shift (@_);
163
164 $self->{'list'} = [];
165}
166
167sub classify {
168
169 my $self = shift (@_);
170 my ($doc_obj) = @_;
171
172 my $has_image_type = 0;
173
174 my @image_type_split = split(/%/,$self->{'imageType'});
175 my @image_type_ext = map { "($_)" } @image_type_split;
176 my $image_type_re = join("|",@image_type_ext);
177 $image_type_re =~ s/\./\\\./g;
178
179 my $assoc_files = $doc_obj->{'associated_files'};
180
181 foreach my $af ( @$assoc_files ) {
182 my ($real_filename, $assoc_filename, $mime_type, $section) = @$af;
183 if ($assoc_filename =~ m/$image_type_re/) {
184 $has_image_type = 1;
185 last;
186 }
187 }
188
189 if ($has_image_type) {
190 my $doc_OID = $doc_obj->get_OID();
191 push (@{$self->{'list'}}, $doc_OID);
192 }
193
194}
195
196sub get_classify_info {
197 my $self = shift (@_);
198
199 my $items_per_page = 2;
200 my $max_items_per_page = 20;
201
202 my @list = @{$self->{'list'}};
203
204 my $outhandle = $self->{'outhandle'};
205 my $verbosity = $self->{'verbosity'};
206
207 if ($verbosity>1) {
208 print $outhandle ("$self->{'title'}\n");
209 }
210
211 my $collage_head = $self->get_entry ($self->{'title'}, "Collage", "Invisible");
212 my $collage_curr = $self->get_entry("Collage","VList");
213 push (@{$collage_head->{'contains'}},$collage_curr);
214
215 my $global_c=1;
216 my $within_page_c=1;
217
218 foreach $oid (@list) {
219 if ($within_page_c>$items_per_page) {
220 my $title = "Items $global_c+";
221 my $nested_node = $self->get_entry($title,"VList");
222 push (@{$collage_curr->{'contains'}}, $nested_node);
223 $collage_curr = $nested_node;
224
225 $within_page_c=1;
226
227 $items_per_page++ if ($items_per_page < $max_items_per_page);
228 }
229
230 push (@{$collage_curr->{'contains'}}, {'OID'=>$oid});
231 $global_c++;
232 $within_page_c++;
233 }
234
235 return $collage_head;
236}
237
238
239sub get_entry {
240 my $self = shift (@_);
241 my ($title, $childtype, $thistype) = @_;
242
243 # organise into classification structure
244 my %classifyinfo = ('childtype'=>$childtype,
245 'Title'=>$title,
246 'parameters'=> $parameters,
247 'contains'=>[]);
248
249 $classifyinfo{'thistype'} = $thistype if (defined $thistype);
250
251 if ($childtype eq "Collage") {
252 my $geometry = $self->{'geometry'};
253 my ($x_dim,$y_dim) = ($geometry =~ m/^(.*)x(.*)$/);
254 my $verbosity = $self->{'verbosity'};
255 my $maxDepth = $self->{'maxDepth'};
256# my $maxDownloads = $self->{'maxDownloads'};
257 my $maxDisplay = $self->{'maxDisplay'};
258 my $imageType = $self->{'imageType'};
259 my $bgcolor = $self->{'bgcolor'};
260 my $refreshDelay = $self->{'refreshDelay'};
261 my $isJava2 = $self->{'isJava2'};
262 my $imageMustNotHave = $self->{'imageMustNotHave'};
263 my $caption = $self->{'caption'};
264
265 if (!defined($maxDownloads)) {
266 $maxDownloads="";
267 }
268
269 my $parameters;
270
271 $parameters = "xdim=".$x_dim;
272 $parameters .= ";ydim=".$y_dim;
273 $parameters .= ";geometry=".$self->{'geometry'};
274 $parameters .= ";verbosity=".$self->{'verbosity'};
275 $parameters .= ";maxDepth=".$self->{'maxDepth'};
276# $parameters .= ";maxDownloads=".$maxDownloads;
277 $parameters .= ";maxDisplay=".$self->{'maxDisplay'};
278 $parameters .= ";imageType=".$self->{'imageType'};
279 $parameters .= ";bgcolor=".$self->{'bgcolor'};
280 $parameters .= ";refreshDelay=".$self->{'refreshDelay'};
281 $parameters .= ";isJava2=".$self->{'isJava2'};
282 $parameters .= ";caption=".$self->{'caption'};
283
284# $parameters .= ";imageMustNotHave=".$self->{'imageMustNotHave'};
285
286
287 $classifyinfo{'parameters'} = $parameters;
288 }
289
290 return \%classifyinfo;
291}
292
2931;
Note: See TracBrowser for help on using the repository browser.