Changeset 9206

Timestamp:

2005-02-28T12:09:17+13:00 (19 years ago)

Author:

davidb

Message:

Reworking of AutoHierarchy and Hierarchy so they are merged as one "super"
hierarchy classifier that is backward compatible.

The original Hierarchy is now HFileHierarchy. This is now an abstract
class that encapsulates everything needed to use the -hfile option.

AutoHierarchy has now been renamed to Hierarchy. Classifiers options between
the two have been merged and kept backwards compatible. If a user specifies
-hfile to Hierarhcy it is patched through to HFileHierarchy to do things
the way they used to be done. If no -hfile flag is specified then the
newer "auto" ability is used.

Location:

trunk/gsdl/perllib/classify

Files:

• HFileHierarchy.pm (added)
• Hierarchy.pm (modified) (5 diffs)

trunk/gsdl/perllib/classify/Hierarchy.pm

@@ -1 +1 @@
 ###########################################################################
 #
-# Hierarchy.pm --
+# Hierarchy.pm -- classifier that enables a Hierarchy to beformed without 
+#                 the need for a hierarchy file (like HFileHierarchy). Used
+#                 to be called AutoHierarchy.  Inherits from HFileHierarchy
+#                 so can also do everything that does as well.
+#                 Created by Imene, modified by Katherine and David.
+#
 # A component of the Greenstone digital library software
 # from the New Zealand Digital Library Project at the 
@@ -24 +29 @@
 ###########################################################################
 
-# classifier plugin for generating hierarchical classifications
-
+# An advanced Hierarchical classifier
+# to see the options, run "perl -S classinfo.pl Hierarchy"
 
 package Hierarchy;
 
