Index: /gsdl/trunk/perllib/classify/List.pm
===================================================================
--- /gsdl/trunk/perllib/classify/List.pm	(revision 18618)
+++ /gsdl/trunk/perllib/classify/List.pm	(revision 18619)
@@ -48,8 +48,17 @@
 	'desc' => "{List.level_partition.per_letter}" },
       { 'name' => "constant_size",
-	'desc' => "{List.level_partition.constant_size}" },
+	'desc' => "{List.level_partition.constant_size}" },      
+      { 'name' => "per_letter_fixed_size",
+	'desc' => "{List.level_partition.per_letter_fixed_size}"}, 
       { 'name' => "none",
 	'desc' => "{List.level_partition.none}" } ];
-      
+
+my $bookshelf_type_list = 
+    [ { 'name' => "always",
+	'desc' => "{List.bookshelf_type.always}" },
+      { 'name' => "duplicate_only",
+	'desc' => "{List.bookshelf_type.duplicate_only}" },
+      { 'name' => "never",
+	'desc' => "{List.bookshelf_type.never}" } ];      
 
 my $arguments = 
@@ -60,7 +69,9 @@
 
       # The interesting options
-      { 'name' => "always_bookshelf_last_level",
-	'desc' => "{GenericList.always_bookshelf_last_level}",
-	'type' => "flag" },
+      { 'name' => "bookshelf_type", 
+	'desc' => "{List.bookshelf_types}",
+	'type' => "enum",
+	'list' => $bookshelf_type_list,
+	'deft' => "duplicate_only" }, 
       { 'name' => "classify_sections",
 	'desc' => "{GenericList.classify_sections}",
@@ -68,6 +79,5 @@
       { 'name' => "partition_type_within_level",
 	'desc' => "{GenericList.partition_type_within_level}",
-	'type' => "enum",
-	'list' => $partition_type_list,
+	'type' => "string",
 	'deft' => "none" },
       { 'name' => "partition_size_within_level",
@@ -88,5 +98,11 @@
       { 'name' => "use_hlist_for",
 	'desc' => "{GenericList.use_hlist_for}",
-	'type' => "string" } ];
+	'type' => "string" },
+      { 'name' => "removeprefix",
+	'desc' => "{BasClas.removeprefix}",
+	'type' => "regexp" },
+      { 'name' => "removesuffix",
+	'desc' => "{BasClas.removesuffix}",
+	'type' => "regexp" } ];
 
 my $options = { 'name'     => "List",
@@ -127,14 +143,12 @@
     }
 
