source: main/trunk/model-sites-dev/heritage-nz/collect/pdf-reports/perllib/classify/List.pm@ 36609

Last change on this file since 36609 was 36609, checked in by anupama, 20 months ago

committing modified perl code for heritage

File size: 58.9 KB
Line 
1###########################################################################
2#
3# List.pm -- A general and flexible list classifier with most of
4# the abilities of AZCompactList, and better Unicode,
5# metadata and sorting capabilities.
6#
7# A component of the Greenstone digital library software
8# from the New Zealand Digital Library Project at the
9# University of Waikato, New Zealand.
10#
11#
12# Copyright (C) 2005 New Zealand Digital Library Project
13#
14# This program is free software; you can redistribute it and/or modify
15# it under the terms of the GNU General Public License as published by
16# the Free Software Foundation; either version 2 of the License, or
17# (at your option) any later version.
18#
19# This program is distributed in the hope that it will be useful,
20# but WITHOUT ANY WARRANTY; without even the implied warranty of
21# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22# GNU General Public License for more details.
23#
24# You should have received a copy of the GNU General Public License
25# along with this program; if not, write to the Free Software
26# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
27#
28# TO DO: - Remove punctuation from metadata values before sorting.
29# - Add an AZCompactList-style hlist option?
30#
31###########################################################################
32
33
34package List;
35
36
37use BaseClassifier;
38use Sort::Naturally;
39use strict;
40
41
42sub BEGIN {
43 @List::ISA = ('BaseClassifier');
44}
45
46
47my $metadata_selection_mode_list =
48 [
49 { 'name' => "firstvalue",
50 'desc' => "{List.metadata_selection.firstvalue}"},
51 { 'name' => "firstvalidmetadata",
52 'desc' => "{List.metadata_selection.firstvalidmetadata}"},
53 { 'name' => "allvalues",
54 'desc' => "{List.metadata_selection.allvalues}"} ];
55
56my $metadata_selection_mode_default = "firstvalidmetadata";
57
58my $valid_metadata_selection_modes = { 'firstvalue' => 1,
59 'firstvalidmetadata' => 1,
60 'allvalues' => 1 };
61
62my $metadata_sort_mode_list =
63 [
64 { 'name' => "unicode",
65 'desc' => "{List.metadata_sort.unicode}"},
66 { 'name' => "alphabetic",
67 'desc' => "{List.metadata_sort.alphabetic}"},
68 { 'name' => "alphanumeric",
69 'desc' => "{List.metadata_sort.alphanumeric}"} ];
70
71my $metadata_sort_mode_default = "alphanumeric";
72
73my $valid_metadata_sort_modes = { 'unicode' => 1,
74 'alphabetic' => 1,
75 'alphanumeric' => 1};
76my $partition_type_list =
77 [ { 'name' => "per_letter",
78 'desc' => "{List.level_partition.per_letter}" },
79 { 'name' => "approximate_size",
80 'desc' => "{List.level_partition.approximate_size}"},
81 { 'name' => "constant_size",
82 'desc' => "{List.level_partition.constant_size}" },
83 { 'name' => "all_values",
84 'desc' => "{List.level_partition.all_values}" },
85 { 'name' => "none",
86 'desc' => "{List.level_partition.none}" } ];
87
88my $partition_type_default = "per_letter";
89
90my $valid_partition_types = { 'per_letter' => 1,
91 'constant_size' => 1,
92 'approximate_size' => 1,
93 'all_values' => 1,
94 'none' => 1};
95
96my $partition_size_default = 20;
97
98my $numeric_partition_type_list =
99 [ { 'name' => "per_digit",
100 'desc' => "{List.level_partition.per_digit}" },
101 { 'name' => "per_number",
102 'desc' => "{List.level_partition.per_number}" },
103 { 'name' => "single_partition",
104 'desc' => "{List.level_partition.single}" },
105 { 'name' => "approximate_size",
106 'desc' => "{List.level_partition.approximate_size_numeric}"},
107 { 'name' => "constant_size",
108 'desc' => "{List.level_partition.constant_size}" },
109 { 'name' => "all_values",
110 'desc' => "{List.level_partition.all_values}" },
111 { 'name' => "none",
112 'desc' => "{List.level_partition.none}" } ];
113
114my $numeric_partition_type_default = "single_partition";
115
116my $valid_numeric_partition_types = { 'per_digit' => 1,
117 'per_number' => 1,
118 'constant_size' => 1,
119 'single_partition' => 1,
120 'approximate_size' => 1,
121 'all_values' => 1,
122 'none' =>1 };
123
124my $numeric_partition_size_default = 20;
125
126my $numeric_partition_name_length_default = "-1"; # use the full number
127
128my $bookshelf_type_list =
129 [ { 'name' => "always",
130 'desc' => "{List.bookshelf_type.always}" },
131 { 'name' => "duplicate_only",
132 'desc' => "{List.bookshelf_type.duplicate_only}" },
133 { 'name' => "never",
134 'desc' => "{List.bookshelf_type.never}" } ];
135
136my $bookshelf_type_default = "never";
137my $sort_leaf_nodes_using_default = "Title";
138my $arguments =
139 [ { 'name' => "metadata",
140 'desc' => "{List.metadata}",
141 'type' => "metadata",
142 'reqd' => "yes" },
143
144 { 'name' => "metadata_selection_mode_within_level",
145 'desc' => "{List.metadata_selection_mode_within_level}",
146 'type' => "enumstring", # Must be enumstring because multiple values can be specified (separated by '/')
147 'list' => $metadata_selection_mode_list,
148 'deft' => $metadata_selection_mode_default },
149
150 { 'name' => "metadata_sort_mode_within_level",
151 'desc' => "{List.metadata_sort_mode_within_level}",
152 'type' => "enumstring", # Must be enumstring because multiple values can be specified (separated by '/')
153 'list' => $metadata_sort_mode_list,
154 'deft' => $metadata_sort_mode_default },
155
156 { 'name' => "bookshelf_type",
157 'desc' => "{List.bookshelf_type}",
158 'type' => "enum",
159 'list' => $bookshelf_type_list,
160 'deft' => $bookshelf_type_default },
161
162 { 'name' => "classify_sections",
163 'desc' => "{List.classify_sections}",
164 'type' => "flag" },
165
166 { 'name' => "partition_type_within_level",
167 'desc' => "{List.partition_type_within_level}",
168 'type' => "enumstring", # Must be enumstring because multiple values can be specified (separated by '/')
169 'list' => $partition_type_list,
170 'deft' => $partition_type_default },
171
172 { 'name' => "partition_size_within_level",
173 'desc' => "{List.partition_size_within_level}",
174 'type' => "string", # Must be string because multiple values can be specified (separated by '/')
175 'deft' => $partition_size_default},
176
177 { 'name' => "partition_name_length",
178 'desc' => "{List.partition_name_length}",
179 'type' => "string" },
180
181 { 'name' => "max_partition_name_length",
182 'desc' => "{List.partition_name_length}",
183 'type' => "string",
184 'deft' => "3" },
185
186 {'name' => "partition_sort_mode_within_level",
187 'desc' => "{List.partition_sort_mode_within_level}",
188 'type' => "enumstring", # Must be enumstring because multiple values can be specified (separated by '/')
189 'list' => $metadata_sort_mode_list,
190 'deft' => $metadata_sort_mode_default },
191
192 { 'name' => "numeric_partition_type_within_level",
193 'desc' => "{List.numeric_partition_type_within_level}",
194 'type' => "enumstring", # Must be enumstring because multiple values can be specified (separated by '/')
195 'list' => $numeric_partition_type_list,
196 'deft' => $numeric_partition_type_default },
197
198 { 'name' => "numeric_partition_size_within_level",
199 'desc' => "{List.numeric_partition_size_within_level}",
200 'type' => "string", # Must be string because multiple values can be specified (separated by '/')
201 'deft' => $numeric_partition_size_default},
202
203 { 'name' => "numeric_partition_name_length_within_level",
204 'desc' => "{List.numeric_partition_name_length_within_level}",
205 'type' => "string",
206 'deft' => $numeric_partition_name_length_default },
207
208 {'name' => "numeric_partition_sort_mode_within_level",
209 'desc' => "{List.numeric_partition_sort_mode_within_level}",
210 'type' => "enumstring", # Must be enumstring because multiple values can be specified (separated by '/')
211 'list' => $metadata_sort_mode_list,
212 'deft' => $metadata_sort_mode_default },
213
214 { 'name' => "numbers_first",
215 'desc' => "{List.numbers_first}",
216 'type' => 'flag'},
217
218 { 'name' => "sort_leaf_nodes_using",
219 'desc' => "{List.sort_leaf_nodes_using}",
220 'type' => "metadata",
221 'deft' => $sort_leaf_nodes_using_default },
222
223 { 'name' => "sort_leaf_nodes_sort_mode",
224 'desc' => "{List.sort_leaf_nodes_sort_mode}",
225 'type' => "enum",
226 'list' => $metadata_sort_mode_list,
227 'deft' => $metadata_sort_mode_default },
228
229 { 'name' => "reverse_sort_leaf_nodes",
230 'desc' => "{List.reverse_sort_leaf_nodes}",
231 'type' => "flag"},
232
233 { 'name' => "sort_leaf_nodes_removeprefix",
234 'desc' => "{List.sort_leaf_removeprefix}",
235 'type' => "regexp" },
236
237 { 'name' => "sort_leaf_nodes_removesuffix",
238 'desc' => "{List.sort_leaf_nodes_removesuffix}",
239 'type' => "regexp" },
240
241 { 'name' => "sort_using_unicode_collation",
242 'desc' => "{List.metadata_sort.unicode} {List.sort_using_unicode_collation}",
243 'type' => "flag" },
244
245 {'name' => "filter_metadata",
246 'desc' => "{List.filter_metadata}",
247 'type' => "metadata"},
248
249 {'name' => "filter_regex",
250 'desc' => "{List.filter_regex}",
251 'type' => "regexp"},
252
253 { 'name' => "use_formatted_metadata_for_bookshelf_display",
254 'desc' => "{List.use_formatted_metadata_for_bookshelf_display}",
255 'type' => "flag"},
256
257 { 'name' => "removeprefix",
258 'desc' => "{BasClas.removeprefix}",
259 'type' => "regexp" },
260
261 { 'name' => "removesuffix",
262 'desc' => "{BasClas.removesuffix}",
263 'type' => "regexp" } ];
264
265my $options = { 'name' => "List",
266 'desc' => "{List.desc}",
267 'abstract' => "no",
268 'inherits' => "yes",
269 'args' => $arguments };
270
271
272sub new
273{
274 my ($class) = shift(@_);
275 my ($classifierslist, $inputargs, $hashArgOptLists) = @_;
276 push(@$classifierslist, $class);
277
278 push(@{$hashArgOptLists->{"ArgList"}}, @{$arguments});
279 push(@{$hashArgOptLists->{"OptList"}}, $options);
280
281 my $self = new BaseClassifier($classifierslist, $inputargs, $hashArgOptLists);
282
283 bless $self, $class;
284
285 if ($self->{'info_only'}) {
286 # don't worry about any options etc
287 return $self;
288 }
289
290 # The metadata elements to use (required)
291 if (!$self->{'metadata'}) {
292 die "Error: No metadata fields specified for List.\n";
293 }
294
295 my @metadata_groups = split(/[\/]/, $self->{'metadata'});
296 $self->{'metadata_groups'} = \@metadata_groups;
297
298 # The classifier button name (default: the first metadata element specified)
299 if (!$self->{'buttonname'}) {
300 my $first_metadata_group = $metadata_groups[0];
301 my $first_metadata_element = (split(/[\;|,\/]/, $first_metadata_group))[0];
302 $self->{'buttonname'} = $self->generate_title_from_metadata($first_metadata_element);
303 }
304
305 # meta selection mode for each level
306 $self->set_metadata_groups_info_per_level("metadata_selection_mode_within_level", $metadata_selection_mode_default, $valid_metadata_selection_modes);
307
308 # meta sort mode for each level
309 if ($self->{'sort_using_unicode_collation'}) {
310 print STDERR "WARNING: sort_using_unicode_collation is set, setting metadata_sort_mode_within_level to unicode for all levels, regardless of current setting\n";
311 $self->{'metadata_sort_mode_within_level'} = "unicode";
312 $metadata_sort_mode_default = "unicode";
313 } else {
314 if ($self->{'metadata_sort_mode_within_level'} =~ /unicode/) {
315 $self->{'sort_using_unicode_collation'} = 1;
316 }
317 }
318
319
320 $self->set_metadata_groups_info_per_level('metadata_sort_mode_within_level', $metadata_sort_mode_default, $valid_metadata_sort_modes);
321
322 # Whether to group items into a bookshelf, (must be 'always' for all metadata fields except the last)
323 foreach my $metadata_group (@metadata_groups) {
324 $self->{$metadata_group . ".bookshelf_type"} = "always";
325 }
326 my $last_metadata_group = $metadata_groups[$#metadata_groups];
327 # Default: duplicate_only, ie. leave leaf nodes ungrouped (equivalent to AZCompactList -mingroup 2)
328 $self->{$last_metadata_group . ".bookshelf_type"} = $self->{'bookshelf_type'};
329
330 # How the items are grouped into partitions (default: by letter)
331 # for each level (metadata group), separated by '/'
332 $self->set_metadata_groups_info_per_level("partition_type_within_level", $partition_type_default, $valid_partition_types);
333 $self->set_metadata_groups_info_per_level("numeric_partition_type_within_level", $numeric_partition_type_default, $valid_numeric_partition_types);
334
335 # now check whether a level was none - need to set the equivalent level in the other half also to none
336 foreach my $metadata_group (@metadata_groups) {
337 if ($self->{$metadata_group . ".partition_type_within_level"} eq "none" || $self->{$metadata_group . ".numeric_partition_type_within_level"} eq "none") {
338
339 print STDERR "WARNING: one of -partition_type_within_level or -numeric_partition_type_within_level was set to 'none' for level $metadata_group, overriding current value of both these options to 'none'\n";
340
341 $self->{$metadata_group . ".partition_type_within_level"} = "none";
342 $self->{$metadata_group . ".numeric_partition_type_within_level"} = "none";
343 }
344 }
345
346 $self->set_metadata_groups_info_per_level("partition_size_within_level", $partition_size_default);
347 $self->set_metadata_groups_info_per_level("numeric_partition_size_within_level", $numeric_partition_size_default);
348
349 $self->set_metadata_groups_info_per_level('partition_sort_mode_within_level', $metadata_sort_mode_default, $valid_metadata_sort_modes);
350
351 $self->set_metadata_groups_info_per_level('numeric_partition_sort_mode_within_level', $metadata_sort_mode_default, $valid_metadata_sort_modes);
352
353 $self->set_metadata_groups_info_per_level("numeric_partition_name_length_within_level", $numeric_partition_name_length_default);
354
355 # The removeprefix and removesuffix expressions
356 if ($self->{'removeprefix'}) {
357 # If there are more than one expressions, use '' to quote each experession and '/' to separate
358 my @removeprefix_exprs_within_levellist = split(/'\/'/, $self->{'removeprefix'});
359
360 foreach my $metadata_group (@metadata_groups) {
361 my $removeprefix_expr_within_levelelem = shift(@removeprefix_exprs_within_levellist);
362
363 if (defined($removeprefix_expr_within_levelelem) && $removeprefix_expr_within_levelelem ne "") {
364 # Remove the other ' at the beginning and the end if there is any
365 $removeprefix_expr_within_levelelem =~ s/^'//;
366 $removeprefix_expr_within_levelelem =~ s/'$//;
367 # Remove the extra ^ at the beginning
368 $removeprefix_expr_within_levelelem =~ s/^\^//;
369 $self->{$metadata_group . ".remove_prefix_expr"} = $removeprefix_expr_within_levelelem;
370 } else {
371 $self->{$metadata_group . ".remove_prefix_expr"} = $self->{$metadata_groups[0] . ".remove_prefix_expr"};
372 }
373 }
374 }
375 if ($self->{'removesuffix'}) {
376 my @removesuffix_exprs_within_levellist = split(/'\/'/, $self->{'removesuffix'});
377
378 foreach my $metadata_group (@metadata_groups) {
379 my $removesuffix_expr_within_levelelem = shift(@removesuffix_exprs_within_levellist);
380
381 if (defined($removesuffix_expr_within_levelelem) && $removesuffix_expr_within_levelelem ne "") {
382 $removesuffix_expr_within_levelelem =~ s/^'//;
383 $removesuffix_expr_within_levelelem =~ s/'$//;
384 # Remove the extra $ at the end
385 $removesuffix_expr_within_levelelem =~ s/\$$//;
386 $self->{$metadata_group . ".remove_suffix_expr"} = $removesuffix_expr_within_levelelem;
387 } else {
388 $self->{$metadata_group . ".remove_suffix_expr"} = $self->{$metadata_groups[0] . ".remove_suffix_expr"};
389 }
390 }
391 }
392
393 # The metadata elements to use to sort the leaf nodes (default: Title)
394 my @sort_leaf_nodes_using_metadata_groups = split(/\|/, $self->{'sort_leaf_nodes_using'});
395 $self->{'sort_leaf_nodes_using_metadata_groups'} = \@sort_leaf_nodes_using_metadata_groups;
396
397 foreach my $sort_group (@sort_leaf_nodes_using_metadata_groups) {
398 # set metadata_select_type, if not already set - might be already set if the same group was used in -metadata
399 if (!defined $self->{$sort_group . ".metadata_selection_mode_within_level"}) {
400 $self->{$sort_group . ".metadata_selection_mode_within_level"} = $metadata_selection_mode_default;
401 }
402
403 }
404
405 my @leaf_nodes_sort_modes = split (/\|/, $self->{'sort_leaf_nodes_sort_mode'});
406 foreach my $sort_group (@sort_leaf_nodes_using_metadata_groups) {
407 my $leaf_sort_mode = shift(@leaf_nodes_sort_modes);
408 if (!defined $self->{$sort_group . ".metadata_sort_mode_within_level"}) {
409 if (defined $leaf_sort_mode && defined $valid_metadata_sort_modes->{$leaf_sort_mode}) {
410 $self->{$sort_group . ".metadata_sort_mode_within_level"} = $leaf_sort_mode;
411 }
412 else {
413 $self->{$sort_group . ".metadata_sort_mode_within_level"} = $metadata_sort_mode_default;
414 }
415 }
416
417 }
418
419 # Create an instance of the Unicode::Collate object if better Unicode sorting is desired
420 if ($self->{'sort_using_unicode_collation'}) {
421 # To use this you first need to download the allkeys.txt file from
422 # http://www.unicode.org/Public/UCA/latest/allkeys.txt and put it in the Perl
423 # Unicode/Collate directory.
424 require Unicode::Collate;
425 $self->{'unicode_collator'} = Unicode::Collate->new();
426 }
427
428 # An empty array for the document/section OIDs that we are classifying
429 $self->{'OIDs'} = [];
430 # A hash for all the doc ids that we have seen, so we don't classify something twice
431 $self->{'all_doc_OIDs'} = {};
432 return $self;
433}
434
435
436sub init
437{
438 # Nothing to do...
439}
440
441sub set_metadata_groups_info_per_level
442{
443 my $self = shift(@_);
444 my $info_name = shift(@_);
445 my $info_default = shift(@_);
446 my $info_valid_types_hash_ref = shift(@_);
447
448 if (!defined $self->{$info_name}) {
449 print STDERR "List Error: no values were set for option $info_name\n";
450 }
451 my @info_list = split(/\//, $self->{$info_name});
452
453 my $first = 1;
454 foreach my $metadata_group (@{$self->{'metadata_groups'}}) {
455 my $info_elem = shift(@info_list);
456 if (defined ($info_elem) && (!defined $info_valid_types_hash_ref || defined $info_valid_types_hash_ref->{$info_elem})) {
457 $self->{$metadata_group .".$info_name"} = $info_elem;
458 } else {
459 # its empty or an invalid entry
460 my $new_info_elem;
461 if ($first) {
462 $new_info_elem = $info_default;
463 } else {
464 # get the value we had at first
465 $new_info_elem = $self->{@{$self->{'metadata_groups'}}[0] . ".$info_name"};
466 }
467 $self->{$metadata_group .".$info_name"} = $new_info_elem;
468 if (defined $info_elem) {
469 print STDERR "List Error: $info_elem is not a valid value for $info_name, changing it to $new_info_elem\n";
470
471 }
472 }
473 $first = 0;
474 }
475
476}
477
478# Called for each document in the collection
479sub classify
480{
481 my $self = shift(@_);
482 my ($doc_obj) = @_;
483
484 if (defined $self->{'all_doc_OIDs'}->{$doc_obj->get_OID()}) {
485 print STDERR "Warning, List classifier has already seen document ".$doc_obj->get_OID().", not classifying again\n";
486 return;
487 }
488
489 $self->{'all_doc_OIDs'}->{$doc_obj->get_OID()} = 1;
490
491 # check against filter here
492 if ($self->{'filter_metadata'}) {
493 my $meta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'filter_metadata'});
494 return unless defined $meta;
495 if ($self->{'filter_regex'} ne "" && $meta !~ /$self->{'filter_regex'}/) {
496 print STDERR "doc $doc_obj doesn't pass filtering requirement. Not classifying.\n" if ($self->{'verbosity'} > 3);
497 return;
498 }
499 }
500 # if we get here, we have passed the test for filtering
501 # If "-classify_sections" is set, classify every section of the document
502 if ($self->{'classify_sections'}) {
503 my $section = $doc_obj->get_next_section($doc_obj->get_top_section());
504 while (defined $section) {
505 $self->classify_section($doc_obj, $doc_obj->get_OID() . ".$section", $section);
506 $section = $doc_obj->get_next_section($section);
507 }
508 }
509 # Otherwise just classify the top document section
510 else {
511 $self->classify_section($doc_obj, $doc_obj->get_OID(), $doc_obj->get_top_section());
512 }
513
514}
515
516sub classify_section
517{
518 my $self = shift(@_);
519 my ($doc_obj,$section_OID,$section) = @_;
520
521 my @metadata_groups = @{$self->{'metadata_groups'}};
522
523 # Only classify the section if it has a value for one of the metadata elements in the first group
524 my $classify_section = 0;
525 my $first_metadata_group = $metadata_groups[0];
526 my $remove_prefix_expr = $self->{$first_metadata_group . ".remove_prefix_expr"};
527 my $remove_suffix_expr = $self->{$first_metadata_group . ".remove_suffix_expr"};
528 foreach my $first_metadata_group_element (split(/\;|,/, $first_metadata_group)) {
529 my $real_first_metadata_group_element = $self->strip_ex_from_metadata($first_metadata_group_element);
530 my $first_metadata_group_element_value = $doc_obj->get_metadata_element($section, $real_first_metadata_group_element);
531 # Remove prefix/suffix if requested
532 if (defined ($first_metadata_group_element_value)) {
533 if (defined $remove_prefix_expr && $remove_prefix_expr ne "") {
534 $first_metadata_group_element_value =~ s/^$remove_prefix_expr//;
535 }
536
537 if (defined $remove_suffix_expr && $remove_suffix_expr ne "") {
538 $first_metadata_group_element_value =~ s/$remove_suffix_expr$//;
539 }
540 }
541
542 $first_metadata_group_element_value = &sorttools::format_metadata_for_sorting($first_metadata_group, $first_metadata_group_element_value, $doc_obj, $self->{'casefold_metadata_for_sorting'}, $self->{'accentfold_metadata_for_sorting'}) unless $self->{'no_metadata_formatting'};
543 if (defined($first_metadata_group_element_value) && $first_metadata_group_element_value ne "") {
544 # This section must be included in the classifier as we have found a value
545 $classify_section = 1;
546 last;
547
548 }
549 }
550
551 # We're not classifying this section because it doesn't have the required metadata
552 return if (!$classify_section);
553
554 # Otherwise, include this section in the classifier
555
556 push(@{$self->{'OIDs'}}, $section_OID);
557
558 # Create a hash for the metadata values of each metadata element we're interested in
559 my %metadata_groups_done = ();
560 foreach my $metadata_group (@metadata_groups, @{$self->{'sort_leaf_nodes_using_metadata_groups'}}) {
561 # Take care not to do a metadata group more than once
562 unless ($metadata_groups_done{$metadata_group}) {
563 my $remove_prefix_expr = $self->{$metadata_group . ".remove_prefix_expr"};
564 my $remove_suffix_expr = $self->{$metadata_group . ".remove_suffix_expr"};
565 foreach my $metadata_element (split(/\;|,/, $metadata_group)) {
566 my $real_metadata_element = $self->strip_ex_from_metadata($metadata_element);
567
568 my @metadata_values = @{$doc_obj->get_metadata($section, $real_metadata_element)};
569 foreach my $metadata_value (@metadata_values) {
570 #print STDERR "working with value $metadata_value\n";
571 # Strip leading and trailing whitespace
572 $metadata_value =~ s/^\s*//;
573 $metadata_value =~ s/\s*$//;
574
575 # Remove prefix/suffix if requested
576 if (defined $remove_prefix_expr && $remove_prefix_expr ne "") {
577 $metadata_value =~ s/^$remove_prefix_expr//;
578 }
579 if (defined $remove_suffix_expr && $remove_suffix_expr ne "") {
580 $metadata_value =~ s/$remove_suffix_expr$//;
581 }
582
583 # lowercase metadata both for sorting meta (d/D under D), and to allow CSS to be able to
584 # text-transform the stored lowercase values as capitalize or uppercase (can't CSS
585 # text-transform if stored uppercase). 2 CSS text-transforms have been added to core.css
586 ### no longer do this, as lowercasing is now an option for the user, and is handled by format_metadata_for_sorting
587 my $lc_metadata_value = $metadata_value; #lc($metadata_value);
588 $lc_metadata_value = &sorttools::format_metadata_for_sorting($real_metadata_element, $lc_metadata_value, $doc_obj, $self->{'casefold_metadata_for_sorting'}, $self->{'accentfold_metadata_for_sorting'}) unless $self->{'no_metadata_formatting'};
589
590 # Add the metadata value into the list for this combination of metadata group
591 # and section - if we have some non-whitespace chars
592 # test that we have some non-whitespace chars
593 if ($lc_metadata_value =~ /\S/) {
594
595 push(@{$self->{$metadata_group . ".list"}->{$section_OID}}, $lc_metadata_value);
596
597 # add the actual value into the stored values so we can remember the case
598 if (!$self->{'use_formatted_metadata_for_bookshelf_display'}) {
599 if (defined $self->{$metadata_group . ".actualvalues"}->{$lc_metadata_value}->{$metadata_value}) {
600 $self->{$metadata_group . ".actualvalues"}->{$lc_metadata_value}->{$metadata_value}++;
601 } else {
602 $self->{$metadata_group . ".actualvalues"}->{$lc_metadata_value}->{$metadata_value} = 1;
603 }
604 }
605 last if ($self->{$metadata_group . ".metadata_selection_mode_within_level"} eq "firstvalue");
606 }
607 } # foreach metadatavalue
608 last if ((@metadata_values > 0) && $self->{$metadata_group . ".metadata_selection_mode_within_level"} =~ /^(firstvalue|firstvalidmetadata)$/ );
609 } # foreach metadata element
610
611 $metadata_groups_done{$metadata_group} = 1;
612 }
613 }
614}
615
616
617sub get_classify_info
618{
619 my $self = shift(@_);
620
621 # The metadata groups to classify by
622 my @metadata_groups = @{$self->{'metadata_groups'}};
623 my $first_metadata_group = $metadata_groups[0];
624
625 # The OID values of the documents to include in the classifier
626 my @OIDs = @{$self->{'OIDs'}};
627
628 # Create the root node of the classification hierarchy
629 my %classifier_node = ( 'thistype' => "Invisible",
630 'childtype' => "VList",
631 'Title' => $self->{'buttonname'},
632 'contains' => [],
633 'mdtype' => $first_metadata_group );
634
635 # Recursively create the classification hierarchy, one level for each metadata group
636 $self->add_level(\@metadata_groups, \@OIDs, \%classifier_node);
637 return \%classifier_node;
638}
639
640
641sub add_level
642{
643 my $self = shift(@_);
644 my @metadata_groups = @{shift(@_)};
645 my @OIDs = @{shift(@_)};
646 my $classifier_node = shift(@_);
647
648 my $metadata_group = $metadata_groups[0];
649 if (!defined($self->{$metadata_group . ".list"})) {
650 print STDERR "Warning: No metadata values assigned to $metadata_group.\n";
651 return;
652 }
653
654 # Create a mapping from metadata value to OID
655 my $OID_to_metadata_values_hash_ref = $self->{$metadata_group . ".list"};
656 my %metadata_value_to_OIDs_hash = ();
657 my %numeric_metadata_value_to_OIDs_hash = ();
658 foreach my $OID (@OIDs)
659 {
660 if ($OID_to_metadata_values_hash_ref->{$OID})
661 {
662 my @metadata_values = @{$OID_to_metadata_values_hash_ref->{$OID}};
663 foreach my $metadata_value (@metadata_values)
664 {
665 if ($metadata_value =~ /^[0-9]/) {
666 push(@{$numeric_metadata_value_to_OIDs_hash{$metadata_value}}, $OID);
667 } else {
668 push(@{$metadata_value_to_OIDs_hash{$metadata_value}}, $OID);
669 }
670 }
671 }
672 }
673 #print STDERR "Number of distinct values: " . scalar(keys %metadata_value_to_OIDs_hash) . "\n";
674 #print STDERR "Number of distinct numeric values: " . scalar(keys %numeric_metadata_value_to_OIDs_hash) . "\n";
675
676 # Partition the values (if necessary)
677 my $partition_type_within_level = $self->{$metadata_group . ".partition_type_within_level"};
678 my $partition_size_within_level = $self->{$metadata_group . ".partition_size_within_level"};
679 my $partition_sort_mode_within_level = $self->{$metadata_group . ".partition_sort_mode_within_level"};
680 my $bookshelf_type_within_level = $self->{$metadata_group. ".bookshelf_type"};
681
682
683 #############################################
684 ### DO THE NUMBERS IF THEY ARE TO COME FIRST
685 #############################################
686 if ($self->{'numbers_first'} && keys(%numeric_metadata_value_to_OIDs_hash)) {
687 $self->partition_numeric_values(\@metadata_groups, $classifier_node, \%numeric_metadata_value_to_OIDs_hash);
688 }
689
690 ############################################
691 # DO THE LETTERS
692 ############################################
693 if (keys(%metadata_value_to_OIDs_hash)){ # make sure we have some values
694 if ($partition_type_within_level =~ /^per_letter$/i) {
695 $self->split_per_letter_or_digit(\@metadata_groups, $classifier_node, $partition_sort_mode_within_level, \%metadata_value_to_OIDs_hash);
696 }
697 elsif ($partition_type_within_level =~ /^approximate_size$/i && scalar(keys %metadata_value_to_OIDs_hash) > $partition_size_within_level) {
698 $self->split_approximate_size(\@metadata_groups, $classifier_node, $partition_size_within_level, $partition_sort_mode_within_level, $bookshelf_type_within_level, \%metadata_value_to_OIDs_hash, $self->{'partition_name_length'}, $self->{'max_partition_name_length'});
699
700 }
701 elsif ($partition_type_within_level =~ /^constant_size$/i && scalar(keys %metadata_value_to_OIDs_hash) > $partition_size_within_level) {
702 $self->split_constant_size(\@metadata_groups, $classifier_node, $partition_size_within_level, $partition_sort_mode_within_level, $bookshelf_type_within_level, \%metadata_value_to_OIDs_hash, $self->{'partition_name_length'}, $self->{'max_partition_name_length'});
703 }
704
705 # Otherwise just add all the values to a VList
706 else {
707 if ($partition_type_within_level =~ /^all_values$/i) {
708 $classifier_node->{'childtype'} = "HList";
709 $self->{$metadata_group. ".bookshelf_type"} = "always";
710 }
711 $self->add_vlist(\@metadata_groups, $classifier_node, \%metadata_value_to_OIDs_hash);
712 }
713 }
714
715 ###########################################
716 ### DO THE NUMBERS IF THEY ARE TO COME LAST
717 ###########################################
718 if (!$self->{'numbers_first'} && keys(%numeric_metadata_value_to_OIDs_hash)) {
719 $self->partition_numeric_values(\@metadata_groups, $classifier_node, \%numeric_metadata_value_to_OIDs_hash);
720 }
721}
722
723sub partition_numeric_values
724{
725 my $self = shift(@_);
726 my @metadata_groups = @{shift(@_)};
727 my $classifier_node = shift(@_);
728 my $numeric_metadata_value_to_OIDs_hash_ref = shift(@_);
729
730 my $metadata_group = $metadata_groups[0];
731 my $numeric_partition_type_within_level = $self->{$metadata_group . ".numeric_partition_type_within_level"};
732 my $numeric_partition_size_within_level = $self->{$metadata_group . ".numeric_partition_size_within_level"};
733 my $numeric_partition_sort_mode_within_level = $self->{$metadata_group . ".numeric_partition_sort_mode_within_level"};
734 my $numeric_partition_name_length_within_level = $self->{$metadata_group . ".numeric_partition_name_length_within_level"};
735 my $bookshelf_type_within_level = $self->{$metadata_group. ".bookshelf_type"};
736
737 if ($numeric_partition_type_within_level eq "single_partition") {
738 $self->add_hlist_partition(\@metadata_groups, $classifier_node, "0-9", $numeric_metadata_value_to_OIDs_hash_ref);
739 }
740 elsif ($numeric_partition_type_within_level eq "per_digit") {
741 $self->split_per_letter_or_digit(\@metadata_groups, $classifier_node, $numeric_partition_sort_mode_within_level, $numeric_metadata_value_to_OIDs_hash_ref, 1, 1);
742 }
743 elsif ($numeric_partition_type_within_level eq "per_number") {
744 # each different number is a bucket
745 $self->split_per_letter_or_digit(\@metadata_groups, $classifier_node, $numeric_partition_sort_mode_within_level, $numeric_metadata_value_to_OIDs_hash_ref, 1, $numeric_partition_name_length_within_level);
746 }
747 elsif ($numeric_partition_type_within_level eq "constant_size" && scalar(keys %$numeric_metadata_value_to_OIDs_hash_ref) > $numeric_partition_size_within_level) {
748 # Generate hlists of a certain size
749
750 $self->split_constant_size(\@metadata_groups, $classifier_node, $numeric_partition_size_within_level, $numeric_partition_sort_mode_within_level, $bookshelf_type_within_level, $numeric_metadata_value_to_OIDs_hash_ref, $numeric_partition_name_length_within_level,$numeric_partition_name_length_within_level, 1);
751 } elsif ($numeric_partition_type_within_level eq "approximate_size" && scalar(keys %$numeric_metadata_value_to_OIDs_hash_ref) > $numeric_partition_size_within_level) {
752 $self->split_approximate_size(\@metadata_groups, $classifier_node, $numeric_partition_size_within_level, $numeric_partition_sort_mode_within_level, $bookshelf_type_within_level, $numeric_metadata_value_to_OIDs_hash_ref, $numeric_partition_name_length_within_level, $numeric_partition_name_length_within_level, 1);
753 }
754 # Otherwise just add all the values to a VList
755 else {
756 if ($numeric_partition_type_within_level =~ /^all_values$/i) {
757 $classifier_node->{'childtype'} = "HList";
758 $self->{$metadata_group. ".bookshelf_type"} = "always";
759 }
760
761 $self->add_vlist(\@metadata_groups, $classifier_node, $numeric_metadata_value_to_OIDs_hash_ref);
762 }
763
764}
765
766###TODO add split_approximate_size_ORIG
767
768sub split_approximate_size
769{
770
771 my $self = shift(@_);
772 my @metadata_groups = @{shift(@_)};
773 my $classifier_node = shift(@_);
774 my $partition_size = shift(@_);
775 my $sort_mode = shift(@_);
776 my $bookshelf_type = shift(@_);
777 my $metadata_value_to_OIDs_hash_ref = shift(@_);
778 my $partition_name_length = shift(@_);
779 my $max_partition_name_length = shift(@_);
780 my $is_numeric = shift(@_);
781
782 my $tolerance = 10; # should this be an option??
783
784 # Generate hlist based on the first letter of the metadata value (like per_letter), or based on
785 # numbers, but also with restriction on the partition size
786 # If a partition has fewer items than specified by the "partition_size_within_level", then group them together if possible
787 # If a partition has more items than specified, split into several hlists.
788 # Depends on the bookshelf_type, one item can be either a document (when bookshelf_type is "never") or a metadata value (otherwise)
789
790 my @sortedmetadata_values = $self->sort_metadata_values_array($sort_mode, keys(%$metadata_value_to_OIDs_hash_ref));
791
792 # Separate values by their first letter, each form a bucket, like the per_letter partition type
793 my $last_partition = $self->generate_partition_name($sortedmetadata_values[0], $partition_name_length, $is_numeric);
794
795 my @partition_buckets = ();
796 my @metadata_values_in_bucket = ();
797 my $num_items_in_bucket = 0;
798
799 foreach my $metadata_value (@sortedmetadata_values) {
800 my $metadata_valuepartition = $self->generate_partition_name($metadata_value, $partition_name_length, $is_numeric);
801 if ($metadata_valuepartition ne $last_partition) {
802 my @temp_array = @metadata_values_in_bucket;
803 # Cache the values that belong to this bucket, and the number of items in this bucket, not necessary to be the same number as the metadata values
804 my %partition_info = ();
805 $partition_info{'metadata_values'} = \@temp_array;
806 $partition_info{'size'} = $num_items_in_bucket;
807 $partition_info{'name'} = $last_partition;
808 push (@partition_buckets, \%partition_info);
809
810 @metadata_values_in_bucket = ($metadata_value);
811 $num_items_in_bucket = ($bookshelf_type eq "never" ? scalar(@{$metadata_value_to_OIDs_hash_ref->{$metadata_value}}) : scalar(@metadata_values_in_bucket));
812 $last_partition = $metadata_valuepartition;
813 } else {
814 $num_items_in_bucket += ($bookshelf_type eq "never" ? scalar(@{$metadata_value_to_OIDs_hash_ref->{$metadata_value}}) : 1); #scalar(@metadata_values_in_bucket);
815 push (@metadata_values_in_bucket, $metadata_value);
816 }
817 }
818 # Last one
819 my %partition_info = ();
820 $partition_info{'metadata_values'} = \@metadata_values_in_bucket;
821 $partition_info{'size'} = $num_items_in_bucket;
822 $partition_info{'name'} = $last_partition;
823
824 push (@partition_buckets, \%partition_info);
825
826 # now go through the array of A, B, C buckets, and merge small buckets
827 my @new_partition_buckets = ();
828 for (my $i = 0; $i < scalar(@partition_buckets) - 1; $i++) {
829
830 my $this_bucket = $partition_buckets[$i];
831 my $next_bucket = $partition_buckets[$i+1];
832
833 my $items_in_partition = $this_bucket->{'size'};
834
835 if ($items_in_partition < $partition_size ) {
836 my $items_in_next_partition = $next_bucket->{'size'};
837 if ($items_in_partition + $items_in_next_partition <= $partition_size+$tolerance ) {
838 # merge this bucket into the next bucket
839 foreach my $metadata_value_to_merge (@{$this_bucket->{'metadata_values'}}) {
840 push(@{$next_bucket->{'metadata_values'}}, $metadata_value_to_merge);
841 }
842 $next_bucket->{'size'} += $items_in_partition;
843
844 } else {
845 # remember this bucket
846 push (@new_partition_buckets, $this_bucket);
847 }
848 } else {
849 # remember this bucket
850 push (@new_partition_buckets, $this_bucket);
851 }
852 }
853 # add in the last bucket
854 my $last_bucket = $partition_buckets[scalar(@partition_buckets) - 1];
855 push (@new_partition_buckets, $last_bucket);
856
857 # Add partitions to the main list, but divide big bucket into several
858 my $last_partition_end = "";
859 my $partition_start = "";
860 my $partition_end = "";
861 my $partition_name = "";
862 foreach my $partition (@new_partition_buckets) {
863 my @metadata_values = $self->sort_metadata_values_array($sort_mode, @{$partition->{'metadata_values'}});
864 my $items_in_partition = $partition->{'size'};
865 $partition_start = $self->generate_partition_start($metadata_values[0], $last_partition_end, $partition_name_length, $max_partition_name_length, $is_numeric);
866
867 if ($items_in_partition <= $partition_size+$tolerance) {
868 # we can just add the partition as is
869 my %metadata_values_to_OIDs_subhashes = ();
870 for (my $i = 0; $i < scalar(@metadata_values); $i++) {
871 my $metadata_value = $metadata_values[$i];
872 $metadata_values_to_OIDs_subhashes{$metadata_value} = $metadata_value_to_OIDs_hash_ref->{$metadata_value};
873 }
874 my $last_metadata_value = $metadata_values[scalar(@metadata_values)-1];
875 $partition_end = $self->generate_partition_end($last_metadata_value, $partition_start, $partition_name_length, $max_partition_name_length, $is_numeric);
876 $partition_name = $partition_start;
877 if ($partition_end ne $partition_start) {
878 $partition_name = $partition_name . "-" . $partition_end;
879 }
880 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partition_name, \%metadata_values_to_OIDs_subhashes);
881 $last_partition_end = $partition_end;
882 } else {
883 # we have too many items, need to split the partition
884 my $num_splits = int($items_in_partition/$partition_size);
885 $num_splits++ if (($items_in_partition - $partition_size*$num_splits) > $tolerance);
886 my $this_partition_size = $items_in_partition/$num_splits;
887 # regenerate-the start, noticing that we are a split
888 $partition_start = $self->generate_partition_start($metadata_values[0], $last_partition_end, $partition_name_length, $max_partition_name_length, $is_numeric, 1);
889 my $items_done = 0;
890 my $prev_done = 0;
891 my %metadata_values_to_OIDs_subhashes = ();
892 for (my $i = 0; $i < scalar(@metadata_values); $i++) {
893 my $metadata_value = $metadata_values[$i];
894 # If the bookshelf_type is "never", count the documents, otherwise count the distinct metadata values
895 my $items_for_this_md_value = $bookshelf_type eq "never" ? scalar(@{$metadata_value_to_OIDs_hash_ref->{$metadata_value}}) : 1;
896
897 if ($items_done + $items_for_this_md_value > $this_partition_size && $items_done != 0 && ($items_in_partition - ($prev_done+$items_done) >= $tolerance)) {
898 # Save the stored items into a partition
899 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partition_name, \%metadata_values_to_OIDs_subhashes);
900 $last_partition_end = $partition_end;
901 $partition_start = $self->generate_partition_start($metadata_value, $last_partition_end, $partition_name_length, $max_partition_name_length, $is_numeric, 1);
902 $prev_done += $items_done;
903 $items_done = 0;
904 %metadata_values_to_OIDs_subhashes = ();
905 }
906
907 # If bookshelf_type is "never" and the current metadata value holds too many items, need to split into several partitions
908 if ($bookshelf_type eq "never" && $items_for_this_md_value > $this_partition_size) {
909 # if this is the case, we would have already stored what we have done in the previous step.
910 my $partitionname_for_this_value = $self->generate_partition_start($metadata_value, $last_partition_end, $partition_name_length, $max_partition_name_length, $is_numeric);
911 # Get the number of partitions needed for this value
912 my $num_splits = int($items_for_this_md_value / $this_partition_size);
913 $num_splits++ if ($items_for_this_md_value / $this_partition_size > $num_splits);
914 my @OIDs_for_this_value = @{$metadata_value_to_OIDs_hash_ref->{$metadata_value}};
915 for (my $i = 0; $i < $num_splits; $i++) {
916 my %OIDs_subhashes_for_this_value = ();
917 my @OIDs_for_this_partition = ();
918 for (my $d = $i * $this_partition_size; $d < (($i+1) * $this_partition_size > $items_for_this_md_value ? $items_for_this_md_value : ($i+1) * $partition_size); $d++) {
919 push (@OIDs_for_this_partition, $OIDs_for_this_value[$d]);
920 }
921
922 # The last bucket might have only a few items and need to be merged with buckets for subsequent metadata values
923 if ($i == $num_splits - 1 && scalar(@OIDs_for_this_partition) < $this_partition_size) {
924 $partition_start = $partitionname_for_this_value;
925 $partition_name = $partition_start;
926 $metadata_values_to_OIDs_subhashes{$metadata_value} = \@OIDs_for_this_partition;
927 $items_done += scalar(@OIDs_for_this_partition);
928 $last_partition_end = $partitionname_for_this_value
929 } else {
930
931 # Add an HList for this bucket
932 $OIDs_subhashes_for_this_value{$metadata_value} = \@OIDs_for_this_partition;
933 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname_for_this_value, \%OIDs_subhashes_for_this_value);
934 $last_partition_end = $partitionname_for_this_value;
935 }
936 }
937 } else {
938 $metadata_values_to_OIDs_subhashes{$metadata_value} = $metadata_value_to_OIDs_hash_ref->{$metadata_value};
939 $items_done += $bookshelf_type eq "never" ? scalar(@{$metadata_values_to_OIDs_subhashes{$metadata_value}}) : 1;
940 $partition_end = $self->generate_partition_end($metadata_value, $partition_start, $partition_name_length, $max_partition_name_length, $is_numeric);
941 $partition_name = $partition_start;
942 if ($partition_end ne $partition_start) {
943 $partition_name = $partition_name . "-" . $partition_end;
944 }
945
946 }
947
948 # The last partition
949 if($i == scalar(@metadata_values) - 1 && $items_done >0) {
950 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partition_name, \%metadata_values_to_OIDs_subhashes);
951 }
952
953 }
954 } # end if items in partition > partition size
955
956 }
957
958 # The partitions are stored in an HList
959 $classifier_node->{'childtype'} = "HList";
960
961}
962
963sub split_constant_size
964{
965 my $self = shift(@_);
966 my @metadata_groups = @{shift(@_)};
967 my $classifier_node = shift(@_);
968 my $partition_size = shift(@_);
969 my $sort_mode = shift(@_);
970 my $bookshelf_type = shift(@_);
971 my $metadata_value_to_OIDs_hash_ref = shift(@_);
972 my $partition_name_length = shift(@_);
973 my $max_partition_name_length = shift(@_);
974 my $is_numeric = shift(@_);
975
976 my @sortedmetadata_values = $self->sort_metadata_values_array($sort_mode, keys(%$metadata_value_to_OIDs_hash_ref));
977 my $items_in_partition = 0;
978 my %metadata_value_to_OIDs_subhash = ();
979 my $lastpartitionend = "";
980 my $partitionstart;
981
982 foreach my $metadata_value (@sortedmetadata_values) {
983 if ($items_in_partition == 0) {
984 # a new partition, set the name
985 $partitionstart = $self->generate_partition_start($metadata_value, $lastpartitionend, $partition_name_length, $max_partition_name_length, $is_numeric);
986 }
987 my $numitems_for_this_value = ($bookshelf_type eq "never" ? scalar(@{$metadata_value_to_OIDs_hash_ref->{$metadata_value}}) : 1);
988 if ($items_in_partition + $numitems_for_this_value <= $partition_size) {
989 # add all the current values into the temporary list
990 $metadata_value_to_OIDs_subhash{$metadata_value} = $metadata_value_to_OIDs_hash_ref->{$metadata_value};
991 $items_in_partition += $numitems_for_this_value;
992 } elsif ($items_in_partition < $partition_size) {
993 # only want to add some of the values into temporary list
994 # note, we only get here if bookshelf type is never
995 my @OIDs = @{$metadata_value_to_OIDs_hash_ref->{$metadata_value}};
996 @OIDs = $self->sort_leaf_items(\@OIDs);
997 my $num_items_needed = $partition_size - $items_in_partition;
998 my @slice = splice(@OIDs, 0, $num_items_needed);
999 $metadata_value_to_OIDs_subhash{$metadata_value} = \@slice;
1000
1001 # now we have filled up the partition
1002 my $partitionend = $self->generate_partition_end($metadata_value, $partitionstart, $partition_name_length, $max_partition_name_length, $is_numeric);
1003 my $partitionname = $partitionstart;
1004 if ($partitionend ne $partitionstart) {
1005 $partitionname = $partitionname . "-" . $partitionend;
1006 }
1007
1008 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname, \%metadata_value_to_OIDs_subhash);
1009 %metadata_value_to_OIDs_subhash = ();
1010 $items_in_partition = 0;
1011 $lastpartitionend = $partitionend;
1012
1013 # can we get more partitions from this metadata value?
1014 while (scalar(@OIDs) >= $partition_size) {
1015 my @slice = splice(@OIDs, 0, $partition_size);
1016 $metadata_value_to_OIDs_subhash{$metadata_value} = \@slice;
1017 $partitionstart = $self->generate_partition_start($metadata_value, $lastpartitionend, $partition_name_length, $max_partition_name_length, $is_numeric);
1018 my $partitionend = $self->generate_partition_end($metadata_value, $partitionstart, $partition_name_length, $max_partition_name_length, $is_numeric);
1019 my $partitionname = $partitionstart;
1020 if ($partitionend ne $partitionstart) {
1021 $partitionname = $partitionname . "-" . $partitionend;
1022 }
1023 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname, \%metadata_value_to_OIDs_subhash);
1024 %metadata_value_to_OIDs_subhash = ();
1025 $items_in_partition = 0;
1026 $lastpartitionend = $partitionend;
1027
1028 }
1029 if (scalar(@OIDs) > 0) {
1030 $metadata_value_to_OIDs_subhash{$metadata_value} = \@OIDs;
1031 $items_in_partition = scalar(@OIDs);
1032 $partitionstart = $self->generate_partition_start($metadata_value, $lastpartitionend, $partition_name_length, $max_partition_name_length, $is_numeric);
1033 }
1034
1035
1036 }
1037
1038 if ($items_in_partition == $partition_size) {
1039 # its the end of a partition
1040 my $partitionend = $self->generate_partition_end($metadata_value, $partitionstart, $partition_name_length, $max_partition_name_length, $is_numeric);
1041 my $partitionname = $partitionstart;
1042 if ($partitionend ne $partitionstart) {
1043 $partitionname = $partitionname . "-" . $partitionend;
1044 }
1045
1046 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname, \%metadata_value_to_OIDs_subhash);
1047 %metadata_value_to_OIDs_subhash = ();
1048 $items_in_partition = 0;
1049 $lastpartitionend = $partitionend;
1050 }
1051 } # foreach metadata value
1052
1053 if ($items_in_partition > 0) {
1054 # we have to add the last partition
1055 my $partitionend = $self->generate_partition_end(@sortedmetadata_values[@sortedmetadata_values-1], $partitionstart, $partition_name_length, $max_partition_name_length, $is_numeric);
1056 my $partitionname = $partitionstart;
1057 if ($partitionend ne $partitionstart) {
1058 $partitionname = $partitionname . "-" . $partitionend;
1059 }
1060
1061 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname, \%metadata_value_to_OIDs_subhash);
1062 }
1063
1064 # The partitions are stored in an HList
1065 $classifier_node->{'childtype'} = "HList";
1066
1067}
1068
1069sub split_per_letter_or_digit
1070{
1071 my $self = shift(@_);
1072 my @metadata_groups = @{shift(@_)};
1073 my $classifier_node = shift(@_);
1074 my $sort_mode = shift(@_);
1075 my $metadata_value_to_OIDs_hash_ref = shift(@_);
1076 my $is_numeric = shift(@_);
1077 my $numeric_partition_length = shift(@_);
1078
1079 if (not defined $is_numeric) {
1080 $is_numeric = 0;
1081 }
1082 if ($is_numeric && not defined($numeric_partition_length)) {
1083 $numeric_partition_length = 1;
1084 }
1085 # Generate one hlist for each letter
1086 my @sortedmetadata_values = $self->sort_metadata_values_array($sort_mode, keys(%$metadata_value_to_OIDs_hash_ref));
1087 my %metadata_value_to_OIDs_subhash = ();
1088
1089 my $lastpartition = $self->generate_partition_name($sortedmetadata_values[0], $numeric_partition_length, $is_numeric);
1090 foreach my $metadata_value (@sortedmetadata_values) {
1091 my $metadata_valuepartition = $self->generate_partition_name($metadata_value, $numeric_partition_length, $is_numeric);
1092 if ($metadata_value =~ /^bagley/i) {
1093 print STDERR "value = $metadata_value, $metadata_valuepartition\n";
1094 }
1095 # Is this the start of a new partition?
1096 if ($metadata_valuepartition ne $lastpartition) {
1097 print STDERR "new partition, old = $lastpartition, new=$metadata_valuepartition\n";
1098 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $lastpartition, \%metadata_value_to_OIDs_subhash);
1099 %metadata_value_to_OIDs_subhash = ();
1100 $lastpartition = $metadata_valuepartition;
1101 }
1102
1103 $metadata_value_to_OIDs_subhash{$metadata_value} = $metadata_value_to_OIDs_hash_ref->{$metadata_value};
1104 }
1105
1106 # Don't forget to add the last partition
1107 $self->add_hlist_partition(\@metadata_groups, $classifier_node, $lastpartition, \%metadata_value_to_OIDs_subhash);
1108
1109 # The partitions are stored in an HList
1110 $classifier_node->{'childtype'} = "HList";
1111
1112}
1113
1114sub generate_partition_name
1115{
1116 my $self = shift(@_);
1117 my $mvalue = shift(@_);
1118 my $numeric_partition_length = shift(@_);
1119 my $is_numeric = shift(@_);
1120
1121 #print STDERR "gpn: $mvalue: $is_numeric: $numeric_partition_length\n";
1122 if (!$is_numeric || $numeric_partition_length == 1 ) {
1123 return substr($mvalue, 0, 1);
1124 }
1125 if ($numeric_partition_length == -1) {
1126 my ($all_digits) = $mvalue =~ /^([0-9]+)/;
1127 return $all_digits;
1128 }
1129 my ($some_digits) = $mvalue =~ /^([0-9]{1,$numeric_partition_length})/;
1130 return $some_digits;
1131}
1132
1133sub generate_partition_start
1134{
1135 my $self = shift(@_);
1136 my $metadata_value = shift(@_);
1137 my $lastpartitionend = shift(@_);
1138 my $partition_name_length = shift(@_);
1139 my $max_partition_name_length = shift(@_);
1140 my $is_numeric = shift(@_);
1141 my $is_split = shift(@_);
1142
1143# print STDERR "generate-partitoin start, $metadata_value, $lastpartitionend, $max_partition_name_length\n";
1144 if ($is_numeric) {
1145 return $self->generate_partition_name($metadata_value, $partition_name_length, $is_numeric);
1146 }
1147
1148 $is_split = 0 unless defined $is_split;
1149 # print STDERR "is sp[lit = $is_split\n";
1150 if ($partition_name_length) {
1151 # print STDERR "partiton anme lenght = $partition_name_length, just using that length\n";
1152 return substr($metadata_value, 0, $partition_name_length);
1153 }
1154
1155 my $variable_partition_name_length = (1+$is_split <= $max_partition_name_length ? 1+$is_split : $max_partition_name_length);
1156 my $partitionstart = substr($metadata_value, 0, $variable_partition_name_length);
1157 # print STDERR "new start = $partitionstart, $variable_partition_name_length\n";
1158 while(($partitionstart le $lastpartitionend) && (($variable_partition_name_length += 1) <= $max_partition_name_length)) {
1159 # print STDERR "NEW###### $variable_partition_name_length\n";
1160 $partitionstart = substr($metadata_value, 0, $variable_partition_name_length);
1161 }
1162
1163 return $partitionstart;
1164}
1165
1166
1167sub generate_partition_end
1168{
1169 my $self = shift(@_);
1170 my $metadata_value = shift(@_);
1171 my $partitionstart = shift(@_);
1172 my $partition_name_length = shift(@_);
1173 my $max_partition_name_length = shift(@_);
1174 my $is_numeric = shift(@_);
1175 #print STDERR "geenrate end, $metadata_value: $partitionstart: $partition_name_length: $max_partition_name_length\n";
1176 if ($is_numeric) {
1177 return $self->generate_partition_name($metadata_value, $partition_name_length, $is_numeric);
1178 }
1179 if ($partition_name_length) {
1180 return substr($metadata_value, 0, $partition_name_length);
1181 }
1182
1183 my $partitionend = substr($metadata_value, 0, length($partitionstart));
1184 if (0) {#$partitionend gt $partitionstart) {
1185 $partitionend = substr($metadata_value, 0, 1);
1186 if ($partitionend le $partitionstart) {
1187 $partitionend = substr($metadata_value, 0, 2);
1188 # Give up after three characters
1189 if ($partitionend le $partitionstart) {
1190 $partitionend = substr($metadata_value, 0, 3);
1191 }
1192 }
1193 }
1194
1195 return $partitionend;
1196}
1197
1198
1199sub add_hlist_partition
1200{
1201 my $self = shift(@_);
1202 my @metadata_groups = @{shift(@_)};
1203 my $classifier_node = shift(@_);
1204 my $partitionname = shift(@_);
1205 my $metadata_value_to_OIDs_hash_ref = shift(@_);
1206
1207 # Create an hlist partition
1208 # Note that we don't need to convert from unicode-aware strings
1209 # to utf8 here, as that is handled elsewhere in the code
1210 my %child_classifier_node = ( 'Title' => $partitionname, #'Title' => $self->convert_unicode_string_to_utf8_string($partitionname),
1211 'childtype' => "VList",
1212 'contains' => [] );
1213
1214 # Add the children to the hlist partition
1215 $self->add_vlist(\@metadata_groups, \%child_classifier_node, $metadata_value_to_OIDs_hash_ref);
1216 push(@{$classifier_node->{'contains'}}, \%child_classifier_node);
1217}
1218
1219
1220sub add_vlist
1221{
1222 my $self = shift(@_);
1223 my @metadata_groups = @{shift(@_)};
1224 my $classifier_node = shift(@_);
1225 my $metadata_value_to_OIDs_hash_ref = shift(@_);
1226 my $metadata_group = shift(@metadata_groups);
1227 $classifier_node->{'mdtype'} = $metadata_group;
1228
1229 my $sort_type = $self->{$metadata_group .".metadata_sort_mode_within_level"};
1230 # Create an entry in the vlist for each value
1231 foreach my $metadata_value ($self->sort_metadata_values_array($sort_type, keys(%{$metadata_value_to_OIDs_hash_ref})))
1232 {
1233 my @OIDs = @{$metadata_value_to_OIDs_hash_ref->{$metadata_value}};
1234
1235 # If there is only one item and 'bookshelf_type' is not always (ie. never or duplicate_only), add the item to the list
1236 if (@OIDs == 1 && $self->{$metadata_group . ".bookshelf_type"} ne "always") {
1237 my $OID = $OIDs[0];
1238 my $offset = $self->metadata_offset($metadata_group, $OID, $metadata_value);
1239 push(@{$classifier_node->{'contains'}}, { 'OID' => $OID, 'offset' => $offset });
1240 }
1241 # If 'bookshelf_type' is 'never', list all the items even if there are duplicated values
1242 elsif ($self->{$metadata_group . ".bookshelf_type"} eq "never") {
1243
1244 @OIDs = $self->sort_leaf_items(\@OIDs);
1245 foreach my $OID (@OIDs) {
1246 my $offset = $self->metadata_offset($metadata_group, $OID, $metadata_value);
1247 push(@{$classifier_node->{'contains'}}, { 'OID' => $OID , 'offset' => $offset });
1248 }
1249
1250 }
1251 # Otherwise create a sublist (bookshelf) for the metadata value
1252 else {
1253 my $metadata_value_display = $self->get_metadata_value_display($metadata_group, $metadata_value);
1254 my %child_classifier_node = ( 'Title' => $metadata_value_display,
1255 'childtype' => "VList",
1256 'mdtype' => $metadata_group,
1257 'contains' => [] );
1258
1259 # If there are metadata elements remaining, recursively apply the process
1260 if (@metadata_groups > 0) {
1261 my $next_metadata_group = $metadata_groups[0];
1262
1263 # separate metadata into those that belong in the next/sub-metadata_group
1264 # and those that belong at the current level's metadata_group
1265
1266 my $OID_to_metadata_values_hash_ref = $self->{$next_metadata_group . ".list"};
1267 my @current_level_OIDs = ();
1268 my @next_level_OIDs = ();
1269 foreach my $OID (@OIDs)
1270 {
1271 if ($OID_to_metadata_values_hash_ref->{$OID}) {
1272 push(@next_level_OIDs, $OID);
1273 } else {
1274 push(@current_level_OIDs, $OID);
1275 }
1276 }
1277 # recursively process those docs belonging to the sub-metadata_group
1278 $self->add_level(\@metadata_groups, \@next_level_OIDs, \%child_classifier_node);
1279
1280 # For those docs that don't belong in the sub/next_metadata_group, but which belong
1281 # at this level, just add the documents as children of this list at the current level
1282 @current_level_OIDs = $self->sort_leaf_items(\@current_level_OIDs);
1283 foreach my $current_level_OID (@current_level_OIDs) {
1284 my $offset = $self->metadata_offset($metadata_group, $current_level_OID, $metadata_value);
1285 push(@{$child_classifier_node{'contains'}}, { 'OID' => $current_level_OID , 'offset' => $offset });
1286 }
1287 }
1288 # Otherwise just add the documents as children of this list
1289 else {
1290 @OIDs = $self->sort_leaf_items(\@OIDs);
1291 foreach my $OID (@OIDs) {
1292 my $offset = $self->metadata_offset($metadata_group, $OID, $metadata_value);
1293 push(@{$child_classifier_node{'contains'}}, { 'OID' => $OID , 'offset' => $offset });
1294 }
1295
1296 }
1297
1298 # Add the sublist to the list
1299 push(@{$classifier_node->{'contains'}}, \%child_classifier_node);
1300 }
1301 }
1302}
1303
1304sub metadata_offset
1305{
1306 my $self = shift(@_);
1307 my $metadata_group = shift(@_);
1308 my $OID = shift(@_);
1309 my $metadata_value = shift(@_);
1310
1311 my $OID_to_metadata_values_hash_ref = $self->{$metadata_group . ".list"};
1312 my @metadata_values = @{$OID_to_metadata_values_hash_ref->{$OID}};
1313 for (my $i = 0; $i < scalar(@metadata_values); $i++) {
1314 if ($metadata_value eq $metadata_values[$i]) {
1315 return $i;
1316 }
1317 }
1318
1319 return 0;
1320}
1321
1322sub sort_leaf_items
1323{
1324 my $self = shift(@_);
1325 my @OIDs = @{shift(@_)};
1326
1327 # Sort leaf nodes and add to list
1328 my @sort_leaf_nodes_using_metadata_groups = @{$self->{'sort_leaf_nodes_using_metadata_groups'}};
1329 foreach my $sort_leaf_nodes_usingmetaelem (reverse @sort_leaf_nodes_using_metadata_groups) {
1330 my $OID_to_metadata_values_hash_ref = $self->{$sort_leaf_nodes_usingmetaelem . ".list"};
1331 my $sort_type = $self->{$sort_leaf_nodes_usingmetaelem . ".metadata_sort_mode_within_level"};
1332 # Force a stable sort (Perl 5.6's sort isn't stable)
1333 # !! The [0] bits aren't ideal (multiple metadata values) !!
1334 @OIDs = @OIDs[ sort {
1335 if (defined($OID_to_metadata_values_hash_ref->{$OIDs[$a]}) && defined($OID_to_metadata_values_hash_ref->{$OIDs[$b]}))
1336 {
1337 if ($sort_type eq "numeric") {
1338 $OID_to_metadata_values_hash_ref->{$OIDs[$a]}[0] <=> $OID_to_metadata_values_hash_ref->{$OIDs[$b]}[0];
1339 } elsif ($sort_type eq "alphabetic") {
1340 $OID_to_metadata_values_hash_ref->{$OIDs[$a]}[0] cmp $OID_to_metadata_values_hash_ref->{$OIDs[$b]}[0];
1341 } else {
1342 ncmp($OID_to_metadata_values_hash_ref->{$OIDs[$a]}[0], $OID_to_metadata_values_hash_ref->{$OIDs[$b]}[0]);
1343 }
1344 }
1345 else
1346 {
1347 $a <=> $b;
1348 }
1349 } 0..$#OIDs ];
1350 }
1351 if ($self->{'reverse_sort_leaf_nodes'}) {
1352 return reverse @OIDs;
1353 }
1354 return @OIDs;
1355}
1356
1357
1358sub sort_metadata_values_array
1359{
1360 my $self = shift(@_);
1361 my ($sort_mode) = shift(@_);
1362 my @metadata_values = @_;
1363
1364 if ($sort_mode eq "unicode") {
1365 if ($self->{'unicode_collator'}) {
1366 return $self->{'unicode_collator'}->sort(@metadata_values);
1367 }
1368 # the collator wasn't loaded, fall back on default
1369 $sort_mode = "alphanumeric";
1370 }
1371 if ($sort_mode eq "numeric") {
1372 return sort {$a <=> $b} @metadata_values;
1373 }
1374 if ($sort_mode eq "alphabetic") {
1375 return sort {$a cmp $b} @metadata_values;
1376 }
1377 # natural sort
1378 return nsort(@metadata_values);
1379}
1380
1381
1382# we are not using this any more. Using nsort instead
1383# $a and $b args automatically passed in and shouldn't be declared
1384sub alpha_numeric_cmp
1385{
1386 my $self = shift (@_);
1387 my ($aStr, $bStr) = @_;
1388 if ($aStr =~ m/^(\d+(\.\d+)?)/)
1389 {
1390 my $val_a = $1;
1391 if ($bStr =~ m/^(\d+(\.\d+)?)/)
1392 {
1393 my $val_b = $1;
1394 if ($val_a != $val_b)
1395 {
1396 return ($val_a <=> $val_b);
1397 }
1398 }
1399 }
1400
1401 return ($aStr cmp $bStr);
1402}
1403
1404
1405sub get_metadata_value_display {
1406 my $self = shift(@_);
1407 my ($metadata_group, $metadata_value) = @_;
1408 return $metadata_value if $self->{'use_formatted_metadata_for_bookshelf_display'};
1409 my $actual_values_hash = $self->{$metadata_group . ".actualvalues"}->{$metadata_value};
1410 my $display_value ="";
1411 my $max_count=0;
1412 foreach my $v (keys %$actual_values_hash) {
1413 if ($actual_values_hash->{$v} > $max_count) {
1414 $display_value = $v;
1415 $max_count = $actual_values_hash->{$v};
1416 }
1417 }
1418 return $display_value;
1419}
14201;
Note: See TracBrowser for help on using the repository browser.