Changeset 1313 for trunk

Timestamp:

2000-08-01T13:56:13+12:00 (24 years ago)

Author:

sjboddie

Message:

Added Davids version of AZCompactList which handles multiple value
metadata

File:

• trunk/gsdl/perllib/classify/AZCompactList.pm (modified) (20 diffs)

trunk/gsdl/perllib/classify/AZCompactList.pm

@@ -26 +26 @@
 # classifier plugin for sorting alphabetically
 # options are:
+#
 # metadata=Metaname -- all documents with Metaname metadata
 #                      will be included in list, list will be sorted
@@ -33 +34 @@
 # mingroup=Num      -- (optional) the smallest value that will cause
 #                      a group in the hierarchy to form.
-
+# minnesting=Num    -- (optional) the smallest value that will cause a 
+#              list to converted into nested list
+# mincompact=Num    -- (optional) used in compact list
+# maxcompact=Num    -- (optional) used in compact list
+# doclevel=top|section -- (optional) level to process document at.
+# onlyfirst         -- (optional) control whether all or only first
+#                      metadata value used from array of metadata
 package AZCompactList;
 
-use AZList;
 use sorttools;
-
-sub BEGIN {
-    @ISA = ('AZList');
-}
 
 sub new {
@@ -48 +50 @@
     my ($metaname, $title);
     my $mingroup = 2;
+    my $minnesting = 20;
+    my $mincompact = 10;
+    my $maxcompact = 30;
+    my $doclevel = "top";
+    my $onlyfirst = 0;
+    my $recopt   = undef;
 
     foreach $option (@options) {
@@ -56 +64 @@
     } elsif ($option =~ /^mingroup(size)?=(.*)$/i) {
         $mingroup = $2;
+    } elsif ($option =~ /^minnesting=(.*)$/i) {
+        $minnesting = $1;
+    } elsif ($option =~ /^mincompact=(.*)$/i) {
+        $mincompact = $1;
+    } elsif ($option =~ /^maxcompact=(.*)$/i) {
+        $maxcompact = $1;
+    } elsif ($option =~ /^doclevel=(.*)$/i) {
+        $doclevel = $1;
+    } elsif ($option =~ /^onlyfirst$/i) {
+        $onlyfirst = 1;
+    } elsif ($option =~ /^recopt$/i) {
+        $recopt = "on";
     }
     }
@@ -70 +90 @@
     'metaname' => $metaname,
     'title' => $title,
-    'mingroup' => $mingroup
+    'mingroup' => $mingroup,
+    'minnesting' => $minnesting,
+    'mincompact' => $mincompact,
+    'maxcompact' => $maxcompact,
+    'doclevel' => $doclevel,
+    'onlyfirst' => $onlyfirst,
+    'recopt' => $recopt
     }, $class;
+
+
 }
 
@@ -93 +121 @@
     my $doc_OID = $doc_obj->get_OID();
 
-    my $thissection = $doc_obj->get_top_section();
+    my @sectionlist = ();
+    my $topsection = $doc_obj->get_top_section();
+
     my $metaname = $self->{'metaname'};
 
