root/gsdl/trunk/perllib/classify/DateList.pm @ 18455

Revision 18455, 12.8 KB (checked in by davidb, 12 years ago)

Addition of 'edit_mode' parameter to classify(). This can be either 'add' 'delete' or 'reindex' (should think about renaming the last one to something more appropriate, e.g. update).

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
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    # now can have comma separated list of Dates - we just use the first one (for now)
110    my @meta_list = split(/,/, $self->{"metadata"});
111    $self->{'meta_list'} = \@meta_list;
112 
113    $self->{'buttonname'} = $self->generate_title_from_metadata($self->{'metadata'}) unless ($self->{'buttonname'});
114
115    $self->{'childtype'} = "DateList";
116    if ($self->{'no_special_formatting'}) {
117    $self->{'childtype'} = "VList";
118    }
119   
120    return bless $self, $class;
121}
122
123sub init {
124    my $self = shift (@_);
125
126    $self->{'list'} = {};
127}
128
129sub classify {
130    my $self = shift (@_);
131    my ($doc_obj, $edit_mode) = @_;
132
133    my $doc_OID = $doc_obj->get_OID();
134
135    # find the first available metadata
136    my $date;
137    foreach my $m (@{$self->{'meta_list'}}) {
138    $date = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $m);
139    last if defined $date;
140    }
141   
142    #my $date = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), $self->{'metadata'});
143    if (!defined $date || $date eq "") {
144    # if this document doesn't contain Date element we won't
145    # include it in this classification
146    return;
147    }
148   
149    if ($edit_mode eq "delete") {
150    $self->oid_hash_delete($doc_OID,'list');
151    return;
152    }
153
154    my $sort_other = "";
155    if (defined $self->{'sort'} && $self->{'sort'} ne "") {
156    $sort_other = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), $self->{'sort'});
157    $sort_other = &sorttools::format_metadata_for_sorting($self->{'sort'}, $sort_other, $doc_obj) unless $self->{'no_metadata_formatting'};
158    }
159   
160    if (defined $self->{'list'}->{$doc_OID}) {
161    my $outhandle = $self->{'outhandle'};
162    print $outhandle "WARNING: DateList::classify called multiple times for $doc_OID\n";
163    }
164   
165     
166    $self->{'list'}->{$doc_OID} = "$date$sort_other";
167
168}
169
170
171sub get_classify_info {
172    my $self = shift (@_);
173
174    my @classlist = sort {$self->{'list'}->{$a} cmp $self->{'list'}->{$b};} keys %{$self->{'list'}};
175
176    if ($self->{'reverse_sort'}) {
177    @classlist = reverse @classlist;
178    }
179
180
181    return $self->splitlist (\@classlist);
182}
183
184
185sub get_entry {
186    my $self = shift (@_);
187    my ($title, $childtype, $thistype) = @_;
188   
189    # organise into classification structure
190    my %classifyinfo = ('childtype'=>$childtype,
191            'Title'=>$title,
192            'contains'=>[],
193            'mdtype'=>$self->{'metadata'});
194    $classifyinfo{'thistype'} = $thistype
195    if defined $thistype && $thistype =~ /\w/;
196
197    return \%classifyinfo;
198}
199
200# splitlist takes an ordered list of classifications (@$classlistref) and
201# splits it up into sub-sections by date
202sub splitlist {
203    my $self = shift (@_);
204    my ($classlistref) = @_;
205    my $classhash = {};
206
207    # top level
208    my $childtype = "HList";
209
210    if (scalar (@$classlistref) <= 39 &&
211    !$self->{'nogroup'}) {$childtype = $self->{'childtype'};}
212
213    my $classifyinfo = $self->get_entry ($self->{'buttonname'}, $childtype, "Invisible");
214    # don't need to do any splitting if there are less than 39 (max + min -1)
215    # classifications, unless nogroup is specified
216    if ((scalar @$classlistref) <= 39 && !$self->{'nogroup'}) {
217    foreach my $subOID (@$classlistref) {
218        push (@{$classifyinfo->{'contains'}}, {'OID'=>$subOID});
219    }
220    return $classifyinfo;
221    }
222
223
224    if ($self->{'bymonth'}) {
225    # first split up the list into separate year+month classifications
226
227    if (!$self->{'nogroup'}) { # hlist of year+month pairs
228        # single level of classifications
229        foreach my $classification (@$classlistref) {
230        my $date = $self->{'list'}->{$classification};
231        $date =~ s/^(\d\d\d\d)-?(\d\d).*$/$1&nbsp;_textmonth$2_/;
232        # sanity check if month is zero
233        if ($date =~ /00_$/) {
234            $date =~ s/^(\d\d\d\d).*$/$1/g;
235        }
236        $classhash->{$date} = [] unless defined $classhash->{$date};
237        push (@{$classhash->{$date}}, $classification);
238        }
239       
240    } else { # don't group - individual years and months
241        foreach my $classification (@$classlistref) {
242        my $date = $self->{'list'}->{$classification};
243        $date =~ s/^(\d\d\d\d)-?(\d\d).*$/$1&nbsp;_textmonth$2_/;
244        my ($year, $month)=($1,$2);
245        # sanity check if month is zero
246        if ($date =~ /00_$/) {
247            $date =~ s/^(\d\d\d\d).*$/$1/g;
248        }
249        # create subclass if it doesn't already exist
250        $classhash->{$year} = () unless defined $classhash->{$year};
251             
252        $classhash->{$year}->{$month} = []
253            unless defined $classhash->{$year}->{$month};
254        push (@{$classhash->{$year}->{$month}}, $classification);
255
256        }
257        # create hlist of years containing hlists of months
258
259       
260        if ($self->{'reverse_sort'}){
261               foreach my $subclass (sort {$b <=> $a}
262                    (keys %$classhash)){
263          my $yearclassify = $self->get_entry($subclass, "HList");
264          foreach my $subsubclass (sort {$b <=> $a}
265                       (keys %{$classhash->{$subclass}})) {
266              my $monthname=$subsubclass;
267              if ($monthname >= 1 && $monthname <= 12) {
268              $monthname="_textmonth" . $monthname . "_";
269              }
270              my $monthclassify=$self->get_entry($monthname, $self->{'childtype'});
271              push (@{$yearclassify->{'contains'}}, $monthclassify);
272             
273              foreach my $subsubOID
274              (@{$classhash->{$subclass}->{$subsubclass}}) {
275                  push (@{$monthclassify->{'contains'}},
276                  {'OID'=>$subsubOID});
277              }
278          }
279          push (@{$classifyinfo->{'contains'}}, $yearclassify);
280          }
281        }
282        else{
283        foreach my $subclass (sort {$a <=> $b}
284                    (keys %$classhash)){
285            my $yearclassify = $self->get_entry($subclass, "HList");
286            foreach my $subsubclass (sort {$a <=> $b}
287                         (keys %{$classhash->{$subclass}})) {
288              my $monthname=$subsubclass;
289              if ($monthname >= 1 && $monthname <= 12) {
290              $monthname="_textmonth" . $monthname . "_";
291              }
292              my $monthclassify=$self->get_entry($monthname, $self->{'childtype'});
293              push (@{$yearclassify->{'contains'}}, $monthclassify);
294             
295              foreach my $subsubOID
296              (@{$classhash->{$subclass}->{$subsubclass}}) {
297                  push (@{$monthclassify->{'contains'}},
298                    {'OID'=>$subsubOID});
299              }
300          }
301            push (@{$classifyinfo->{'contains'}}, $yearclassify);
302        }
303       
304       
305        }
306       
307        return $classifyinfo;
308    } # nogroup
309    }else {
310    # not by month
311    # first split up the list into separate year classifications
312    foreach my $classification (@$classlistref) {
313        my $date = $self->{'list'}->{$classification};
314        $date =~ s/^(\d\d\d\d).*$/$1/;
315        $classhash->{$date} = [] unless defined $classhash->{$date};
316        push (@{$classhash->{$date}}, $classification);
317    }
318         
319    }
320   
321    # only compact the list if nogroup not specified
322    if (!$self->{'nogroup'}) {
323    $classhash = $self->compactlist ($classhash);
324    }
325
326    if ($self->{'reverse_sort'} && $self->{'nogroup'} ) {
327    foreach my $subclass (reverse sort keys %$classhash) {
328        my $tempclassify = $self->get_entry($subclass, $self->{'childtype'});
329        foreach my $subsubOID (@{$classhash->{$subclass}}) {
330        push (@{$tempclassify->{'contains'}}, {'OID'=>$subsubOID});
331        }
332        push (@{$classifyinfo->{'contains'}}, $tempclassify);
333    }
334    }
335    else{
336    foreach my $subclass (sort keys %$classhash) {
337        my $tempclassify = $self->get_entry($subclass, $self->{'childtype'});
338        foreach my $subsubOID (@{$classhash->{$subclass}}) {
339        push (@{$tempclassify->{'contains'}}, {'OID'=>$subsubOID});
340        }
341        push (@{$classifyinfo->{'contains'}}, $tempclassify);
342    }
343
344    }
345   
346 
347    return $classifyinfo;
348}
349
350sub compactlist {
351    my $self = shift (@_);
352    my ($classhashref) = @_;
353    my $compactedhash = {};
354    my @currentOIDs = ();
355    my $currentfirstdate = "";
356    my $currentlastdate = "";
357    my $lastkey = "";
358
359    # minimum and maximum documents to be displayed per page.
360    # the actual maximum will be max + (min-1).
361    # the smallest sub-section is a single letter at present
362    # so in this case there may be many times max documents
363    # displayed on a page.
364    my $min = 10;
365    my $max = 30;
366    foreach my $subsection (sort keys %$classhashref) {
367    $currentfirstdate = $subsection if $currentfirstdate eq "";
368    if ((scalar (@currentOIDs) < $min) ||
369        ((scalar (@currentOIDs) + scalar (@{$classhashref->{$subsection}})) <= $max)) {
370        push (@currentOIDs, @{$classhashref->{$subsection}});
371        $currentlastdate = $subsection;
372    } else {
373
374        if ($currentfirstdate eq $currentlastdate) {
375        @{$compactedhash->{$currentfirstdate}} = @currentOIDs;
376        $lastkey = $currentfirstdate;
377        } else {
378        @{$compactedhash->{"$currentfirstdate-$currentlastdate"}} = @currentOIDs;
379        $lastkey = "$currentfirstdate-$currentlastdate";
380        }
381        if (scalar (@{$classhashref->{$subsection}}) >= $max) {
382        $compactedhash->{$subsection} = $classhashref->{$subsection};
383        @currentOIDs = ();
384        $currentfirstdate = "";
385        $lastkey = $subsection;
386        } else {
387        @currentOIDs = @{$classhashref->{$subsection}};
388        $currentfirstdate = $subsection;
389        $currentlastdate = $subsection;
390        }
391    }
392    }
393
394    # add final OIDs to last sub-classification if there aren't many otherwise
395    # add final sub-classification
396    if ((scalar (@currentOIDs) < $min) && (scalar (@currentOIDs) > 0)) {
397    # want every thing in previous up to the dash
398    my ($newkey) = $lastkey =~ /^([^\-]+)/;
399    @currentOIDs = (@{$compactedhash->{$lastkey}}, @currentOIDs);
400    delete $compactedhash->{$lastkey};
401    @{$compactedhash->{"$newkey-$currentlastdate"}} = @currentOIDs;
402    } else {
403    if ($currentfirstdate eq $currentlastdate) {
404        @{$compactedhash->{$currentfirstdate}} = @currentOIDs;
405    } else {
406        @{$compactedhash->{"$currentfirstdate-$currentlastdate"}} = @currentOIDs;
407    }
408    }
409
410    return $compactedhash;
411}
412
4131;
Note: See TracBrowser for help on using the browser.