-use BasClas;
-use util;
-use cfgread;
+use HFileHierarchy;
 use sorttools;
 
 sub BEGIN {
-    @Hierarchy::ISA = ('BasClas');
-}
-
-my $arguments =
-    [ { 'name' => "metadata",
-    'desc' => "{Hierarchy.metadata}",
-    'type' => "metadata",
-    'reqd' => "yes" },
-      { 'name' => "hfile",
-    'desc' => "{Hierarchy.hfile}",
-    'type' => "string",
-    'deft' => "",
-    'reqd' => "yes" },
-      { 'name' => "buttonname",
-    'desc' => "{BasClas.buttonname}",
-    'type' => "string",
-    'deft' => "",
+    @ISA = ('HFileHierarchy');
+}
+
+my $arguments = 
+    [ { 'name' => "separator",
+    'desc' => "{AutoHierarchy.separator}",
+    'type' => "regexp",
+    'deft' => "[\\\\\\\/|\\\\\\\|]",
     'reqd' => "no" },
-      { 'name' => "sort",
-    'desc' => "{Hierarchy.sort}",
-    'type' => "string",
-    'deft' => "{BasClas.metadata.deft}", 
-    'reqd' => "no" },
-      { 'name' => "reverse_sort",
-    'desc' => "{Hierarchy.reverse_sort}",
-    'type' => "flag",
-    'reqd' => "no" },
-      { 'name' => "hlist_at_top",
-    'desc' => "{Hierarchy.hlist_at_top}",
+      { 'name' => "suppresslastlevel",
+    'desc' => "{AutoHierarchy.suppresslastlevel}",
     'type' => "flag",
     'reqd' => "no" } ];
 
-my $options = 
-{   'name'     => "Hierarchy",
-    'desc'     => "{Hierarchy.desc}",
-    'abstract' => "no",
-    'inherits' => "yes", 
-    'args'     => $arguments };
+my $options = { 'name'     => "Hierarchy",
+        'desc'     => "{AutoHierarchy.desc}",
+        'abstract' => "no",
+        'inherits' => "yes",
+        'args'     => $arguments };
 
 
 sub new {
     my $class = shift (@_);
-    my $self = new BasClas($class, @_);
- 
+    my $self = new HFileHierarchy($class, @_);
+
+    # 14-05-02 To allow for proper inheritance of arguments - John Thompson
     my $option_list = $self->{'option_list'};
     push( @{$option_list}, $options );
- 
+
     if ($self->{'info_only'}) {
     # created from classinfo.pl - don't need to parse the arguments
     return bless $self, $class;
     }
- 
-    my ($hfile, $metadata, $sortname, $reverse_sort, $title, $hlist_at_top);
-    
+
+    my $separator;
+    my $suppresslastlevel = 0;
+
     if (!parsargv::parse(\@_, 
-             q^buttonname/.*/^, \$title,
-             q^sort/.*/^, \$sortname,
-             q^reverse_sort^, \$reverse_sort,
-             q^hfile/.*/^, \$hfile,
-             q^metadata/.*/^, \$metadata,
-             q^hlist_at_top^, \$hlist_at_top,
+             q^separator/.*/^, \$separator,
+             q^suppresslastlevel^, \$suppresslastlevel,
              "allow_extra_options")) {
     
@@ -101 +83 @@
     $self->print_txt_usage("");  # Use default resource bundle
     die "\n";
-
-    }
-
-    if (!$metadata) {
-    print STDERR "$class Error: required option -metadata not supplied\n";
-    $self->print_txt_usage("");  # Use default resource bundle
+    }
+
+    
+    if (!$separator) {
+    $separator = "[\\\/|\\\|]";
+    }
+    $self->{'separator'} = $separator;
+    $self->{'suppresslastlevel'} = $suppresslastlevel;
+    
+    # the hash that we use to build up the hierarchy
+    $self->{'path_hash'}= {};
+    
+    return bless $self, $class;
+}
+
+
+sub auto_classify {
+    my $self = shift (@_);
+    my ($doc_obj,$nosort,$sortmeta,$metavalues) = @_;
+
+    my $doc_OID = $doc_obj->get_OID();
+    
+    #Add all the metadata values to the hash
+    my $path_hash;
+    my $current_pos;
+    
+    foreach my $metavalue (@$metavalues) {
+    $path_hash = $self->{'path_hash'};
+    my @chunks = split (/$self->{'separator'}/, $metavalue);
+    if ($self->{'suppresslastlevel'}) {
+        pop(@chunks); # remove the last element from the end
+    }
     
-    die "$class Error: required option -metadata not supplied\n";
-    }
-    
-    if (!$hfile) {
-    print STDERR "$class Error: required option -hfile not supplied\n";
-    $self->print_txt_usage("");  # Use default resource bundle
-    
-    die "$class Error: required option -hfile not supplied\n";
-    }
-    
-    $title = $metadata unless ($title);
-    # if no sortname specified, it defaults to metadata
-    $sortname = $metadata unless ($sortname); 
-    $sortname = undef if $sortname =~ /^nosort$/;
-    if (defined $sortname && $reverse_sort) {
-    $self->{'reverse_sort'} = 1;
-    }
-    
-    my $subjectfile;
-    $subjectfile = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"etc", $hfile);
-    if (!-e $subjectfile) {
-    my $collfile = $subjectfile;
-    $subjectfile = &util::filename_cat($ENV{'GSDLHOME'},"etc", $hfile);
-    if (!-e $subjectfile) {
-        my $outhandle = $self->{'outhandle'};
-        print STDERR "\nHierarchy Error: Can't locate subject file $hfile\n";
-        print STDERR "This file should be in $collfile or $subjectfile\n";
-        $self->print_txt_usage("");  # Use default resource bundle
-        print STDERR "\nHierarchy Error: Can't locate subject file $hfile\n";
-        print STDERR "This file should be in $collfile or $subjectfile\n";
-        die "\n";
-    }
-    }
-    
-    $self->{'descriptorlist'} = {}; # first field in subject file
-    $self->{'locatorlist'} = {}; # second field in subject file
-    $self->{'subjectfile'} = $subjectfile;
-    $self->{'metaname'} = $metadata;
-    $self->{'sortname'} = $sortname;
-    $self->{'title'} = $title;
-    $self->{'hlist_at_top'} = $hlist_at_top;
-    
-    return bless $self, $class;
-}
-
-sub init {
-    my $self = shift (@_);
-    
-    # read in the subject file
-    my $list = &cfgread::read_cfg_file ($self->{'subjectfile'}, undef, '^[^#]?\S');
-    # $list is a hash that is indexed by the descriptor. The contents of this
-    # hash is a list of two items. The first item is the OID and the second item
-    # is the title
-    foreach $descriptor (keys (%$list)) {
-    $self->{'descriptorlist'}->{$descriptor} = $list->{$descriptor}->[0];
-    unless (defined $self->{'locatorlist'}->{$list->{$descriptor}->[0]}) {
-        $self->{'locatorlist'}->{$list->{$descriptor}->[0]}->{'title'} = $list->{$descriptor}->[1];
-        $self->{'locatorlist'}->{$list->{$descriptor}->[0]}->{'contents'} = [];
-    }
-    }
+    foreach my $folderName (@chunks) 
+    {
+        if ($folderName ne ""){ #sometimes the tokens are empty
+        $current_pos = $self->add_To_Hash($path_hash, $folderName, $nosort);
+        $path_hash = $current_pos->{'nodes'};
+        } 
+    }
+    # now add the document, with sort meta if needed
+    if ($nosort) {
+        push(@{$current_pos->{'docs'}}, $doc_OID);
+    } else {
+        if (defined $sortmeta) {
+        # can you ever get the same doc twice in one classification??
+        $current_pos->{'docs'}->{$doc_OID} = $sortmeta;
+        } else {
+        $current_pos->{'docs'}->{$doc_OID} = $metavalue;
+        }
+    }
+    } # foreach metadata
+
 }
 