-    my $metavalue = $doc_obj->get_metadata_element($thissection,$metaname);
-    my $date = $doc_obj->get_metadata_element($thissection,"Date");
-
-    # if this document doesn't contain the metadata element we're
-    # sorting by we won't include it in this classification
-    if (defined $metavalue && $metavalue =~ /\w/) 
-    {
-    my $formatted_metavalue = $metavalue;
-
-    if ($self->{'metaname'} eq 'Creator') 
-    {
-        &sorttools::format_string_name_english (\$formatted_metavalue);
+    $metaname =~ s/(\/.*)//; # grab first name in n1/n2/n3 list
+##    print STDERR "AZCompactList: processing $doc_OID for $metaname\n";
+
+    if ($self->{'doclevel'} =~ /^top(level)?/i)
+    {
+    push(@sectionlist,$topsection);
+    }
+    else
+    {
+    my $thissection = $doc_obj->get_next_section($topsection);
+    while (defined $thissection) 
+    {
+        push(@sectionlist,$thissection);
+        $thissection = $doc_obj->get_next_section ($thissection);
+    }
+    }
+
+    my $thissection;
+    foreach $thissection (@sectionlist)
+    {
+    my $full_doc_OID 
+        = ($thissection ne "") ? "$doc_OID.$thissection" : $doc_OID;
+
+    if (defined $self->{'list'}->{$full_doc_OID}) 
+    {
+        print STDERR "WARNING: AZCompactList::classify called multiple times for $full_doc_OID\n";
     } 
-    else 
-    {
-        &sorttools::format_string_english (\$formatted_metavalue);
-    }
-    if (defined $self->{'list'}->{$doc_OID}) 
-    {
-        print STDERR "WARNING: AZCompactList::classify called multiple times for $doc_OID\n";
-    } 
-
-    $self->{'list'}->{$doc_OID} = $formatted_metavalue;
-    $self->{'listmetavalue'}->{$doc_OID} = $metavalue;
-    $self->{'reclassify'}->{$doc_OID} = [$doc_obj,$date]
+    $self->{'list'}->{$full_doc_OID} = [];  
+    $self->{'listmetavalue'}->{$full_doc_OID} = [];
+
+    my $metavalues = $doc_obj->get_metadata($thissection,$metaname);
+    my $metavalue;
+    foreach $metavalue (@$metavalues) 
+    {
+###     print STDERR "$metaname :\tmetavalue = $metavalue\n";
+        # if this document doesn't contain the metadata element we're
+        # sorting by we won't include it in this classification
+        if (defined $metavalue && $metavalue =~ /\w/) 
+        {
+        my $formatted_metavalue = $metavalue;
+        if ($self->{'metaname'} =~ m/^Creator(:.*)?$/)
+        {
+            &sorttools::format_string_name_english (\$formatted_metavalue);
+        } 
+        else 
+        {
+            &sorttools::format_string_english (\$formatted_metavalue);
+        }
+        
+        push(@{$self->{'list'}->{$full_doc_OID}},$formatted_metavalue);
+        push(@{$self->{'listmetavalue'}->{$full_doc_OID}} ,$metavalue);
+
+        last if ($self->{'onlyfirst'});
+        }
+    }
+    my $date = $doc_obj->get_metadata_element($thissection,"Date");
+    $self->{'reclassify'}->{$full_doc_OID} = [$doc_obj,$date];
     }
 }
@@ -133 +195 @@
 
     # find out how often each metavalue occurs
-    map { $mtfreq{$self->{'listmetavalue'}->{$_}}++; } @$classlist_ref;
+    map 
+    { 
+    my $mv;
+    foreach $mv (@{$self->{'listmetavalue'}->{$_}} )
+    {
+        $mtfreq{$mv}++; 
+    }
+    } @$classlist_ref;
 
     # use this information to split the list: single metavalue/repeated value
     map
     { 
-    my $metavalue = $self->{'listmetavalue'}->{$_};
-    print "meta value = $metavalue; count = $mtfreq{$metavalue}\n";
-
-    if ($mtfreq{$metavalue}>=$self->{'mingroup'})
-    {
-        push(@multiple_classlist,$_); 
-    } 
-    else
-    {
-        push(@single_classlist,$_); 
-        $self->{'reclassifylist'}->{$_} = $metavalue;
+    my $i = 1;
+    my $metavalue;
+    foreach $metavalue (@{$self->{'listmetavalue'}->{$_}})
+    {
+        if ($mtfreq{$metavalue} >= $self->{'mingroup'})
+        {
+        push(@multiple_classlist,[$_,$i,$metavalue]); 
+        } 
+        else
+        {
+        push(@single_classlist,[$_,$metavalue]); 
+        $metavalue =~ tr/[A-Z]/[a-z]/;
+        $self->{'reclassifylist'}->{"Metavalue_$i.$_"} = $metavalue;
+        }
+        $i++;
     }
     } @$classlist_ref;
@@ -157 +230 @@
     $self->{'classifiers'} = {};
 
-    my $listname 
-    = &util::filename_cat($ENV{'GSDLHOME'},"perllib/classify/List.pm");
-    if (-e $listname) { require $listname; }
-    else 
-    { 
-    die "TCCList ERROR - couldn't find classifier \"$listname\"\n"; 
-    }
-
+    my $pm;
+    foreach $pm ("List", "SectionList")
+    {
+    my $listname 
+        = &util::filename_cat($ENV{'GSDLHOME'},"perllib/classify/$pm.pm");
+    if (-e $listname) { require $listname; }
+    else 
+    { 
+        die "AZCompactList ERROR - couldn't find classifier \"$listname\"\n"; 
+    }
+    }
+
+    # Create classifiers objects for each entry >= mingroup
     my $metavalue;
     foreach $metavalue (keys %mtfreq)
     {
-    if ($mtfreq{$metavalue}>=$self->{'mingroup'})
+    if ($mtfreq{$metavalue} >= $self->{'mingroup'})
     {
         my $listclassobj;
+        my $doclevel = $self->{'doclevel'};
         my $metaname  = $self->{'metaname'};
-        
-        eval ("\$listclassobj = new List(\"metadata=$metaname\", \"title=\$metavalue\", \"sort=Date\")");
+        my @metaname_list = split('/',$metaname);
+        $metaname = shift(@metaname_list);
+        if (@metaname_list==0)
+        {
+        if ($doclevel =~ m/^top(level)?/i)
+        {
+            my $args = "\"metadata=$metaname\"";
+            $args .= ", \"title=\$metavalue\"";
+            $args .= ", \"sort=Date\"";
+            eval ("\$listclassobj = new List($args)");
+        }
+        else
+        {
+            my $args = "\"metadata=$metaname\"";
+            $args .= ", \"title=\$metavalue\"";
+            $args .= ", \"sort=Date\"";
+            eval ("\$listclassobj = new SectionList($args)");
+        }
+        }
+        else
+        {
+        $metaname = join('/',@metaname_list);
+
+        my $args = "\"metadata=$metaname\"";
+        $args .= ", \"title=\$metavalue\"";
+        $args .= ", \"doclevel=\$doclevel\"";
+        $args .= ", \"recopt\"";
+
+        eval ("\$listclassobj = new AZCompactList($args)");
+        }
         die "$@" if $@;
         
@@ -181 +288 @@
         {
         my $formatted_node = $metavalue;
-        if ($self->{'metaname'} eq 'Creator') 
+        if ($self->{'metaname'} =~ m/^Creator(:.*)?$/)
         {
             &sorttools::format_string_name_english(\$formatted_node);
@@ -206 +313 @@
     my ($self,$multiple_cl_ref) = @_;
 
-    my $metaname  = $self->{'metaname'};
-
-    my $doc_OID;
-    foreach $doc_OID (@$multiple_cl_ref) 
-    {
+    # Entries in the current classify list that are "book nodes"
+    # should be recursively classified.
+    #--
+    foreach $dm_pair (@$multiple_cl_ref) 
+    {
+    my ($doc_OID,$mdoffset,$metavalue) = @$dm_pair;
         my $listclassobj;
-        my $metavalue = $self->{'listmetavalue'}->{$doc_OID};
-    
+
     # find metavalue in list of sub-classifiers
     my $found = 0;
@@ -219 +326 @@
     foreach $node_name (keys %{$self->{'classifiers'}}) 
     {
-        if ($metavalue =~ /^$node_name$/i) 
+        $resafe_node_name = $node_name;
+        $resafe_node_name =~ s/(\(|\)|\[|\]|\{|\}|\^|\$|\.|\+|\*|\?|\|)/\\$1/g;
+        if ($metavalue =~ m/^$resafe_node_name$/i) 
         {
         my ($doc_obj,$date) = @{$self->{'reclassify'}->{$doc_OID}};
 
-        $self->{'classifiers'}->{$node_name}->{'classifyobj'}
-              ->classify($doc_obj, $date);
-
+        ## date appears to not be used in classifier call ####
+
+        if ($doc_OID =~ m/^.*\.(\d+)$/)
+        {
+            $self->{'classifiers'}->{$node_name}->{'classifyobj'}
+            ->classify($doc_obj, "Section=$1"); 
+        }
+        else
+        {
+            $self->{'classifiers'}->{$node_name}->{'classifyobj'}
+            ->classify($doc_obj); 
+        }
+        
         $found = 1;
         last;
         }
     }
-
+    
     if (!$found)
     {
         print STDERR "Warning: AZCompactList::reclassify ";
-        print STDERR "could not find sub-node for $metavalue\n";
+        print STDERR "could not find sub-node for $metavalue with doc_OID $doc_OID\n";
     }
     }
@@ -250 +369 @@
         my $classifyinfo 
         = $self->{'classifiers'}->{$node_name}->{'classifyobj'}
-            ->get_classify_info(1);
+            ->get_classify_info();
         $self->{'classifiers'}->{$node_name}->{'classifyinfo'} 
         = $classifyinfo;
@@ -259 +378 @@
 
 
+sub alpha_numeric_cmp
+{
+    my ($self,$a,$b) = @_;
+
+    my $title_a = $self->{'reclassifylist'}->{$a};
+    my $title_b = $self->{'reclassifylist'}->{$b};
+
+    if ($title_a =~ m/^(\d+(\.\d+)?)/)
+    {
+    my $val_a = $1;
+    if ($title_b =~ m/^(\d+(\.\d+)?)/)
+    {
+        my $val_b = $1;
+        if ($val_a != $val_b)
+        {
+        return ($val_a <=> $val_b);
+        }
+    }
+    }
+    
+    return ($title_a cmp $title_b);
+}
+
 sub get_classify_info {
     my $self = shift (@_);
 
-    my @classlist = sort {$self->{'list'}->{$a} cmp $self->{'list'}->{$b};} keys %{$self->{'list'}};
+    my @classlist =keys %{$self->{'list'}}; # list all doc oids
 
     my ($single_cl_ref,$multiple_cl_ref) = $self->reinit(\@classlist);
@@ -268 +410 @@
     $self->get_reclassify_info();
 
+
+#    my @reclassified_classlist 
+#   = sort {$self->{'reclassifylist'}->{$a} cmp $self->{'reclassifylist'}->{$b};} keys %{$self->{'reclassifylist'}};
+
+    # alpha_numeric_cmp is slower but handles numbers better ...
     my @reclassified_classlist 
-    = sort {$self->{'reclassifylist'}->{$a} cmp $self->{'reclassifylist'}->{$b};} keys %{$self->{'reclassifylist'}};
+    = sort { $self->alpha_numeric_cmp($a,$b) } keys %{$self->{'reclassifylist'}};
+
 
     return $self->splitlist (\@reclassified_classlist);
 }
 
-# splitlist takes an ordered list of classifications (@$classlistref) and splits it
-# up into alphabetical sub-sections.
+sub get_entry {
+    my $self = shift (@_);
+    my ($title, $childtype, $metaname, $thistype) = @_;
+
+    # organise into classification structure
+    my %classifyinfo = ('childtype'=>$childtype,
+                        'Title'=>$title,
+                        'contains'=>[],
+            'mdtype'=>$metaname);
+
+    $classifyinfo{'thistype'} = $thistype
+        if defined $thistype && $thistype =~ /\w/;
+
+    return \%classifyinfo;
+}
+
+
+
+# splitlist takes an ordered list of classifications (@$classlistref) and 
+# splits it up into alphabetical sub-sections.
 sub splitlist {
     my $self = shift (@_);
@@ -282 +448 @@
 
     # top level
+    my @metanames = split("/",$self->{'metaname'});
+    my $metaname = shift(@metanames);
+
     my $childtype = "HList";
-    if (scalar (@$classlistref) <= 39) {$childtype = "VList";}
-    my $classifyinfo = $self->get_entry ($self->{'title'}, $childtype, "Invisible");
-
-    # don't need to do any splitting if there are less than 39 (max + min-1) classifications
-    if ((scalar @$classlistref) <= 39) {
+    $childtype = "VList" if (scalar (@$classlistref) <= $self->{'minnesting'});
+
+    my $classifyinfo;
+    if (!defined($self->{'recopt'}))
+    {
+    my $title = $metaname;
+    $classifyinfo 
+        = $self->get_entry ($metaname, $childtype, $metaname, "Invisible");
+    }
+    else
+    {
+    my $title = $self->{'title'};
+    $classifyinfo 
+        = $self->get_entry ($title, $childtype, $metaname, "VList");
+    }
+
+    # don't need to do any splitting if there are less than 'minnesting' classifications
+    if ((scalar @$classlistref) <= $self->{'minnesting'}) {
     foreach $subOID (@$classlistref) {
             if ($subOID =~ /^CLASSIFY\.(.*)$/ 
         && defined $self->{'classifiers'}->{$1}) 
         {
+###     print STDERR "*** subOID = $subOID\n";
+
                 push (@{$classifyinfo->{'contains'}}, 
               $self->{'classifiers'}->{$1}->{'classifyinfo'});
@@ -297 +481 @@
         else 
         {
-        push (@{$classifyinfo->{'contains'}}, {'OID'=>$subOID});
+        $subOID =~ s/^Metavalue_(\d+)\.//;
+        my $metaname_offset = $1 -1;
+        my $oid_rec = {'OID'=>$subOID, 'offset'=>$metaname_offset};
+        push (@{$classifyinfo->{'contains'}}, $oid_rec);
         }
     }
@@ -307 +494 @@
     my $title = $self->{'reclassifylist'}->{$classification};
     $title =~ s/&(.){2,4};//g; # remove any HTML special chars
-    $title =~ s/^(\'|\`|\"|\:|\()//g; # remove any opening punctutation
+### $title =~ s/^\s+//g; # remove a leading spaces
+### $title =~ s/^_+//g; # remove a leading underscores
+    $title =~ s/^\W+//g;
+### $title =~ s/^(\'|\`|\"|\:|\()//g; # remove any opening punctutation
     $title =~ s/^(.).*$/$1/;
     $title =~ tr/[a-z]/[A-Z]/;
@@ -334 +524 @@
     foreach $subclass (@tmparr) 
     {
-    my $tempclassify = $self->get_entry ($subclass, "VList");
+    my $tempclassify = $self->get_entry($subclass, "VList", $metaname);
     foreach $subsubOID (@{$classhash->{$subclass}}) 
     {
@@ -345 +535 @@
         else
         {
-        push (@{$tempclassify->{'contains'}}, {'OID'=>$subsubOID});
+        $subsubOID =~ s/^Metavalue_(\d+)\.//;
+        my $metaname_offset = $1 -1;
+        my $oid_rec = {'OID'=>$subsubOID, 'offset'=>$metaname_offset};
+        push (@{$tempclassify->{'contains'}}, $oid_rec);
         }
     }
@@ -354 +547 @@
 }
 
+sub compactlist {
+    my $self = shift (@_);
+    my ($classhashref) = @_;
+    my $compactedhash = {};
+    my @currentOIDs = ();
+    my $currentfirstletter = "";
+    my $currentlastletter = "";
+    my $lastkey = "";
+
+    # minimum and maximum documents to be displayed per page.
+    # the actual maximum will be max + (min-1).
+    # the smallest sub-section is a single letter at present
+    # so in this case there may be many times max documents
+    # displayed on a page.
+    my $min = $self->{'mincompact'}; 
+    my $max = $self->{'maxcompact'};
+
+    foreach $subsection (sort keys %$classhashref) {
+    if ($subsection eq '0-9') {
+        @{$compactedhash->{$subsection}} = @{$classhashref->{$subsection}};
+        next;
+    }
+    $currentfirstletter = $subsection if $currentfirstletter eq "";
+    if ((scalar (@currentOIDs) < $min) ||
+        ((scalar (@currentOIDs) + scalar (@{$classhashref->{$subsection}})) <= $max)) {
+        push (@currentOIDs, @{$classhashref->{$subsection}});
+        $currentlastletter = $subsection;
+    } else {
+
+        if ($currentfirstletter eq $currentlastletter) {
+        @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
+        $lastkey = $currentfirstletter;
+        } else {
+        @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
+        $lastkey = "$currentfirstletter-$currentlastletter";
+        } 
+        if (scalar (@{$classhashref->{$subsection}}) >= $max) {
+        $compactedhash->{$subsection} = $classhashref->{$subsection};
+        @currentOIDs = ();
+        $currentfirstletter = "";
+        } else {
+        @currentOIDs = @{$classhashref->{$subsection}};
+        $currentfirstletter = $subsection;
+        $currentlastletter = $subsection;
+        }
+    }
+    }
+
+    # add final OIDs to last sub-classification if there aren't many otherwise
+    # add final sub-classification
+    if (scalar (@currentOIDs) < $min) {
+    my ($newkey) = $lastkey =~ /^(.)/;
+    @currentOIDs = (@{$compactedhash->{$lastkey}}, @currentOIDs);
+    delete $compactedhash->{$lastkey};
+    @{$compactedhash->{"$newkey-$currentlastletter"}} = @currentOIDs;
+    } else {
+    if ($currentfirstletter eq $currentlastletter) {
+        @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
+    } else {
+        @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
+    } 
+    }
+
+    return $compactedhash;
+}
+
 1;
+
+