-    # Whether to group single items into a bookshelf (must be true for all metadata fields except the last)
+    # Whether to group items into a bookshelf, (must be 'always' for all metadata fields except the last)
     foreach my $metadata_group (@metadata_groups) {
-	$self->{$metadata_group . ".always_bookshelf"} = "t";
-    }
-    if (!$self->{'always_bookshelf_last_level'}) {
-	# Default: leave leaf nodes ungrouped (equivalent to AZCompactList -mingroup 2)
-	my $last_metadata_group = $metadata_groups[$#metadata_groups];
-	$self->{$last_metadata_group . ".always_bookshelf"} = "f";
-    }
-
+	$self->{$metadata_group . ".bookshelf_type"} = "always";
+    }    
+    my $last_metadata_group = $metadata_groups[$#metadata_groups];
+    # Default: duplicate_only, ie. leave leaf nodes ungrouped (equivalent to AZCompactList -mingroup 2)
+    $self->{$last_metadata_group . ".bookshelf_type"} = $self->{'bookshelf_type'};
+        
     # Whether to use an hlist or a vlist for each level in the hierarchy (default: vlist)
     foreach my $metadata_group (@metadata_groups) {
@@ -145,7 +159,21 @@
     }
 
-    # How the items are grouped into partitions (default: no partition)
+    # How the items are grouped into partitions (default: no partition) 
+    # for each level (metadata group), separated by '/'
     if (!$self->{"partition_type_within_level"}) {
-	$self->{"partition_type_within_level"} = "none";
+	foreach my $metadata_group (@metadata_groups) {
+	    $self->{$metadata_group . ".partition_type_within_level"} = "none";
+	}
+    } else {
+	my @partition_type_within_levellist = split(/\//, $self->{'partition_type_within_level'});	
+	foreach my $metadata_group (@metadata_groups) {
+	    my $partition_type_within_levelelem = shift(@partition_type_within_levellist);
+	    if (defined($partition_type_within_levelelem)) {
+		$self->{$metadata_group . ".partition_type_within_level"} = $partition_type_within_levelelem;
+	    }
+	    else {
+		$self->{$metadata_group . ".partition_type_within_level"} = $self->{$metadata_groups[0] . ".partition_type_within_level"};
+	    }
+	}
     }
 
@@ -168,4 +196,40 @@
 	    else {
 		$self->{$metadata_group . ".partition_size_within_level"} = $self->{$metadata_groups[0] . ".partition_size_within_level"};
+	    }
+	}
+    }
+
+    # The removeprefix and removesuffix expressions
+    if ($self->{'removeprefix'}) {
+	# If there are more than one expressions, use '' to quote each experession and '/' to separate
+	my @removeprefix_exprs_within_levellist = split(/'\/'/, $self->{'removeprefix'});
+
+	foreach my $metadata_group (@metadata_groups) {
+	    my $removeprefix_expr_within_levelelem = shift(@removeprefix_exprs_within_levellist);
+	    if (defined($removeprefix_expr_within_levelelem) && $removeprefix_expr_within_levelelem ne "") {
+		# Remove the other ' at the beginning and the end if there is any
+		$removeprefix_expr_within_levelelem =~ s/^'//;
+		$removeprefix_expr_within_levelelem =~ s/'$//;
+		# Remove the extra ^ at the beginning
+		$removeprefix_expr_within_levelelem =~ s/^\^//;
+		$self->{$metadata_group . ".remove_prefix_expr"} = $removeprefix_expr_within_levelelem;
+	    } else {
+		$self->{$metadata_group . ".remove_prefix_expr"} = $self->{$metadata_groups[0] . ".remove_prefix_expr"};
+	    }
+	}
+    } 
+    if ($self->{'removesuffix'}) {	
+	my @removesuffix_exprs_within_levellist = split(/'\/'/, $self->{'removesuffix'});
+
+	foreach my $metadata_group (@metadata_groups) {
+	    my $removesuffix_expr_within_levelelem = shift(@removesuffix_exprs_within_levellist);
+	    if (defined($removesuffix_expr_within_levelelem) && $removesuffix_expr_within_levelelem ne "") {
+		$removesuffix_expr_within_levelelem =~ s/^'//;
+		$removesuffix_expr_within_levelelem =~ s/'$//;
+		# Remove the extra $ at the end
+		$removesuffix_expr_within_levelelem =~ s/\$$//;
+		$self->{$metadata_group . ".remove_suffix_expr"} = $removesuffix_expr_within_levelelem;
+	    } else {
+		$self->{$metadata_group . ".remove_suffix_expr"} = $self->{$metadata_groups[0] . ".remove_suffix_expr"};
 	    }
 	}
@@ -233,15 +297,25 @@
     my $first_metadata_group = $metadata_groups[0];
     foreach my $first_metadata_group_element (split(/\;/, $first_metadata_group)) {
-	my $first_metadata_group_element_value = $doc_obj->get_metadata_element($section, $first_metadata_group_element);
+	my $first_metadata_group_element_value = $doc_obj->get_metadata_element($section, $first_metadata_group_element);	
+	
+	# Remove prefix/suffix if requested
+	my $remove_prefix_expr = $self->{$first_metadata_group_element . ".remove_prefix_expr"};
+	if (defined $remove_prefix_expr && $remove_prefix_expr ne "") {	    
+	    $first_metadata_group_element_value =~ s/^$remove_prefix_expr//;
+	}
+	my $remove_suffix_expr = $self->{$first_metadata_group_element . ".remove_suffix_expr"};
+	if (defined $remove_suffix_expr && $remove_suffix_expr ne "") {
+	    $first_metadata_group_element_value =~ s/$remove_suffix_expr$//;
+	}
+
 	if (defined($first_metadata_group_element_value) && $first_metadata_group_element_value ne "") {
 	    # This section must be included in the classifier
 	    $classify_section = 1;
 	    last;
-	}
+	} 
     }
 
     # We're not classifying this section because it doesn't have the required metadata
     return if (!$classify_section);
