source: main/trunk/greenstone2/perllib/classify/DateList.pm@ 27308

Last change on this file since 27308 was 27308, checked in by kjdon, 8 years ago

fixed up DateList so that reverse sort works properly when years are grouped together.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 12.0 KB
Line 
1###########################################################################
2#
3# DateList.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
26# classifier plugin for sorting by date
27
28# date is assumed to be in the form yyyymmdd
29
30# at present dates are split by year - this should change
31# jrm21 - added option "bymonth", which splits by year and month.
32
33# 23/09/03 Added some more options -kjdon.
34# these include:
35# -nogroup, which makes each year (or year+month) an individual entry in
36# the horizontal list and prevents compaction
37# -metadata, use a different metadata for the date (instead of Date), still expects yyyymmdd format. this affects display cos greenstone displays Date metadata as dd month yyyy, whereas any other date metadata is displayed as yyyymmdd - this needs fixing
38# -sort specifies an additional metadata to use in sorting, will take affect when two docs have the same date.
39
40package DateList;
41
42use BaseClassifier;
43use sorttools;
44
45use strict;
46no strict 'refs'; # allow filehandles to be variables and viceversa
47
48sub BEGIN {
49 @DateList::ISA = ('BaseClassifier');
50}
51
52my $arguments =
53 [ { 'name' => "metadata",
54 'desc' => "{DateList.metadata}",
55 'type' => "metadata",
56 'deft' => "Date",
57 'reqd' => "yes" } ,
58 { 'name' => "sort",
59 'desc' => "{DateList.sort}",
60 'type' => "metadata",
61 'reqd' => "no" } ,
62 { 'name' => "reverse_sort",
63 'desc' => "{DateList.reverse_sort}",
64 'type' => "flag",
65 'reqd' => "no" },
66 { 'name' => "bymonth",
67 'desc' => "{DateList.bymonth}",
68 'type' => "flag",
69 'reqd' => "no" },
70 { 'name' => "nogroup",
71 'desc' => "{DateList.nogroup}",
72 'type' => "flag",
73 'reqd' => "no" },
74 { 'name' => "no_special_formatting",
75 'desc' => "{DateList.no_special_formatting}",
76 'type' => "flag",
77 'reqd' => "no" }
78
79 ];
80
81my $options = { 'name' => "DateList",
82 'desc' => "{DateList.desc}",
83 'abstract' => "no",
84 'inherits' => "yes",
85 'args' => $arguments };
86
87
88sub new {
89 my ($class) = shift (@_);
90 my ($classifierslist,$inputargs,$hashArgOptLists) = @_;
91 push(@$classifierslist, $class);
92
93 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
94 push(@{$hashArgOptLists->{"OptList"}},$options);
95
96 my $self = new BaseClassifier($classifierslist, $inputargs, $hashArgOptLists);
97
98 if ($self->{'info_only'}) {
99 # don't worry about any options etc
100 return bless $self, $class;
101 }
102
103 # Manually set $self parameters.
104 $self->{'list'} = {};
105
106 if (!defined $self->{"metadata"} || $self->{"metadata"} eq "") {
107 $self->{'metadata'} = "Date";
108 }
109 # remove any ex.s
110 $self->{'metadata'} = $self->strip_ex_from_metadata($self->{'metadata'});
111 $self->{'sort'} = $self->strip_ex_from_metadata($self->{'sort'});
112
113 # now can have comma separated list of Dates - we just use the first one (for now)
114 my @meta_list = split(/,/, $self->{"metadata"});
115 $self->{'meta_list'} = \@meta_list;
116
117 $self->{'buttonname'} = $self->generate_title_from_metadata($self->{'metadata'}) unless ($self->{'buttonname'});
118
119 $self->{'childtype'} = "DateList";
120 if ($self->{'no_special_formatting'}) {
121 $self->{'childtype'} = "VList";
122 }
123
124 return bless $self, $class;
125}
126
127sub init {
128 my $self = shift (@_);
129
130 $self->{'list'} = {};
131}
132
133sub classify {
134 my $self = shift (@_);
135 my ($doc_obj) = @_;
136
137 my $doc_OID = $doc_obj->get_OID();
138
139 # find the first available metadata
140 my $date;
141 foreach my $m (@{$self->{'meta_list'}}) {
142 $date = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $m);
143 last if defined $date;
144 }
145
146 if (!defined $date || $date eq "") {
147 # if this document doesn't contain Date element we won't
148 # include it in this classification
149 return;
150 }
151
152 my $sort_other = "";
153 if (defined $self->{'sort'} && $self->{'sort'} ne "") {
154 $sort_other = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), $self->{'sort'});
155 $sort_other = &sorttools::format_metadata_for_sorting($self->{'sort'}, $sort_other, $doc_obj) unless $self->{'no_metadata_formatting'};
156 }
157
158 if (defined $self->{'list'}->{$doc_OID}) {
159 my $outhandle = $self->{'outhandle'};
160 print $outhandle "WARNING: DateList::classify called multiple times for $doc_OID\n";
161 }
162
163 $self->{'list'}->{$doc_OID} = "$date$sort_other";
164
165}
166
167
168sub get_classify_info {
169 my $self = shift (@_);
170
171 my @classlist = sort {$self->{'list'}->{$a} cmp $self->{'list'}->{$b};} keys %{$self->{'list'}};
172
173 if ($self->{'reverse_sort'}) {
174 @classlist = reverse @classlist;
175 }
176
177
178 return $self->splitlist (\@classlist);
179}
180
181
182sub get_entry {
183 my $self = shift (@_);
184 my ($title, $childtype, $thistype) = @_;
185
186 # organise into classification structure
187 my %classifyinfo = ('childtype'=>$childtype,
188 'Title'=>$title,
189 'contains'=>[],
190 'mdtype'=>$self->{'metadata'});
191 $classifyinfo{'thistype'} = $thistype
192 if defined $thistype && $thistype =~ /\w/;
193
194 return \%classifyinfo;
195}
196
197# splitlist takes an ordered list of classifications (@$classlistref) and
198# splits it up into sub-sections by date
199sub splitlist {
200 my $self = shift (@_);
201 my ($classlistref) = @_;
202 my $classhash = {};
203
204 # top level
205 my $childtype = "HList";
206
207 if (scalar (@$classlistref) <= 39 &&
208 !$self->{'nogroup'}) {$childtype = $self->{'childtype'};}
209
210 my $classifyinfo = $self->get_entry ($self->{'buttonname'}, $childtype, "Invisible");
211 # don't need to do any splitting if there are less than 39 (max + min -1)
212 # classifications, unless nogroup is specified
213 if ((scalar @$classlistref) <= 39 && !$self->{'nogroup'}) {
214 foreach my $subOID (@$classlistref) {
215 push (@{$classifyinfo->{'contains'}}, {'OID'=>$subOID});
216 }
217 return $classifyinfo;
218 }
219
220
221 if ($self->{'bymonth'}) {
222 # first split up the list into separate year+month classifications
223
224 if (!$self->{'nogroup'}) { # hlist of year+month pairs
225 # single level of classifications
226 foreach my $classification (@$classlistref) {
227 my $date = $self->{'list'}->{$classification};
228 $date =~ s/^(\d\d\d\d)-?(\d\d).*$/$1&nbsp;_textmonth$2_/;
229 # sanity check if month is zero
230 if ($date =~ /00_$/) {
231 $date =~ s/^(\d\d\d\d).*$/$1/g;
232 }
233 $classhash->{$date} = [] unless defined $classhash->{$date};
234 push (@{$classhash->{$date}}, $classification);
235 }
236
237 } else { # -nogroup - individual years and months
238 foreach my $classification (@$classlistref) {
239 my $date = $self->{'list'}->{$classification};
240 $date =~ s/^(\d\d\d\d)-?(\d\d).*$/$1&nbsp;_textmonth$2_/;
241 my ($year, $month)=($1,$2);
242 # sanity check if month is zero
243 if ($date =~ /00_$/) {
244 $date =~ s/^(\d\d\d\d).*$/$1/g;
245 }
246 # create subclass if it doesn't already exist
247 $classhash->{$year} = () unless defined $classhash->{$year};
248
249 $classhash->{$year}->{$month} = []
250 unless defined $classhash->{$year}->{$month};
251 push (@{$classhash->{$year}->{$month}}, $classification);
252
253 }
254 # create hlist of years containing hlists of months
255
256 my @subclasslist = sort {$a <=> $b} (keys %$classhash);
257 if ($self->{'reverse_sort'}) {
258 @subclasslist = reverse @subclasslist;
259 }
260
261 foreach my $subclass (@subclasslist) {
262 my $yearclassify = $self->get_entry($subclass, "HList");
263 my @subsubclasslist = sort {$a <=> $b} (keys %{$classhash->{$subclass}});
264 if ($self->{'reverse_sort'}) {
265 @subsubclasslist = reverse @subsubclasslist;
266 }
267
268 foreach my $subsubclass (@subsubclasslist) {
269 my $monthname=$subsubclass;
270 if ($monthname >= 1 && $monthname <= 12) {
271 $monthname="_textmonth" . $monthname . "_";
272 }
273 my $monthclassify=$self->get_entry($monthname, $self->{'childtype'});
274 push (@{$yearclassify->{'contains'}}, $monthclassify);
275
276 foreach my $subsubOID
277 (@{$classhash->{$subclass}->{$subsubclass}}) {
278 push (@{$monthclassify->{'contains'}},
279 {'OID'=>$subsubOID});
280 }
281 }
282 push (@{$classifyinfo->{'contains'}}, $yearclassify);
283 }
284
285 return $classifyinfo;
286 } # nogroup
287 } else {
288 # not by month
289 # first split up the list into separate year classifications
290 foreach my $classification (@$classlistref) {
291 my $date = $self->{'list'}->{$classification};
292 $date =~ s/^(\d\d\d\d).*$/$1/;
293 $classhash->{$date} = [] unless defined $classhash->{$date};
294 push (@{$classhash->{$date}}, $classification);
295 }
296
297 }
298
299 # only compact the list if nogroup not specified
300 if (!$self->{'nogroup'}) {
301 $classhash = $self->compactlist ($classhash);
302 }
303 my @subclasslist = sort keys %$classhash;
304 if ($self->{'reverse_sort'}) {
305 @subclasslist = reverse @subclasslist;
306 }
307 foreach my $subclass (@subclasslist) {
308 my $tempclassify = $self->get_entry($subclass, $self->{'childtype'});
309 foreach my $subsubOID (@{$classhash->{$subclass}}) {
310 push (@{$tempclassify->{'contains'}}, {'OID'=>$subsubOID});
311 }
312 push (@{$classifyinfo->{'contains'}}, $tempclassify);
313 }
314
315 return $classifyinfo;
316}
317
318sub compactlist {
319 my $self = shift (@_);
320 my ($classhashref) = @_;
321 my $compactedhash = {};
322 my @currentOIDs = ();
323 my $currentfirstdate = "";
324 my $currentlastdate = "";
325 my $lastkey = "";
326
327 # minimum and maximum documents to be displayed per page.
328 # the actual maximum will be max + (min-1).
329 # the smallest sub-section is a single letter at present
330 # so in this case there may be many times max documents
331 # displayed on a page.
332 my $min = 10;
333 my $max = 30;
334 my @subsectionlist = sort keys %$classhashref;
335 if ($self->{'reverse_sort'}) {
336 @subsectionlist = reverse @subsectionlist;
337 }
338 foreach my $subsection (@subsectionlist) {
339 $currentfirstdate = $subsection if $currentfirstdate eq "";
340 if ((scalar (@currentOIDs) < $min) ||
341 ((scalar (@currentOIDs) + scalar (@{$classhashref->{$subsection}})) <= $max)) {
342 push (@currentOIDs, @{$classhashref->{$subsection}});
343 $currentlastdate = $subsection;
344 } else {
345 if ($currentfirstdate eq $currentlastdate) {
346 @{$compactedhash->{$currentfirstdate}} = @currentOIDs;
347 $lastkey = $currentfirstdate;
348 } else {
349 @{$compactedhash->{"$currentfirstdate-$currentlastdate"}} = @currentOIDs;
350 $lastkey = "$currentfirstdate-$currentlastdate";
351 }
352 if (scalar (@{$classhashref->{$subsection}}) >= $max) {
353 $compactedhash->{$subsection} = $classhashref->{$subsection};
354 @currentOIDs = ();
355 $currentfirstdate = "";
356 $lastkey = $subsection;
357 } else {
358 @currentOIDs = @{$classhashref->{$subsection}};
359 $currentfirstdate = $subsection;
360 $currentlastdate = $subsection;
361 }
362 }
363 }
364
365 # add final OIDs to last sub-classification if there aren't many otherwise
366 # add final sub-classification
367 if (scalar (@currentOIDs) > 0) {
368 if ((scalar (@currentOIDs) < $min)) {
369
370 # want every thing in previous up to the dash
371 my ($newkey) = $lastkey =~ /^([^\-]+)/;
372 @currentOIDs = (@{$compactedhash->{$lastkey}}, @currentOIDs);
373 delete $compactedhash->{$lastkey};
374 @{$compactedhash->{"$newkey-$currentlastdate"}} = @currentOIDs;
375 } else {
376 if ($currentfirstdate eq $currentlastdate) {
377 @{$compactedhash->{$currentfirstdate}} = @currentOIDs;
378 } else {
379 @{$compactedhash->{"$currentfirstdate-$currentlastdate"}} = @currentOIDs;
380 }
381 }
382 }
383
384 return $compactedhash;
385}
386
3871;
Note: See TracBrowser for help on using the repository browser.