source: trunk/gsdl/perllib/classify/AZSectionList.pm@ 741

Last change on this file since 741 was 741, checked in by sjboddie, 25 years ago

fixed up a bit of a bug - should fix this properly
some time

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 7.5 KB
Line 
1###########################################################################
2#
3# AZSectionList.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 sections alphabetically
27
28# this is very similar to AZList except it sorts by
29# section level metadata (excluding the top level)
30# instead of just top level metadata
31
32# options are:
33# metadata=Metadata
34
35# the only change is to the classify() subroutine which
36# must now iterate through each section, adding each
37# to the classification
38
39package AZSectionList;
40
41use sorttools;
42
43sub new {
44 my ($class, @options) = @_;
45
46 my ($metaname);
47 foreach $option (@options) {
48 if ($option =~ /^metadata=(.*)$/i) {
49 $metaname = $1;
50 }
51 }
52
53 if (!defined $metaname) {
54 die "AZSectionList used with no metadata name to classify by\n";
55 }
56
57 return bless {
58 'list'=>{},
59 'metaname' => $metaname
60 }, $class;
61}
62
63sub init {
64 my $self = shift (@_);
65
66 $self->{'list'} = {};
67}
68
69sub classify {
70 my $self = shift (@_);
71 my ($doc_obj) = @_;
72
73 my $doc_OID = $doc_obj->get_OID();
74 my $thissection = $doc_obj->get_next_section ($doc_obj->get_top_section());
75
76 while (defined $thissection) {
77 $self->classify_section ($thissection, $doc_obj);
78 $thissection = $doc_obj->get_next_section ($thissection);
79 }
80}
81
82sub classify_section {
83 my $self = shift (@_);
84 my ($section, $doc_obj) = @_;
85
86 my $doc_OID = $doc_obj->get_OID();
87 my $metavalue = $doc_obj->get_metadata_element ($section, $self->{'metaname'});
88
89 # if this section doesn't contain the metadata element we're
90 # sorting by we won't include it in this classification
91 if (defined $metavalue && $metavalue ne "") {
92 if ($self->{'metaname'} eq 'Creator') {
93 &sorttools::format_string_name_english (\$metavalue);
94 } else {
95 &sorttools::format_string_english (\$metavalue);
96 }
97 if (defined $self->{'list'}->{"$doc_OID.$section"}) {
98 print STDERR "WARNING: AZSectionList::classify called multiple times " .
99 "for $doc_OID.$section\n";
100 }
101 $self->{'list'}->{"$doc_OID.$section"} = $metavalue;
102 }
103}
104
105sub get_classify_info {
106 my $self = shift (@_);
107
108 my @classlist = sort {$self->{'list'}->{$a} cmp $self->{'list'}->{$b};}
109 keys %{$self->{'list'}};
110
111 return $self->splitlist (\@classlist);
112}
113
114sub get_entry {
115 my $self = shift (@_);
116 my ($title, $childtype, $thistype) = @_;
117
118 # organise into classification structure
119 my %classifyinfo = ('childtype'=>$childtype,
120 'Title'=>$title,
121 'contains'=>[]);
122 $classifyinfo{'thistype'} = $thistype
123 if defined $thistype && $thistype =~ /\w/;
124
125 return \%classifyinfo;
126}
127
128# splitlist takes an ordered list of classifications (@$classlistref) and splits it
129# up into alphabetical sub-sections.
130sub splitlist {
131 my $self = shift (@_);
132 my ($classlistref) = @_;
133 my $classhash = {};
134
135 # top level
136 my $childtype = "HList";
137 if (scalar (@$classlistref) <= 39) {$childtype = "VList";}
138 my $classifyinfo = $self->get_entry ($self->{'metaname'}, $childtype, "Invisible");
139
140 # don't need to do any splitting if there are less than 39 (max + min -1) classifications
141 if ((scalar @$classlistref) <= 39) {
142 foreach $subOID (@$classlistref) {
143 push (@{$classifyinfo->{'contains'}}, {'OID'=>$subOID});
144 }
145 return $classifyinfo;
146 }
147
148 # first split up the list into separate A-Z and 0-9 classifications
149 foreach $classification (@$classlistref) {
150 my $title = $self->{'list'}->{$classification};
151 $title =~ s/^(.).*$/$1/;
152 $title =~ tr/[a-z]/[A-Z]/;
153 if ($title =~ /^[0-9]$/) {$title = '0-9';}
154 elsif ($title !~ /^[A-Z]$/) {
155 print STDERR "AZSectionList: WARNING $classification has badly " .
156 "formatted title ($title)\n";
157 }
158 $classhash->{$title} = [] unless defined $classhash->{$title};
159 push (@{$classhash->{$title}}, $classification);
160 }
161 $classhash = $self->compactlist ($classhash);
162
163 my @tmparr = ();
164 foreach $subsection (sort keys (%$classhash)) {
165 push (@tmparr, $subsection);
166 }
167
168 # if there's a 0-9 section it will have been sorted to the beginning
169 # but we want it at the end
170 if ($tmparr[0] eq '0-9') {
171 shift @tmparr;
172 push (@tmparr, '0-9');
173 }
174
175 foreach $subclass (@tmparr) {
176 my $tempclassify = $self->get_entry($subclass, "VList");
177 foreach $subsubOID (@{$classhash->{$subclass}}) {
178 push (@{$tempclassify->{'contains'}}, {'OID'=>$subsubOID});
179 }
180 push (@{$classifyinfo->{'contains'}}, $tempclassify);
181 }
182
183 return $classifyinfo;
184}
185
186sub compactlist {
187 my $self = shift (@_);
188 my ($classhashref) = @_;
189 my $compactedhash = {};
190 my @currentOIDs = ();
191 my $currentfirstletter = "";
192 my $currentlastletter = "";
193 my $lastkey = "";
194
195 # minimum and maximum documents to be displayed per page.
196 # the actual maximum will be max + (min-1).
197 # the smallest sub-section is a single letter at present
198 # so in this case there may be many times max documents
199 # displayed on a page.
200 my $min = 10;
201 my $max = 30;
202
203 foreach $subsection (sort keys %$classhashref) {
204 if ($subsection eq '0-9') {
205 @{$compactedhash->{$subsection}} = @{$classhashref->{$subsection}};
206 next;
207 }
208 $currentfirstletter = $subsection if $currentfirstletter eq "";
209 if ((scalar (@currentOIDs) < $min) ||
210 ((scalar (@currentOIDs) + scalar (@{$classhashref->{$subsection}})) <= $max)) {
211 push (@currentOIDs, @{$classhashref->{$subsection}});
212 $currentlastletter = $subsection;
213 } else {
214
215 if ($currentfirstletter eq $currentlastletter) {
216 @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
217 $lastkey = $currentfirstletter;
218 } else {
219 @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
220 $lastkey = "$currentfirstletter-$currentlastletter";
221 }
222 if (scalar (@{$classhashref->{$subsection}}) >= $max) {
223 $compactedhash->{$subsection} = $classhashref->{$subsection};
224 @currentOIDs = ();
225 $currentfirstletter = "";
226 $lastkey = $subsection;
227 } else {
228 @currentOIDs = @{$classhashref->{$subsection}};
229 $currentfirstletter = $subsection;
230 $currentlastletter = $subsection;
231 }
232 }
233 }
234
235 # add final OIDs to last sub-classification if there aren't many otherwise
236 # add final sub-classification
237 if (scalar (@currentOIDs) < $min) {
238 my ($newkey) = $lastkey =~ /^(.)/;
239 @currentOIDs = (@{$compactedhash->{$lastkey}}, @currentOIDs);
240 delete $compactedhash->{$lastkey};
241 @{$compactedhash->{"$newkey-$currentlastletter"}} = @currentOIDs;
242 } else {
243 if ($currentfirstletter eq $currentlastletter) {
244 @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
245 } else {
246 @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
247 }
248 }
249
250 return $compactedhash;
251}
252
2531;
Note: See TracBrowser for help on using the repository browser.