@@ -173 +141 @@
     my $self = shift (@_);
     my ($doc_obj) = @_;
-    
+
     my $doc_OID = $doc_obj->get_OID();
-    
-    my $metadata = $doc_obj->get_metadata ($doc_obj->get_top_section(),
-                       $self->{'metaname'});
-    
-    my $lang = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), 'Language');
-    $lang = 'en' unless defined $lang;
-
-    my $sortmeta = "";
-    if (defined $self->{'sortname'}) {
+
+    # are we sorting the list??
+    my $nosort = 0;
+    if (defined $self->{'sortname'} && $self->{'sortname'} eq "nosort") {
+    $nosort = 1;
+    }
+
+    my $metavalues = [];
+    # find all the metadata values
+    foreach $m (@{$self->{'meta_list'}}) {
+    my $mvalues = $doc_obj->get_metadata($doc_obj->get_top_section(), $m);
+    next unless (@{$mvalues});
+    if ($self->{'onlyfirst'}) {
+        # we only want the first metadata value
+        push (@$metavalues, $mvalues[0]);
+        last;
+    }
+    push (@$metavalues, @$mvalues);
+    last if (!$self->{'allvalues'}); # we don't want to try other elements
+                                     # cos we have already found some 
+    } 
+    
+    return unless (@$metavalues);
+
+    #check for a sort element other than our metadata
+    my $sortmeta = undef;
+    if (!$nosort && defined $self->{'sortname'}) {
+        
     if ($self->{'sortname'} =~ /^filename$/i) {
         $sortmeta = $doc_obj->get_source_filename();
     } else {
-        $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(),
-                               $self->{'sortname'});
+        $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'sortname'});
         if (defined $sortmeta) {
         $sortmeta = &sorttools::format_metadata_for_sorting($self->{'sortname'}, $sortmeta, $doc_obj);
-        #if ($self->{'sortname'} eq "Creator") {
-        #    if ($lang eq 'en') {
-        #   &sorttools::format_string_name_english (\$sortmeta);
-        #    }
-        #} else {
-        #    if ($lang eq 'en') {
-        #   &sorttools::format_string_english (\$sortmeta);
-        #    }
-        #}
         }
     }
     $sortmeta = "" unless defined $sortmeta;
     }
