Changeset 10218
- Timestamp:
- 2005-07-06T15:27:45+12:00 (19 years ago)
- Location:
- trunk/gsdl/perllib
- Files:
-
- 63 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gsdl/perllib/classify.pm
r9790 r10218 58 58 my ($classobj); 59 59 my $options = "-gsdlinfo"; 60 61 eval ("\$classobj = new \$classifier($options)"); 60 eval ("\$classobj = new \$classifier([],[$options])"); 62 61 die "$@" if $@; 63 62 … … 112 111 my $options .= join (",", @newoptions); 113 112 114 eval ("\$classobj = new \$classname($options)"); 113 114 eval ("\$classobj = new \$classname([],[$options])"); 115 115 die "$@" if $@; 116 116 -
trunk/gsdl/perllib/classify/AZCompactList.pm
r10113 r10218 62 62 'desc' => "{AZCompactList.sort}", 63 63 'type' => "string", 64 'deft' => "Title",64 # 'deft' => "Title", 65 65 'reqd' => "no" }, 66 66 { 'name' => "removeprefix", … … 121 121 122 122 sub new { 123 my $class = shift (@_); 124 my $self = new BasClas($class, @_); 125 126 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 127 my $option_list = $self->{'option_list'}; 128 push( @{$option_list}, $options ); 129 130 if ($self->{'info_only'}) { 131 # created from classinfo.pl - don't need to parse the arguments 132 return bless $self, $class; 133 } 134 135 my ($metaname, $title, $removeprefix, $removesuffix); 136 my $sortname = "Title"; 137 my $mingroup = 2; 138 my $minnesting = 20; 139 my $mincompact = 10; 140 my $maxcompact = 30; 141 my $doclevel = "top"; 142 my $firstvalueonly = 0; 143 my $allvalues = 0; 144 my $freqsort = 0; 145 my $recopt = undef; 146 147 if (!parsargv::parse(\@_, 148 q^metadata/.*/^, \$metaname, 149 q^buttonname/.*/^, \$title, 150 q^sort/.*/^, \$sortname, 151 q^removeprefix/.*/^, \$removeprefix, 152 q^removesuffix/.*/^, \$removesuffix, 153 q^mingroup/.*/2^, \$mingroup, 154 q^minnesting/.*/20^, \$minnesting, 155 q^mincompact/.*/10^, \$mincompact, 156 q^maxcompact/.*/30^, \$maxcompact, 157 q^doclevel/.*/top^, \$doclevel, 158 q^firstvalueonly^, \$firstvalueonly, 159 q^allvalues^, \$allvalues, 160 q^freqsort/.*/0^, \$freqsort, 161 q^recopt/.*/-1^, \$recopt, # Used in nested metadata such as -metadata Year/Organisation 162 163 "allow_extra_options")) { 164 165 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 166 $self->print_txt_usage(""); # Use default resource bundle 167 die "\n"; 168 } 169 170 if (!defined($metaname)) { 123 my ($class) = shift (@_); 124 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 125 push(@$pluginlist, $class); 126 127 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 128 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 129 130 my $self = (defined $hashArgOptLists)? new BasClas($pluginlist,$inputargs,$hashArgOptLists): new BasClas($pluginlist,$inputargs); 131 132 if (!$self->{"metadata"}) { 171 133 my $outhandle = $self->{'outhandle'}; 172 134 print $outhandle "AZCompactList Error: required option -metadata not supplied\n"; … … 175 137 } 176 138 177 $title = $self->generate_title_from_metadata($metaname) unless ($title); 178 #$title = $metaname unless ($title); 179 139 # Manually set $self parameters. 180 140 $self->{'list'} = {}; 181 141 $self->{'listmetavalue'} = {}; … … 183 143 $self->{'reclassify'} = {}; 184 144 $self->{'reclassifylist'} = {}; 185 $self->{'metaname'} = $metaname; 186 $self->{'title'} = "$title"; # title for the titlebar. 187 $self->{'sortname'} = $sortname; 188 189 if (defined($removeprefix) && $removeprefix) { 190 $removeprefix =~ s/^\^//; # don't need a leading ^ 191 $self->{'removeprefix'} = $removeprefix; 192 } 193 if (defined($removesuffix) && $removesuffix) { 194 $removesuffix =~ s/\$$//; # don't need a trailing $ 195 $self->{'removesuffix'} = $removesuffix; 196 } 197 $self->{'mingroup'} = $mingroup; 198 $self->{'minnesting'} = $minnesting; 199 $self->{'mincompact'} = $mincompact; 200 $self->{'maxcompact'} = $maxcompact; 201 $self->{'doclevel'} = $doclevel; 202 203 if ($firstvalueonly != 0) { 204 $firstvalueonly = 1; 205 } 206 $self->{'firstvalueonly'} = $firstvalueonly; 207 208 if ($allvalues != 0) { 209 $allvalues = 1; 210 } 211 $self->{'allvalues'} = $allvalues; 212 if ($freqsort != 0) { 213 $freqsort = 1; 214 } 215 $self->{'freqsort'} = $freqsort; 216 217 if ($recopt == -1) { 218 $recopt = undef; 219 } else { 220 $recopt = "on"; 221 } 222 $self->{'recopt'} = $recopt; 145 146 $self->{'buttonname'} = $self->generate_title_from_metadata($self->{'metadata'}) unless ($self->{'buttonname'}); 147 148 if (defined($self->{"removeprefix"}) && $self->{"removeprefix"}) { 149 $self->{"removeprefix"} =~ s/^\^//; # don't need a leading ^ 150 } 151 if (defined($self->{"removesuffix"}) && $self->{"removesuffix"}) { 152 $self->{"removesuffix"} =~ s/\$$//; # don't need a trailing $ 153 } 154 155 $self->{'recopt'} = ($self->{'recopt'} == 0) ? undef : "on"; 156 157 # Clean out the unused keys 158 if($self->{"removeprefix"} eq "") {delete $self->{"removeprefix"};} 159 if($self->{"removesuffix"} eq "") {delete $self->{"removesuffix"};} 223 160 224 161 return bless $self, $class; … … 247 184 my @sectionlist = (); 248 185 my $topsection = $doc_obj->get_top_section(); 249 my $metaname = $self->{'meta name'};186 my $metaname = $self->{'metadata'}; 250 187 my $outhandle = $self->{'outhandle'}; 251 188 … … 317 254 318 255 my $formatted_metavalue = 319 sorttools::format_metadata_for_sorting($self->{'meta name'},256 sorttools::format_metadata_for_sorting($self->{'metadata'}, 320 257 $metavalue, $doc_obj); 321 258 … … 338 275 339 276 # This is used in reclassify below for AZCompactSectionList 340 my $sortmeta = $doc_obj->get_metadata_element($thissection, $self->{'sort name'});277 my $sortmeta = $doc_obj->get_metadata_element($thissection, $self->{'sort'}); 341 278 $self->{'reclassify'}->{$full_doc_OID} = [$doc_obj,$sortmeta]; 342 279 } … … 413 350 my $doclevel = $self->{'doclevel'}; 414 351 my $mingroup = $self->{'mingroup'}; 415 my @metaname_list = split(/\/|\|/,$self->{'meta name'});352 my @metaname_list = split(/\/|\|/,$self->{'metadata'}); 416 353 my $metaname = shift(@metaname_list); 417 354 my $hierarchical = 0; … … 433 370 # buttonname is also used for the node's title 434 371 push @args, ("-buttonname", "$metavalue"); 435 push @args, ("-sort", $self->{'sortname'}); 436 372 push @args, ("-sort", $self->{'sort'}); 373 374 my $ptArgs = \@args; 437 375 if ($doclevel =~ m/^top(level)?/i) 438 376 { 439 eval ("\$listclassobj = new List(\@args)"); 440 warn $@ if $@; 377 eval ("\$listclassobj = new List([],\$ptArgs)"); 441 378 } 442 379 else 443 380 { 444 eval ("\$listclassobj = new SectionList(\@args)"); 445 warn $@ if $@; 381 eval ("\$listclassobj = new SectionList([],\$ptArgs)"); 446 382 } 447 383 } … … 453 389 # buttonname is also used for the node's title 454 390 push @args, ("-buttonname", "$metavalue"); 455 push @args, ("-sort", $self->{'sort name'});391 push @args, ("-sort", $self->{'sort'}); 456 392 457 393 if (defined $self->{'removeprefix'}) { … … 466 402 push @args, "-recopt "; 467 403 468 eval ("\$listclassobj = new AZCompactList(\@args)"); 469 warn $@ if $@; 470 } 404 my $ptArgs = \@args; 405 eval ("\$listclassobj = new AZCompactList([],\$ptArgs)"); 406 } 407 471 408 if ($@) { 472 409 print $outhandle "$@"; … … 493 430 } 494 431 495 $formatted_node = &sorttools::format_metadata_for_sorting($self->{'meta name'}, $formatted_node);432 $formatted_node = &sorttools::format_metadata_for_sorting($self->{'metadata'}, $formatted_node); 496 433 497 434 # In case our formatted string is empty... … … 671 608 my $self = shift (@_); 672 609 my ($title, $childtype, $metaname, $thistype) = @_; 673 674 610 # organise into classification structure 675 611 my %classifyinfo = ('childtype'=>$childtype, … … 694 630 695 631 # top level 696 my @metanames = split(/\/|\|/,$self->{'meta name'});632 my @metanames = split(/\/|\|/,$self->{'metadata'}); 697 633 my $metaname = shift(@metanames); 698 634 … … 700 636 $childtype = "VList" if (scalar (@$classlistref) <= $self->{'minnesting'}); 701 637 638 my $title = $self->{'buttonname'}; # should always be defined by now. 702 639 my $classifyinfo; 703 640 if (!defined($self->{'recopt'})) 704 641 { 705 my $title = $self->{'title'}; # should always be defined by now....706 $title = $metaname unless defined $title;707 642 $classifyinfo 708 643 = $self->get_entry ($title, $childtype, $metaname, "Invisible"); … … 710 645 else 711 646 { 712 my $title = $self->{'title'};713 647 $classifyinfo 714 648 = $self->get_entry ($title, $childtype, $metaname, "VList"); -
trunk/gsdl/perllib/classify/AZCompactSectionList.pm
r9578 r10218 23 23 24 24 sub 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 #if ($self->{'info_only'}) { 33 # created from classinfo.pl - don't need to parse the arguments 34 #return bless $self, $class; 35 #} 25 my ($class) = shift (@_); 26 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 27 push(@$classifierslist, $class); 28 29 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 30 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 31 32 my $self = (defined $hashArgOptLists)? new AZCompactList($classifierslist,$inputargs,$hashArgOptLists): new AZCompactList($classifierslist,$inputargs); 36 33 37 34 return bless $self, $class; … … 117 114 # buttonname is also used for the node's title 118 115 push @args, ("-buttonname", "$metavalue"); 119 push @args, ("-sort", $self->{'sortname'}); 120 116 push @args, ("-sort", $self->{'sort'}); 117 118 my $ptArgs = \@args; 121 119 if ($doclevel =~ m/^top(level)?/i) 122 120 { 123 eval ("\$listclassobj = new List( \@args)"); warn $@ if $@;121 eval ("\$listclassobj = new List([],\$ptArgs)"); warn $@ if $@; 124 122 } 125 123 else … … 127 125 # SECTIONFIX? 128 126 #eval ("\$listclassobj = new SectionList($args)"); 129 eval ("\$listclassobj = new SectionList( \@args)");127 eval ("\$listclassobj = new SectionList([],\$ptArgs)"); 130 128 } 131 129 } … … 143 141 # SECTIONFIX? 144 142 #eval ("\$listclassobj = new AZCompactList($args)"); 145 eval ("\$listclassobj = new AZCompactList(\@args)"); 143 my $ptArgs = \@args; 144 eval ("\$listclassobj = new AZCompactList([],\$ptArgs)"); 146 145 } 147 146 if ($@) { -
trunk/gsdl/perllib/classify/AZList.pm
r9322 r10218 67 67 68 68 sub new { 69 my $class = shift (@_); 70 my $self = new BasClas($class, @_); 71 72 my $option_list = $self->{'option_list'}; 73 push( @{$option_list}, $options ); 74 75 if ($self->{'info_only'}) { 76 # created from classinfo.pl - don't need to parse the arguments 77 return bless $self, $class; 78 } 79 my ($metadata, $title, $removeprefix, $removesuffix); 80 81 if (!parsargv::parse(\@_, 82 q^metadata/.*/^, \$metadata, 83 q^buttonname/.*/^, \$title, 84 q^removeprefix/.*/^, \$removeprefix, 85 q^removesuffix/.*/^, \$removesuffix, 86 "allow_extra_options")) { 87 88 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 89 $self->print_txt_usage(""); # Use default resource bundle 90 die "\n"; 91 } 92 93 if (!$metadata) { 69 my ($class) = shift (@_); 70 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 71 push(@$classifierslist, $class); 72 73 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 74 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 75 76 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 77 78 if (!$self->{"metadata"}) { 94 79 print STDERR "AZList Error: required option -metadata not supplied \n"; 95 80 $self->print_txt_usage(""); # Use default resource bundle … … 97 82 die "AZList Error: required option -metadata not supplied\n"; 98 83 } 99 100 my @meta_list = split(/,/, $metadata); 101 #my $meta1 = $meta_list[0]; 102 103 #$title = $meta1 unless ($title); 104 $title = $self->generate_title_from_metadata($metadata) unless ($title); 84 85 # Manually set $self parameters. 105 86 $self->{'list'} = {}; 87 88 # Transfer value from Auto Parsing to the variavle name that used in previous GreenStone. 89 my @meta_list = split(/,/, $self->{"metadata"}); 106 90 $self->{'meta_list'} = \@meta_list; 107 $self->{'title'} = $title; 108 109 if (defined($removeprefix) && $removeprefix) { 110 $removeprefix =~ s/^\^//; # don't need a leading ^ 111 $self->{'removeprefix'} = $removeprefix; 112 } 113 if (defined($removesuffix) && $removesuffix) { 114 $removesuffix =~ s/\$$//; # don't need a trailing $ 115 $self->{'removesuffix'} = $removesuffix; 116 } 91 92 $self->{'buttonname'} = $self->generate_title_from_metadata($self->{'metadata'}) unless ($self->{'buttonname'}); 93 94 # Further setup 95 if (defined($self->{"removeprefix"}) && $self->{"removeprefix"}) { 96 $self->{"removeprefix"} =~ s/^\^//; # don't need a leading ^ 97 } 98 if (defined($self->{"removesuffix"}) && $self->{"removesuffix"}) { 99 $self->{"removesuffix"} =~ s/\$$//; # don't need a trailing $ 100 } 101 102 # Clean out the unused keys 103 delete $self->{"metadata"}; # Delete this key 104 105 if($self->{"removeprefix"} eq "") {delete $self->{"removeprefix"};} 106 if($self->{"removesuffix"} eq "") {delete $self->{"removesuffix"};} 117 107 118 108 return bless $self, $class; … … 233 223 my $childtype = "HList"; 234 224 if (scalar (@$classlistref) <= 39) {$childtype = "VList";} 235 my $classifyinfo = $self->get_entry ($self->{' title'}, $childtype, "Invisible");225 my $classifyinfo = $self->get_entry ($self->{'buttonname'}, $childtype, "Invisible"); 236 226 237 227 # don't need to do any splitting if there are less than 39 (max + min -1) classifications -
trunk/gsdl/perllib/classify/AZSectionList.pm
r8852 r10218 52 52 53 53 sub new { 54 my $class = shift (@_); 55 my $self = new AZList($class, @_); 54 my ($class) = shift (@_); 55 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 56 push(@$classifierslist, $class); 56 57 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 #} 58 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 59 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 60 61 my $self = (defined $hashArgOptLists)? new AZList($classifierslist,$inputargs,$hashArgOptLists): new AZList($classifierslist,$inputargs); 65 62 66 63 return bless $self, $class; -
trunk/gsdl/perllib/classify/AllList.pm
r8716 r10218 15 15 16 16 sub new { 17 my $class = shift (@_); 18 my $self = new BasClas($class, @_); 17 my ($class) = shift (@_); 18 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 19 push(@$classifierslist, $class); 19 20 21 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 22 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 23 24 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 25 26 # Manually set $self parameters. 20 27 $self->{'list'} = []; 21 $self->{' title'} = "All Documents";28 $self->{'buttonname'} = "All Documents"; 22 29 23 30 return bless $self, $class; … … 44 51 45 52 my %classifyinfo = ('childtype' =>'VList', 46 'Title' =>$self->{' title'},53 'Title' =>$self->{'buttonname'}, 47 54 'contains' =>[], 48 55 'classifyOID' =>"oai"); … … 56 63 57 64 my %tempinfo=('childtype'=>'VList', 58 'Title'=>$self->{' title'},65 'Title'=>$self->{'buttonname'}, 59 66 'classifyOID' =>"oai.$seqNo", 60 67 'contains' =>[]); -
trunk/gsdl/perllib/classify/BasClas.pm
r8852 r10218 56 56 use gsprintf; 57 57 use printusage; 58 58 use parse2; 59 59 60 60 my $arguments = … … 67 67 'type' => "string", 68 68 'deft' => "STDERR" }, 69 #{ 'name' => "verbosity",70 #'desc' => "{BasClas.verbosity}",69 { 'name' => "verbosity", 70 'desc' => "{BasClas.verbosity}", 71 71 # 'type' => "enum", 72 # 'deft' => "2", 73 # 'reqd' => "no" } ]; 72 'type' => "int", 73 'deft' => "2", 74 'reqd' => "no" }, 74 75 # { 'name' => "ignore_namespace", 75 76 # 'desc' => "{BasClas.ignore_namespace}", … … 214 215 215 216 sub new { 216 my $class = shift (@_); 217 my $name = shift (@_); 218 217 my ($class) = shift (@_); 218 my ($classifierslist,$args,,$hashArgOptLists) = @_; 219 push(@$classifierslist, $class); 220 my $classifier_name = (defined $classifierslist->[0]) ? $classifierslist->[0] : $class; 221 print STDERR "new $classifier_name\n"; 222 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 223 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 224 225 226 # Manually set $self parameters. 219 227 my $self = {}; 220 221 228 $self->{'outhandle'} = STDERR; 222 229 $self->{'idnum'} = -1; 223 224 $self->{'option_list'} = [ $options ]; 225 my $gsdlinfo; 226 227 # general options available to all classifiers 228 if (!parsargv::parse(\@_, 229 q^builddir/.*/^, \$self->{'builddir'}, 230 q^outhandle/.*/STDERR^, \$self->{'outhandle'}, 231 q^verbosity/\d/2^, \$self->{'verbosity'}, 232 q^ignore_namespace^, \$self->{'ignore_namespace'}, 233 q^gsdlinfo^, \$gsdlinfo, 234 "allow_extra_options")) { 235 236 &gsprintf(STDERR, "\n{BasClas.bad_general_option}\n", $name); 237 $self->print_txt_usage(""); # Use default resource bundle 238 die "\n"; 239 } 240 241 if ($gsdlinfo) { 242 # created from classinfo.pl - set this so subclasses don't need to 243 # parse the arguments 244 $self->{'info_only'} = 1; 245 } 246 return bless $self, $class; 230 $self->{'option_list'} = $hashArgOptLists->{"OptList"}; 231 $self->{"info_only"} = 0; 232 233 # Check if gsdlinfo is in the argument list or not. 234 foreach $strArg (@{$args}) 235 { 236 if($strArg eq "gsdlinfo") 237 { 238 $self->{"info_only"} = 1; 239 last; 240 } 241 } 242 243 # If gsdlinfo is not in the argument list, process the argument normally. 244 if($self->{"info_only"} == 0) 245 { 246 my $blnParseFailed = "false"; 247 # general options available to all plugins 248 if(!parse2::parse($args,$hashArgOptLists->{"ArgList"},$self)) 249 { 250 $blnParseFailed = "true"; 251 } 252 253 # If the parsing wasn't successful, then print out the text usage of this classifier. 254 my $classTempClass = bless $self, $class; 255 if($blnParseFailed eq "true") 256 { 257 &gsprintf(STDERR, "\n{BasClas.bad_general_option}\n", $classifier_name); 258 $classTempClass->print_txt_usage(""); # Use default resource bundle 259 die "\n"; 260 } 261 else 262 { 263 delete $self->{"info_only"}; 264 return $classTempClass; 265 } 266 } 267 268 # If gsdlinfo is in the argument list, do not perform any parsing. 269 else 270 { 271 delete $self->{"info_only"}; 272 return bless $self, $class; 273 } 247 274 } 248 275 -
trunk/gsdl/perllib/classify/Browse.pm
r6968 r10218 42 42 43 43 sub new { 44 my $class = shift (@_); 45 my $self = new BasClas($class, @_); 46 47 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 48 my $option_list = $self->{'option_list'}; 49 push( @{$option_list}, $options ); 44 my ($class) = shift (@_); 45 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 46 push(@$classifierslist, $class); 50 47 51 if ($self->{'info_only'}) { 52 # created from classinfo.pl - don't need to parse the arguments 53 return bless $self, $class; 54 } 48 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 49 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 55 50 56 # classifier information 57 $self->{'collection'} = $ENV{'GSDLCOLLECTION'}; 51 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 58 52 59 $self->{'title'} = "Browse"; 53 # Manually set $self parameters. 54 $self->{'collection'} = $ENV{'GSDLCOLLECTION'}; # classifier information 55 $self->{'buttonname'} = "Browse"; 60 56 61 57 return bless $self, $class; … … 80 76 # use to create macros when the Phind classifier document is displayed. 81 77 my %classifyinfo = ('thistype'=>'Invisible', 82 'Title'=>$self->{' title'},78 'Title'=>$self->{'buttonname'}, 83 79 'contains'=>[]); 84 80 -
trunk/gsdl/perllib/classify/Collage.pm
r9142 r10218 106 106 107 107 sub new { 108 my $class = shift (@_); 109 my $self = new BasClas($class, @_); 110 111 my $option_list = $self->{'option_list'}; 112 push( @{$option_list}, $options ); 113 114 if ($self->{'info_only'}) { 115 # created from classinfo.pl - don't need to parse the arguments 116 return bless $self, $class; 117 } 118 119 my ($title, $geometry, $verbosity, $maxDepth, $imageType, $bgcolor, $refreshDelay, $isJava2, $caption, $maxDisplay, $maxDownloads, $list); 120 121 if (!parsargv::parse(\@_, 122 q^buttonname/.*/Collage^, \$title, 123 q^geometry/.*/600x300^, \$geometry, 124 q^verbosity/.*/3^, \$verbosity, 125 q^maxDepth/.*/500^, \$maxDepth, 126 # q^maxDownloads/.*/^, \$maxDownloads, 127 q^maxDisplay/.*/25^, \$maxDisplay, 128 q^imageType/.*/.jpg%.png^, \$imageType, 129 q^bgcolor/.*/\#96c29a^, \$bgcolor, 130 q^refreshDelay/.*/1200^, \$refreshDelay, 131 q^isJava2/.*/auto^, \$isJava2, 132 q^imageMustNotHave/.*/hl=\%x=\%gt=\%gc=\%.pr^, \$imageMustNotHave, 133 q^caption/.*/ ^, \$caption, 134 "allow_extra_options")) { 135 136 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 137 $self->print_txt_usage(""); # Use default resource bundle 138 die "\n"; 139 } 140 141 if (!$title) { 142 $title = 'Collage'; 143 } 144 145 $self->{'list'} = $list; 146 $self->{'title'} = $title; 147 $self->{'geometry'} = $geometry; 148 $self->{'verbosity'} = $verbosity; 149 $self->{'maxDepth'} = $maxDepth; 150 $self->{'maxDownloads'} = $maxDownloads; 151 $self->{'maxDisplay'} = $maxDisplay; 152 $self->{'imageType'} = $imageType; 153 $self->{'bgcolor'} = $bgcolor; 154 $self->{'refreshDelay'} = $refreshDelay; 155 $self->{'isJava2'} = $isJava2; 156 # $self->{'imageMustNotHave'} = $imageMustNotHave; 157 $self->{'caption'} = $caption; 108 my ($class) = shift (@_); 109 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 110 push(@$classifierslist, $class); 111 112 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 113 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 114 115 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 116 117 # Manually set $self parameters. 118 $self->{'list'} = {}; 119 print STDERR "buttonnmae = $buttonname\n"; 120 $self->{'buttonname'} = 'Collage' unless ($self->{'buttonname'}); 121 158 122 return bless $self, $class; 159 123 } … … 206 170 207 171 if ($verbosity>1) { 208 print $outhandle ("$self->{' title'}\n");209 } 210 211 my $collage_head = $self->get_entry ($self->{' title'}, "Collage", "Invisible");172 print $outhandle ("$self->{'buttonname'}\n"); 173 } 174 175 my $collage_head = $self->get_entry ($self->{'buttonname'}, "Collage", "Invisible"); 212 176 my $collage_curr = $self->get_entry("Collage","VList"); 213 177 push (@{$collage_head->{'contains'}},$collage_curr); -
trunk/gsdl/perllib/classify/DateList.pm
r10199 r10218 79 79 80 80 sub new { 81 my $class = shift (@_); 82 my $self = new BasClas($class, @_); 83 84 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 85 my $option_list = $self->{'option_list'}; 86 push( @{$option_list}, $options ); 87 88 if ($self->{'info_only'}) { 89 # created from classinfo.pl - don't need to parse the arguments 90 return bless $self, $class; 91 } 92 81 my ($class) = shift (@_); 82 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 83 push(@$classifierslist, $class); 84 85 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 86 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 87 88 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 89 90 # Manually set $self parameters. 93 91 $self->{'list'} = {}; 94 92 95 my ($datemeta, $sortmeta); 96 $self->{'nogroup'}=0; 97 if (!parsargv::parse(\@_, 98 q^bymonth^, \$self->{'bymonth'}, 99 q^nogroup^, \$self->{'nogroup'}, 100 q^metadata/.*/^, \$datemeta, 101 q^sort/.*/^, \$sortmeta, 102 q^reverse_sort^, \$self->{'reverse_sort'}, 103 "allow_extra_options")) { 104 $self->print_txt_usage(""); # Use default resource bundle 105 die "\n"; 106 } 107 108 if (!defined $datemeta || $datemeta eq "") { 109 $datemeta = "Date"; 110 } 111 $self->{'datemeta'} = $datemeta; 112 113 if (defined $sortmeta && $sortmeta ne "") { 114 $self->{'sortmeta'} = $sortmeta; 115 } 93 if (!defined $self->{"metadata"} || $self->{"metadata"} eq "") { 94 $self->{'metadata'} = "Date"; 95 } 96 116 97 return bless $self, $class; 117 98 } … … 128 109 129 110 my $doc_OID = $doc_obj->get_OID(); 130 my $date = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), $self->{' datemeta'});111 my $date = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), $self->{'metadata'}); 131 112 132 113 my $sort_other = ""; 133 if (defined $self->{'sort meta'} && $self->{'sortmeta'} ne "") {134 $sort_other = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), $self->{'sort meta'});135 $sort_other = &sorttools::format_metadata_for_sorting($self->{'sort meta'}, $sort_other, $doc_obj);114 if (defined $self->{'sort'} && $self->{'sort'} ne "") { 115 $sort_other = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), $self->{'sort'}); 116 $sort_other = &sorttools::format_metadata_for_sorting($self->{'sort'}, $sort_other, $doc_obj); 136 117 } 137 118 # if this document doesn't contain Date element we won't … … 143 124 } 144 125 145 146 126 $self->{'list'}->{$doc_OID} = "$date$sort_other"; 147 127 } … … 169 149 'Title'=>$title, 170 150 'contains'=>[], 171 'mdtype'=>$self->{' datemeta'});151 'mdtype'=>$self->{'metadata'}); 172 152 $classifyinfo{'thistype'} = $thistype 173 153 if defined $thistype && $thistype =~ /\w/; -
trunk/gsdl/perllib/classify/HFileHierarchy.pm
r9206 r10218 51 51 'type' => "flag", 52 52 'reqd' => "no" }, 53 { 'name' => "sort",54 'desc' => "{Hierarchy.sort}",55 'type' => "string",56 'deft' => "{BasClas.metadata.deft}",57 'reqd' => "no" },58 53 { 'name' => "hfile", 59 54 'desc' => "{Hierarchy.hfile}", … … 69 64 'desc' => "{Hierarchy.sort}", 70 65 'type' => "string", 71 'deft' => "{BasClas.metadata.deft}",66 # 'deft' => "{BasClas.metadata.deft}", 72 67 'reqd' => "no" }, 73 68 { 'name' => "reverse_sort", … … 82 77 my $options = 83 78 { 'name' => "HFileHierarchy", 84 'desc' => "{H ierarchy.desc}",79 'desc' => "{HFileHierarchy.desc}", 85 80 'abstract' => "yes", 86 81 'inherits' => "yes", … … 89 84 90 85 sub new { 91 my $class = shift (@_); 92 my $self = new BasClas($class, @_); 93 94 my $option_list = $self->{'option_list'}; 95 push( @{$option_list}, $options ); 96 97 if ($self->{'info_only'}) { 98 # created from classinfo.pl - don't need to parse the arguments 99 return bless $self, $class; 100 } 101 102 my ($hfile, $metadata, $buttonname, $sortname, $reverse_sort, $title, 103 $hlist_at_top); 104 my $firstvalueonly = 0; 105 my $allvalues = 0; 106 107 if (!parsargv::parse(\@_, 108 q^metadata/.*/^, \$metadata, 109 q^buttonname/.*/^, \$buttonname, 110 q^firstvalueonly^, \$firstvalueonly, 111 q^allvalues^, \$allvalues, 112 q^sort/.*/^, \$sortname, 113 q^reverse_sort^, \$reverse_sort, 114 q^hfile/.*/^, \$hfile, 115 q^hlist_at_top^, \$hlist_at_top, 116 "allow_extra_options")) { 117 118 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 119 $self->print_txt_usage(""); # Use default resource bundle 120 die "\n"; 121 122 } 123 86 my ($class) = shift (@_); 87 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 88 push(@$classifierslist, $class); 89 90 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 91 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 92 93 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 94 95 my $metadata = $self->{'metadata'}; 124 96 if (!$metadata) { 125 97 print STDERR "$class Error: required option -metadata not supplied\n"; … … 129 101 } 130 102 131 $buttonname = $self->generate_title_from_metadata($metadata) unless ($buttonname); 132 $title = $buttonname; 133 $self->{'title'} = $title; 134 135 $self->{'metaname'} = $metadata; 103 $self->{'buttonname'} = $self->generate_title_from_metadata($metadata) unless ($self->{'buttonname'}); 104 105 #$self->{'metaname'} = $metadata; 136 106 my @meta_list = split(/,/, $metadata); 137 107 $self->{'meta_list'} = \@meta_list; 108 109 print STDERR "sort = $self->{'sort'}\n"; 110 # sort = undef in this case is the same as sort=nosort 111 if ($self->{'sort'} eq "nosort") { 112 $self->{'sort'} = undef; 113 } 138 114 139 115 # sortname is handled a bit differently - kjdon … … 142 118 # we have a list of possible metadata. 143 119 # To get no sorting, set sortname = 'nosort' 144 if (!$sortname) { 145 if (defined ($metadata)) { 146 $sortname = undef; 147 } else { 148 $sortname = "nosort"; 149 } 150 } 151 $self->{'sortname'} = $sortname; 152 153 if (defined $sortname && $reverse_sort) { 154 $self->{'reverse_sort'} = 1; 155 } 120 # we don't need to set it to undef if its not defined do we??? 121 122 # if (!$self->{'sort'}) { 123 # if (defined ($metadata)) { 124 # $sortname = undef; 125 # } else { 126 # $sortname = "nosort"; 127 # } 128 # } 129 # $self->{'sortname'} = $sortname; 130 131 #if (defined $self->{'sort'} && $reverse_sort) { 132 # $self->{'reverse_sort'} = 1; 133 # } 156 134 157 if ($hfile) { 135 if ($self->{'hfile'}) { 136 my $hfile = $self->{'hfile'}; 158 137 my $subjectfile; 159 138 $subjectfile = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"etc", $hfile); … … 177 156 178 157 179 $self->{'firstvalueonly'} = $firstvalueonly; 180 $self->{'allvalues'} = $allvalues; 181 182 $self->{'hlist_at_top'} = $hlist_at_top; 183 158 # $self->{'firstvalueonly'} = $firstvalueonly; 159 # $self->{'allvalues'} = $allvalues; 160 161 #$self->{'hlist_at_top'} = $hlist_at_top; 162 163 # Clean out the unused keys 164 delete $self->{'metadata'}; 165 delete $self->{'hfile'}; 184 166 185 167 return bless $self, $class; … … 240 222 my $tempinfo = $self->get_OID_entry ($OID, $classifyinfo, $list->{$OID}->{'title'}, "VList"); 241 223 242 if (defined $self->{'sort name'}) {224 if (defined $self->{'sort'}) { 243 225 if ($self->{'reverse_sort'}) { 244 226 foreach $subOID (sort {$b->[1] cmp $a->[1];} @{$list->{$OID}->{'contents'}}) { -
trunk/gsdl/perllib/classify/HTML.pm
r6983 r10218 54 54 55 55 sub new { 56 my $class = shift (@_); 57 my $self = new BasClas($class, @_); 56 my ($class) = shift (@_); 57 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 58 push(@$classifierslist, $class); 58 59 59 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 60 my $option_list = $self->{'option_list'}; 61 push( @{$option_list}, $options ); 60 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 61 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 62 62 63 if ($self->{'info_only'}) { 64 # created from classinfo.pl - don't need to parse the arguments 65 return bless $self, $class; 66 } 63 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 67 64 68 my ($title, $url); 69 70 if (!parsargv::parse(\@_, 71 q^url/.*/^, \$url, 72 q^buttonname/.*/Browse^, \$title, 73 "allow_extra_options")) { 74 75 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 76 $self->print_txt_usage(""); # Use default resource bundle 77 die "\n"; 78 } 79 80 if (!$url) { 65 if (!$self->{'url'}) { 81 66 my $outhandle = $self->{'outhandle'}; 82 67 print $outhandle "HTML Error: required option -url not supplied\n"; … … 84 69 die "HTML Error: required option -url not supplied\n"; 85 70 } 86 87 $self->{'url'} = $url;88 $self->{'title'} = $title;89 90 71 return bless $self, $class; 91 72 } … … 107 88 my %classifyinfo = ('thistype'=>'Invisible', 108 89 'childtype'=>'HTML', 109 'Title'=>$self->{' title'},90 'Title'=>$self->{'buttonname'}, 110 91 'contains'=>[]); 111 92 -
trunk/gsdl/perllib/classify/Hierarchy.pm
r9206 r10218 43 43 my $arguments = 44 44 [ { 'name' => "separator", 45 'desc' => "{ AutoHierarchy.separator}",45 'desc' => "{Hierarchy.separator}", 46 46 'type' => "regexp", 47 47 'deft' => "[\\\\\\\/|\\\\\\\|]", 48 48 'reqd' => "no" }, 49 49 { 'name' => "suppresslastlevel", 50 'desc' => "{ AutoHierarchy.suppresslastlevel}",50 'desc' => "{Hierarchy.suppresslastlevel}", 51 51 'type' => "flag", 52 52 'reqd' => "no" } ]; 53 53 54 54 my $options = { 'name' => "Hierarchy", 55 'desc' => "{ AutoHierarchy.desc}",55 'desc' => "{Hierarchy.desc}", 56 56 'abstract' => "no", 57 57 'inherits' => "yes", … … 60 60 61 61 sub new { 62 my $class = shift (@_); 63 my $self = new HFileHierarchy($class, @_); 64 65 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 66 my $option_list = $self->{'option_list'}; 67 push( @{$option_list}, $options ); 68 69 if ($self->{'info_only'}) { 70 # created from classinfo.pl - don't need to parse the arguments 71 return bless $self, $class; 72 } 73 74 my $separator; 75 my $suppresslastlevel = 0; 76 77 if (!parsargv::parse(\@_, 78 q^separator/.*/^, \$separator, 79 q^suppresslastlevel^, \$suppresslastlevel, 80 "allow_extra_options")) { 81 82 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 83 $self->print_txt_usage(""); # Use default resource bundle 84 die "\n"; 85 } 86 87 88 if (!$separator) { 89 $separator = "[\\\/|\\\|]"; 90 } 91 $self->{'separator'} = $separator; 92 $self->{'suppresslastlevel'} = $suppresslastlevel; 62 my ($class) = shift (@_); 63 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 64 push(@$classifierslist, $class); 65 66 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 67 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 68 69 my $self = (defined $hashArgOptLists)? new HFileHierarchy($classifierslist,$inputargs,$hashArgOptLists): new HFileHierarchy($classifierslist,$inputargs); 93 70 94 71 # the hash that we use to build up the hierarchy … … 127 104 push(@{$current_pos->{'docs'}}, $doc_OID); 128 105 } else { 129 if (defined $sortmeta) { 130 # can you ever get the same doc twice in one classification?? 131 $current_pos->{'docs'}->{$doc_OID} = $sortmeta; 132 } else { 133 $current_pos->{'docs'}->{$doc_OID} = $metavalue; 134 } 106 $current_pos->{'docs'}->{$doc_OID} = $sortmeta; 107 108 #if (defined $sortmeta) { 109 # # can you ever get the same doc twice in one classification?? 110 # $current_pos->{'docs'}->{$doc_OID} = $sortmeta; 111 # } else { 112 # $current_pos->{'docs'}->{$doc_OID} = $metavalue; 113 # } 135 114 } 136 115 } # foreach metadata … … 146 125 # are we sorting the list?? 147 126 my $nosort = 0; 148 if ( defined $self->{'sortname'} && $self->{'sortname'} eq "nosort") {127 if (!defined $self->{'sort'}) { 149 128 $nosort = 1; 150 129 } 151 130 152 131 my $metavalues = []; 153 132 # find all the metadata values … … 155 134 my $mvalues = $doc_obj->get_metadata($doc_obj->get_top_section(), $m); 156 135 next unless (@{$mvalues}); 157 if ($self->{' onlyfirst'}) {136 if ($self->{'firstvalueonly'}) { 158 137 # we only want the first metadata value 159 138 push (@$metavalues, $mvalues[0]); … … 169 148 #check for a sort element other than our metadata 170 149 my $sortmeta = undef; 171 if (!$nosort && defined $self->{'sortname'}) { 172 173 if ($self->{'sortname'} =~ /^filename$/i) { 150 if (!$nosort) { 151 if ($self->{'sort'} =~ /^filename$/i) { 174 152 $sortmeta = $doc_obj->get_source_filename(); 175 153 } else { 176 $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'sort name'});154 $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'sort'}); 177 155 if (defined $sortmeta) { 178 $sortmeta = &sorttools::format_metadata_for_sorting($self->{'sort name'}, $sortmeta, $doc_obj);156 $sortmeta = &sorttools::format_metadata_for_sorting($self->{'sort'}, $sortmeta, $doc_obj); 179 157 } 180 158 } … … 252 230 my @doc_list; 253 231 # generate a sorted list of doc ids 254 if ( $nosort&& scalar(@{$top_hash->{$key}->{'docs'}})) {232 if (not (defined ($self->{'sort'})) && scalar(@{$top_hash->{$key}->{'docs'}})) { 255 233 @doc_list = @{$top_hash->{$key}->{'docs'}}; 256 } elsif ( !$nosort&& (keys %{$top_hash->{$key}->{'docs'}})) {234 } elsif (defined ($self->{'sort'}) && (keys %{$top_hash->{$key}->{'docs'}})) { 257 235 @doc_list = sort {$top_hash->{$key}->{'docs'}->{$a} 258 236 cmp $top_hash->{$key}->{'docs'}->{$b};} keys %{$top_hash->{$key}->{'docs'}}; … … 289 267 if ($self->{'path_hash'}) { 290 268 if ($self->{'hlist_at_top'}) { 291 $classification = $self->get_entry ($self->{' title'}, "HList", "Invisible");269 $classification = $self->get_entry ($self->{'buttonname'}, "HList", "Invisible"); 292 270 } 293 271 else { 294 $classification = $self->get_entry ($self->{' title'}, "VList", "Invisible");272 $classification = $self->get_entry ($self->{'buttonname'}, "VList", "Invisible"); 295 273 } 296 274 } … … 319 297 320 298 if ($self->{'hlist_at_top'}) { 321 $classifyinfo = $self->get_entry ($self->{' title'}, "HList", "Invisible");299 $classifyinfo = $self->get_entry ($self->{'buttonname'}, "HList", "Invisible"); 322 300 } 323 301 else { 324 $classifyinfo = $self->get_entry ($self->{' title'}, "VList", "Invisible");302 $classifyinfo = $self->get_entry ($self->{'buttonname'}, "VList", "Invisible"); 325 303 } 326 304 -
trunk/gsdl/perllib/classify/List.pm
r8852 r10218 44 44 'desc' => "{BasClas.buttonname}", 45 45 'type' => "string", 46 'deft' => "{BasClas.metadata.deft}",46 # 'deft' => "{BasClas.metadata.deft}", 47 47 'reqd' => "no" }, 48 48 { 'name' => "sort", 49 49 'desc' => "{List.sort}", 50 50 'type' => "string", 51 'deft' => "{BasClas.metadata.deft}",51 # 'deft' => "{BasClas.metadata.deft}", 52 52 'reqd' => "no" } ]; 53 53 … … 60 60 61 61 sub new { 62 my $class = shift (@_); 63 my $self = new BasClas($class, @_); 64 65 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 66 my $option_list = $self->{'option_list'}; 67 push( @{$option_list}, $options ); 68 69 if ($self->{'info_only'}) { 70 # created from classinfo.pl - don't need to parse the arguments 71 return bless $self, $class; 72 } 73 74 my ($metadata, $title, $sortname, $list); 75 76 if (!parsargv::parse(\@_, 77 q^metadata/.*/^, \$metadata, 78 q^buttonname/.*/^, \$title, 79 q^sort/.*/^, \$sortname, 80 "allow_extra_options")) { 81 82 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 83 $self->print_txt_usage(""); # Use default resource bundle 84 die "\n"; 85 } 86 my @meta_list; 87 my $meta1; 88 89 if ($metadata) { 90 @meta_list = split(/,/, $metadata); 62 my ($class) = shift (@_); 63 64 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 65 push(@$classifierslist, $class); 66 67 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 68 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 69 70 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 71 72 # Transfer value from Auto Parsing to the variable name that used in previous GreenStone. 73 my (@meta_list,$meta1); 74 print STDERR "new List\n"; 75 if ($self->{"metadata"}) { 76 print STDERR "List: splitting metadata, ".$self->{"metadata"}."\n"; 77 @meta_list = split(/,/, $self->{"metadata"}); 91 78 $meta1 = $meta_list[0]; 92 } else { 93 $metadata = undef; 79 $self->{'meta_list'} = \@meta_list; 80 } else { 94 81 $meta1=undef; 95 82 @meta_list = undef; 96 83 } 97 84 98 if (!$title) { 99 if (defined ($meta1)) { 100 $title = $meta1; 101 } else { 102 $title = 'List'; 103 } 104 } 105 106 # sortname is handled a bit differently - kjdon 85 if (!$self->{"buttonname"}) { 86 if (defined ($self->{'metadata'})) { 87 $self->{"buttonname"} = $self->generate_title_from_metadata($self->{'metadata'}); 88 } else { 89 $self->{"buttonname"} = 'List'; 90 } 91 } 92 93 # Further setup 94 # $self->{"sort"} is handled a bit differently - kjdon 107 95 # undef means to sort, but use the metadata value from -metadata 108 96 # because there is no one metadata value to get for sorting when 109 97 # we have a list of possible metadata 110 # to get no sorting, set sortname = 'nosort' 111 if (!$sortname) { 112 if (defined ($metadata)) { 113 $sortname = undef; 114 } else { 115 $sortname = "nosort"; 116 } 117 } 98 # to get no sorting, set $self->{"sort"} = 'nosort' 99 if (!$self->{"sort"}) { 100 print STDERR "no sorting\n"; 101 if (defined ($self->{"metadata"})) { 102 $self->{"sort"} = undef; 103 print STDERR "setting no meta\n"; 104 } else { 105 $self->{"sort"} = "nosort"; 106 } 107 } 108 if (defined $self->{"sort"} && $self->{"sort"} eq "nosort") { 109 $self->{'list'} = []; 110 } else { 111 $self->{'list'} = {}; 112 } 113 114 # Clean out the unused keys 115 delete $self->{"metadata"}; # Delete this key 118 116 119 if (defined $sortname && $sortname eq "nosort") {120 $list = [];121 } else {122 $list = {};123 }124 125 $self->{'list'} = $list;126 if (defined $metadata) {127 $self->{'meta_list'} = \@meta_list;128 }129 $self->{'title'} = $title;130 $self->{'sortname'} = $sortname;131 132 117 return bless $self, $class; 133 118 } … … 146 131 # are we sorting the list?? 147 132 my $nosort = 0; 148 if (defined $self->{'sort name'} && $self->{'sortname'} eq "nosort") {133 if (defined $self->{'sort'} && $self->{'sort'} eq "nosort") { 149 134 $nosort = 1; 150 135 } … … 195 180 196 181 #check for a sort element other than our metadata 197 if (defined $self->{'sort name'}) {182 if (defined $self->{'sort'}) { 198 183 my $sortmeta; 199 if ($self->{'sort name'} =~ /^filename$/i) {184 if ($self->{'sort'} =~ /^filename$/i) { 200 185 $sortmeta = $doc_obj->get_source_filename(); 201 186 } else { 202 $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'sort name'});187 $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'sort'}); 203 188 if (defined $sortmeta) { 204 $sortmeta = &sorttools::format_metadata_for_sorting($self->{'sort name'}, $sortmeta, $doc_obj);189 $sortmeta = &sorttools::format_metadata_for_sorting($self->{'sort'}, $sortmeta, $doc_obj); 205 190 } 206 191 } … … 225 210 226 211 my @list = (); 227 if (defined $self->{'sort name'} && $self->{'sortname'} eq "nosort") {212 if (defined $self->{'sort'} && $self->{'sort'} eq "nosort") { 228 213 @list = @{$self->{'list'}}; 229 214 } else { … … 233 218 } 234 219 } 235 236 220 # organise into classification structure 237 221 my %classifyinfo = ('childtype'=>'VList', 238 'Title'=>$self->{' title'},222 'Title'=>$self->{'buttonname'}, 239 223 'contains'=>[]); 240 224 $classifyinfo{'thistype'} = 'Invisible' unless $no_thistype; -
trunk/gsdl/perllib/classify/Phind.pm
r8362 r10218 150 150 151 151 sub new { 152 my $class = shift (@_); 153 my $self = new BasClas($class, @_); 154 155 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 156 my $option_list = $self->{'option_list'}; 157 push( @{$option_list}, $options ); 158 159 if ($self->{'info_only'}) { 160 # created from classinfo.pl - don't need to parse the arguments 161 return bless $self, $class; 162 } 163 164 my $out = $self->{'outhandle'}; 152 my ($class) = shift (@_); 153 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 154 push(@$classifierslist, $class); 155 156 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 157 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 158 159 my $self = (defined $hashArgOptLists)? new BasClas($classifierslist,$inputargs,$hashArgOptLists): new BasClas($classifierslist,$inputargs); 165 160 166 161 # Ensure the Phind generate scripts are in place … … 168 163 $file1 .= ".exe" if $ENV{'GSDLOS'} =~ /^windows$/; 169 164 my $src = &util::filename_cat($ENV{'GSDLHOME'}, "src", "phind", "generate"); 170 171 165 if (!(-e $file1)) { 172 166 print STDERR "Phind.pm: ERROR: The Phind \"suffix\" program is not installed.\n\n"; 173 167 exit(1); 174 168 } 175 176 # Parse classifier arguments 177 my $builddir = ""; 178 if (!parsargv::parse(\@_, 179 q^text/.*/section:Title,section:text^, \$self->{'indexes'}, 180 q^title/.*/Title^, \$self->{'titlefield'}, 181 q^buttonname/.*/Phrase^, \$self->{'buttonname'}, 182 q^language/.*/en^, \$language, 183 q^savephrases/.*/^, \$self->{'savephrases'}, 184 q^suffixmode/\d/1^, \$self->{'suffixmode'}, 185 q^min_occurs/\d/2^, \$self->{'min_occurs'}, 186 q^thesaurus/.*/^, \$self->{'thesaurus'}, 187 q^untidy^, \$self->{'untidy'}, 188 "allow_extra_options")) { 189 190 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n"; 191 $self->print_txt_usage(""); # Use default resource bundle 192 die "\n"; 193 } 194 195 # classifier information 196 $self->{'collection'} = $ENV{'GSDLCOLLECTION'}; 197 198 # limit languages 199 $self->{'language_exp'} = $language; 200 201 # collection directories 202 $self->{'collectiondir'} = $ENV{'GSDLCOLLECTDIR'}; 203 169 170 # Transfer value from Auto Parsing to the variable name that used in previous GreenStone. 171 $self->{"indexes"} = $self->{"text"}; 172 173 # Further setup 174 $self->{'collection'} = $ENV{'GSDLCOLLECTION'}; # classifier information 175 $self->{'collectiondir'} = $ENV{'GSDLCOLLECTDIR'}; # collection directories 204 176 if (! defined $self->{'builddir'}) { 205 177 $self->{'builddir'} = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "building"); 206 178 } 207 208 179 $self->{'total'} = 0; 209 180 181 # Clean out the unused keys 182 delete $self->{"text"}; 183 210 184 return bless $self, $class; 211 185 } … … 265 239 my $top_section = $doc_obj->get_top_section(); 266 240 267 my $titlefield = $self->{'title field'};241 my $titlefield = $self->{'title'}; 268 242 269 243 my $title = $doc_obj->get_metadata_element ($top_section, $titlefield); … … 276 250 # Only consider the file if it is in the correct language 277 251 my $doclanguage = $doc_obj->get_metadata_element ($top_section, "Language"); 278 my $phrlanguage = $self->{'language _exp'};252 my $phrlanguage = $self->{'language'}; 279 253 return if ($doclanguage && ($doclanguage !~ /$phrlanguage/i)); 280 254 … … 282 256 $self->{'total'} ++; 283 257 print "file $self->{'total'}: $file\n" if ($self->{'$verbosity'}); 284 285 258 286 259 # Store document details … … 698 671 my $phinddir = $self->{'phinddir'}; 699 672 700 my $language_exp = $self->{'language _exp'};673 my $language_exp = $self->{'language'}; 701 674 702 675 my ($w, $l, $line, $word); -
trunk/gsdl/perllib/classify/SectionList.pm
r8852 r10218 45 45 46 46 47 sub new { 48 my $class = shift (@_); 49 my $self = new List($class, @_); 47 sub new { 48 my ($class) = shift (@_); 49 my ($classifierslist,$inputargs,$hashArgOptLists) = @_; 50 push(@$classifierslist, $class); 50 51 51 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 52 my $option_list = $self->{'option_list'}; 53 push( @{$option_list}, $options ); 52 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 53 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 54 54 55 #if ($self->{'info_only'}) { 56 # created from classinfo.pl - don't need to parse the arguments 57 # return bless $self, $class; 58 #} 55 my $self = (defined $hashArgOptLists)? new List($classifierslist,$inputargs,$hashArgOptLists): new List($classifierslist,$inputargs); 56 59 57 return bless $self, $class; 60 58 } … … 67 65 # are we sorting the list?? 68 66 my $nosort = 0; 69 if (defined $self->{'sort name'} && $self->{'sortname'} eq "nosort") {67 if (defined $self->{'sort'} && $self->{'sort'} eq "nosort") { 70 68 $nosort = 1; 71 69 } … … 83 81 84 82 my $sortmeta = ""; 85 if (!$nosort && defined $self->{'sort name'}) {86 if ($self->{'sort name'} =~ /^filename$/i) {83 if (!$nosort && defined $self->{'sort'}) { 84 if ($self->{'sort'} =~ /^filename$/i) { 87 85 $sortmeta = $doc_obj->get_source_filename(); 88 86 } else { 89 $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'sort name'});87 $sortmeta = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $self->{'sort'}); 90 88 if (defined $sortmeta) { 91 $sortmeta = &sorttools::format_metadata_for_sorting($self->{'sort name'}, $sortmeta, $doc_obj);89 $sortmeta = &sorttools::format_metadata_for_sorting($self->{'sort'}, $sortmeta, $doc_obj); 92 90 } 93 91 } … … 140 138 } 141 139 142 if (defined $self->{'sort name'}) {140 if (defined $self->{'sort'}) { 143 141 # sorting on alternative metadata 144 142 $self->{'list'}->{"$doc_OID.$section"} = $sortmeta; 145 143 } else { 146 # sorting on the classification metadata144 # sorting on the classification metadata 147 145 # do the same formatting on the meta value as for sort meta 148 146 $metavalue = &sorttools::format_metadata_for_sorting($metaname, $metavalue, $doc_obj); -
trunk/gsdl/perllib/plugin.pm
r10155 r10218 84 84 $options =~ s/\$/\\\$/g; 85 85 86 eval ("\$plugobj = new \$pluginname( $options)");86 eval ("\$plugobj = new \$pluginname([],[$options])"); 87 87 die "$@" if $@; 88 88 -
trunk/gsdl/perllib/plugins/ArcPlug.pm
r10156 r10218 53 53 54 54 sub new { 55 my ($class) = @_; 56 my $self = new BasPlug ("ArcPlug", @_); 57 58 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 59 my $option_list = $self->{'option_list'}; 60 push( @{$option_list}, $options ); 55 my ($class) = shift (@_); 56 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 57 push(@$pluginlist, $class); 58 59 if(defined $arguments){print "SETSEGE\n"; push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 60 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 61 62 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 61 63 62 64 return bless $self, $class; -
trunk/gsdl/perllib/plugins/BNContentePlug.pm
r9853 r10218 39 39 40 40 sub BEGIN { 41 @ ISA = ('BasPlug');41 @BNContentePlug::ISA = ('BasPlug'); 42 42 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan"); 43 43 } … … 93 93 94 94 sub new { 95 my $class = shift (@_); 96 #my $plugin_name = shift (@_); 97 98 $self = new BasPlug ($class, @_); 99 $self->{'plugin_type'} = "BNContentePlug"; 100 101 my $option_list = $self->{'option_list'}; 102 push( @{$option_list}, $options ); 103 104 if (!parsargv::parse(\@_, 105 "allow_extra_options")) { 106 print STDERR "\nBNContentePlug uses an incorrect option.\n"; 107 print STDERR "Check your collect.cfg configuration file.\n\n"; 108 $self->print_txt_usage(""); # Use default resource bundle 109 die "\n"; 110 } 95 my ($class) = shift (@_); 96 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 97 push(@$pluginlist, $class); 98 99 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 100 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 101 102 $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 111 103 112 104 #create XML::Parser object for parsing metsHTML.xml, NCB_???.xml files -
trunk/gsdl/perllib/plugins/BasPlug.pm
r10155 r10218 53 53 use gsprintf 'gsprintf'; 54 54 use printusage; 55 #$%^ 56 use parse2; 57 55 58 56 59 use GISBasPlug; … … 59 62 60 63 my $unicode_list = 61 [ { 'name' => "auto", 62 'desc' => "{BasPlug.input_encoding.auto}" }, 63 { 'name' => "ascii", 64 [ { 'name' => "ascii", 64 65 'desc' => "{BasPlug.input_encoding.ascii}" }, 65 66 { 'name' => "utf8", … … 68 69 'desc' => "{BasPlug.input_encoding.unicode}" } ]; 69 70 71 my $auto_unicode_list = 72 [ { 'name' => "auto", 73 'desc' => "{BasPlug.input_encoding.auto}" } ]; 74 70 75 my $arguments = 71 76 [ { 'name' => "process_exp", … … 90 95 'desc' => "{BasPlug.input_encoding}", 91 96 'type' => "enum", 92 'list' => $ unicode_list,97 'list' => $auto_unicode_list, 93 98 'reqd' => "no" , 94 99 'deft' => "auto" } , … … 107 112 'type' => "language", 108 113 'deft' => "en", 114 'char_length' => "2", 109 115 'reqd' => "no" }, 110 116 { 'name' => "extract_acronyms", … … 141 147 'type' => "int", 142 148 'deft' => (localtime)[5]+1900, 149 'char_length' => "4", 150 #'range' => "2,100", 143 151 'reqd' => "no"}, 144 152 { 'name' => "maximum_century", 145 153 'desc' => "{BasPlug.maximum_century}", 146 154 'type' => "string", 147 'deft' => " ",155 'deft' => "-1", 148 156 'reqd' => "no" }, 149 157 { 'name' => "no_bibliography", … … 154 162 'desc' => "{BasPlug.no_cover_image}", 155 163 'type' => "flag", 156 'reqd' => "no" } ]; 164 'reqd' => "no" }, 165 { 'name' => "extract_keyphrases", 166 'desc' => "{BasPlug.extract_keyphrases}", 167 'type' => "flag", 168 'reqd' => "no", 169 'hiddengli' => "yes" }, 170 { 'name' => "extract_keyphrase_options", 171 'desc' => "{BasPlug.extract_keyphrase_options}", 172 'type' => "string", 173 'reqd' => "no", 174 'hiddengli' => "yes" }, 175 { 'name' => "separate_cjk", 176 'desc' => "{BasPlug.separate_cjk}", 177 'type' => "flag", 178 'reqd' => "no", 179 'hiddengli' => "yes" }, 180 { 'name' => "smart_block", 181 'desc' => "{BasPlug.smart_block}", 182 'type' => "flag", 183 'reqd' => "no", 184 'hiddengli' => "yes" }, 185 { 'name' => "new_extract_email", 186 'desc' => "", 187 'type' => "flag", 188 'reqd' => "no", 189 'hiddengli' => "yes" } ]; 157 190 158 191 my $gis_arguments = … … 238 271 { 239 272 my $self = shift(@_); 240 241 273 # Print the usage message for a plugin (recursively) 242 274 my $descoffset = $self->determine_description_offset(0); … … 317 349 318 350 sub new { 351 # Set Encodings to the list!! 352 353 my $e = $encodings::encodings; 354 foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) 355 { 356 my $hashEncode = 357 {'name' => $enc, 358 'desc' => $e->{$enc}->{'name'}}; 359 360 push(@{$unicode_list},$hashEncode); 361 } 362 363 push(@{$auto_unicode_list},@{$unicode_list}); 364 365 # Start the BasPlug Constructor 319 366 my $class = shift (@_); 320 my $plugin_name = shift (@_); 321 my $self = {}; 322 $self->{'plugin_type'} = "BasPlug"; 367 my ($pluginlist,$args,$hashArgOptLists) = @_; 368 push(@$pluginlist, $class); 369 my $plugin_name = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class; 370 371 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 372 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 323 373 324 374 if (GISBasPlug::has_mapdata()) { 325 375 push(@$arguments,@$gis_arguments); 326 376 } 327 328 my $enc = "^("; 329 map {$enc .= "$_|";} keys %$encodings::encodings; 330 my $denc = $enc . "ascii|utf8|unicode)\$"; 331 $enc .= "ascii|utf8|unicode|auto)\$"; 332 377 378 my $self = {}; 379 if(!parse2::parse($args,$hashArgOptLists->{"ArgList"},$self)) 380 { 381 my $classTempClass = bless $self, $class; 382 &gsprintf(STDERR, "\n{BasPlug.bad_general_option}\n", $plugin_name); 383 $classTempClass->print_txt_usage(""); # Use default resource bundle 384 die "\n"; 385 } 386 387 # else parsing was successful. 388 389 $self->{'plugin_type'} = $plugin_name; 333 390 $self->{'outhandle'} = STDERR; 334 my $year = (localtime)[5]+1900;335 336 391 $self->{'textcat'} = new textcat(); 337 338 392 $self->{'num_processed'} = 0; 339 393 $self->{'num_not_processed'} = 0; … … 341 395 $self->{'num_archives'} = 0; 342 396 $self->{'cover_image'} = 1; # cover image is on by default 343 344 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 345 $self->{'option_list'} = [ $options ]; 346 347 my $no_cover_image = 0; 348 # general options available to all plugins 349 if (!parsargv::parse(\@_, 350 q^process_exp/.*/^, \$self->{'process_exp'}, 351 q^block_exp/.*/^, \$self->{'block_exp'}, 352 q^associate_ext/.*/^, \$self->{'associate_ext'}, 353 q^extract_language^, \$self->{'extract_language'}, 354 q^extract_acronyms^, \$self->{'extract_acronyms'}, 355 q^extract_keyphrases^, \$self->{'kea'}, #with extra options (UNDOCUMENTED) 356 q^extract_keyphrase_options/.*/^, \$self->{'kea_options'}, #no extra options (UNDOCUMENTED) 357 qq^input_encoding/$enc/auto^, \$self->{'input_encoding'}, 358 qq^default_encoding/$denc/utf8^, \$self->{'default_encoding'}, 359 q^extract_email^, \$self->{'extract_email'}, 360 q^extract_placenames^, \$self->{'extract_placenames'}, 361 q^gazetteer/.*/^, \$self->{'gazetteer'}, 362 q^place_list^, \$self->{'place_list'}, 363 q^markup_acronyms^, \$self->{'markup_acronyms'}, 364 q^default_language/.{2}/en^, \$self->{'default_language'}, 365 q^first/.*/^, \$self->{'first'}, 366 q^extract_historical_years^, \$self->{'date_extract'}, 367 qq^maximum_year/\\d{4}/$year^, \$self->{'max_year'}, 368 q^no_bibliography^, \$self->{'no_biblio'}, 369 qq^maximum_century/-?\\d{1,2}( ?B\\.C\\.E\\.)?/-1^, \$self->{'max_century'}, 370 q^no_cover_image^, \$no_cover_image, 371 q^separate_cjk^, \$self->{'separate_cjk'}, 372 q^smart_block^, \$self->{'smart_block'}, 373 q^smart_block_BN^, \$self->{'smart_block_BN'}, 374 "allow_extra_options")) { 375 376 gsprintf(STDERR, "\n{BasPlug.bad_general_option}\n", $plugin_name); 377 bless $self, $class; 378 $self->print_txt_usage(""); # Use default resource bundle 379 die "\n"; 380 } 381 397 $self->{'cover_image'} = 0 if ($self->{'no_cover_image'}); 398 $self->{'file_blocks'} = {}; 399 $self->{'option_list'} = $hashArgOptLists->{"OptList"}; 400 382 401 my $associate_ext = $self->{'associate_ext'}; 383 402 if ((defined $associate_ext) && ($associate_ext ne "")) { … … 395 414 $self->{'file_blocks'} = {}; 396 415 397 $self->{'cover_image'} = 0 if ($no_cover_image);398 399 416 if ($self->{'extract_placenames'}) { 400 417 401 418 my $outhandle = $self->{'outhandle'}; 402 419 403 420 my $places_ref 404 421 = GISBasPlug::loadGISDatabase($outhandle,$self->{'gazetteer'}); 405 422 406 423 if (!defined $places_ref) { 407 424 print $outhandle "Warning: Error loading mapdata gazetteer \"$self->{'gazetteer'}\"\n"; … … 414 431 } 415 432 return bless $self, $class; 433 416 434 } 417 435 … … 1121 1139 @email = sort @email; 1122 1140 1123 my @email2 = (); 1141 # if($self->{"new_extract_email"} == 0) 1142 # { 1143 # my @email2 = (); 1144 # foreach my $address (@email) 1145 # { 1146 # if (!(join(" ",@email2) =~ m/(^| )$address( |$)/ )) 1147 # { 1148 # push @email2, $address; 1149 # $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address); 1150 # # print $outhandle " extracting $address\n" 1151 # &gsprintf($outhandle, " {BasPlug.extracting} $address\n") 1152 # if ($self->{'verbosity'} > 3); 1153 # } 1154 # } 1155 # } 1156 # else 1157 # { 1158 my $hashExistMail = {}; 1124 1159 foreach my $address (@email) { 1125 if (!(join(" ",@email2) =~ m/$address/ )) { 1126 push @email2, $address; 1160 if (!(defined $hashExistMail->{$address})) 1161 { 1162 $hashExistMail->{$address} = 1; 1127 1163 $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address); 1128 1164 gsprintf($outhandle, " {BasPlug.extracting} $address\n") … … 1157 1193 } 1158 1194 1159 # 1160 if ($self->{' kea'}) {1195 #adding kea keyphrases 1196 if ($self->{'extract_keyphrases'}) { 1161 1197 1162 1198 my $thissection = $doc_obj->get_top_section(); … … 1171 1207 } 1172 1208 1173 if ($self->{'kea_options'}) { 1174 #if kea options flag is set, call Kea with specified options 1175 $list = &Kea::extract_KeyPhrases ($text, $self->{'kea_options'}); 1176 } else { 1177 #otherwise call Kea with no options 1209 if($self->{'extract_keyphrase_options'}) { #if kea options flag is set, call Kea with specified options 1210 $list = &Kea::extract_KeyPhrases ($text, $self->{'extract_keyphrase_options'}); 1211 } else { #otherwise call Kea with no options 1178 1212 $list = &Kea::extract_KeyPhrases ($text); 1179 1213 } 1214 1180 1215 if ($list){ 1181 1216 # if a list of kea keyphrases was returned (ie not empty) … … 1227 1262 } 1228 1263 1229 if($self->{' date_extract'}) {1264 if($self->{'extract_historical_years'}) { 1230 1265 my $thissection = $doc_obj->get_top_section(); 1231 1266 while (defined $thissection) { 1232 1267 1233 1268 my $text = $doc_obj->get_text($thissection); 1234 1269 &DateExtract::get_date_metadata($text, $doc_obj, 1235 1270 $thissection, 1236 $self->{'no_biblio '},1237 $self->{'max _year'},1238 $self->{'max _century'});1271 $self->{'no_bibliography'}, 1272 $self->{'maximum_year'}, 1273 $self->{'maximum_century'}); 1239 1274 $thissection = $doc_obj->get_next_section ($thissection); 1240 1275 } -
trunk/gsdl/perllib/plugins/BibTexPlug.pm
r9582 r10218 81 81 } 82 82 sub new { 83 my $class = shift (@_); 84 my $self = new SplitPlug ($class, @_); 85 $self->{'plugin_type'} = "BibTexPlug"; 86 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 87 my $option_list = $self->{'option_list'}; 88 push( @{$option_list}, $options ); 83 my ($class) = shift (@_); 84 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 85 push(@$pluginlist, $class); 86 87 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 88 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 89 90 my $self = (defined $hashArgOptLists)? new SplitPlug($pluginlist,$inputargs,$hashArgOptLists): new SplitPlug($pluginlist,$inputargs); 91 89 92 return bless $self, $class; 90 93 } -
trunk/gsdl/perllib/plugins/BookPlug.pm
r8121 r10218 79 79 80 80 sub new { 81 my ($class) = @_; 82 my $self = new BasPlug ("BookPlug", @_); 83 $self->{'plugin_type'} = "BookPlug"; 84 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 85 my $option_list = $self->{'option_list'}; 86 push( @{$option_list}, $options ); 87 81 my ($class) = shift (@_); 82 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 83 push(@$pluginlist, $class); 84 85 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 86 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 87 88 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 89 88 90 return bless $self, $class; 89 91 } -
trunk/gsdl/perllib/plugins/ConvertToPlug.pm
r9853 r10218 65 65 'desc' => "{ConvertToPlug.use_strings}", 66 66 'type' => "flag", 67 'reqd' => "no" } ]; 67 'reqd' => "no" }, 68 { 'name' => "extract_keyphrases", 69 'desc' => "{BasPlug.extract_keyphrases}", 70 'type' => "flag", 71 'reqd' => "no", 72 'hiddengli' => "yes" }, 73 { 'name' => "extract_keyphrase_options", 74 'desc' => "{BasPlug.extract_keyphrase_options}", 75 'type' => "string", 76 'reqd' => "no", 77 'hiddengli' => "yes" } ]; 68 78 69 79 my $options = { 'name' => "ConvertToPlug", … … 73 83 'args' => $arguments }; 74 84 75 sub parse_args 85 86 sub findType 76 87 { 77 my $class = shift (@_); 78 my ($args) = @_; 79 80 my $plugin_name = $class; 81 $plugin_name =~ s/\.pm$//; 82 83 my $newargs = {}; 84 85 if (!parsargv::parse($args, 86 q^extract_keyphrases^, \$newargs->{'kea'}, #with extra options (undocumented) 87 q^extract_keyphrase_options/.*/^, \$newargs->{'kea_options'}, #no extra options (undocumented) 88 q^convert_to/(html|text)/html^, \$newargs->{'generate_format'}, 89 q^use_strings^, \$newargs->{'use_strings'}, 90 "allow_extra_options")) { 91 92 print STDERR "\nIncorrect options passed to $plugin_name, "; 93 print STDERR "check your collect.cfg configuration file\n"; 94 $self->print_txt_usage(""); # Use default resource bundle 95 die "\n"; 96 } 97 98 return ($plugin_name, $newargs); 88 my ($inputargs) = @_; 89 90 for(my $intCounter = 0; $intCounter < scalar(@{$inputargs}) ; $intCounter++) 91 { 92 if($inputargs->[$intCounter] eq "-convert_to") 93 { 94 if($inputargs->[$intCounter+1] eq "text" || $inputargs->[$intCounter+1] eq "html") 95 { 96 return $inputargs->[$intCounter+1]; 97 } 98 else {return "html";} 99 } 100 } 101 return "html"; 99 102 } 100 103 101 104 sub new { 102 my $class = shift (@_); 103 if ($class eq "ConvertToPlug" && defined $_[0]) {$class = shift (@_);} 104 my $self; 105 # parsargv::parse might modify the list, so we do this by creating a copy 106 # of the argument list. 107 my @arglist = @_; 108 my ($plugin_name, $args) = $class->parse_args(\@_); 109 110 if ($class eq "PDFPlug" && $args->{'generate_format'} eq "text" && 105 my ($class) = shift (@_); 106 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 107 push(@$pluginlist, $class); 108 my $classPluginName = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class; 109 my $strConvertTo = findType($inputargs); 110 111 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 112 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 113 114 if ($classPluginName eq "PDFPlug" && $strConvertTo eq "text" && 111 115 $ENV{'GSDLOS'} =~ /^windows$/i) { 112 116 print STDERR "Windows does not support pdf to text. PDFs will be converted to HTML instead\n"; 113 $args->{'generate_format'} = "html"; 114 } 115 116 if ($args->{'generate_format'} eq "text") 117 $strConvertTo = "html"; 118 } 119 120 my $self = {}; 121 if ($strConvertTo eq "text") 117 122 { 118 $self = new TEXTPlug ($class, @arglist);123 $self = (defined $hashArgOptLists)? new TEXTPlug($pluginlist,$inputargs,$hashArgOptLists): new TEXTPlug($pluginlist,$inputargs); 119 124 $self->{'convert_to'} = "TEXT"; 120 125 $self->{'convert_to_ext'} = "txt"; … … 122 127 else 123 128 { 124 $self = new HTMLPlug ($class, @arglist);129 $self = (defined $hashArgOptLists)? new HTMLPlug($pluginlist,$inputargs,$hashArgOptLists): new HTMLPlug($pluginlist,$inputargs); 125 130 $self->{'convert_to'} = "HTML"; 126 131 $self->{'convert_to_ext'} = "html"; … … 130 135 } 131 136 132 # 14-05-02 To allow for proper inheritance of arguments - John Thompson133 my $option_list = $self->{'option_list'};134 push( @{$option_list}, $options );135 136 foreach my $key (keys %$args) {137 $self->{$key} = $args->{$key};138 }139 140 137 return bless $self, $class; 141 138 } … … 273 270 274 271 my $outhandle = $self->{'outhandle'}; 275 272 276 273 my $filename = $file; 277 274 $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/; … … 296 293 297 294 my $output_ext = $self->{'convert_to_ext'}; 295 298 296 my $conv_filename = $self->tmp_area_convert_file($output_ext, $filename); 299 297 -
trunk/gsdl/perllib/plugins/ConvertToRogPlug.pm
r9853 r10218 63 63 64 64 sub new { 65 my $class= shift (@_);66 if ($class eq "ConvertToRogPlug" && defined $_[0]) {$class = shift (@_);}67 my $self;68 # parsargv::parse might modify the list, so we do this by creating a copy 69 # of the argument list.70 my @arglist = @_;71 my ($plugin_name) = $class->parse_args(\@_); 72 73 $self = new RogPlug ($class, @arglist); 65 my ($class) = shift (@_); 66 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 67 push(@$pluginlist, $class); 68 69 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 70 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 71 72 my $self = (defined $hashArgOptLists)? new RogPlug($pluginlist,$inputargs,$hashArgOptLists): new RogPlug($pluginlist,$inputargs); 73 74 74 $self->{'convert_to'} = "Rog"; 75 75 $self->{'convert_to_ext'} = "rog"; 76 $self->{'plugin_type'} = "ConvertToRogPlug";77 # 14-05-02 To allow for proper inheritance of arguments - John Thompson78 my $option_list = $self->{'option_list'};79 push( @{$option_list}, $options );80 76 81 77 return bless $self, $class; -
trunk/gsdl/perllib/plugins/DBPlug.pm
r9853 r10218 61 61 62 62 sub new { 63 my ($class) = @_; 64 my $self = new BasPlug ($class, @_); 65 $self->{'plugin_type'} = "DBPlug"; 66 my $option_list = $self->{'option_list'}; 67 push( @{$option_list}, $options ); 68 69 # no plugin-specific options 70 # if (!parsargv::parse(\@_, "allow_extra_options")) { 71 # $self->print_txt_usage(""); # Use default resource bundle 72 # die "\n"; 73 # } 74 63 my ($class) = shift (@_); 64 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 65 push(@$pluginlist, $class); 66 67 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 68 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 69 70 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 75 71 76 72 return bless $self, $class; -
trunk/gsdl/perllib/plugins/DSpacePlug.pm
r9853 r10218 54 54 55 55 sub BEGIN { 56 @ ISA = ('BasPlug');56 @DSpacePlug::ISA = ('BasPlug'); 57 57 } 58 58 … … 96 96 97 97 sub new { 98 my $class = shift (@_); 99 #my $plugin_name = shift (@_); 100 101 $self = new BasPlug ($class, @_); 102 $self->{'plugin_type'} = "DSpacePlug"; 103 104 my $option_list = $self->{'option_list'}; 105 push( @{$option_list}, $options ); 106 107 108 if (!parsargv::parse(\@_, 109 q^only_first_doc^, \$self->{'only_first_doc'}, 110 q^first_inorder_ext/.*/^, \$self->{'first_inorder_ext'}, 111 q^first_inorder_mime/.*/^, \$self->{'first_inorder_mime'}, 112 "allow_extra_options")) { 113 print STDERR "\nDSpacePlug uses an incorrect option.\n"; 114 print STDERR "Check your collect.cfg configuration file.\n\n"; 115 $self->print_txt_usage(""); # Use default resource bundle 116 die "\n"; 117 } 98 my ($class) = shift (@_); 99 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 100 push(@$pluginlist, $class); 101 102 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 103 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 104 105 $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 118 106 119 107 #create XML::Parser object for parsing dublin_core.xml files -
trunk/gsdl/perllib/plugins/EMAILPlug.pm
r9971 r10218 113 113 114 114 sub new { 115 my ($class) = @_; 116 my $self = new BasPlug ($class, @_); 117 $self->{'plugin_type'} = "EMAILPlug"; 118 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 119 my $option_list = $self->{'option_list'}; 120 push( @{$option_list}, $options ); 121 122 if (!parsargv::parse(\@_, 123 q^split_exp/.*/^, \$self->{'split_exp'}, 124 q^no_attachments^, \$self->{'ignore_attachments'}, 125 q^headers^, \$self->{'header_metadata'}, 126 "allow_extra_options")) { 127 print STDERR "\nIncorrect options passed to $class."; 128 print STDERR "\nCheck your collect.cfg configuration file\n"; 129 $self->print_txt_usage(""); # Use default resource bundle 130 die "\n"; 131 } 115 my ($class) = shift (@_); 116 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 117 push(@$pluginlist, $class); 118 119 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 120 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 121 122 my $self = (defined $hashArgOptLists)? new SplitPlug($pluginlist,$inputargs,$hashArgOptLists): new SplitPlug($pluginlist,$inputargs); 123 132 124 $self->{'assoc_filenames'} = {}; # to save attach names so we don't clobber 133 125 … … 431 423 432 424 433 if ($self->{'header _metadata'} && $self->{'header_metadata'} == 1) {425 if ($self->{'headers'} && $self->{'headers'} == 1) { 434 426 # Add "All headers" metadata 435 427 $Headers = &text_into_html($Headers); … … 791 783 792 784 # save attachment by default 793 if (!$self->{' ignore_attachments'}785 if (!$self->{'no_attachments'} 794 786 && $filename ne "") { # this part has a file... 795 787 my $encoding="8bit"; -
trunk/gsdl/perllib/plugins/ExcelPlug.pm
r9465 r10218 49 49 50 50 sub new { 51 my $class = shift (@_); 51 my ($class) = shift (@_); 52 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 53 push(@$pluginlist, $class); 52 54 53 my $self = new ConvertToPlug ($class, @_); 54 $self->{'plugin_type'} = "ExcelPlug"; 55 # I'm not sure what encoding xlhtml produces - I think it puts it 56 # into the Content-Type meta tag in the header of the HTML file. 55 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 56 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 57 57 58 # if ($self->{'input_encoding'} eq "auto") { 59 # $self->{'input_encoding'} = "utf8"; 60 # } 61 62 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 63 my $option_list = $self->{'option_list'}; 64 push( @{$option_list}, $options ); 58 my $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs); 65 59 66 60 return bless $self, $class; -
trunk/gsdl/perllib/plugins/FOXPlug.pm
r9853 r10218 51 51 52 52 sub new { 53 my ($class) = @_; 54 $self = new BasPlug (); 55 $self->{'plugin_type'} = "FOXPlug"; 56 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 57 my $option_list = $self->{'option_list'}; 58 push( @{$option_list}, $options ); 53 my ($class) = shift (@_); 54 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 55 push(@$pluginlist, $class); 56 57 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 58 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 59 60 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 59 61 60 62 return bless $self, $class; -
trunk/gsdl/perllib/plugins/FavouritesPlug.pm
r9893 r10218 34 34 35 35 sub BEGIN { 36 @ ISA = ('BasPlug');36 @FavouritesPlug::ISA = ('BasPlug'); 37 37 } 38 38 … … 52 52 53 53 sub new { 54 my ($class) = @_;55 my $self = new BasPlug ($class, @_);56 $self->{'plugin_type'} = "FavouritesPlug";54 my ($class) = shift(@_); 55 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 56 push(@$pluginlist, $class); 57 57 58 # To allow for proper inheritance of arguments 59 my $option_list = $self->{'option_list'}; 60 push( @{$option_list}, $options ); 58 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 59 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 60 61 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 61 62 62 63 return bless $self, $class; -
trunk/gsdl/perllib/plugins/GAPlug.pm
r9468 r10218 32 32 33 33 use XMLPlug; 34 #$%^ 35 use parse2; 34 36 35 37 sub BEGIN { … … 50 52 51 53 sub new { 52 my $class = shift (@_); 53 my $self = new XMLPlug ($class, @_); 54 my ($class) = shift (@_); 55 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 56 push(@$pluginlist, $class); 54 57 55 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 56 my $option_list = $self->{'option_list'}; 57 push( @{$option_list}, $options ); 58 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 59 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 60 61 my $self = (defined $hashArgOptLists)? new XMLPlug($pluginlist,$inputargs,$hashArgOptLists): new XMLPlug($pluginlist,$inputargs); 58 62 59 63 $self->{'section'} = ""; -
trunk/gsdl/perllib/plugins/GMLPlug.pm
r9853 r10218 53 53 54 54 sub new { 55 my ($class) = @_; 56 my $self = new BasPlug ("GMLPlug", @_); 57 58 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 59 my $option_list = $self->{'option_list'}; 60 push( @{$option_list}, $options ); 61 62 return bless $self, $class;} 55 my ($class) = shift (@_); 56 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 57 push(@$pluginlist, $class); 58 59 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 60 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 61 62 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 63 64 return bless $self, $class; 65 } 63 66 64 67 sub get_default_process_exp { -
trunk/gsdl/perllib/plugins/HBPlug.pm
r9853 r10218 68 68 69 69 sub new { 70 my ($class) = @_; 71 my $self = new BasPlug ("HBPlug", @_); 72 $self->{'plugin_type'} = "HBPlug"; 73 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 74 my $option_list = $self->{'option_list'}; 75 push( @{$option_list}, $options ); 70 my ($class) = shift (@_); 71 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 72 push(@$pluginlist, $class); 73 74 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 75 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 76 77 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 76 78 77 79 return bless $self, $class; -
trunk/gsdl/perllib/plugins/HTMLPlug.pm
r10121 r10218 92 92 'desc' => "{HTMLPlug.description_tags}", 93 93 'type' => "flag" }, 94 # retain this for backward compatibility (w3mir option was replaced by 95 # file_is_url) 96 { 'name' => "w3mir", 97 # 'desc' => "{HTMLPlug.w3mir}", 98 'type' => "flag", 99 'hiddengli' => "yes"}, 94 100 { 'name' => "no_strip_metadata_html", 95 101 'desc' => "{HTMLPlug.no_strip_metadata_html}", … … 109 115 110 116 sub new { 111 my $class = shift (@_); 112 my $self = new BasPlug ($class, @_); 113 $self->{'plugin_type'} = "HTMLPlug"; 114 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 115 my $option_list = $self->{'option_list'}; 116 push( @{$option_list}, $options ); 117 118 if (!parsargv::parse(\@_, 119 q^nolinks^, \$self->{'nolinks'}, 120 q^keep_head^, \$self->{'keep_head'}, 121 q^no_metadata^, \$self->{'no_metadata'}, 122 q^metadata_fields/.*/Title^, \$self->{'metadata_fields'}, 123 q^hunt_creator_metadata^, \$self->{'hunt_creator_metadata'}, 124 q^w3mir^, \$self->{'w3mir'}, 125 q^file_is_url^, \$self->{'file_is_url'}, 126 q^assoc_files/.*/(?i)\.(jpe?g|jpe|gif|png|css)$^, \$self->{'assoc_files'}, 127 q^rename_assoc_files^, \$self->{'rename_assoc_files'}, 128 q^title_sub/.*/^, \$self->{'title_sub'}, 129 q^description_tags^, \$self->{'description_tags'}, 130 q^no_strip_metadata_html/.*/^, \$self->{'no_strip_metadata_html'}, 131 q^sectionalise_using_h_tags^, \$self->{'sectionalise_using_h_tags'}, 132 "allow_extra_options")) { 133 134 print STDERR "\nIncorrect options passed to HTMLPlug, check your collect.cfg configuration file\n"; 135 $self->print_txt_usage(""); # Use default resource bundle 136 die "\n"; 137 } 138 139 # retain this for backward compatibility (w3mir option was replaced by 140 # file_is_url) 117 my ($class) = shift (@_); 118 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 119 push(@$pluginlist, $class); 120 121 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 122 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 123 124 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 125 141 126 if ($self->{'w3mir'}) { 142 127 $self->{'file_is_url'} = 1; … … 146 131 $self->{'dir_num'} = 0; 147 132 $self->{'file_num'} = 0; 148 133 149 134 return bless $self, $class; 150 135 } -
trunk/gsdl/perllib/plugins/ISISPlug.pm
r9998 r10218 96 96 sub new 97 97 { 98 my $class = shift(@_); 99 100 my $self = new SplitPlug($class, @_); 101 if (!parsargv::parse(\@_, 102 q^subfield_separator/.*/, ^, \$self->{'subfield_separator'}, 103 q^entry_separator/.*/<br>^, \$self->{'entry_separator'}, 104 "allow_extra_options")) { 105 print STDERR "\nIncorrect options passed to ISISPlug, check your collect.cfg configuration file\n"; 106 die "\n"; 107 } 108 109 # To allow for proper inheritance of arguments 110 my $option_list = $self->{'option_list'}; 111 push(@{$option_list}, $options); 112 $self->{'plugin_type'} = "ISISPlug"; 98 my ($class) = shift (@_); 99 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 100 push(@$pluginlist, $class); 101 102 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 103 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 104 105 my $self = (defined $hashArgOptLists)? new SplitPlug($pluginlist,$inputargs,$hashArgOptLists): new SplitPlug($pluginlist,$inputargs); 113 106 114 107 return bless $self, $class; -
trunk/gsdl/perllib/plugins/ImagePlug.pm
r9960 r10218 46 46 'type' => "int", 47 47 'deft' => "100", 48 'range' => "1,", 48 49 'reqd' => "no" }, 49 50 { 'name' => "thumbnailtype", … … 56 57 'type' => "int", 57 58 'deft' => "0", 59 'range' => "1,", 58 60 'reqd' => "no" }, 59 61 { 'name' => "screenviewtype", … … 71 73 'type' => "int", 72 74 'deft' => "100", 75 'range' => "1,", 73 76 'reqd' => "no" } ]; 74 77 … … 82 85 83 86 sub new { 84 my ($class) = @_; 85 my $plugin_name = shift (@_); 86 my $self = new BasPlug ("ImagePlug", @_); 87 $self->{'plugin_type'} = "ImagePlug"; 88 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 89 my $option_list = $self->{'option_list'}; 90 push( @{$option_list}, $options ); 91 92 if (!parsargv::parse(\@_, 93 q^noscaleup^, \$self->{'noscaleup'}, 94 q^converttotype/.*/^, \$self->{'converttotype'}, 95 q^minimumsize/[0-9]*/100^, \$self->{'minimumsize'}, 96 97 q^thumbnailsize/[0-9]*/100^, \$self->{'thumbnailsize'}, 98 q^thumbnailtype/.*/gif^, \$self->{'thumbnailtype'}, 99 q^screenviewsize/[0-9]*/0^, \$self->{'screenviewsize'}, 100 q^screenviewtype/.*/jpg^, \$self->{'screenviewtype'}, 101 "allow_extra_options")) { 102 103 print STDERR "\nImagePlug uses an incorrect option.\n"; 104 print STDERR "Check your collect.cfg configuration file.\n"; 105 $self->print_txt_usage(""); # Use default resource bundle 106 die "\n"; 107 } 87 my ($class) = shift (@_); 88 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 89 push(@$pluginlist, $class); 90 91 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 92 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 93 94 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 108 95 109 96 # Check that ImageMagick is installed and available on the path (except for Windows 95/98) -
trunk/gsdl/perllib/plugins/IndexPlug.pm
r9853 r10218 70 70 71 71 sub new { 72 my ($class) = @_; 73 my $self = new BasPlug ("IndexPlug", @_); 74 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 75 my $option_list = $self->{'option_list'}; 76 push( @{$option_list}, $options ); 72 my ($class) = shift (@_); 73 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 74 push(@$pluginlist, $class); 75 76 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 77 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 78 79 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 77 80 78 81 return bless $self, $class; -
trunk/gsdl/perllib/plugins/LaTeXPlug.pm
r8121 r10218 28 28 package LaTeXPlug; 29 29 30 use strict; 31 no strict 'refs'; # so we can print to a handle named by a variable 30 # System complains about $arguments if the strict is set 31 #use strict; 32 #no strict 'refs'; # so we can print to a handle named by a variable 32 33 33 34 # greenstone packages … … 37 38 use util; 38 39 40 my $options={ 'name' => 'LaTeXPlug', 41 'desc' => '{LaTeXPlug.desc}', 42 'abstract' => 'no', 43 'inherits' => 'yes' }; 39 44 sub BEGIN { 40 45 @LaTeXPlug::ISA = ('BasPlug'); … … 46 51 47 52 sub new { 48 my $class = shift (@_); 49 my $self = new BasPlug ($class, @_); 50 $self->{'plugin_type'} = 'LaTeXPlug'; 51 my $option_list = $self->{'option_list'}; 52 my $options={ 'name' => 'LaTeXPlug', 53 'desc' => '{LaTeXPlug.desc}', 54 'abstract' => 'no', 55 'inherits' => 'yes', 56 'args' => [ 57 ] # no arguments for now... 58 }; 59 60 push( @{$option_list}, $options ); 61 62 if (!parsargv::parse(\@_, 63 "allow_extra_options")) { 64 65 print STDERR "\nIncorrect options passed to LaTeXPlug, check your collect.cfg configuration file\n"; 66 $self->print_txt_usage(""); # don't specify which language bundle 67 die "\n"; 68 } 53 my ($class) = shift (@_); 54 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 55 push(@$pluginlist, $class); 56 57 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 58 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 59 60 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 69 61 70 62 $self->{'aux_files'} = {}; -
trunk/gsdl/perllib/plugins/MACROPlug.pm
r9853 r10218 85 85 86 86 sub new { 87 my ($class) = @_; 88 my $self = new BasPlug ($class, @_); 89 90 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 91 my $option_list = $self->{'option_list'}; 92 push( @{$option_list}, $options ); 87 my ($class) = shift (@_); 88 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 89 push(@$pluginlist, $class); 90 91 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 92 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 93 94 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 93 95 94 96 # $self->{'lang_abbr'} = load_language_table(); -
trunk/gsdl/perllib/plugins/MARCPlug.pm
r9494 r10218 69 69 70 70 sub new { 71 my $class = shift (@_); 72 my $self = new SplitPlug ($class, @_); 73 $self->{'plugin_type'} = "MARCPlug"; 74 my $metadata_mapping; 75 76 if (!parsargv::parse(\@_, 77 q^metadata_mapping/.*/marctodc.txt^, \$metadata_mapping, 78 "allow_extra_options")) { 79 80 print STDERR "\nIncorrect options passed to MARCPlug, check your collect.cfg configuration file\n"; 81 $self->print_txt_usage(""); # Use default resource bundle 82 die "\n"; 83 } 84 85 86 $self->{'mm_file'} = $metadata_mapping; # relative to etc dir 87 88 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 89 my $option_list = $self->{'option_list'}; 90 push( @{$option_list}, $options ); 71 my ($class) = shift (@_); 72 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 73 push(@$pluginlist, $class); 74 75 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 76 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 77 78 my $self = (defined $hashArgOptLists)? new SplitPlug($pluginlist,$inputargs,$hashArgOptLists): new SplitPlug($pluginlist,$inputargs); 91 79 92 80 return bless $self, $class; … … 101 89 # read in the metadata mapping file 102 90 my $mm_file = 103 &util::filename_cat( $ENV{'GSDLHOME'}, "etc", $self->{'m m_file'} );91 &util::filename_cat( $ENV{'GSDLHOME'}, "etc", $self->{'metadata_mapping'} ); 104 92 105 93 if (!-e $mm_file) … … 107 95 108 96 my $msg = "MARCPlug ERROR: Can't locate mapping file \"" . 109 $self->{'m m_file'} . "\".\n This file should be at $mm_file\n" .97 $self->{'metadata_mapping'} . "\".\n This file should be at $mm_file\n" . 110 98 " No marc files can be processed.\n"; 111 99 112 100 print $outhandle $msg; 113 101 print $failhandle $msg; 114 $self->{'m m_file'} = undef;102 $self->{'metadata_mapping'} = undef; 115 103 # We pick up the error in process() if there is no $mm_file 116 104 # If we exit here, then pluginfo.pl will exit too! … … 222 210 my $filename = &util::filename_cat($base_dir, $file); 223 211 224 if (! defined($self->{'m m_file'}))212 if (! defined($self->{'metadata_mapping'})) 225 213 { 226 214 print $outhandle "MARCPlug: no metadata file! Can't process $file\n"; -
trunk/gsdl/perllib/plugins/METSPlug.pm
r9468 r10218 40 40 41 41 sub BEGIN { 42 @ ISA = ('XMLPlug');42 @METSPlug::ISA = ('XMLPlug'); 43 43 } 44 44 … … 56 56 57 57 sub new { 58 my $class = shift (@_); 59 my $self = new XMLPlug ($class, @_); 60 61 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 62 my $option_list = $self->{'option_list'}; 63 push( @{$option_list}, $options ); 58 my ($class) = shift (@_); 59 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 60 push(@$pluginlist, $class); 61 62 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 63 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 64 65 my $self = (defined $hashArgOptLists)? new XMLPlug($pluginlist,$inputargs,$hashArgOptLists): new XMLPlug($pluginlist,$inputargs); 64 66 65 67 $self->{'section'} = ""; -
trunk/gsdl/perllib/plugins/MP3Plug.pm
r9962 r10218 66 66 67 67 sub new { 68 my ($class) = @_; 69 my $self = new UnknownPlug ($class, @_); 70 $self->{'plugin_type'} = "MP3Plug"; 71 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 72 my $option_list = $self->{'option_list'}; 73 push( @{$option_list}, $options ); 74 75 if (!parsargv::parse(\@_, 76 q^assoc_images^, \$self->{'assoc_images'}, 77 q^applet_metadata^, \$self->{'applet_metadata'}, 78 q^metadata_fields/.*/Title,Artist,Genre^, \$self->{'metadata_fields'}, 79 "allow_extra_options")) { 80 print STDERR "\nIncorrect options passed to MP3Plug, check your collect.cfg configuration file\n"; 81 $self->print_txt_usage(""); # Use default resource bundle 82 die "\n"; 83 } 68 my ($class) = shift (@_); 69 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 70 push(@$pluginlist, $class); 71 72 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 73 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 74 75 my $self = (defined $hashArgOptLists)? new UnknownPlug($pluginlist,$inputargs,$hashArgOptLists): new UnknownPlug($pluginlist,$inputargs); 84 76 85 77 return bless $self, $class; -
trunk/gsdl/perllib/plugins/NULPlug.pm
r9853 r10218 57 57 58 58 sub new { 59 my ($class) = @_; 60 my $self = new BasPlug ($class, @_); 61 $self->{'plugin_type'} = "NULPlug"; 62 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 63 my $option_list = $self->{'option_list'}; 64 push( @{$option_list}, $options ); 59 my ($class) = shift (@_); 60 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 61 push(@$pluginlist, $class); 65 62 66 if (!parsargv::parse(\@_, 67 "allow_extra_options")) { 68 print STDERR "\nIncorrect options passed to NULPlug, check your collect.cfg configuration file\n"; 69 $self->print_txt_usage(""); # Use default resource bundle 70 die "\n"; 71 } 63 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 64 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 72 65 73 66 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 67 74 68 return bless $self, $class; 75 69 } -
trunk/gsdl/perllib/plugins/OAIPlug.pm
r10111 r10218 54 54 55 55 sub new { 56 my $class = shift (@_); 57 my $self = new XMLPlug ($class, @_); 58 $self->{'plugin_type'} = "OAIPlug"; 59 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 60 my $option_list = $self->{'option_list'}; 61 push( @{$option_list}, $options ); 62 63 if (!parsargv::parse(\@_, 64 "allow_extra_options")) { 65 66 print STDERR "\nIncorrect options passed to OAIPlug, check your collect.cfg configuration file\n"; 67 $self->print_txt_usage(""); # Use default resource bundle 68 die "\n"; 69 } 56 my ($class) = shift (@_); 57 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 58 push(@$pluginlist, $class); 59 60 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 61 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 62 63 my $self = (defined $hashArgOptLists)? new XMLPlug($pluginlist,$inputargs,$hashArgOptLists): new XMLPlug($pluginlist,$inputargs); 70 64 71 65 return bless $self, $class; -
trunk/gsdl/perllib/plugins/OggVorbisPlug.pm
r9853 r10218 35 35 36 36 sub BEGIN { 37 @ ISA = ('UnknownPlug');37 @OggVorbisPlug::ISA = ('UnknownPlug'); 38 38 } 39 39 … … 65 65 sub new 66 66 { 67 my $class = shift(@_); 68 69 my $self = new UnknownPlug($class, @_); 70 $self->{'plugin_type'} = "OggVorbisPlug"; 71 72 if (!parsargv::parse(\@_, 73 q^add_technical_metadata^, \$self->{'add_technical_metadata'}, 74 "allow_extra_options")) { 75 die "\nIncorrect options passed to OggVorbisPlug, check your collect.cfg configuration file\n"; 76 } 77 78 # To allow for proper inheritance of arguments 79 my $option_list = $self->{'option_list'}; 80 push(@{$option_list}, $options); 81 67 my ($class) = shift(@_); 68 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 69 push(@$pluginlist, $class); 70 71 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 72 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 73 74 my $self = (defined $hashArgOptLists)? new UnknownPlug($pluginlist,$inputargs,$hashArgOptLists): new UnknownPlug($pluginlist,$inputargs); 75 82 76 return bless $self, $class; 83 77 } -
trunk/gsdl/perllib/plugins/PDFPlug.pm
r9465 r10218 70 70 71 71 sub new { 72 my $class = shift (@_); 73 74 my ($noimages, $complex, $zoom, $use_sections, $nohidden); 75 76 my @args=@_; 77 78 if (!parsargv::parse(\@_, 79 q^noimages^, \$noimages, 80 q^complex^, \$complex, 81 q^zoom/\d+/2^, \$zoom, 82 q^nohidden^, \$nohidden, 83 q^use_sections^, \$use_sections, 84 "allow_extra_options")) { 85 86 my $self = new ConvertToPlug($class, @_); 87 my $outhandle=$self->{'outhandle'}; 88 print $outhandle "\nIncorrect options passed to PDFPlug, check your collect.cfg configuration file\n"; 89 $self->print_txt_usage(""); # Use default resource bundle 90 exit 1; 91 } 92 93 94 if ($use_sections) { 95 push (@args, "-description_tags"); 96 } 97 98 # following title_sub removes "Page 1" added by pdftohtml, and a leading 99 # "1", which is often the page number at the top of the page. Bad Luck 100 # if your document title actually starts with "1 " - is there a better way? 101 102 my $self = new ConvertToPlug ($class, @args, "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?'); 103 $self->{'plugin_type'} = "PDFPlug"; 104 if ($use_sections) { 105 $self->{'use_sections'}=1; 106 } 107 108 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 109 my $option_list = $self->{'option_list'}; 110 push( @{$option_list}, $options ); 72 my ($class) = shift (@_); 73 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 74 push(@$pluginlist, $class); 75 76 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 77 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 78 79 push(@$inputargs,"-title_sub"); 80 push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?'); 81 82 my $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs); 83 84 85 if ($self->{"use_sections"}) { 86 $self->{"description_tags"} = 1; 87 } 111 88 112 89 # these are passed through to gsConvert.pl by ConvertToPlug.pm 90 my $zoom = $self->{"zoom"}; 113 91 $self->{'convert_options'} = "-pdf_zoom $zoom"; 114 $self->{'convert_options'} .= " -pdf_complex" if $ complex;115 $self->{'convert_options'} .= " -pdf_nohidden" if $ nohidden;116 $self->{'convert_options'} .= " -pdf_ignore_images" if $ noimages;92 $self->{'convert_options'} .= " -pdf_complex" if $self->{"complex"}; 93 $self->{'convert_options'} .= " -pdf_nohidden" if $self->{"nohidden"}; 94 $self->{'convert_options'} .= " -pdf_ignore_images" if $self->{"noimages"}; 117 95 118 96 # pdftohtml will always produce html files encoded as utf-8 -
trunk/gsdl/perllib/plugins/PPTPlug.pm
r9465 r10218 49 49 50 50 sub new { 51 my $class = shift (@_); 51 my ($class) = shift (@_); 52 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 53 push(@$pluginlist, $class); 52 54 53 my $self = new ConvertToPlug ($class, @_); 54 $self->{'plugin_type'} = "PPTPlug"; 55 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 56 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 57 58 my $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs); 59 55 60 # ppthtml outputs utf-8 already. 56 61 if ($self->{'input_encoding'} eq "auto") { 57 62 $self->{'input_encoding'} = "utf8"; 58 63 } 59 60 # 14-05-02 To allow for proper inheritance of arguments - John Thompson61 my $option_list = $self->{'option_list'};62 push( @{$option_list}, $options );63 64 64 65 return bless $self, $class; -
trunk/gsdl/perllib/plugins/PSPlug.pm
r9467 r10218 62 62 63 63 sub new { 64 my $class = shift (@_); 64 my ($class) = shift (@_); 65 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 66 push(@$pluginlist, $class); 65 67 66 # title_sub removes leading "Page 1" or "1 " from auto-extracted title. 68 push(@$inputargs,"-convert_to"); 69 push(@$inputargs,"text"); 70 push(@$inputargs,"-title_sub"); 71 push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?'); 67 72 68 my $self = new ConvertToPlug ($class, "-convert_to", "text", @_ , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?'); 69 $self->{'plugin_type'} = "PSPlug"; 70 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 71 my $option_list = $self->{'option_list'}; 72 push( @{$option_list}, $options ); 73 74 if (!parsargv::parse(\@_, 75 q^extract_date^, \$self->{'extract_date'}, 76 q^extract_pages^, \$self->{'extract_pages'}, 77 q^extract_title^, \$self->{'extract_title'}, 78 "allow_extra_options")) { 79 print STDERR "\nIncorrect options passed to HTMLPlug, check your collect.cfg configuration file\n"; 80 $self->print_txt_usage(""); # Use default resource bundle 81 die "\n"; 82 } 73 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 74 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 75 76 my $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs); 83 77 84 78 return bless $self, $class; -
trunk/gsdl/perllib/plugins/PagedImgPlug.pm
r10168 r10218 137 137 138 138 sub BEGIN { 139 @ ISA = ('XMLPlug');139 @PagedImgPlug::ISA = ('XMLPlug'); 140 140 } 141 141 … … 220 220 221 221 sub new { 222 my ($class) = @_; 223 my $plugin_name = shift (@_); 224 $self = new XMLPlug ("PagedImgPlug", @_); 225 226 my $option_list = $self->{'option_list'}; 227 push( @{$option_list}, $options ); 228 229 if (!parsargv::parse(\@_, 230 q^noscaleup^, \$self->{'noscaleup'}, 231 q^converttotype/.*/^, \$self->{'converttotype'}, 232 q^minimumsize/[0-9]*/100^, \$self->{'minimumsize'}, 233 234 q^thumbnailsize/[0-9]*/100^, \$self->{'thumbnailsize'}, 235 q^thumbnailtype/.*/gif^, \$self->{'thumbnailtype'}, 236 q^screenviewsize/[0-9]*/0^, \$self->{'screenviewsize'}, 237 q^screenviewtype/.*/jpg^, \$self->{'screenviewtype'}, 238 q^thumbnail^, \$self->{'thumbnail'}, 239 q^screenview^, \$self->{'screenview'}, 240 q^headerpage^, \$self->{'headerpage'}, 241 'documenttype/^(paged|hierarchy)$/paged', \$self->{'doctype'}, 242 "allow_extra_options")) { 243 244 print STDERR "\nPagedImgPlug uses an incorrect option.\n"; 245 print STDERR "Check your collect.cfg configuration file.\n"; 246 $self->print_txt_usage(""); # Use default resource bundle 247 die "\n"; 248 } 222 my ($class) = shift (@_); 223 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 224 push(@$pluginlist, $class); 225 226 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 227 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 228 229 my $self = (defined $hashArgOptLists)? new XMLPlug($pluginlist,$inputargs,$hashArgOptLists): new XMLPlug($pluginlist,$inputargs); 249 230 250 231 return bless $self, $class; … … 768 749 $self->{'num_pages'} = 0; 769 750 my $topsection = $doc_obj->get_top_section(); 770 if ($self->{'doc type'} eq 'paged') {751 if ($self->{'documenttype'} eq 'paged') { 771 752 # set the gsdlthistype metadata to Paged - this ensures this document will 772 753 # be treated as a Paged doc, even if Titles are not numeric … … 806 787 my $topsection = $doc_obj->get_top_section(); 807 788 808 if ($self->{'doc type'} eq 'paged') {789 if ($self->{'documenttype'} eq 'paged') { 809 790 # set the gsdlthistype metadata to Paged - this ensures this document will 810 791 # be treated as a Paged doc, even if Titles are not numeric -
trunk/gsdl/perllib/plugins/ProCitePlug.pm
r9494 r10218 74 74 sub new 75 75 { 76 my $class = shift(@_); 77 78 my $self = new SplitPlug($class, @_); 79 if (!parsargv::parse(\@_, 80 "allow_extra_options")) { 81 die "\nIncorrect options passed to ProCitePlug, check your collect.cfg configuration file\n"; 82 } 83 84 # To allow for proper inheritance of arguments 85 my $option_list = $self->{'option_list'}; 86 push(@{$option_list}, $options); 87 $self->{'plugin_type'} = "ProCitePlug"; 76 my ($class) = shift (@_); 77 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 78 push(@$pluginlist, $class); 79 80 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 81 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 82 83 my $self = (defined $hashArgOptLists)? new SplitPlug($pluginlist,$inputargs,$hashArgOptLists): new SplitPlug($pluginlist,$inputargs); 88 84 89 85 return bless $self, $class; -
trunk/gsdl/perllib/plugins/RTFPlug.pm
r9465 r10218 49 49 50 50 sub new { 51 my $class = shift (@_); 52 my $self = new ConvertToPlug ($class, @_); 53 $self->{'plugin_type'}="RTFPlug"; 54 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 55 my $option_list = $self->{'option_list'}; 56 push( @{$option_list}, $options ); 51 my ($class) = shift (@_); 52 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 53 push(@$pluginlist, $class); 54 55 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 56 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 57 58 my $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs); 57 59 58 60 return bless $self, $class; -
trunk/gsdl/perllib/plugins/RecPlug.pm
r10156 r10218 131 131 132 132 my ($self); 133 133 134 sub new { 134 my $class = shift (@_); 135 136 # $self is global for use within subroutines called by XML::Parser 137 $self = new BasPlug ($class, @_); 138 139 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 140 my $option_list = $self->{'option_list'}; 141 push( @{$option_list}, $options ); 142 143 if (!parsargv::parse(\@_, 144 q^use_metadata_files^, \$self->{'use_metadata_files'}, 145 q^recheck_directories^, \$self->{'recheck_directories'}, 146 "allow_extra_options")) { 147 print STDERR "\nRecPlug uses an incorrect option.\n"; 148 print STDERR "Check your collect.cfg configuration file.\n\n"; 149 $self->print_txt_usage(""); # Use default resource bundle 150 die "\n"; 151 } 152 135 my ($class) = shift (@_); 136 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 137 push(@$pluginlist, $class); 138 139 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 140 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 141 142 $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 153 143 if ($self->{'use_metadata_files'}) { 154 144 # create XML::Parser object for parsing metadata.xml files … … 157 147 'Doctype' => \&Doctype 158 148 }); 149 159 150 $self->{'parser'} = $parser; 160 151 $self->{'in_filename'} = 0; 161 152 } 162 153 163 154 $self->{'subdir_extrametakeys'} = {}; 164 155 … … 425 416 # Next add metadata read in XML files (if it is supplied) 426 417 if ($additionalmetadata == 1) { 418 427 419 my ($filespec, $mdref); 428 420 foreach $filespec (@extrametakeys) { … … 498 490 sub StartTag { 499 491 my ($expat, $element) = @_; 500 492 501 493 if ($element eq "FileSet") { 502 494 $self->{'saved_targets'} = []; -
trunk/gsdl/perllib/plugins/ReferPlug.pm
r8121 r10218 102 102 103 103 sub new { 104 my $class = shift (@_); 105 my $self = new SplitPlug ($class, @_); 106 $self->{'plugin_type'} = "ReferPlug"; 107 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 108 my $option_list = $self->{'option_list'}; 109 push( @{$option_list}, $options ); 104 my ($class) = shift (@_); 105 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 106 push(@$pluginlist, $class); 107 108 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 109 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 110 111 my $self = (defined $hashArgOptLists)? new SplitPlug($pluginlist,$inputargs,$hashArgOptLists): new SplitPlug($pluginlist,$inputargs); 110 112 111 113 return bless $self, $class; -
trunk/gsdl/perllib/plugins/RogPlug.pm
r9853 r10218 51 51 52 52 sub new { 53 my ($class) = @_; 54 $self = new BasPlug (); 55 $self->{'plugin_type'} = "RogPlug"; 56 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 57 my $option_list = $self->{'option_list'}; 58 push( @{$option_list}, $options ); 53 my ($class) = shift (@_); 54 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 55 push(@$pluginlist, $class); 56 57 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 58 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 59 60 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 59 61 60 62 return bless $self, $class; -
trunk/gsdl/perllib/plugins/SRCPlug.pm
r8121 r10218 71 71 72 72 sub new { 73 my ($class) = @_; 74 my $self = new BasPlug ($class, @_); 75 $self->{'plugin_type'} = "SRCPlug"; 76 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 77 my $option_list = $self->{'option_list'}; 78 push( @{$option_list}, $options ); 79 80 if (!parsargv::parse(\@_, 81 q^remove_prefix/(\S+)/^, \$self->{'remove_prefix'}, 82 "allow_extra_options" 83 ) 84 ) { 85 print STDERR "\nIncorrect options passed to SRCPlug, "; 86 print STDERR "check your collect.cfg configuration file\n"; 87 $self->print_txt_usage(""); # Use default resource bundle 88 die "\n"; 89 } 73 my ($class) = shift (@_); 74 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 75 push(@$pluginlist, $class); 76 77 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 78 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 79 80 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 81 90 82 return bless $self, $class; 91 83 } -
trunk/gsdl/perllib/plugins/SplitPlug.pm
r9853 r10218 54 54 'desc' => "{SplitPlug.split_exp}", 55 55 'type' => "regexp", 56 'deft' => &get_default_split_exp(), 56 #'deft' => &get_default_split_exp(), 57 'deft' => "", 57 58 'reqd' => "no" } ]; 58 59 … … 65 66 66 67 sub new { 67 my ($class) = @_; 68 $self = new BasPlug($class, @_); 69 70 $self->{'plugin_type'} = "SplitPlug"; 71 72 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 73 my $option_list = $self->{'option_list'}; 74 push( @{$option_list}, $options ); 75 76 if (!parsargv::parse(\@_, 77 q^split_exp/.*/^, \$self->{'split_exp'}, 78 "allow_extra_options")) { 79 print STDERR "\nIncorrect options passed to $class."; 80 print STDERR "\nCheck your collect.cfg configuration file\n"; 81 die "\n"; 82 } 68 my ($class) = shift (@_); 69 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 70 push(@$pluginlist, $class); 71 72 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 73 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 74 75 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 83 76 84 77 $self->{'textcat_store'} = {}; -
trunk/gsdl/perllib/plugins/TEXTPlug.pm
r8121 r10218 59 59 60 60 sub new { 61 my ($class) = @_; 62 my $self = new BasPlug ($class, @_); 63 $self->{'plugin_type'} = "TEXTPlug"; 64 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 65 my $option_list = $self->{'option_list'}; 66 push( @{$option_list}, $options ); 61 my ($class) = shift (@_); 62 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 63 push(@$pluginlist, $class); 67 64 68 if (!parsargv::parse(\@_, 69 q^title_sub/.*/^, \$self->{'title_sub'}, 70 "allow_extra_options")) { 71 print STDERR "\nIncorrect options passed to TEXTPlug, check your collect.cfg configuration file\n"; 72 $self->print_txt_usage(""); # Use default resource bundle 73 die "\n"; 74 } 65 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 66 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 75 67 68 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 76 69 77 70 return bless $self, $class; -
trunk/gsdl/perllib/plugins/UnknownPlug.pm
r9853 r10218 58 58 use BasPlug; 59 59 use parsargv; 60 #$%^ 61 use parse2; 62 60 63 61 64 … … 94 97 95 98 sub new { 96 my ($class) = @_; 97 my $self = new BasPlug ($class, @_); 98 $self->{'plugin_type'} = "UnknownPlug"; 99 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 100 my $option_list = $self->{'option_list'}; 101 push( @{$option_list}, $options ); 102 103 if (!parsargv::parse(\@_, 104 q^assoc_field/.*/^, \$self->{'assoc_field'}, 105 q^file_format/.*/^, \$self->{'file_format'}, 106 q^mime_type/.*/^, \$self->{'mime_type'}, 107 q^process_extension/.*/^, \$self->{'process_extension'}, 108 "allow_extra_options")) { 109 print STDERR "\nIncorrect options passed to UnknownPlug, check your collect.cfg configuration file\n"; 110 $self->print_txt_usage(""); # Use default resource bundle 111 die "\n"; 112 } 99 my ($class) = shift (@_); 100 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 101 push(@$pluginlist, $class); 102 103 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 104 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 105 106 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 113 107 114 108 # "-process_extension" is a simpler alternative to -process_exp for non-regexp people -
trunk/gsdl/perllib/plugins/W3ImgPlug.pm
r9853 r10218 225 225 226 226 sub new { 227 my $class = shift (@_); 228 my $self = new HTMLPlug ($class, @_); 229 $self->{'plugin_type'} = "W3ImgPlug"; 230 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 231 my $option_list = $self->{'option_list'}; 232 push( @{$option_list}, $options ); 233 234 if (!parsargv::parse(\@_, 235 q^aggressiveness/\d/3^, \$self->{'aggressiveness'}, 236 q^index_pages^, \$self->{'index_pages'}, 237 q^no_cache_images^, \$self->{'no_cache_images'}, 238 q^min_size/\d*/2000^, \$self->{'min_img_filesize'}, 239 q^min_width/\d*/50^, \$self->{'min_img_width'}, 240 q^min_height/\d*/50^, \$self->{'min_img_height'}, 241 q^thumb_size/\d*/100^, \$self->{'thumbnail_size'}, 242 q^convert_params/.*/ ^, \$self->{'img_convert_param'}, 243 q^max_near_text/\d*/400^, \$self->{'maxtext'}, 244 q^min_near_text/\d*/10^, \$self->{'mintext'}, 245 q^smallpage_threshold/\d*/2048^, \$self->{'smallpage_threshold'}, 246 q^textrefs_threshold/\d*/2^, \$self->{'textref_threshold'}, 247 q^caption_length/\d*/80^, \$self->{'caption_len'}, 248 q^neartext_length/\d*/300^, \$self->{'neartext_len'}, 249 q^document_text^, \$self->{'document_text'}, 250 "allow_extra_options" 251 )) { 252 253 print STDERR "\nIncorrect options passed to W3ImgPlug, check your collect.cfg configuration file\n"; 254 $self->print_txt_usage(""); # Use default resource bundle 255 die "\n"; 256 } 257 227 my ($class) = shift (@_); 228 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 229 push(@$pluginlist, $class); 230 231 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 232 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 233 234 my $self = (defined $hashArgOptLists)? new HTMLPlug($pluginlist,$inputargs,$hashArgOptLists): new HTMLPlug($pluginlist,$inputargs); 235 258 236 # init class variables 259 237 $self->{'textref'} = undef; # init by read_file fn … … 399 377 } 400 378 401 if ( $self->{'neartext_len '} > $self->{'maxtext'} ) {402 $self->{'max text'} = $self->{'neartext_len'} * 1.33;403 print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max text'}\n";379 if ( $self->{'neartext_length'} > $self->{'max_near_text'} ) { 380 $self->{'max_near_text'} = $self->{'neartext_length'} * 1.33; 381 print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max_near_text'}\n"; 404 382 } 405 if ( $self->{'caption_len '} > $self->{'maxtext'} ) {406 $self->{'max text'} = $self->{'caption_len'} * 1.33;407 print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max text'}\n";383 if ( $self->{'caption_length'} > $self->{'max_near_text'} ) { 384 $self->{'max_near_text'} = $self->{'caption_length'} * 1.33; 385 print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max_near_text'}\n"; 408 386 } 409 387 … … 492 470 } else { ($crcid) = `cksum $filepath` =~ /^(\d+)/; } 493 471 $thumbfp = "$tndir/tn_$crcid.jpg"; 494 `convert -flatten -filter Hanning $self->{' img_convert_param'} -geometry "$self->{'thumbnail_size'}x$self->{'thumbnail_size'}>" $filepath $thumbfp` unless -e $thumbfp;472 `convert -flatten -filter Hanning $self->{'convert_params'} -geometry "$self->{'thumb_size'}x$self->{'thumb_size'}>" $filepath $thumbfp` unless -e $thumbfp; 495 473 if ( ! (-e $thumbfp) ) { 496 474 print STDERR "W3ImgPlug: 'convert' failed. Check ImageMagicK binaries are installed and working correctly\n"; return 0; … … 532 510 # textual references 533 511 if ( $aggr == 5 || $aggr >= 7) { 534 if ( length($relreltext) > ($self->{'caption_len '} * 2) ) {512 if ( length($relreltext) > ($self->{'caption_length'} * 2) ) { 535 513 $reltext .= $self->get_textrefs($relreltext, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos); } 536 514 else { … … 610 588 611 589 # extract larger context 612 $maxtext = $self->{'max text'};590 $maxtext = $self->{'max_near_text'}; 613 591 $startpos = $pos - ($maxtext * 4); 614 592 $context_size = $maxtext*10; … … 663 641 } 664 642 foreach $sentence ( keys %sentences ) { 665 if ($sentences{$sentence} < $self->{'textref _threshold'}) {643 if ($sentences{$sentence} < $self->{'textrefs_threshold'}) { 666 644 delete $sentences{$sentence}; 667 645 } … … 681 659 $startpos, $context, $context_size); 682 660 683 $mintext = $self->{'min text'};684 $goodlen = $self->{'caption_len '};661 $mintext = $self->{'min_near_text'}; 662 $goodlen = $self->{'caption_length'}; 685 663 686 664 # extract a context to extract near text from (faster) 687 $context_size = $self->{'max text'}*3;665 $context_size = $self->{'max_near_text'}*3; 688 666 $startpos = $pos - ($context_size / 2); 689 667 if ($startpos < $prevpos ) { $startpos = $prevpos } … … 762 740 # if bound_tag too far from the image, then prob not caption 763 741 # (note: have to allow for tags, so multiply by 3 764 if ( $etag && length($nt[0]) < ($self->{'caption_len '} * 3) ) {742 if ( $etag && length($nt[0]) < ($self->{'caption_length'} * 3) ) { 765 743 if ( $nt[0] =~ /<\/$etag>/si ) { 766 744 # the whole caption is above the image: <tag>text</tag><img> 767 745 ($nt[0]) =~ /<(?:$etag)[\s]?.*?>(.*?)<\/$etag>/is; 768 746 $nt[0] = $self->strip_tags($nt[0]); 769 if ( length($nt[0]) > $self->{'min text'} ) {747 if ( length($nt[0]) > $self->{'min_near_text'} ) { 770 748 $gotcap = 1; 771 749 $nt[1] = ""; … … 776 754 ($nt[1]) = $nt[1] =~ /(.*?)<\/$etag>/si; 777 755 $nt[0] = $self->strip_tags($nt[0] . $nt[1]); 778 if ( length($nt[0]) > $self->{'min text'} ) {756 if ( length($nt[0]) > $self->{'min_near_text'} ) { 779 757 $gotcap = 2; 780 758 $nt[1] = ""; … … 818 796 $bestlen[0] = $bestlen[1] = 0; $bestlen[2] = $bdist = 999999; 819 797 $best[0] = $best[1] = $best[2] = ""; 820 $maxtext = $self->{'max text'};821 $mintext = $self->{'min text'};822 $goodlen = $self->{'neartext_len '};798 $maxtext = $self->{'max_near_text'}; 799 $mintext = $self->{'min_near_text'}; 800 $goodlen = $self->{'neartext_length'}; 823 801 824 802 # extract a context to extract near text from (faster) … … 945 923 # either side of the tag (by word boundary) 946 924 return "" if ( ! exists $imgs->{$fp}{'rawpos'} ); 947 $startpos = $imgs->{$fp}{'rawpos'} - (($self->{'max text'} / 2) + 20);925 $startpos = $imgs->{$fp}{'rawpos'} - (($self->{'max_near_text'} / 2) + 20); 948 926 if ( $startpos < 0 ) { $startpos = 0 } 949 $rawtext = substr $self->{'plaintext'}, $startpos, $self->{'max text'} + 20;927 $rawtext = substr $self->{'plaintext'}, $startpos, $self->{'max_near_text'} + 20; 950 928 $rawtext =~ s/\s\s/ /g; 951 929 … … 1010 988 } 1011 989 $filesize = (-s $abspath); 1012 if ( $filesize >= $self->{'min_ img_filesize'}1013 && ( $width >= $self->{'min_ img_width'} )1014 && ( $height >= $self->{'min_ img_height'} ) ) {990 if ( $filesize >= $self->{'min_size'} 991 && ( $width >= $self->{'min_width'} ) 992 && ( $height >= $self->{'min_height'} ) ) { 1015 993 1016 994 $imgs->{$filepath}{'exists'} = 1; -
trunk/gsdl/perllib/plugins/WordPlug.pm
r9465 r10218 48 48 49 49 sub new { 50 my $class = shift (@_); 51 52 my $self = new ConvertToPlug ($class, @_); 53 $self->{'plugin_type'} = "WordPlug"; 54 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 55 my $option_list = $self->{'option_list'}; 56 push( @{$option_list}, $options ); 50 my ($class) = shift (@_); 51 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 52 push(@$pluginlist, $class); 57 53 58 # wvWare will always produce html files encoded as utf-8 54 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 55 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 56 57 my $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs); 58 59 # wvWare will always produce html files encoded as utf-8 59 60 if ($self->{'input_encoding'} eq "auto") { 60 61 $self->{'input_encoding'} = "utf8"; -
trunk/gsdl/perllib/plugins/XMLPlug.pm
r10170 r10218 28 28 use BasPlug; 29 29 use doc; 30 #$%^ 31 use parse2; 30 32 31 33 sub BEGIN { … … 57 59 our ($self); 58 60 sub new { 59 my $class = shift (@_); 60 61 my ($class) = shift (@_); 62 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 63 push(@$pluginlist, $class); 64 65 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 66 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 67 61 68 # $self is global for use within subroutines called by XML::Parser 62 $self = new BasPlug ($class, @_); 63 $self->{'plugin_type'} = "XMLPlug"; 64 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 65 my $option_list = $self->{'option_list'}; 66 push( @{$option_list}, $options ); 67 68 if (!parsargv::parse(\@_, 69 q^xslt/.*/^, \$self->{'xslt'}, 70 "allow_extra_options")) { 71 72 print STDERR "\nIncorrect options passed to XSLTPlug, check your collect.cfg configuration file\n"; 73 $self->print_txt_usage(""); # Use default resource bundle 74 die "\n"; 75 } 76 69 $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 77 70 78 71 my $parser = new XML::Parser('Style' => 'Stream', … … 82 75 'Doctype' => \&Doctype, 83 76 'Default' => \&Default 84 }); 85 86 87 77 }); 88 78 $self->{'parser'} = $parser; 89 79 -
trunk/gsdl/perllib/plugins/ZIPPlug.pm
r9960 r10218 43 43 # tar (for tar) 44 44 45 # 12/05/02 Added usage datastructure - John Thompson46 45 47 46 package ZIPPlug; … … 51 50 use util; 52 51 use Cwd; 52 #$%^ 53 use parse2; 53 54 54 55 … … 71 72 72 73 sub new { 73 my ($class) = @_; 74 my $self = new BasPlug ("ZIPPlug", @_); 75 $self->{'plugin_type'} = "ZIPPlug"; 76 77 # 14-05-02 To allow for proper inheritance of arguments - John Thompson 78 my $option_list = $self->{'option_list'}; 79 push( @{$option_list}, $options ); 80 81 if (!parsargv::parse(\@_, 82 q^process_exp/.*/^, \$self->{'process_exp'}, 83 "allow_extra_options")) { 84 print STDERR "\nIncorrect options passed to ZIPPlug, check your collect.cfg configuration file\n"; 85 $self->print_txt_usage(""); # Use default resource bundle 86 die "\n"; 87 } 74 75 my ($class) = shift (@_); 76 my ($pluginlist,$inputargs,$hashArgOptLists) = @_; 77 push(@$pluginlist, $class); 78 79 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});} 80 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)}; 81 82 my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs); 88 83 89 84 # BasPlug is explicitly set not to set process_exp if recursive plugin 90 85 # Not sure of this reasoning. Want it to be set in ZIPPlug, so explicitly 91 86 # pass it in as default value 87 88 ## do we need this???? --kjdon 92 89 if (!$self->{'process_exp'}) { 93 90 $self->{'process_exp'} = get_default_process_exp(); -
trunk/gsdl/perllib/printusage.pm
r8716 r10218 101 101 } 102 102 103 # If the option has a charactor length field, display this 104 if (defined($option->{'char_length'})) { 105 &gsprintf(STDERR, " <Charactor Length>$option->{'char_length'}</Charactor Length>\n"); 106 } 107 103 108 # If the option has a range field, display this 104 109 if (defined($option->{'range'})) { … … 125 130 } 126 131 127 # Special case for 'input_encoding'128 if ($optionname =~ m/^input_encoding$/i) {129 my $e = $encodings::encodings;130 foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {131 &gsprintf(STDERR, " <Value>\n");132 &gsprintf(STDERR, " <Name>$enc</Name>\n");133 &gsprintf(STDERR, " <Desc>$e->{$enc}->{'name'}</Desc>\n");134 &gsprintf(STDERR, " </Value>\n");135 }136 }132 # # Special case for 'input_encoding' 133 # if ($optionname =~ m/^input_encoding$/i) { 134 # my $e = $encodings::encodings; 135 # foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) { 136 # &gsprintf(STDERR, " <Value>\n"); 137 # &gsprintf(STDERR, " <Name>$enc</Name>\n"); 138 # &gsprintf(STDERR, " <Desc>$e->{$enc}->{'name'}</Desc>\n"); 139 # &gsprintf(STDERR, " </Value>\n"); 140 # } 141 # } 137 142 138 143 &gsprintf(STDERR, " </List>\n"); … … 246 251 } 247 252 248 # Special case for 'input_encoding'249 if ($optionname =~ m/^input_encoding$/i) {250 my $e = $encodings::encodings;251 foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {252 &gsprintf(STDERR, " " x $optiondescoffset);253 &gsprintf(STDERR, "$enc:");254 255 my $encodingdesc = $e->{$enc}->{'name'};256 &display_text_in_column($encodingdesc, $optiondescoffset + 2,257 $optiondescoffset + length("$enc:"), 80);258 }259 }253 # # Special case for 'input_encoding' 254 # if ($optionname =~ m/^input_encoding$/i) { 255 # my $e = $encodings::encodings; 256 # foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) { 257 # &gsprintf(STDERR, " " x $optiondescoffset); 258 # &gsprintf(STDERR, "$enc:"); 259 # 260 # my $encodingdesc = $e->{$enc}->{'name'}; 261 # &display_text_in_column($encodingdesc, $optiondescoffset + 2, 262 # $optiondescoffset + length("$enc:"), 80); 263 # } 264 # } 260 265 261 266 # Add a blank line to separate options
Note:
See TracChangeset
for help on using the changeset viewer.