<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">###########################################################################
#
# AZCompactSectionList.pm --
#
# Experimental AZCompactList with fixes to handle section-level metadata
#
###########################################################################

package AZCompactSectionList;

use AZCompactList;
use strict;
no strict 'refs'; # allow filehandles to be variables and viceversa

sub BEGIN {
    @AZCompactSectionList::ISA = ('AZCompactList');
}

my $arguments = [
		 ];
my $options = 
{ 	'name'     =&gt; "AZCompactSectionList",
	'desc'     =&gt; "{AZCompactSectionList.desc}",
	'abstract' =&gt; "no",
	'inherits' =&gt; "yes",
	'args'     =&gt; $arguments };

sub new {
    my ($class) = shift (@_);
    my ($classifierslist,$inputargs,$hashArgOptLists) = @_;
    push(@$classifierslist, $class);

    push(@{$hashArgOptLists-&gt;{"ArgList"}},@{$arguments});
    push(@{$hashArgOptLists-&gt;{"OptList"}},$options);
    
    my $self = new AZCompactList($classifierslist, $inputargs, $hashArgOptLists);

    return bless $self, $class;
}

#
# override reinit() &amp; reclassify() to demonstrate possible bug fixes
# (search for SECTIONFIX? to see lines changed from AZCompactList.pm)
#
sub reinit 
{
    my ($self,$classlist_ref) = @_;
    
    my %mtfreq = ();
    my @single_classlist = ();
    my @multiple_classlist = ();

    # find out how often each metavalue occurs
    map 
    { 
	my $mv;
	foreach $mv (@{$self-&gt;{'listmetavalue'}-&gt;{$_}} )
	{
	    $mtfreq{$mv}++; 
	}
    } @$classlist_ref;

    # use this information to split the list: single metavalue/repeated value
    map
    { 
	my $i = 1;
	my $metavalue;
	foreach $metavalue (@{$self-&gt;{'listmetavalue'}-&gt;{$_}})
	{
	    if ($mtfreq{$metavalue} &gt;= $self-&gt;{'mingroup'})
	    {
		push(@multiple_classlist,[$_,$i,$metavalue]); 
	    } 
	    else
	    {
		push(@single_classlist,[$_,$metavalue]); 
		$metavalue =~ tr/[A-Z]/[a-z]/;
		$self-&gt;{'reclassifylist'}-&gt;{"Metavalue_$i.$_"} = $metavalue;
	    }
	    $i++;
	}
    } @$classlist_ref;
    
    
    # Setup sub-classifiers for multiple list

    $self-&gt;{'classifiers'} = {};

    my $pm;
    foreach $pm ("SimpleList", "SectionList")
    {
	my $listname 
	    = &amp;util::filename_cat($ENV{'GSDLHOME'},"perllib/classify/$pm.pm");
	if (-e $listname) { require $listname; }
	else 
	{ 
	    my $outhandle = $self-&gt;{'outhandle'};
	    print $outhandle "AZCompactList ERROR - couldn't find classifier \"$listname\"\n"; 
	    die "\n";
	}
    }

    # Create classifiers objects for each entry &gt;= mingroup
    my $metavalue;
    foreach $metavalue (keys %mtfreq)
    {
	if ($mtfreq{$metavalue} &gt;= $self-&gt;{'mingroup'})
	{
	    my $listclassobj;
	    my $doclevel = $self-&gt;{'doclevel'};
	    my $metaname  = $self-&gt;{'metaname'};
	    my @metaname_list = split('/',$metaname);
	    $metaname = shift(@metaname_list);
	    if (@metaname_list==0)
	    {
		my @args;
		push @args, ("-metadata", "$metaname");
# buttonname is also used for the node's title
		push @args, ("-buttonname", "$metavalue");
		push @args, ("-sort", $self-&gt;{'sort'});

		my $ptArgs = \@args;
		if ($doclevel =~ m/^top(level)?/i)
		{
		    eval ("\$listclassobj = new SimpleList([],\$ptArgs)"); warn $@ if $@;
		}
		else
		{
		    # SECTIONFIX?
		    #eval ("\$listclassobj = new SectionList($args)");
		    eval ("\$listclassobj = new SectionList([],\$ptArgs)");
		}
	    }
	    else
	    {
		$metaname = join('/',@metaname_list);
		
		my @args;
		push @args, ("-metadata", "$metaname");
# buttonname is also used for the node's title
		push @args, ("-buttonname", "$metavalue");
		push @args, ("-doclevel", "$doclevel");
		push @args, "-recopt";

		# SECTIONFIX?
		#eval ("\$listclassobj = new AZCompactList($args)");
		my $ptArgs = \@args;
		eval ("\$listclassobj = new AZCompactList([],\$ptArgs)");
	    }
	    if ($@) {
		my $outhandle = $self-&gt;{'outhandle'};
		print $outhandle "$@";
		die "\n";
	    }
	    
	    $listclassobj-&gt;init();

	    if (defined $metavalue &amp;&amp; $metavalue =~ /\w/) 
	    {
		my $formatted_node = $metavalue;
		if ($self-&gt;{'metaname'} =~ m/^Creator(:.*)?$/)
		{
		    &amp;sorttools::format_string_name_en(\$formatted_node);
		} 
		else 
		{
		    &amp;sorttools::format_string_en(\$formatted_node);
		}
		
		$self-&gt;{'classifiers'}-&gt;{$metavalue} 
		= { 'classifyobj'   =&gt; $listclassobj,
		    'formattednode' =&gt; $formatted_node };
	    }
	}
    }


    return (\@single_classlist,\@multiple_classlist);
}


sub reclassify 
{
    my ($self,$multiple_cl_ref) = @_;

    # Entries in the current classify list that are "book nodes"
    # should be recursively classified.
    #--
    foreach my $dm_pair (@$multiple_cl_ref) 
    {
	my ($doc_OID,$mdoffset,$metavalue) = @$dm_pair;
        my $listclassobj;

	# find metavalue in list of sub-classifiers
	my $found = 0;
	my $node_name;
	foreach $node_name (keys %{$self-&gt;{'classifiers'}}) 
	{
	    my $resafe_node_name = $node_name;
	    $resafe_node_name =~ s/(\(|\)|\[|\]|\{|\}|\^|\$|\.|\+|\*|\?|\|)/\\$1/g;
	    if ($metavalue =~ m/^$resafe_node_name$/i) 
	    {
		my ($doc_obj, $sortmeta) = @{$self-&gt;{'reclassify'}-&gt;{$doc_OID}};

		# SECTIONFIX?  section must include multiple levels, e.g. '1.12'
		#if ($doc_OID =~ m/^.*\.(\d+)$/)
		if ($doc_OID =~ m/^[^\.]*\.([\d\.]+)$/)
		{
		    $self-&gt;{'classifiers'}-&gt;{$node_name}-&gt;{'classifyobj'}
		    # SECTIONFIX? classify can't handle multi-level section
		    #-&gt;classify($doc_obj, "Section=$1"); 
		    -&gt;classify_section($1, $doc_obj, $sortmeta);
		}
		else
		{
		    $self-&gt;{'classifiers'}-&gt;{$node_name}-&gt;{'classifyobj'}
		    -&gt;classify($doc_obj); 
		}
		
		$found = 1;
		last;
	    }
	}
	
	if (!$found)
	{
	    my $outhandle = $self-&gt;{'outhandle'};
	    print $outhandle "Warning: AZCompactList::reclassify ";
	    print $outhandle "could not find sub-node for $metavalue with doc_OID $doc_OID\n";
	}
    }
}

1;
</pre></body></html>