source: trunk/gsdl/perllib/classify/AZSectionList.pm@ 8852

Last change on this file since 8852 was 8852, checked in by kjdon, 19 years ago

shifted format_metadata_for_sorting from BasCLas to sorttools, so other things can use it

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1###########################################################################
2#
3# AZSectionList.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26# classifier plugin for sorting sections alphabetically
27
28# this is very similar to AZList except it sorts by
29# section level metadata (excluding the top level)
30# instead of just top level metadata
31
32# the only change is to the classify() subroutine which
33# must now iterate through each section, adding each
34# to the classification
35
36# 12/05/02 Added usage datastructure - John Thompson
37
38package AZSectionList;
39
40use AZList;
41use sorttools;
42
43sub BEGIN {
44 @ISA = ('AZList');
45}
46
47my $options = { 'name' => "AZSectionList",
48 'desc' => "{AZSectionList.desc}",
49 'abstract' => "no",
50 'inherits' => "yes" };
51
52
53sub new {
54 my $class = shift (@_);
55 my $self = new AZList($class, @_);
56
57 # 14-05-02 To allow for proper inheritance of arguments - John Thompson
58 my $option_list = $self->{'option_list'};
59 push( @{$option_list}, $options );
60
61 #if ($self->{'info_only'}) {
62 # created from classinfo.pl - don't need to parse the arguments
63 # return bless $self, $class;
64 #}
65
66 return bless $self, $class;
67}
68
69sub classify {
70 my $self = shift (@_);
71 my ($doc_obj) = @_;
72
73 my $doc_OID = $doc_obj->get_OID();
74 my $thissection = $doc_obj->get_next_section ($doc_obj->get_top_section());
75
76 while (defined $thissection) {
77 $self->classify_section ($thissection, $doc_obj);
78 $thissection = $doc_obj->get_next_section ($thissection);
79 }
80}
81
82sub classify_section {
83 my $self = shift (@_);
84 my ($section, $doc_obj) = @_;
85
86 my $doc_OID = $doc_obj->get_OID();
87
88 my $metavalue;
89 my $metaname;
90
91 if (!defined $self->{'meta_list'}) {
92 # just in case
93 return;
94 }
95
96 # find the first available metadata
97 foreach $m (@{$self->{'meta_list'}}) {
98 $metavalue = $doc_obj->get_metadata_element($section, $m);
99 $metaname = $m;
100 last if defined $metavalue;
101 }
102
103 # if this section doesn't contain the metadata element we're
104 # sorting by we won't include it in this classification
105
106 if (defined $metavalue && $metavalue ne "") {
107 if ($self->{'removeprefix'}) {
108 $metavalue =~ s/^$self->{'removeprefix'}//;
109 }
110
111 $metavalue = &sorttools::format_metadata_for_sorting($metaname, $metavalue, $doc_obj);
112 if (defined $self->{'list'}->{"$doc_OID.$section"}) {
113 my $outhandle = $self->{'outhandle'};
114 print $outhandle "WARNING: AZSectionList::classify called multiple times " .
115 "for $doc_OID.$section\n";
116 }
117 $self->{'list'}->{"$doc_OID.$section"} = $metavalue;
118 }
119}
120
121
1221;
Note: See TracBrowser for help on using the repository browser.