Changeset 1483
- Timestamp:
- 2000-08-31T20:05:25+12:00 (24 years ago)
- Location:
- trunk/gsdl/perllib
- Files:
-
- 1 added
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gsdl/perllib/classify.pm
r831 r1483 37 37 my @classify_objects = (); 38 38 39 my $outhandle = pop (@_); 40 39 41 foreach $classifyoption (@$classify_list) { 40 42 … … 57 59 map { $_ = "\"$_\""; } @$classifyoption; 58 60 my $options = join (",", @$classifyoption); 59 eval ("\$classobj = new \$classname($options )");61 eval ("\$classobj = new \$classname($options, $outhandle)"); 60 62 die "$@" if $@; 61 63 -
trunk/gsdl/perllib/classify/AZCompactList.pm
r1313 r1483 43 43 package AZCompactList; 44 44 45 use BasClas; 45 46 use sorttools; 47 48 sub BEGIN { 49 @ISA = ('BasClas'); 50 } 46 51 47 52 sub new { 48 53 my ($class, @options) = @_; 54 my $self = new BasClas ($class, @_); 49 55 50 56 my ($metaname, $title); … … 79 85 } 80 86 81 die "AZCompactList used with no metadata name to classify by\n" 82 unless defined $metaname; 87 if (!defined $metaname) { 88 my $outhandle = $self->{'outhandle'}; 89 print $outhandle "AZCompactList used with no metadata name to classify by\n"; 90 die "\n"; 91 } 92 83 93 $title = $metaname unless defined $title; 84 94 85 return bless { 86 'list'=>{}, 87 'listmetavalue'=>{}, 88 'reclassify'=>{}, 89 'reclassifylist'=>{}, 90 'metaname' => $metaname, 91 'title' => $title, 92 'mingroup' => $mingroup, 93 'minnesting' => $minnesting, 94 'mincompact' => $mincompact, 95 'maxcompact' => $maxcompact, 96 'doclevel' => $doclevel, 97 'onlyfirst' => $onlyfirst, 98 'recopt' => $recopt 99 }, $class; 100 101 95 $self->{'list'} = {}; 96 $self->{'listmetavalue'} = {}; 97 $self->{'reclassify'} = {}; 98 $self->{'reclassifylist'} = {}; 99 $self->{'metaname'} = $metaname; 100 $self->{'title'} = $title; 101 $self->{'mingroup'} = $mingroup; 102 $self->{'minnesting'} = $minnesting; 103 $self->{'mincompact'} = $mincompact; 104 $self->{'maxcompact'} = $maxcompact; 105 $self->{'doclevel'} = $doclevel; 106 $self->{'onlyfirst'} = $onlyfirst; 107 $self->{'recopt'} = $recopt; 108 109 return bless $self, $class; 102 110 } 103 111 … … 125 133 126 134 my $metaname = $self->{'metaname'}; 135 my $outhandle = $self->{'outhandle'}; 127 136 128 137 $metaname =~ s/(\/.*)//; # grab first name in n1/n2/n3 list 129 ## print STDERR "AZCompactList: processing $doc_OID for $metaname\n";130 138 131 139 if ($self->{'doclevel'} =~ /^top(level)?/i) … … 151 159 if (defined $self->{'list'}->{$full_doc_OID}) 152 160 { 153 print STDERR"WARNING: AZCompactList::classify called multiple times for $full_doc_OID\n";161 print $outhandle "WARNING: AZCompactList::classify called multiple times for $full_doc_OID\n"; 154 162 } 155 163 $self->{'list'}->{$full_doc_OID} = []; … … 238 246 else 239 247 { 240 die "AZCompactList ERROR - couldn't find classifier \"$listname\"\n"; 248 my $outhandle = $self->{'outhandle'}; 249 print $outhandle "AZCompactList ERROR - couldn't find classifier \"$listname\"\n"; 250 die "\n"; 241 251 } 242 252 } … … 281 291 eval ("\$listclassobj = new AZCompactList($args)"); 282 292 } 283 die "$@" if $@; 293 if ($@) { 294 my $outhandle = $self->{'outhandle'}; 295 print $outhandle "$@"; 296 die "\n"; 297 } 284 298 285 299 $listclassobj->init(); … … 352 366 if (!$found) 353 367 { 354 print STDERR"Warning: AZCompactList::reclassify ";355 print STDERR"could not find sub-node for $metavalue with doc_OID $doc_OID\n";368 print $outhandle "Warning: AZCompactList::reclassify "; 369 print $outhandle "could not find sub-node for $metavalue with doc_OID $doc_OID\n"; 356 370 } 357 371 } … … 503 517 if ($title =~ /^[0-9]$/) {$title = '0-9';} 504 518 elsif ($title !~ /^[A-Z]$/) { 505 print STDERR "AZCompactList: WARNING $classification has badly formatted title ($title)\n"; 519 my $outhandle = $self->{'outhandle'}; 520 print $outhandle "AZCompactList: WARNING $classification has badly formatted title ($title)\n"; 506 521 } 507 522 $classhash->{$title} = [] unless defined $classhash->{$title}; -
trunk/gsdl/perllib/classify/AZList.pm
r837 r1483 34 34 package AZList; 35 35 36 use BasClas; 36 37 use sorttools; 38 39 sub BEGIN { 40 @ISA = ('BasClas'); 41 } 37 42 38 43 sub new { 39 44 my ($class, @options) = @_; 45 my $self = new BasClas ($class, @_); 40 46 41 47 my ($metaname, $title); … … 49 55 } 50 56 51 die "AZList used with no metadata name to classify by\n" 52 unless defined $metaname; 57 if (!defined $metaname) { 58 my $outhandle = $self->{'outhandle'}; 59 print $outhandle "AZList used with no metadata name to classify by\n"; 60 die "\n"; 61 } 62 53 63 $title = $metaname unless defined $title; 54 64 55 return bless {56 'list'=>{}, 57 'metaname' => $metaname, 58 'title' => $title 59 }, $class;65 $self->{'list'} = {}; 66 $self->{'metaname'} = $metaname; 67 $self->{'title'} = $title; 68 69 return bless $self, $class; 60 70 } 61 71 … … 83 93 } 84 94 if (defined $self->{'list'}->{$doc_OID}) { 85 print STDERR "WARNING: AZList::classify called multiple times for $doc_OID\n"; 95 my $outhandle = $self->{'outhandle'}; 96 print $outhandle "WARNING: AZList::classify called multiple times for $doc_OID\n"; 86 97 } 87 98 $self->{'list'}->{$doc_OID} = $metavalue; … … 164 175 if ($title =~ /^[0-9]$/) {$title = '0-9';} 165 176 elsif ($title !~ /^[A-Z]$/) { 166 print STDERR "AZList: WARNING $classification has badly formatted title ($title)\n"; 177 my $outhandle = $self->{'outhandle'}; 178 print $outhandle "AZList: WARNING $classification has badly formatted title ($title)\n"; 167 179 } 168 180 $classhash->{$title} = [] unless defined $classhash->{$title}; -
trunk/gsdl/perllib/classify/AZSectionList.pm
r1250 r1483 43 43 } 44 44 45 sub new { 46 my ($class, @options) = @_; 47 my $self = new AZList ($class, @_); 48 } 49 45 50 sub classify { 46 51 my $self = shift (@_); … … 72 77 } 73 78 if (defined $self->{'list'}->{"$doc_OID.$section"}) { 74 print STDERR "WARNING: AZSectionList::classify called multiple times " . 79 my $outhandle = $self->{'outhandle'}; 80 print $outhandle "WARNING: AZSectionList::classify called multiple times " . 75 81 "for $doc_OID.$section\n"; 76 82 } -
trunk/gsdl/perllib/classify/DateList.pm
r677 r1483 34 34 package DateList; 35 35 36 use BasClas; 36 37 use sorttools; 38 39 sub BEGIN { 40 @ISA = ('BasClas'); 41 } 37 42 38 43 sub new { 39 44 my ($class, @options) = @_; 40 41 return bless { 42 'list'=>{}, 43 }, $class; 45 my $self = new BasClas ($class, @_); 46 47 $self->{'list'} = {}; 48 49 return bless $self, $class; 44 50 } 45 51 … … 61 67 if (defined $date && $date =~ /\d/) { 62 68 if (defined $self->{'list'}->{$doc_OID}) { 63 print STDERR "WARNING: DateList::classify called multiple times for $doc_OID\n"; 69 my $outhandle = $self->{'outhandle'}; 70 print $outhandle "WARNING: DateList::classify called multiple times for $doc_OID\n"; 64 71 } 65 72 $self->{'list'}->{$doc_OID} = $date; -
trunk/gsdl/perllib/classify/HTML.pm
r717 r1483 33 33 package HTML; 34 34 35 use BasClas; 36 37 sub BEGIN { 38 @ISA = ('BasClas'); 39 } 40 35 41 sub new { 36 42 my ($class, @options) = @_; 43 my $self = new BasClas ($class, @_); 37 44 38 45 my ($title, $url); … … 46 53 } 47 54 48 die "Error: HTML classifier contains no 'url' option\n" 49 unless defined $url; 55 if (!defined $url) { 56 my $outhandle = $self->{'outhandle'}; 57 print $outhandle "Error: HTML classifier contains no 'url' option\n"; 58 die "\n"; 59 } 50 60 51 61 $title = 'Browse' unless defined $title; 52 62 53 return bless {54 'url' => $url, 55 'title' => $title 56 }, $class;63 $self->{'url'} = $url; 64 $self->{'title'} = $title; 65 66 return bless $self, $class; 57 67 } 58 68 -
trunk/gsdl/perllib/classify/Hierarchy.pm
r677 r1483 41 41 package Hierarchy; 42 42 43 use BasClas; 43 44 use util; 44 45 use cfgread; 45 46 use sorttools; 46 47 48 sub BEGIN { 49 @ISA = ('BasClas'); 50 } 51 47 52 sub new { 48 53 my ($class, @options) = @_; 54 my $self = new BasClas ($class, @_); 49 55 50 56 my $sortname = "Title"; … … 65 71 66 72 if (!defined ($hfile) || !defined ($metadata)) { 67 die "Error in options passed to Hierarchy classification\n" . 68 "hfile and metadata options aren't optional\n\n" . 69 "Options:\n" . 70 "hfile -- the classification structure file\n" . 71 "metadata -- metadata field to test against hfile\n" . 72 "sort -- metadata field to sort by\n" . 73 "title -- title of classification\n\n"; 73 my $outhandle = $self->{'outhandle'}; 74 print $outhandle "Error in options passed to Hierarchy classification\n"; 75 print $outhandle "hfile and metadata options aren't optional\n\n"; 76 print $outhandle "Options:\n"; 77 print $outhandle "hfile -- the classification structure file\n"; 78 print $outhandle "metadata -- metadata field to test against hfile\n"; 79 print $outhandle "sort -- metadata field to sort by\n"; 80 print $outhandle "title -- title of classification\n\n"; 81 die "\n"; 74 82 } 75 83 … … 81 89 $subjectfile = &util::filename_cat($ENV{'GSDLHOME'},"etc", $hfile); 82 90 if (!-e $subjectfile) { 83 die "Hierarchy Error: Can't locate subject file $hfile\n" . 84 "This file should be in $collfile or $subjectfile\n"; 85 } 86 } 87 88 return bless { 89 'descriptorlist'=>{}, # first field in subject file 90 'locatorlist'=>{}, # second field in subject file 91 'subjectfile' => $subjectfile, 92 'metaname' => $metadata, 93 'sortname' => $sortname, 94 'title' => $title 95 }, $class; 91 my $outhandle = $self->{'outhandle'}; 92 print $outhandle "Hierarchy Error: Can't locate subject file $hfile\n"; 93 print $outhandle "This file should be in $collfile or $subjectfile\n"; 94 die "\n"; 95 } 96 } 97 98 $self->{'descriptorlist'} = {}; # first field in subject file 99 $self->{'locatorlist'} = {}; # second field in subject file 100 $self->{'subjectfile'} = $subjectfile; 101 $self->{'metaname'} = $metadata; 102 $self->{'sortname'} = $sortname; 103 $self->{'title'} = $title; 104 105 return bless $self, $class; 96 106 } 97 107 -
trunk/gsdl/perllib/classify/List.pm
r1086 r1483 42 42 use sorttools; 43 43 44 sub BEGIN { 45 @ISA = ('BasClas'); 46 } 47 44 48 sub new { 45 49 my ($class, @options) = @_; 50 my $self = new BasClas ($class, @_); 46 51 47 52 my $list = []; … … 73 78 } 74 79 75 return bless {76 'list'=>$list, 77 'metaname' => $metaname, 78 'title' => $title, 79 'sortname' => $sortname 80 }, $class;80 $self->{'list'} = $list; 81 $self->{'metaname'} = $metaname; 82 $self->{'title'} = $title; 83 $self->{'sortname'} = $sortname; 84 85 return bless $self, $class; 81 86 } 82 87 … … 119 124 if (defined $metavalue) { 120 125 if (defined $self->{'list'}->{$doc_OID}) { 121 print STDERR "WARNING: List::classify called multiple times for $doc_OID\n"; 126 my $outhandle = $self->{'outhandle'}; 127 print $outhandle "WARNING: List::classify called multiple times for $doc_OID\n"; 122 128 } 123 129 $self->{'list'}->{$doc_OID} = $sortmeta; … … 125 131 } else { 126 132 if (defined $self->{'list'}->{$doc_OID}) { 127 print STDERR "WARNING: List::classify called multiple times for $doc_OID\n"; 133 my $outhandle = $self->{'outhandle'}; 134 print $outhandle "WARNING: List::classify called multiple times for $doc_OID\n"; 128 135 } 129 136 $self->{'list'}->{$doc_OID} = $sortmeta; -
trunk/gsdl/perllib/classify/SectionList.pm
r1362 r1483 30 30 package SectionList; 31 31 32 use List; 32 33 use sorttools; 33 34 34 35 sub BEGIN { 35 36 @ISA = ('List'); 37 } 38 39 sub new { 40 my ($class, @options) = @_; 41 my $self = new List ($class, @_); 36 42 } 37 43 … … 94 100 if (defined $metavalue) { 95 101 if (defined $self->{'list'}->{"$doc_OID.$section"}) { 96 print STDERR "WARNING: SectionList::classify called multiple times for $doc_OID.$section\n"; 102 my $outhandle = $self->{'outhandle'}; 103 print $outhandle "WARNING: SectionList::classify called multiple times for $doc_OID.$section\n"; 97 104 } 98 105 $self->{'list'}->{"$doc_OID.$section"} = $sortmeta; … … 100 107 } else { 101 108 if (defined $self->{'list'}->{"$doc_OID.$section"}) { 102 print STDERR "WARNING: SectionList::classify called multiple times for $doc_OID.$section\n"; 109 my $outhandle = $self->{'outhandle'}; 110 print $outhandle "WARNING: SectionList::classify called multiple times for $doc_OID.$section\n"; 103 111 } 104 112 $self->{'list'}->{"$doc_OID.$section"} = $sortmeta; -
trunk/gsdl/perllib/mgbuilder.pm
r1424 r1483 128 128 129 129 # load all the classifiers 130 $self->{'classifiers'} = &classify::load_classifiers ($classifiers );130 $self->{'classifiers'} = &classify::load_classifiers ($classifiers, $outhandle); 131 131 132 132 # load up any dontgdbm fields
Note:
See TracChangeset
for help on using the changeset viewer.