-    
-    foreach $metaelement (@$metadata) {
-    if ((defined $self->{'descriptorlist'}->{$metaelement}) &&
-        (defined $self->{'locatorlist'}->{$self->{'descriptorlist'}->{$metaelement}})) {
-        push (@{$self->{'locatorlist'}->{$self->{'descriptorlist'}->{$metaelement}}->{'contents'}}, 
-          [$doc_OID, $sortmeta]);
-        my $localid = $self->{'descriptorlist'}->{$metaelement};
-        my $classid = $self->get_number();
-
-        $doc_obj->add_metadata($doc_obj->get_top_section(), "memberof", "CL$classid.$localid");
-    }
-    }
-}
-
-sub get_classify_info {
-    my $self = shift (@_);
-    
-    my $list = $self->{'locatorlist'};
-    
-    my ($classifyinfo);
-    if ($self->{'hlist_at_top'}) {
-    $classifyinfo = $self->get_entry ($self->{'title'}, "HList", "Invisible");
-    } else {
-    $classifyinfo = $self->get_entry ($self->{'title'}, "VList", "Invisible");
-    }
-    # sorted the keys - otherwise funny things happen - kjdon 03/01/03
-    foreach $OID (sort keys (%$list)) {
-    my $tempinfo = $self->get_OID_entry ($OID, $classifyinfo, $list->{$OID}->{'title'}, "VList");
-    
-    if (defined $self->{'sortname'}) {
-        if ($self->{'reverse_sort'}) {
-        foreach $subOID (sort {$b->[1] cmp $a->[1];} @{$list->{$OID}->{'contents'}}) {
-            push (@{$tempinfo->{'contains'}}, {'OID'=>$subOID->[0]});
-        }
-        }
-        else {
-        foreach $subOID (sort {$a->[1] cmp $b->[1];} @{$list->{$OID}->{'contents'}}) {
-            push (@{$tempinfo->{'contains'}}, {'OID'=>$subOID->[0]});
-        }
-        }
-    }
-    else {
-        foreach $subOID (@{$list->{$OID}->{'contents'}}) {
-        push (@{$tempinfo->{'contains'}}, {'OID'=>$subOID->[0]});
-        }
-    }
-    }
-    
-    return $classifyinfo;
-}
-
-sub supports_memberof {
-    my $self = shift(@_);
-
-    return "true";
-}
-
-sub get_OID_entry {
-    my $self = shift (@_);
-    my ($OID, $classifyinfo, $title, $classifytype) = @_;
-
-    $OID = "" unless defined $OID;
-    $OID =~ s/^\.+//;
-
-    my ($headOID, $tailOID) = $OID =~ /^(\d+)(.*)$/;
-    $tailOID = "" unless defined $tailOID;
-
-    if (!defined $headOID) {
-    $classifyinfo->{'Title'} = $title;
-    $classifyinfo->{'classifytype'} = $classifytype;
-    return $classifyinfo;
-    }
-
-    $classifyinfo->{'contains'} = [] unless defined $classifyinfo->{'contains'};
-    my $offset = 0;
-    foreach my $thing (@{$classifyinfo->{'contains'}}) {
-    $offset ++ if defined $thing->{'OID'};
-    }
-
-    while (scalar(@{$classifyinfo->{'contains'}}) < ($headOID+$offset)) { 
-    push (@{$classifyinfo->{'contains'}}, $self->get_entry("", $classifytype));
-    }
-
-    return $self->get_OID_entry ($tailOID, $classifyinfo->{'contains'}->[($headOID+$offset-1)], $title, $classifytype);
+
+    if (defined $self->{'subjectfile'}) {
+    $self->hfile_classify($doc_obj,$sortmeta,$metavalues);
+    }
+    else {
+    $self->auto_classify($doc_obj,$nosort,$sortmeta,$metavalues);
+    }
+}
+
+sub add_To_Hash {
+    my $self = shift (@_);
+    my ($myhash, $k, $nosort) = @_;
+    
+    if (!defined $myhash->{$k}){
+    $myhash->{$k}={};
+    $myhash->{$k}->{'nodes'}={};
+    if ($nosort) {
+        $myhash->{$k}->{'docs'}=[];
+    } else {
+        $myhash->{$k}->{'docs'} = {};
+    }
+    }
+    return $myhash->{$k}; 
+}
+
+sub print_Hash{
+    my $self = shift (@_); 
+    my ($myHash, $num_spaces) = @_;
+
+    foreach my $key (keys %{$myHash}){
+    print "\n";
+    $self->print_spaces($num_spaces);
+    print STDERR "$key*";
+    $self->print_Hash($myHash->{$key}, $num_spaces + 2);
+    }    
+}
+
+sub print_spaces{
+    my $self = shift (@_);
+    my ($num_spaces) = @_;
+    
+    for ($i = 0; $i < $num_spaces; $i++){
+    print STDERR " ";
+    }
 }
 
