Changeset 1250


Ignore:
Timestamp:
2000-06-28T15:01:49+12:00 (24 years ago)
Author:
sjboddie
Message:

Tidied up the classfiers slightly, made them a little more object oriented
and removed large chunks of identical code that existed in several
different places. There's still lots to be done to them but I'd like to
wait for gsdl-3.0 (as one of the changes will effect the way options are
passed so all collect.cfg files will need to be updated).

Location:
trunk/gsdl/perllib/classify
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsdl/perllib/classify/AZCompactList.pm

    r1086 r1250  
    3636package AZCompactList;
    3737
     38use AZList;
    3839use sorttools;
     40
     41sub BEGIN {
     42    @ISA = ('AZList');
     43}
    3944
    4045sub new {
    … …  
    269274}
    270275
    271 sub get_entry {
    272     my $self = shift (@_);
    273     my ($title, $childtype, $thistype) = @_;
    274    
    275     # organise into classification structure
    276     my %classifyinfo = ('childtype'=>$childtype,
    277             'Title'=>$title,
    278             'contains'=>[]);
    279     $classifyinfo{'thistype'} = $thistype
    280     if defined $thistype && $thistype =~ /\w/;
    281 
    282     return \%classifyinfo;
    283 }
    284 
    285276# splitlist takes an ordered list of classifications (@$classlistref) and splits it
    286277# up into alphabetical sub-sections.
    … …  
    363354}
    364355
    365 sub compactlist {
    366     my $self = shift (@_);
    367     my ($classhashref) = @_;
    368     my $compactedhash = {};
    369     my @currentOIDs = ();
    370     my $currentfirstletter = "";
    371     my $currentlastletter = "";
    372     my $lastkey = "";
    373 
    374     # minimum and maximum documents to be displayed per page.
    375     # the actual maximum will be max + (min-1).
    376     # the smallest sub-section is a single letter at present
    377     # so in this case there may be many times max documents
    378     # displayed on a page.
    379     my $min = 10;
    380     my $max = 30;
    381 
    382     foreach $subsection (sort keys %$classhashref) {
    383     if ($subsection eq '0-9') {
    384         @{$compactedhash->{$subsection}} = @{$classhashref->{$subsection}};
    385         next;
    386     }
    387     $currentfirstletter = $subsection if $currentfirstletter eq "";
    388     if ((scalar (@currentOIDs) < $min) ||
    389         ((scalar (@currentOIDs) + scalar (@{$classhashref->{$subsection}})) <= $max)) {
    390         push (@currentOIDs, @{$classhashref->{$subsection}});
    391         $currentlastletter = $subsection;
    392     } else {
    393 
    394         if ($currentfirstletter eq $currentlastletter) {
    395         @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
    396         $lastkey = $currentfirstletter;
    397         } else {
    398         @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
    399         $lastkey = "$currentfirstletter-$currentlastletter";
    400         }
    401         if (scalar (@{$classhashref->{$subsection}}) >= $max) {
    402         $compactedhash->{$subsection} = $classhashref->{$subsection};
    403         @currentOIDs = ();
    404         $currentfirstletter = "";
    405         } else {
    406         @currentOIDs = @{$classhashref->{$subsection}};
    407         $currentfirstletter = $subsection;
    408         $currentlastletter = $subsection;
    409         }
    410     }
    411     }
    412 
    413     # add final OIDs to last sub-classification if there aren't many otherwise
    414     # add final sub-classification
    415     if (scalar (@currentOIDs) < $min) {
    416     my ($newkey) = $lastkey =~ /^(.)/;
    417     @currentOIDs = (@{$compactedhash->{$lastkey}}, @currentOIDs);
    418     delete $compactedhash->{$lastkey};
    419     @{$compactedhash->{"$newkey-$currentlastletter"}} = @currentOIDs;   
    420     } else {
    421     if ($currentfirstletter eq $currentlastletter) {
    422         @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
    423     } else {
    424         @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
    425     }
    426     }
    427 
    428     return $compactedhash;
    429 }
    430 
    4313561;
    432 
    433 

  • trunk/gsdl/perllib/classify/AZSectionList.pm

    r741 r1250  
    3030# instead of just top level metadata
    3131
    32 # options are:
    33 # metadata=Metadata
    34 
    3532# the only change is to the classify() subroutine which
    3633# must now iterate through each section, adding each
    … …  
    3936package AZSectionList;
    4037
     38use AZList;
    4139use sorttools;
    4240
    43 sub new {
    44     my ($class, @options) = @_;
    45 
    46     my ($metaname);
    47     foreach $option (@options) {
    48     if ($option =~ /^metadata=(.*)$/i) {
    49         $metaname = $1;
    50     }
    51     }
    52 
    53     if (!defined $metaname) {
    54     die "AZSectionList used with no metadata name to classify by\n";
    55     }
    56    
    57     return bless {
    58     'list'=>{},
    59     'metaname' => $metaname
    60     }, $class;
    61 }
    62 
    63 sub init {
    64     my $self = shift (@_);
    65 
    66     $self->{'list'} = {};
     41sub BEGIN {
     42    @ISA = ('AZList');
    6743}
    6844
    … …  
    10379}
    10480
    105 sub get_classify_info {
    106     my $self = shift (@_);
    107 
    108     my @classlist = sort {$self->{'list'}->{$a} cmp $self->{'list'}->{$b};}
    109     keys %{$self->{'list'}};
    110 
    111     return $self->splitlist (\@classlist);
    112 }
    113 
    114 sub get_entry {
    115     my $self = shift (@_);
    116     my ($title, $childtype, $thistype) = @_;
    117    
    118     # organise into classification structure
    119     my %classifyinfo = ('childtype'=>$childtype,
    120             'Title'=>$title,
    121             'contains'=>[]);
    122     $classifyinfo{'thistype'} = $thistype
    123     if defined $thistype && $thistype =~ /\w/;
    124 
    125     return \%classifyinfo;
    126 }
    127 
    128 # splitlist takes an ordered list of classifications (@$classlistref) and splits it
    129 # up into alphabetical sub-sections.
    130 sub splitlist {
    131     my $self = shift (@_);
    132     my ($classlistref) = @_;
    133     my $classhash = {};
    134 
    135     # top level
    136     my $childtype = "HList";
    137     if (scalar (@$classlistref) <= 39) {$childtype = "VList";}
    138     my $classifyinfo = $self->get_entry ($self->{'metaname'}, $childtype, "Invisible");
    139 
    140     # don't need to do any splitting if there are less than 39 (max + min -1) classifications
    141     if ((scalar @$classlistref) <= 39) {
    142     foreach $subOID (@$classlistref) {
    143         push (@{$classifyinfo->{'contains'}}, {'OID'=>$subOID});
    144     }
    145     return $classifyinfo;
    146     }
    147    
    148     # first split up the list into separate A-Z and 0-9 classifications
    149     foreach $classification (@$classlistref) {
    150     my $title = $self->{'list'}->{$classification};
    151     $title =~ s/^(.).*$/$1/;
    152     $title =~ tr/[a-z]/[A-Z]/;
    153     if ($title =~ /^[0-9]$/) {$title = '0-9';}
    154     elsif ($title !~ /^[A-Z]$/) {
    155         print STDERR "AZSectionList: WARNING $classification has badly " .
    156         "formatted title ($title)\n";
    157     }
    158     $classhash->{$title} = [] unless defined $classhash->{$title};
    159     push (@{$classhash->{$title}}, $classification);
    160     }
    161     $classhash = $self->compactlist ($classhash);
    162 
    163     my @tmparr = ();
    164     foreach $subsection (sort keys (%$classhash)) {
    165     push (@tmparr, $subsection);
    166     }
    167    
    168     # if there's a 0-9 section it will have been sorted to the beginning
    169     # but we want it at the end
    170     if ($tmparr[0] eq '0-9') {
    171     shift @tmparr;
    172     push (@tmparr, '0-9');
    173     }
    174 
    175     foreach $subclass (@tmparr) {
    176     my $tempclassify = $self->get_entry($subclass, "VList");
    177     foreach $subsubOID (@{$classhash->{$subclass}}) {
    178         push (@{$tempclassify->{'contains'}}, {'OID'=>$subsubOID});
    179     }
    180     push (@{$classifyinfo->{'contains'}}, $tempclassify);
    181     }
    182 
    183     return $classifyinfo;
    184 }
    185 
    186 sub compactlist {
    187     my $self = shift (@_);
    188     my ($classhashref) = @_;
    189     my $compactedhash = {};
    190     my @currentOIDs = ();
    191     my $currentfirstletter = "";
    192     my $currentlastletter = "";
    193     my $lastkey = "";
    194 
    195     # minimum and maximum documents to be displayed per page.
    196     # the actual maximum will be max + (min-1).
    197     # the smallest sub-section is a single letter at present
    198     # so in this case there may be many times max documents
    199     # displayed on a page.
    200     my $min = 10;
    201     my $max = 30;
    202 
    203     foreach $subsection (sort keys %$classhashref) {
    204     if ($subsection eq '0-9') {
    205         @{$compactedhash->{$subsection}} = @{$classhashref->{$subsection}};
    206         next;
    207     }
    208     $currentfirstletter = $subsection if $currentfirstletter eq "";
    209     if ((scalar (@currentOIDs) < $min) ||
    210         ((scalar (@currentOIDs) + scalar (@{$classhashref->{$subsection}})) <= $max)) {
    211         push (@currentOIDs, @{$classhashref->{$subsection}});
    212         $currentlastletter = $subsection;
    213     } else {
    214 
    215         if ($currentfirstletter eq $currentlastletter) {
    216         @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
    217         $lastkey = $currentfirstletter;
    218         } else {
    219         @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
    220         $lastkey = "$currentfirstletter-$currentlastletter";
    221         }
    222         if (scalar (@{$classhashref->{$subsection}}) >= $max) {
    223         $compactedhash->{$subsection} = $classhashref->{$subsection};
    224         @currentOIDs = ();
    225         $currentfirstletter = "";
    226         $lastkey = $subsection;
    227         } else {
    228         @currentOIDs = @{$classhashref->{$subsection}};
    229         $currentfirstletter = $subsection;
    230         $currentlastletter = $subsection;
    231         }
    232     }
    233     }
    234 
    235     # add final OIDs to last sub-classification if there aren't many otherwise
    236     # add final sub-classification
    237     if (scalar (@currentOIDs) < $min) {
    238     my ($newkey) = $lastkey =~ /^(.)/;
    239     @currentOIDs = (@{$compactedhash->{$lastkey}}, @currentOIDs);
    240     delete $compactedhash->{$lastkey};
    241     @{$compactedhash->{"$newkey-$currentlastletter"}} = @currentOIDs;   
    242     } else {
    243     if ($currentfirstletter eq $currentlastletter) {
    244         @{$compactedhash->{$currentfirstletter}} = @currentOIDs;
    245     } else {
    246         @{$compactedhash->{"$currentfirstletter-$currentlastletter"}} = @currentOIDs;
    247     }
    248     }
    249 
    250     return $compactedhash;
    251 }
    25281
    253821;

  • trunk/gsdl/perllib/classify/SectionList.pm

    r838 r1250  
    2727# (excluding top level) rather than just top level document
    2828# itself
    29 # options are:
    30 # metadata=Metaname -- (optional) all documents with Metaname metadata
    31 #                      will be included in list. if not included all documents
    32 #                      will be included in list.
    33 # sort=Meta         -- (optional) sort documents in list alphabetically by
    34 #                      Meta. by default it will sort by Metaname, if neither
    35 #                      are set documents will be in build (random) order.
    36 #                      Meta may be Filename to sort by original filename or
    37 #                      nosort to force not to sort
    38 # title=Title       -- (optional) the title field for this classification.
    39 #                      if not included title field will be Metaname.
    40 #                      if metadata is also not included title will be 'List'
    4129
    4230package SectionList;
    4331
     32use List;
    4433use sorttools;
    4534
    46 sub new {
    47     my ($class, @options) = @_;
    48 
    49     my $list = [];
    50     my ($metaname, $title, $sortname);
    51 
    52     foreach $option (@options) {
    53     if ($option =~ /^metadata=(.*)$/i) {
    54         $metaname = $1;
    55         $list = {};
    56     } elsif ($option =~ /^title=(.*)$/i) {
    57         $title = $1;
    58     } elsif ($option =~ /^sort=(.*)$/i) {
    59         $sortname = $1;
    60     }
    61     }
    62 
    63     if (!defined $title) {
    64     if (defined $metaname) {
    65         $title = $metaname;
    66     } else {
    67         $title = 'List';
    68     }
    69     }
    70 
    71     if (defined $sortname && $sortname =~ /^nosort$/i) {
    72     $sortname = undef;
    73     } elsif (!defined $sortname && defined $metaname) {
    74     $sortname = $metaname;
    75     }
    76 
    77     return bless {
    78     'list'=>$list,
    79     'metaname' => $metaname,
    80     'title' => $title,
    81     'sortname' => $sortname
    82     }, $class;
    83 }
    84 
    85 sub init {
    86     my $self = shift (@_);
    87 
    88     if (defined $self->{'sortname'}) {
    89     $self->{'list'} = {};
    90     } else {
    91     $self->{'list'} = [];
    92     }
     35sub BEGIN {
     36    @ISA = ('List');
    9337}
    9438
    9539sub classify {
    9640    my $self = shift (@_);
    97     my ($doc_obj,@options) = @_;
     41    my ($doc_obj, @options) = @_;
    9842   
    9943    my $thissection = undef;
    … …  
    175119}
    176120
    177 sub get_classify_info {
    178     my $self = shift (@_);
    179 
    180     my @list = ();
    181     if (defined $self->{'sortname'}) {
    182     if (keys %{$self->{'list'}}) {
    183         @list = sort {$self->{'list'}->{$a}
    184               cmp $self->{'list'}->{$b};} keys %{$self->{'list'}};
    185     }
    186     } else {
    187     @list = @{$self->{'list'}};
    188     }
    189 
    190     # organise into classification structure
    191     my %classifyinfo = ('thistype'=>'Invisible',
    192             'childtype'=>'VList',
    193             'Title'=>$self->{'title'},
    194             'contains'=>[]);
    195     foreach $OID (@list) {
    196     push (@{$classifyinfo{'contains'}}, {'OID'=>$OID});
    197     }
    198 
    199     return \%classifyinfo;
    200 }
    201 
    202 
    2031211;
Note: See TracChangeset for help on using the changeset viewer.