source: trunk/gsdl/perllib/classify/AZCompactSectionList.pm@ 6956

Last change on this file since 6956 was 6408, checked in by jmt12, 20 years ago

Added two new attributes for script arguments. HiddenGLI controls whether the argument will be visible at all in GLI, while ModeGLI defines the lowest detail mode under which the argument will be visible (only really for import and buildcol). Also ensured that the scripts were reporting their correct default process expressions, and further refined argument types by adding the catagory regexp for any regular expression (which can then be hidden under lower detail modes in GLI)

  • Property svn:keywords set to Author Date Id Revision
File size: 5.4 KB
Line 
1###########################################################################
2#
3# AZCompactSectionList.pm --
4#
5# Experimental AZCompactList with fixes to handle section-level metadata
6#
7###########################################################################
8
9package AZCompactSectionList;
10
11use AZCompactList;
12
13sub BEGIN {
14 @ISA = ('AZCompactList');
15}
16
17my $options =
18{ 'name' => "AZCompactSectionList",
19 'desc' => "{AZCompactSectionList.desc}",
20 'abstract' => "no",
21 'inherits' => "yes",
22 'args' => $arguments };
23
24sub new {
25 my $class = shift (@_);
26 my $self = new AZCompactList($class, @_);
27
28 # 14-05-02 To allow for proper inheritance of arguments - John Thompson
29 my $option_list = $self->{'option_list'};
30 push( @{$option_list}, $options );
31
32 return bless $self, $class;
33}
34
35#
36# override reinit() & reclassify() to demonstrate possible bug fixes
37# (search for SECTIONFIX? to see lines changed from AZCompactList.pm)
38#
39sub reinit
40{
41 my ($self,$classlist_ref) = @_;
42
43 my %mtfreq = ();
44 my @single_classlist = ();
45 my @multiple_classlist = ();
46
47 # find out how often each metavalue occurs
48 map
49 {
50 my $mv;
51 foreach $mv (@{$self->{'listmetavalue'}->{$_}} )
52 {
53 $mtfreq{$mv}++;
54 }
55 } @$classlist_ref;
56
57 # use this information to split the list: single metavalue/repeated value
58 map
59 {
60 my $i = 1;
61 my $metavalue;
62 foreach $metavalue (@{$self->{'listmetavalue'}->{$_}})
63 {
64 if ($mtfreq{$metavalue} >= $self->{'mingroup'})
65 {
66 push(@multiple_classlist,[$_,$i,$metavalue]);
67 }
68 else
69 {
70 push(@single_classlist,[$_,$metavalue]);
71 $metavalue =~ tr/[A-Z]/[a-z]/;
72 $self->{'reclassifylist'}->{"Metavalue_$i.$_"} = $metavalue;
73 }
74 $i++;
75 }
76 } @$classlist_ref;
77
78
79 # Setup sub-classifiers for multiple list
80
81 $self->{'classifiers'} = {};
82
83 my $pm;
84 foreach $pm ("List", "SectionList")
85 {
86 my $listname
87 = &util::filename_cat($ENV{'GSDLHOME'},"perllib/classify/$pm.pm");
88 if (-e $listname) { require $listname; }
89 else
90 {
91 my $outhandle = $self->{'outhandle'};
92 print $outhandle "AZCompactList ERROR - couldn't find classifier \"$listname\"\n";
93 die "\n";
94 }
95 }
96
97 # Create classifiers objects for each entry >= mingroup
98 my $metavalue;
99 foreach $metavalue (keys %mtfreq)
100 {
101 if ($mtfreq{$metavalue} >= $self->{'mingroup'})
102 {
103 my $listclassobj;
104 my $doclevel = $self->{'doclevel'};
105 my $metaname = $self->{'metaname'};
106 my @metaname_list = split('/',$metaname);
107 $metaname = shift(@metaname_list);
108 if (@metaname_list==0)
109 {
110 my @args;
111 push @args, ("-metadata", "$metaname");
112# buttonname is also used for the node's title
113 push @args, ("-buttonname", "$metavalue");
114 push @args, ("-sort", "Date");
115
116 if ($doclevel =~ m/^top(level)?/i)
117 {
118 eval ("\$listclassobj = new List(\@args)"); warn $@ if $@;
119 }
120 else
121 {
122 # SECTIONFIX?
123 #eval ("\$listclassobj = new SectionList($args)");
124 eval ("\$listclassobj = new SectionList(\@args)");
125 }
126 }
127 else
128 {
129 $metaname = join('/',@metaname_list);
130
131 my @args;
132 push @args, ("-metadata", "$metaname");
133# buttonname is also used for the node's title
134 push @args, ("-buttonname", "$metavalue");
135 push @args, ("-doclevel", "$doclevel");
136 push @args, "-recopt";
137
138 # SECTIONFIX?
139 #eval ("\$listclassobj = new AZCompactList($args)");
140 eval ("\$listclassobj = new AZCompactList(\@args)");
141 }
142 if ($@) {
143 my $outhandle = $self->{'outhandle'};
144 print $outhandle "$@";
145 die "\n";
146 }
147
148 $listclassobj->init();
149
150 if (defined $metavalue && $metavalue =~ /\w/)
151 {
152 my $formatted_node = $metavalue;
153 if ($self->{'metaname'} =~ m/^Creator(:.*)?$/)
154 {
155 &sorttools::format_string_name_english(\$formatted_node);
156 }
157 else
158 {
159 &sorttools::format_string_english(\$formatted_node);
160 }
161
162 $self->{'classifiers'}->{$metavalue}
163 = { 'classifyobj' => $listclassobj,
164 'formattednode' => $formatted_node };
165 }
166 }
167 }
168
169
170 return (\@single_classlist,\@multiple_classlist);
171}
172
173
174sub reclassify
175{
176 my ($self,$multiple_cl_ref) = @_;
177
178 # Entries in the current classify list that are "book nodes"
179 # should be recursively classified.
180 #--
181 foreach $dm_pair (@$multiple_cl_ref)
182 {
183 my ($doc_OID,$mdoffset,$metavalue) = @$dm_pair;
184 my $listclassobj;
185
186 # find metavalue in list of sub-classifiers
187 my $found = 0;
188 my $node_name;
189 foreach $node_name (keys %{$self->{'classifiers'}})
190 {
191 $resafe_node_name = $node_name;
192 $resafe_node_name =~ s/(\(|\)|\[|\]|\{|\}|\^|\$|\.|\+|\*|\?|\|)/\\$1/g;
193 if ($metavalue =~ m/^$resafe_node_name$/i)
194 {
195 my ($doc_obj,$date) = @{$self->{'reclassify'}->{$doc_OID}};
196
197 ## date appears to not be used in classifier call ####
198
199 # SECTIONFIX? section must include multiple levels, e.g. '1.12'
200 #if ($doc_OID =~ m/^.*\.(\d+)$/)
201 if ($doc_OID =~ m/^[^\.]*\.([\d\.]+)$/)
202 {
203 $self->{'classifiers'}->{$node_name}->{'classifyobj'}
204 # SECTIONFIX? classify can't handle multi-level section
205 #->classify($doc_obj, "Section=$1");
206 ->classify_section($1, $doc_obj, $date);
207 }
208 else
209 {
210 $self->{'classifiers'}->{$node_name}->{'classifyobj'}
211 ->classify($doc_obj);
212 }
213
214 $found = 1;
215 last;
216 }
217 }
218
219 if (!$found)
220 {
221 print $outhandle "Warning: AZCompactList::reclassify ";
222 print $outhandle "could not find sub-node for $metavalue with doc_OID $doc_OID\n";
223 }
224 }
225}
226
2271;
Note: See TracBrowser for help on using the repository browser.