@@ -293 +230 @@
     my $self = shift (@_);
     my ($title, $childtype, $thistype) = @_;
-    my $memberof = &supports_memberof();
     
     # organise into classification structure
     my %classifyinfo = ('childtype'=>$childtype,
             'Title'=>$title,
-            'supportsmemberof'=>$memberof,
-            'contains'=>[]);
+            'contains'=>[],);
     $classifyinfo{'thistype'} = $thistype 
     if defined $thistype && $thistype =~ /\w/;
-
+    
     return \%classifyinfo;
 }
 
+sub process_hash {
+    my $self = shift (@_);
+    my ($top_hash, $top_entry) = @_;   
+    my ($entry);
+    
+    my $hash = {};
+    foreach my $key (sort keys %{$top_hash}) {
+    $entry = $self->get_entry($key,"VList","VList");
+    my $has_content = 0;
+    my @doc_list;
+    # generate a sorted list of doc ids
+    if ($nosort && scalar(@{$top_hash->{$key}->{'docs'}})) {
+        @doc_list = @{$top_hash->{$key}->{'docs'}};
+    } elsif (!$nosort && (keys %{$top_hash->{$key}->{'docs'}})) {
+        @doc_list = sort {$top_hash->{$key}->{'docs'}->{$a} 
+                  cmp $top_hash->{$key}->{'docs'}->{$b};} keys %{$top_hash->{$key}->{'docs'}};
+        
+    }
+    # if this key has documents, add them
+    if (@doc_list) {
+        $has_content = 1;
+        foreach $d(@doc_list) {
+        push (@{$entry->{'contains'}}, {'OID'=>$d});
+        }    
+    }
+    # if this key has nodes, add them
+    if (scalar(keys %{$top_hash->{$key}->{'nodes'}})) {
+        $has_content = 1;
+        $self->process_hash($top_hash->{$key}->{'nodes'}, $entry); 
+    }
+    # if we have found some content, add the new entry for this key into the parent node
+    if ($has_content) {
+        push (@{$top_entry->{'contains'}}, $entry);
+    }
+
+    }    
+}
+
+sub auto_get_classify_info {
+    my $self = shift (@_);
+    my ($no_thistype) = @_;
+    $no_thistype = 0 unless defined $no_thistype;
+
+    my ($classification);
+    my $top_h = $self->{'path_hash'};
+
+    if ($self->{'path_hash'}) {
+    if ($self->{'hlist_at_top'}) {
+        $classification = $self->get_entry ($self->{'title'}, "HList", "Invisible");
+    }
+    else {
+        $classification = $self->get_entry ($self->{'title'}, "VList", "Invisible");
+    }
+    }
+
+    $self->process_hash($top_h, $classification);
+   
+    return  $classification;
+
+}
+
+sub auto_get_classify_info
+{
+    my $self = shift (@_);
+    my ($classifyinfo) = @_;
+
+    $self->process_hash($self->{'path_hash'}, $classifyinfo);
+
+    return $classifyinfo;
+}
+
+
+sub get_classify_info {
+    my $self = shift (@_);
+
+    my ($classifyinfo);
+
+    if ($self->{'hlist_at_top'}) {
+    $classifyinfo = $self->get_entry ($self->{'title'}, "HList", "Invisible");
+    }
+    else {
+    $classifyinfo = $self->get_entry ($self->{'title'}, "VList", "Invisible");
+    }
+
+    if (defined $self->{'subjectfile'}) {
+    return $self->hfile_get_classify_info($classifyinfo);
+    }
+    else {
+    return $self->auto_get_classify_info($classifyinfo);
+    }
+}
+
 
 1;
+
+
+