-
 
     if (($edit_mode eq "delete") || ($edit_mode eq "update")) {
@@ -260,5 +334,7 @@
 	# Take care not to do a metadata group more than once
 	unless ($metadata_groups_done{$metadata_group}) {
-	    foreach my $metadata_element (split(/\;/, $metadata_group)) {
+	    foreach my $metadata_element (split(/\;/, $metadata_group)) {		
+		my $remove_prefix_expr = $self->{$metadata_element . ".remove_prefix_expr"};
+		my $remove_suffix_expr = $self->{$metadata_element . ".remove_suffix_expr"};
 		my @metadata_values = @{$doc_obj->get_metadata($section, $metadata_element)};
 		foreach my $metadata_value (@metadata_values) {
@@ -266,4 +342,12 @@
 		    $metadata_value =~ s/^\s*//;
 		    $metadata_value =~ s/\s*$//;
+
+		    # Remove prefix/suffix if requested
+		    if (defined $remove_prefix_expr && $remove_prefix_expr ne "") {
+			$metadata_value =~ s/^$remove_prefix_expr//;
+		    }
+		    if (defined $remove_suffix_expr && $remove_suffix_expr ne "") {
+			$metadata_value =~ s/$remove_suffix_expr$//;
+		    }
 
 		    # Convert the metadata value from a UTF-8 string to a Unicode string
@@ -327,5 +411,5 @@
     # Create a mapping from metadata value to OID
     my $OID_to_metadata_values_hash_ref = $self->{$metadata_group . ".list"};
-    my %metadata_value_to_OIDs_hash = ();
+    my %metadata_value_to_OIDs_hash = ();    
     foreach my $OID (@OIDs)
     {
@@ -342,5 +426,5 @@
 
     # Partition the values (if necessary)
-    my $partition_type_within_level = $self->{"partition_type_within_level"};
+    my $partition_type_within_level = $self->{$metadata_group . ".partition_type_within_level"};
     if ($partition_type_within_level =~ /^per_letter$/i) {
 	# Generate one hlist for each letter
@@ -368,5 +452,150 @@
 	$classifier_node->{'childtype'} = "HList";
     }
-
+    elsif ($partition_type_within_level =~ /^per_letter_fixed_size$/i) {
+	# Generate hlist based on the first letter of the metadata value (like per_letter) but with restriction on the partition size
+	# If a letter has fewer items than specified by the "partition_size_within_level", then group them together if possible
+	# If a letter has more items than specified, split into several hlists.
+	# Depends on the bookshelf_type, one item can be either a document (when bookshelf_type is "never") or a metadata value (otherwise)
+	my $partition_size_within_level = $self->{$metadata_group . ".partition_size_within_level"};		
+	my @sortedmetadata_values = $self->sort_metadata_values_array(keys(%metadata_value_to_OIDs_hash));
+	my $bookshelf_type = $self->{$metadata_group . ".bookshelf_type"};
+	
+	# Separate values by their first letter, each form a bucket, like the per_letter partition type
+	my $last_partition = substr($sortedmetadata_values[0], 0, 1);
+	my %partition_buckets = ();
+	my @metadata_values_in_bucket = ();
+	my $num_items_in_bucket = 0;
+	foreach my $metadata_value (@sortedmetadata_values) {	    
+	    my $metadata_valuepartition = substr($metadata_value, 0, 1);
+	    if ($metadata_valuepartition ne $last_partition) {
+		my @temp_array = @metadata_values_in_bucket;
+		# 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 
+		my %partition_info = ();		
+		$partition_info{'metadata_values'} = \@temp_array;
+		$partition_info{'size'} = $num_items_in_bucket;		
+		$partition_buckets{$last_partition} = \%partition_info;		
+		
+		@metadata_values_in_bucket = ($metadata_value);
+		$num_items_in_bucket = $bookshelf_type eq "never" ? scalar(@{$metadata_value_to_OIDs_hash{$metadata_value}}) : scalar(@metadata_values_in_bucket);
+		$last_partition = $metadata_valuepartition;
+	    } else {
+		$num_items_in_bucket += $bookshelf_type eq "never" ? scalar(@{$metadata_value_to_OIDs_hash{$metadata_value}}) : scalar(@metadata_values_in_bucket);
+		push (@metadata_values_in_bucket, $metadata_value);
+	    }
+	}
+	# Last one
+	my %partition_info = ();
+	$partition_info{'metadata_values'} = \@metadata_values_in_bucket;
+	$partition_info{'size'} = $num_items_in_bucket;	
+	$partition_buckets{$last_partition} = \%partition_info;
+		
+	my @partition_keys = $self->sort_metadata_values_array(keys(%partition_buckets));	
+	for (my $i = 0; $i < scalar(@partition_keys) - 1; $i++) {
+	    my $partition = $partition_keys[$i];
+	    my $items_in_partition = $partition_buckets{$partition}->{'size'};	    	    
+	    # Merge small buckets together, but keep the numeric bucket apart
+	    if ($items_in_partition < $partition_size_within_level) {
+		my $items_in_next_partition = $partition_buckets{$partition_keys[$i+1]}->{'size'};
+		if ($items_in_partition + $items_in_next_partition <= $partition_size_within_level 
+		    && !(($partition =~ /^[^0-9]/ && $partition_keys[$i+1] =~ /^[0-9]/) 
+			 || ($partition =~ /^[0-9]/ && $partition_keys[$i+1] =~ /^[^0-9]/))) {
+		    foreach my $metadata_value_to_merge (@{$partition_buckets{$partition}->{'metadata_values'}}) {
+			push(@{$partition_buckets{$partition_keys[$i+1]}->{'metadata_values'}}, $metadata_value_to_merge);
+		    }		    
+		    $partition_buckets{$partition_keys[$i+1]}->{'size'} += $items_in_partition;
+		    delete $partition_buckets{$partition};		    		    
+		} 
+	    }
+	}
+	@partition_keys = $self->sort_metadata_values_array(keys(%partition_buckets));
+	
+	# Add partitions, and divide big bucket into several
+	my $last_partition_end = "";
+	my $partition_start = "";
+	foreach my $partition (@partition_keys) {
+	    my @metadata_values = $self->sort_metadata_values_array(@{$partition_buckets{$partition}->{'metadata_values'}});
+	    my $items_in_partition = $partition_buckets{$partition}->{'size'}; 
+	    $partition_start = $self->generate_partition_start($metadata_values[0], $last_partition_end, $self->{"partition_name_length"});
+	    
+	    if ($items_in_partition > $partition_size_within_level) {	
+		my $items_done = 0;
+		my %metadata_values_to_OIDs_subhashes = ();
+		for (my $i = 0; $i < scalar(@metadata_values); $i++) {
+		    my $metadata_value = $metadata_values[$i];
+		    # If the bookshelf_type is "never", count the documents, otherwise count the distinct metadata values
+		    my $items_for_this_md_value = $bookshelf_type eq "never" ? scalar(@{$metadata_value_to_OIDs_hash{$metadata_value}}) : 1;
+
+		    my $partitionend = $self->generate_partition_end($metadata_value, $partition_start, $self->{"partition_name_length"});
+		    my $partitionname = $partition_start;
+		    if ($partitionend ne $partition_start) {
+			$partitionname = $partitionname . "-" . $partitionend;
+		    }
+		    
+		    # Start a new partition
+		    if ($items_done + $items_for_this_md_value > $partition_size_within_level && $items_done != 0) {
+			$self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname, \%metadata_values_to_OIDs_subhashes);
+			$last_partition_end = $partitionend;			
+			$partition_start = $self->generate_partition_start($metadata_value, $last_partition_end, $self->{"partition_name_length"});
+			$items_done = 0;
+			%metadata_values_to_OIDs_subhashes = ();
+ 		    } 
+		    
+		    # If bookshelf_type is "never" and the current metadata value holds too many items, need to split into several partitions
+                    if ($bookshelf_type eq "never" && $items_for_this_md_value > $partition_size_within_level) {
+			my $partitionname_for_this_value = $self->generate_partition_start($metadata_value, $last_partition_end, $self->{"partition_name_length"});
+			# Get the number of partitions needed for this value
+			my $num_splits = int($items_for_this_md_value / $partition_size_within_level);
+			$num_splits++ if ($items_for_this_md_value / $partition_size_within_level > $num_splits);
+
+			my @OIDs_for_this_value = @{$metadata_value_to_OIDs_hash{$metadata_value}};
+			for (my $i = 0; $i < $num_splits; $i++) {
+			    my %OIDs_subhashes_for_this_value = ();
+			    my @OIDs_for_this_partition = ();
+			    for (my $d = $i * $partition_size_within_level; $d < (($i+1) * $partition_size_within_level > $items_for_this_md_value ? $items_for_this_md_value : ($i+1) * $partition_size_within_level); $d++) {
+				push (@OIDs_for_this_partition, $OIDs_for_this_value[$d]);
+			    } 
+			    
+			    # The last bucket might have only a few items and need to be merged with buckets for subsequent metadata values 
+			    if ($i == $num_splits - 1 && scalar(@OIDs_for_this_partition) < $partition_size_within_level) {
+				$metadata_values_to_OIDs_subhashes{$metadata_value} = \@OIDs_for_this_partition;
+				$items_done += scalar(@OIDs_for_this_partition);
+				next;
+			    }
+			    
+			    # Add an HList for this bucket
+			    $OIDs_subhashes_for_this_value{$metadata_value} = \@OIDs_for_this_partition;
+			    $self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname_for_this_value, \%OIDs_subhashes_for_this_value);
+			    $last_partition_end = $partitionname_for_this_value;
+			}
+			next;
+                    }
+		    		    
+		    $metadata_values_to_OIDs_subhashes{$metadata_value} = $metadata_value_to_OIDs_hash{$metadata_value};
+		    $items_done += $bookshelf_type eq "never" ? scalar(@{$metadata_values_to_OIDs_subhashes{$metadata_value}}) : 1;		    
+		    
+		    # The last partition
+		    if($i == scalar(@metadata_values) - 1) {
+			$self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname, \%metadata_values_to_OIDs_subhashes);
+		    }
+		}		
+	    } 
+	    else {
+		# The easier case, just add a partition
+		my %metadata_values_to_OIDs_subhashes = ();
+		for (my $i = 0; $i < scalar(@metadata_values); $i++) {
+		    my $metadata_value = $metadata_values[$i];
+		    $metadata_values_to_OIDs_subhashes{$metadata_value} = $metadata_value_to_OIDs_hash{$metadata_value};		    
+		}
+		my $last_metadata_value = $metadata_values[scalar(@metadata_values)-1];
+		my $partitionend = $self->generate_partition_end($last_metadata_value, $partition_start, $self->{"partition_name_length"});
+		my $partitionname = $partition_start;
+		if ($partitionend ne $partition_start) {
+		    $partitionname = $partitionname . "-" . $partitionend;
+		}
+		$self->add_hlist_partition(\@metadata_groups, $classifier_node, $partitionname, \%metadata_values_to_OIDs_subhashes);			
+		$last_partition_end = $partitionend;		
+	    }
+	}	
+    }
     else {
 	# Generate hlists of a certain size
@@ -525,6 +754,6 @@
 	my @OIDs = @{$metadata_value_to_OIDs_hash_ref->{$metadata_value}};
 
-	# If there is only one item and 'always_bookshelf' is false, add the item to the list
-	if (@OIDs == 1 && $self->{$metadata_group . ".always_bookshelf"} eq "f") {
+	# If there is only one item and 'bookshelf_type' is not always (ie. never or duplicate_only), add the item to the list
+	if (@OIDs == 1 && $self->{$metadata_group . ".bookshelf_type"} ne "always") {
 	    my $OID = $OIDs[0];
 
@@ -540,8 +769,11 @@
 	    }
 	    push(@{$classifier_node->{'contains'}}, { 'OID' => $OID, 'offset' => $offset });
-	}
-
+	} 
+	# If 'bookshelf_type' is 'never', list all the items even if there are duplicated values
+	elsif ($self->{$metadata_group . ".bookshelf_type"} eq "never") {
+	   $self->add_sorted_leaf_items(\@OIDs, $classifier_node); 
+	}
 	# Otherwise create a sublist (bookshelf) for the metadata value
-	else {
+	else {		    
 	    my %child_classifier_node = ( 'Title' => $self->convert_unicode_string_to_utf8_string($metadata_value),
 					  'childtype' => "VList",
@@ -556,16 +788,5 @@
 	    # Otherwise just add the documents as children of this list
 	    else {
-		# Sort the leaf nodes by the metadata elements specified with -sort_leaf_nodes_using
-		my @sort_leaf_nodes_usingmetadata_groups = @{$self->{'sort_leaf_nodes_using_metadata_groups'}};
-		foreach my $sort_leaf_nodes_usingmetaelem (reverse @sort_leaf_nodes_usingmetadata_groups) {
-		    my $OID_to_metadata_values_hash_ref = $self->{$sort_leaf_nodes_usingmetaelem . ".list"};
-		    # Force a stable sort (Perl 5.6's sort isn't stable)
-		    # !! The [0] bits aren't ideal (multiple metadata values) !! 
-		    @OIDs = @OIDs[ sort { $OID_to_metadata_values_hash_ref->{$OIDs[$a]}[0] cmp $OID_to_metadata_values_hash_ref->{$OIDs[$b]}[0] || $a <=> $b; } 0..$#OIDs ];
-		}
-
-  		foreach my $OID (@OIDs) {
-  		    push(@{$child_classifier_node{'contains'}}, { 'OID' => $OID });
-  		}
+		$self->add_sorted_leaf_items(\@OIDs, \%child_classifier_node); 
 	    }
 
@@ -576,4 +797,24 @@
 }
 
+sub add_sorted_leaf_items
+{
+    my $self = shift(@_);
+    my @OIDs = @{shift(@_)};
+    my $classifier_node = shift(@_);    
+    
+    # Sort leaf nodes and add to list
+    my @sort_leaf_nodes_usingmetadata_groups = @{$self->{'sort_leaf_nodes_using_metadata_groups'}};
+    foreach my $sort_leaf_nodes_usingmetaelem (reverse @sort_leaf_nodes_usingmetadata_groups) {
+	my $OID_to_metadata_values_hash_ref = $self->{$sort_leaf_nodes_usingmetaelem . ".list"};
+	# Force a stable sort (Perl 5.6's sort isn't stable)
+	# !! The [0] bits aren't ideal (multiple metadata values) !! 
+	@OIDs = @OIDs[ sort { $OID_to_metadata_values_hash_ref->{$OIDs[$a]}[0] cmp $OID_to_metadata_values_hash_ref->{$OIDs[$b]}[0] || $a <=> $b; } 0..$#OIDs ];
+    }
+
+    foreach my $OID (@OIDs) {
+	push(@{$classifier_node->{'contains'}}, { 'OID' => $OID });
+    }
+}
+
 
 sub sort_metadata_values_array
