source: gsdl/trunk/perllib/classify/DateList.pm@ 20828

Last change on this file since 20828 was 20828, checked in by kjdon, 15 years ago

fixed a bug where when compacting, if the last bucket was retained as a bucket, then got an empty classification cos weren't testing whether the remaining oids were empty or not

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