Changeset 8716


Ignore:
Timestamp:
2004-12-01T16:14:11+13:00 (19 years ago)
Author:
kjdon
Message:

added some changes made by Emanuel Dejanu (Simple Words)

Location:
trunk/gsdl/perllib
Files:
34 edited

Legend:

Unmodified
Added
Removed

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

    r7835 r8716  
    168168    }
    169169
    170     if (!$metaname) {
     170    if (!defined($metaname)) {
    171171    my $outhandle = $self->{'outhandle'};
    172172    print $outhandle "AZCompactList Error: required option -metadata not supplied\n";

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

    r8221 r8716  
    33
    44sub BEGIN {
    5     @ISA = ('BasClas');
     5    @AllList::ISA = ('BasClas');
    66}
    77

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

    r8221 r8716  
    9292sub print_xml_usage
    9393{
    94     local $self = shift(@_);
     94    my $self = shift(@_);
    9595
    9696    # XML output is always in UTF-8
    … …  
    104104sub print_xml
    105105{
    106     local $self = shift(@_);
    107 
    108     local $optionlistref = $self->{'option_list'};
    109     local @optionlist = @$optionlistref;
    110     local $classifieroptions = pop(@$optionlistref);
     106    my $self = shift(@_);
     107
     108    my $optionlistref = $self->{'option_list'};
     109    my @optionlist = @$optionlistref;
     110    my $classifieroptions = pop(@$optionlistref);
    111111    return if (!defined($classifieroptions));
    112112
    … …  
    134134sub print_txt_usage
    135135{
    136     local $self = shift(@_);
     136    my $self = shift(@_);
    137137
    138138    # Print the usage message for a classifier (recursively)
    139     local $descoffset = $self->determine_description_offset(0);
     139    my $descoffset = $self->determine_description_offset(0);
    140140    $self->print_classifier_usage($descoffset, 1);
    141141}
    … …  
    144144sub determine_description_offset
    145145{
    146     local $self = shift(@_);
    147     local $maxoffset = shift(@_);
    148 
    149     local $optionlistref = $self->{'option_list'};
    150     local @optionlist = @$optionlistref;
    151     local $classifieroptions = pop(@$optionlistref);
     146    my $self = shift(@_);
     147    my $maxoffset = shift(@_);
     148
     149    my $optionlistref = $self->{'option_list'};
     150    my @optionlist = @$optionlistref;
     151    my $classifieroptions = pop(@$optionlistref);
    152152    return $maxoffset if (!defined($classifieroptions));
    153153
    154154    # Find the length of the longest option string of this classifier
    155     local $classifierargs = $classifieroptions->{'args'};
     155    my $classifierargs = $classifieroptions->{'args'};
    156156    if (defined($classifierargs)) {
    157     local $longest = &PrintUsage::find_longest_option_string($classifierargs);
     157    my $longest = &PrintUsage::find_longest_option_string($classifierargs);
    158158    if ($longest > $maxoffset) {
    159159        $maxoffset = $longest;
    … …  
    170170sub print_classifier_usage
    171171{
    172     local $self = shift(@_);
    173     local $descoffset = shift(@_);
    174     local $isleafclass = shift(@_);
    175 
    176     local $optionlistref = $self->{'option_list'};
    177     local @optionlist = @$optionlistref;
    178     local $classifieroptions = pop(@$optionlistref);
     172    my $self = shift(@_);
     173    my $descoffset = shift(@_);
     174    my $isleafclass = shift(@_);
     175
     176    my $optionlistref = $self->{'option_list'};
     177    my @optionlist = @$optionlistref;
     178    my $classifieroptions = pop(@$optionlistref);
    179179    return if (!defined($classifieroptions));
    180180
    181     local $classifiername = $classifieroptions->{'name'};
    182     local $classifierargs = $classifieroptions->{'args'};
    183     local $classifierdesc = $classifieroptions->{'desc'};
     181    my $classifiername = $classifieroptions->{'name'};
     182    my $classifierargs = $classifieroptions->{'args'};
     183    my $classifierdesc = $classifieroptions->{'desc'};
    184184    # Produce the usage information using the data structure above
    185185    if ($isleafclass) {
    … …  
    194194    if (defined($classifierargs)) {
    195195    # Calculate the column offset of the option descriptions
    196     local $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
     196    my $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
    197197
    198198    if ($isleafclass) {

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

    r8647 r8716  
    5757        'type' => "metadata",
    5858    'reqd' => "no" } ,
     59      { 'name' => "reverse_sort",
     60    'desc' => "{DateList.reverse_sort}",
     61    'type' => "flag",
     62    'reqd' => "no" },
    5963      { 'name' => "bymonth",
    6064    'desc' => "{DateList.bymonth}",
    … …  
    6367      { 'name' => "nogroup",
    6468    'desc' => "{DateList.nogroup}",
    65     'type' => "flag",
    66     'reqd' => "no" },
    67       { 'name' => "newest_first",
    68     'desc' => "{DateList.newest_first}",
    6969    'type' => "flag",
    7070    'reqd' => "no" }

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

    r8221 r8716  
    3535
    3636sub BEGIN {
    37     @ISA = ('BasClas');
     37    @Hierarchy::ISA = ('BasClas');
    3838}
    3939
    … …  
    5858    'deft' => "{BasClas.metadata.deft}",
    5959    'reqd' => "no" },
     60      { 'name' => "reverse_sort",
     61    'desc' => "{Hierarchy.reverse_sort}",
     62    'type' => "flag",
     63    'reqd' => "no" },
    6064      { 'name' => "hlist_at_top",
    6165    'desc' => "{Hierarchy.hlist_at_top}",
    … …  
    8387    }
    8488 
    85     my ($hfile, $metadata, $sortname, $title, $hlist_at_top);
     89    my ($hfile, $metadata, $sortname, $reverse_sort, $title, $hlist_at_top);
    8690   
    8791    if (!parsargv::parse(\@_,
    8892             q^buttonname/.*/^, \$title,
    8993             q^sort/.*/^, \$sortname,
     94             q^reverse_sort^, \$reverse_sort,
    9095             q^hfile/.*/^, \$hfile,
    9196             q^metadata/.*/^, \$metadata,
    … …  
    117122    $sortname = $metadata unless ($sortname);
    118123    $sortname = undef if $sortname =~ /^nosort$/;
    119    
     124    if (defined $sortname && $reverse_sort) {
     125    $self->{'reverse_sort'} = 1;
     126    }
     127   
    120128    my $subjectfile;
    121129    $subjectfile = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"etc", $hfile);
    … …  
    225233   
    226234    if (defined $self->{'sortname'}) {
     235        if ($self->{'reverse_sort'}) {
     236        foreach $subOID (sort {$b->[1] cmp $a->[1];} @{$list->{$OID}->{'contents'}}) {
     237            push (@{$tempinfo->{'contains'}}, {'OID'=>$subOID->[0]});
     238        }
     239        } else {
    227240        foreach $subOID (sort {$a->[1] cmp $b->[1];} @{$list->{$OID}->{'contents'}}) {
    228241        push (@{$tempinfo->{'contains'}}, {'OID'=>$subOID->[0]});
    … …  
    262275    $classifyinfo->{'contains'} = [] unless defined $classifyinfo->{'contains'};
    263276    my $offset = 0;
    264     foreach $thing (@{$classifyinfo->{'contains'}}) {
     277    foreach my $thing (@{$classifyinfo->{'contains'}}) {
    265278    $offset ++ if defined $thing->{'OID'};
    266279    }

  • trunk/gsdl/perllib/doc.pm

    r8504 r8716  
    9595    my $newobj = {};
    9696   
    97     foreach $k (keys %$self) {
     97    foreach my $k (keys %$self) {
    9898    $newobj->{$k} = &clone ($self->{$k});
    9999    }
    … …  
    109109    if ($type eq "HASH") {
    110110    my $to = {};
    111     foreach $key (keys %$from) {
     111    foreach my $key (keys %$from) {
    112112        $to->{$key} = &clone ($from->{$key});
    113113    }
    … …  
    115115    } elsif ($type eq "ARRAY") {
    116116    my $to = [];
    117     foreach $v (@$from) {
     117    foreach my $v (@$from) {
    118118        push (@$to, &clone ($v));
    119119    }
    … …  
    128128    my ($type) = @_;
    129129
    130     if ($type eq "incremental") {
     130    if ($type =~ /^(hash|incremental|dirname)$/) {
    131131    $self->{'OIDtype'} = $type;
    132132    } else {
    … …  
    638638        $OID = "D" . $OIDcount;
    639639        $OIDcount ++;
     640     
     641    } elsif ($self->{'OIDtype'} eq "dirname") {
     642        $OID = 'J';
     643        my $filename = $self->get_source_filename();
     644        if (defined($filename) && -e $filename) {
     645        $OID = &File::Basename::dirname($filename);
     646        if (defined $OID) {
     647            $OID = 'J'.&File::Basename::basename($OID);
     648        } else {
     649            print STDERR "Failed to find base for filename ($filename).....\n";
     650            die("\n"); 
     651        }
     652        } else {
     653        print STDERR "Failed to find filename.....\n";
     654        die("\n");
     655        }   
    640656       
    641657    } else {
    … …  
    10021018    my $section_ptr = $self->_lookup_section($section);
    10031019    if (!defined $section_ptr) {
    1004     print STDERR "doc::get_metadata_element couldn't find section " .
    1005         "$section\n";
     1020    print STDERR "doc::get_metadata_element couldn't find section ", $section, "\n";
    10061021    return;
    10071022    }
    … …  
    10361051    my $section_ptr = $self->_lookup_section($section);
    10371052    if (!defined $section_ptr) {
    1038         print STDERR "doc::get_metadata couldn't find section " .
    1039             "$section\n";
     1053        print STDERR "doc::get_metadata couldn't find section ",
     1054        $section, "\n";
    10401055        return;
    10411056    }
    … …  
    10681083    my $section_ptr = $self->_lookup_section($section);
    10691084    if (!defined $section_ptr) {
    1070     print STDERR "doc::get_all_metadata couldn't find section " .
    1071         "$section\n";
     1085    print STDERR "doc::get_all_metadata couldn't find section ", $section, "\n";
    10721086    return;
    10731087    }
    … …  
    10831097    my $section_ptr = $self->_lookup_section($section);
    10841098    if (!defined $section_ptr) {
    1085     print STDERR "doc::delete_metadata couldn't find section " .
    1086         "$section\n";
     1099    print STDERR "doc::delete_metadata couldn't find section ", $section, "\n";
    10871100    return;
    10881101    }
    … …  
    11051118    my $section_ptr = $self->_lookup_section($section);
    11061119    if (!defined $section_ptr) {
    1107     print STDERR "doc::delete_all_metadata couldn't find section " .
    1108         "$section\n";
     1120    print STDERR "doc::delete_all_metadata couldn't find section ", $section, "\n";
    11091121    return;
    11101122    }
    … …  
    11491161    my $section_ptr = $self->_lookup_section($section);
    11501162    if (!defined $section_ptr) {
    1151     print STDERR "doc::add_utf8_metadata couldn't find section " .
    1152         "$section\n";
     1163    print STDERR "doc::add_utf8_metadata couldn't find section ", $section, "\n";
    11531164    return;
    11541165    }

  • trunk/gsdl/perllib/docprint.pm

    r2267 r8716  
    3535
    3636sub BEGIN {
    37     @ISA = ('docproc');
     37    @docprint::ISA = ('docproc');
    3838}
    3939
    … …  
    5151    # add associated files as metadata to the document
    5252    my @assoc_files = ();
    53     foreach $assoc_file (@{$doc_obj->get_assoc_files()}) {
     53    foreach my $assoc_file (@{$doc_obj->get_assoc_files()}) {
    5454    if (-e $assoc_file->[0]) {
    5555        $doc_obj->add_metadata ($doc_obj->get_top_section(),

  • trunk/gsdl/perllib/docproc.pm

    r7902 r8716  
    4545}
    4646
    47 # OIDtype may be "hash" or "incremental"
     47# OIDtype may be "hash" or "incremental" or "dirname"
    4848sub set_OIDtype {
    4949    my $self = shift (@_);
    5050    my ($type) = @_;
    5151
    52     if ($type eq "incremental") {
     52    if ($type =~ /^(hash|incremental|dirname)$/) {
    5353    $self->{'OIDtype'} = $type;
    5454    } else {

  • trunk/gsdl/perllib/docsave.pm

    r8517 r8716  
    6161    $self->{'verbosity'} = $verbosity;
    6262    $self->{'gzip'} = $gzip;
    63    
     63    $self->{'keepimportstructure'} = 0;
    6464    $self->{'groupsize'} = $groupsize;
    6565    $self->{'gs_count'} = 0;
    … …  
    127127
    128128    # get document's directory
    129     my $doc_dir = $self->get_doc_dir ($OID);
     129    my $doc_dir = $self->get_doc_dir ($OID, $doc_obj->get_source_filename());
    130130
    131131    # groupsize is 1 (i.e. one document per XML file) so sortmeta
    … …  
    342342
    343343    # get document's directory
    344     my $doc_dir = $self->get_doc_dir ($OID);
     344    my $doc_dir = $self->get_doc_dir ($OID, $doc_obj->get_source_filename());
    345345
    346346    # copy all the associated files, add this information as metadata
    … …  
    380380sub get_doc_dir {
    381381    my $self = shift (@_);
    382     my ($OID) = @_;
     382    my ($OID, $source_filename) = @_;
    383383    my $doc_info;
    384     my $doc_dir;
     384    my $doc_dir = '';
    385385    my $service = $self-> {'service'};
    386386    my $working_dir;
    … …  
    403403    $doc_dir = $doc_info->[0];
    404404    $doc_dir =~ s/\/?doc\.xml(\.gz)?$//;
    405     } else {
     405    } elsif ($self->{'keepimportstructure'}) {
     406    $source_filename = &File::Basename::dirname($source_filename);
     407    $source_filename =~ s/[\\\/]+/\//g;
     408    $source_filename =~ s/\/$//;
     409 
     410   
     411    #print STDERR "Source filename: $source_filename; \nImport dir:",$ENV{'GSDLIMPORTDIR'}, "\n";
     412    $doc_dir = substr($source_filename, length($ENV{'GSDLIMPORTDIR'}) + 1);
     413
     414    }
     415    if ($doc_dir eq "") {
    406416    # have to get a new document directory
    407417    my $doc_dir_rest = $OID;

  • trunk/gsdl/perllib/encodings.pm

    r6807 r8716  
    3636#                                  routine this is the name of that routine.
    3737
    38 $encodings = {
     38$encodings::encodings = {
    3939    'iso_8859_1' => {'name' => 'Latin1 (western languages)', 'mapfile' => '8859_1.ump'},
    4040

  • trunk/gsdl/perllib/ghtml.pm

    r7903 r8716  
    8888
    8989# named entry to the standard html font
    90 %charnetosf = ("Agrave"=> "192",  "Aacute"=> "193",  "Acirc" => "194",  "Atilde"=> "195",
     90my %charnetosf = ("Agrave"=> "192",  "Aacute"=> "193",  "Acirc" => "194",  "Atilde"=> "195",
    9191           "Auml"  => "196",  "Aring" => "197",  "AElig" => "198",  "Ccedil"=> "199",
    9292           "Egrave"=> "200",  "Eacute"=> "201",  "Ecirc" => "202",  "Euml"  => "203",
    … …  
    105105           "uuml"  => "252",  "yacute"=> "253",  "thorn" => "254",  "yuml"  => "255");
    106106
    107 %symnetosf = ("quot"  => "34",   "amp"   => "38",   "lt"    => "60",   "gt"    => "62",
     107my %symnetosf = ("quot"  => "34",   "amp"   => "38",   "lt"    => "60",   "gt"    => "62",
    108108          "nbsp"  => "160",  "iexcl" => "161",  "cent"  => "162",  "pound" => "163",
    109109          "curren"=> "164",  "yen"   => "165",  "brvbar"=> "166",  "sect"  => "167",
    … …  
    119119
    120120# standard font to plain text
    121 %sftotxt = ("32"  => " ",  "33"  => "!",  "34"  => "\"",  "35"  => "\#",  "36"  => "\$",
     121my %sftotxt = ("32"  => " ",  "33"  => "!",  "34"  => "\"",  "35"  => "\#",  "36"  => "\$",
    122122        "37"  => "\%", "38"  => "&",  "39"  => "'",   "40"  => "(",   "41"  => ")",
    123123        "42"  => "*",  "43"  => "+",  "44"  => ",",   "45"  => "-",   "46"  => ".",

  • trunk/gsdl/perllib/lang.pm

    r537 r8716  
    2929package lang;
    3030
    31 @trans = (["ab", "Abkhazian"],      ["om", "Afan Oromo"],
     31@lang::trans = (["ab", "Abkhazian"],      ["om", "Afan Oromo"],
    3232      ["om", "Oromo"],          ["aa", "Afar"],
    3333      ["af", "Afrikaans"],      ["sq", "Albanian"],
    … …  
    135135    my $iso639 = "";
    136136
    137     foreach $lang (@trans) {
     137    foreach my $lang (@lang::trans) {
    138138    my $code = $lang->[0];
    139139    my $enname = $lang->[1];
    140     if ($english =~ /\s*($code|$enname)\s*$/i) {
     140    if ($english =~ /^\s*($code|$enname)\s*$/i) {
    141141        # found the language
    142142        $iso639 = $code;
    … …  
    157157    my @iso639list = ();
    158158
    159     foreach $english (@englishlist) {
     159    foreach my $english (@englishlist) {
    160160    push (@iso639list, &one_english_to_iso639($english));
    161161    }
    … …  
    169169    my $english = "";
    170170
    171     foreach $lang (@trans) {
     171    foreach my $lang (@lang::trans) {
    172172    my $code = $lang->[0];
    173173    my $enname = $lang->[1];
    … …  
    180180    }
    181181
    182     return $enname;
     182    return $english;
    183183}
    184184

  • trunk/gsdl/perllib/lucenebuilder.pm

    r8072 r8716  
    3131
    3232sub BEGIN {
    33     @ISA = ('mgppbuilder');
     33    @lucenebuilder::ISA = ('mgppbuilder');
    3434}
    3535

  • trunk/gsdl/perllib/lucenebuildproc.pm

    r8072 r8716  
    3535
    3636sub BEGIN {
    37     @ISA = ('mgppbuildproc');
     37    @lucenebuildproc::ISA = ('mgppbuildproc');
    3838}
    3939

  • trunk/gsdl/perllib/mgbuilder.pm

    r8361 r8716  
    4545}
    4646
    47 $maxdocsize = 12000;
    48 
    49 %wanted_index_files = ('td'=>1,
     47my $maxdocsize = 12000;
     48
     49my %wanted_index_files = ('td'=>1,
    5050               't'=>1,
    5151               'idb'=>1,
    … …  
    101101    my $indexes = $self->{'collect_cfg'}->{'indexes'};
    102102    $self->{'collect_cfg'}->{'indexes'} = [];
    103     foreach $subcollection (@{$self->{'collect_cfg'}->{'indexsubcollections'}}) {
    104         foreach $index (@$indexes) {
     103    foreach my $subcollection (@{$self->{'collect_cfg'}->{'indexsubcollections'}}) {
     104        foreach my $index (@$indexes) {
    105105        push (@{$self->{'collect_cfg'}->{'indexes'}}, "$index:$subcollection");
    106106        }
    … …  
    112112    my $indexes = $self->{'collect_cfg'}->{'indexes'};
    113113    $self->{'collect_cfg'}->{'indexes'} = [];
    114     foreach $language (@{$self->{'collect_cfg'}->{'languages'}}) {
    115         foreach $index (@$indexes) {
     114    foreach my $language (@{$self->{'collect_cfg'}->{'languages'}}) {
     115        foreach my $index (@$indexes) {
    116116        if (defined ($self->{'collect_cfg'}->{'indexsubcollections'})) {
    117117            push (@{$self->{'collect_cfg'}->{'indexes'}}, "$index:$language");
    … …  
    176176    $self->{'dontgdbm'} = {};
    177177    if (defined ($self->{'collect_cfg'}->{'dontgdbm'})) {
    178     foreach $dg (@{$self->{'collect_cfg'}->{'dontgdbm'}}) {
     178    foreach my $dg (@{$self->{'collect_cfg'}->{'dontgdbm'}}) {
    179179        $self->{'dontgdbm'}->{$dg} = 1;
    180180    }
    … …  
    329329
    330330    if (defined ($self->{'collect_cfg'}->{'dontbuild'})) {
    331     foreach $checkstr (@{$self->{'collect_cfg'}->{'dontbuild'}}) {
     331    foreach my $checkstr (@{$self->{'collect_cfg'}->{'dontbuild'}}) {
    332332        if ($index =~ /^$checkstr$/) {
    333333        #push (@{$self->{'notbuilt'}}, $self->{'index_mapping'}->{$index});
    … …  
    358358
    359359    # build each of the indexes
    360     foreach $index (@$indexes) {
     360    foreach my $index (@$indexes) {
    361361    if ($self->want_built($index)) {
    362362        print $outhandle "\n*** building index $index in subdirectory " .
    … …  
    384384    my %dirnames = ('text'=>'text',
    385385            'extra'=>'extra');
    386     my %pnames = ('index' => '', 'subcollection' => '', 'languages' => '');
    387 
    388     foreach $index (@$indexes) {
     386    my %pnames = ('index' => {}, 'subcollection' => {}, 'languages' => {});
     387
     388    foreach my $index (@$indexes) {
    389389    my ($level, $gran, $subcollection, $languages) = split (":", $index);
    390390
    … …  
    434434    }
    435435    $dirnames{$dirname} = $index;
    436     $pnames{'index'}{$pindex} = "$level:$gran";
    437     $pnames{'subcollection'}{$psub} = $subcollection;
    438     $pnames{'languages'}{$plang} = $languages;
     436    $pnames{'index'}->{$pindex} = "$level:$gran";
     437    $pnames{'subcollection'}->{$psub} = $subcollection;
     438    $pnames{'languages'}->{$plang} = $languages;
    439439    }
    440440
    … …  
    554554    @subcollections = split /,/, $subcollection if (defined $subcollection);
    555555
    556     foreach $subcollection (@subcollections) {
     556    foreach my $subcollection (@subcollections) {
    557557    if (defined ($self->{'collect_cfg'}->{'subcollection'}->{$subcollection})) {
    558558        push (@$indexexparr, $self->{'collect_cfg'}->{'subcollection'}->{$subcollection});
    … …  
    569569    my @languages = ();
    570570    @languages = split /,/, $language if (defined $language);
    571     foreach $language (@languages) {
     571    foreach my $language (@languages) {
    572572    my $not=0;
    573573    if ($language =~ s/^\!//) {
    … …  
    683683    opendir (DIR, $tmpdir) || die
    684684        "mgbuilder::build_index - couldn't read directory $tmpdir\n";
    685     foreach $file (readdir(DIR)) {
     685    foreach my $file (readdir(DIR)) {
    686686        next if $file =~ /^\./;
    687687        my ($suffix) = $file =~ /\.([^\.]+)$/;
    … …  
    753753    print $handle "[collection]\n";
    754754     
    755     foreach $cmeta (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}})) {
     755    foreach my $cmeta (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}})) {
    756756        my $defaultfound=0;
    757757        my $first=1;
    … …  
    773773        }
    774774        #iterate through the languages
    775         foreach $lang (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}->{$cmeta}})) {
     775        foreach my $lang (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}->{$cmeta}})) {
    776776        if ($first) {
    777777            $first=0;
    … …  
    842842    my $self = shift (@_);
    843843    my ($index);
    844     my %build_cfg = ();
     844    my $build_cfg = {};
    845845    my $outhandle = $self->{'outhandle'};
    846846
    … …  
    880880    # the index map is used to determine what indexes there are, so any that are not built should not be put into the map.
    881881    my @indexmap = ();
    882     foreach $index (@{$self->{'index_mapping'}->{'indexmaporder'}}) {
     882    foreach my $index (@{$self->{'index_mapping'}->{'indexmaporder'}}) {
    883883    if (not defined ($self->{'notbuilt'}->{$index})) {
    884884        push (@indexmap, "$index\-\>$self->{'index_mapping'}->{'indexmap'}->{$index}");
    … …  
    888888
    889889    my @subcollectionmap = ();
    890     foreach $subcollection (@{$self->{'index_mapping'}->{'subcollectionmaporder'}}) {
     890    foreach my $subcollection (@{$self->{'index_mapping'}->{'subcollectionmaporder'}}) {
    891891    push (@subcollectionmap, "$subcollection\-\>" .
    892892          $self->{'index_mapping'}->{'subcollectionmap'}->{$subcollection});
    … …  
    895895
    896896    my @languagemap = ();
    897     foreach $language (@{$self->{'index_mapping'}->{'languagemaporder'}}) {
     897    foreach my $language (@{$self->{'index_mapping'}->{'languagemaporder'}}) {
    898898    push (@languagemap, "$language\-\>" .
    899899          $self->{'index_mapping'}->{'languagemap'}->{$language});
    … …  
    903903    #$build_cfg->{'notbuilt'} = $self->{'notbuilt'} if scalar @{$self->{'notbuilt'}};
    904904    my @notbuilt = ();
    905     foreach $nb (keys %{$self->{'notbuilt'}}) {
     905    foreach my $nb (keys %{$self->{'notbuilt'}}) {
    906906    push (@notbuilt, $nb);
    907907    }

  • trunk/gsdl/perllib/mgbuildproc.pm

    r8402 r8716  
    3838
    3939BEGIN {
    40     @ISA = ('docproc');
     40    @mgbuildproc::ISA = ('docproc');
    4141}
    4242
    … …  
    515515            } else {
    516516            my $first = 1;
    517             foreach $meta (@{$doc_obj->get_metadata ($section, $real_field)}) {
     517            foreach my $meta (@{$doc_obj->get_metadata ($section, $real_field)}) {
    518518                $meta =~ s/[\cB\cC]//g;
    519519                $self->{'num_processed_bytes'} += length ($meta);

  • trunk/gsdl/perllib/mgppbuilder.pm

    r8361 r8716  
    4646}
    4747
    48 $maxdocsize = 12000;
    49 
    50 %level_map = ('document'=>'Doc',
     48my $maxdocsize = 12000;
     49
     50my %level_map = ('document'=>'Doc',
    5151          'section'=>'Sec',
    5252          'paragraph'=>'Para',
    … …  
    5959#$para_level = "Para";
    6060
    61 %wanted_index_files = ('td'=>1,
     61my %wanted_index_files = ('td'=>1,
    6262               't'=>1,
    6363               'tl'=>1,
    … …  
    7575#add AND, OR, NOT NEAR to this list - these cannot be used as field names
    7676#also add the level names (Doc, Sec, Para)
    77 %static_indexfield_map = ('Title'=>'TI',
     77my %static_indexfield_map = ('Title'=>'TI',
    7878              'TI'=>1,
    7979              'Subject'=>'SU',
    … …  
    112112    my ($collection, $source_dir, $build_dir, $verbosity,
    113113    $maxdocs, $debug, $keepold, $remove_empty_classifications,
    114     $outhandle, $no_text, $gli) = @_;
     114    $outhandle, $no_text, $failhandle, $gli) = @_;
    115115
    116116    $outhandle = STDERR unless defined $outhandle;
    … …  
    153153    my $indexes = $self->{'collect_cfg'}->{'indexes'};
    154154    $self->{'collect_cfg'}->{'indexes'} = [];
    155     foreach $subcollection (@{$self->{'collect_cfg'}->{'indexsubcollections'}}) {
    156         foreach $index (@$indexes) {
     155    foreach my $subcollection (@{$self->{'collect_cfg'}->{'indexsubcollections'}}) {
     156        foreach my $index (@$indexes) {
    157157        push (@{$self->{'collect_cfg'}->{'indexes'}}, "$index:$subcollection");
    158158        }
    … …  
    164164    my $indexes = $self->{'collect_cfg'}->{'indexes'};
    165165    $self->{'collect_cfg'}->{'indexes'} = [];
    166     foreach $language (@{$self->{'collect_cfg'}->{'languages'}}) {
    167         foreach $index (@$indexes) {
     166    foreach my $language (@{$self->{'collect_cfg'}->{'languages'}}) {
     167        foreach my $index (@$indexes) {
    168168        if (defined ($self->{'collect_cfg'}->{'indexsubcollections'})) {
    169169            push (@{$self->{'collect_cfg'}->{'indexes'}}, "$index:$language");
    … …  
    193193    $self->{'levelorder'} = ();
    194194    if (defined $self->{'collect_cfg'}->{'levels'}) {
    195         foreach $level ( @{$self->{'collect_cfg'}->{'levels'}} ){
     195        foreach my $level ( @{$self->{'collect_cfg'}->{'levels'}} ){
    196196        $level =~ tr/A-Z/a-z/;
    197197            $self->{'levels'}->{$level} = 1;
    … …  
    244244    $self->{'dontgdbm'} = {};
    245245    if (defined ($self->{'collect_cfg'}->{'dontgdbm'})) {
    246     foreach $dg (@{$self->{'collect_cfg'}->{'dontgdbm'}}) {
     246    foreach my $dg (@{$self->{'collect_cfg'}->{'dontgdbm'}}) {
    247247        $self->{'dontgdbm'}->{$dg} = 1;
    248248    }
    … …  
    324324    my ($doc_level) = $self->{'doc_level'};
    325325    $mgpp_passes_sections .= "-J " . $level_map{$doc_level} . " ";
    326     foreach $level (keys %{$self->{'levels'}}) {
     326    foreach my $level (keys %{$self->{'levels'}}) {
    327327    if ($level ne $doc_level && $level ne "paragraph") {
    328328        $mgpp_passes_sections .= "-K " . $level_map{$level} . " ";
    … …  
    419419
    420420    if (defined ($self->{'collect_cfg'}->{'dontbuild'})) {
    421     foreach $checkstr (@{$self->{'collect_cfg'}->{'dontbuild'}}) {
     421    foreach my $checkstr (@{$self->{'collect_cfg'}->{'dontbuild'}}) {
    422422        if ($index =~ /^$checkstr$/) {
    423423        #push (@{$self->{'notbuilt'}}, $self->{'index_mapping'}->{$index});
    … …  
    448448
    449449    # build each of the indexes
    450     foreach $index (@$indexes) {
     450    foreach my $index (@$indexes) {
    451451    if ($self->want_built($index)) {
    452452        print $outhandle "\n*** building index $index in subdirectory " .
    … …  
    479479    my %dirnames = ('text'=>'text',
    480480            'extra'=>'extra');
    481     my %pnames = ('index' => '', 'subcollection' => '', 'languages' => '');
    482 
    483     foreach $index (@$indexes) {
     481    my %pnames = ('index' => {}, 'subcollection' => {}, 'languages' => {});
     482
     483    foreach my $index (@$indexes) {
    484484    my ($fields, $subcollection, $languages) = split (":", $index);
    485485    # the directory name starts with a processed version of index fields
    … …  
    487487    #$pindex = lc ($pindex);
    488488    # now we only ever have one index, and its called 'idx'
    489     $pindex = 'idx';
     489    my $pindex = 'idx';
    490490   
    491491    # next comes a processed version of the subcollection if there is one.
    … …  
    528528    }
    529529    $dirnames{$dirname} = $index;
    530     $pnames{'index'}{$pindex} = "$fields";
    531     $pnames{'subcollection'}{$psub} = $subcollection;
    532     $pnames{'languages'}{$plang} = $languages;
     530    $pnames{'index'}->{$pindex} = "$fields";
     531    $pnames{'subcollection'}->{$psub} = $subcollection;
     532    $pnames{'languages'}->{$plang} = $languages;
    533533    }
    534534
    … …  
    577577    my $self = shift (@_);
    578578    my ($nameref) = @_;
    579 
     579    my $num=0;
    580580    if ($$nameref =~ /(\d\d)$/) {
    581     my $num = $1; $num ++;
     581    $num = $1; $num ++;
    582582    $$nameref =~ s/\d\d$/$num/;
    583583    } elsif ($$nameref =~ /(\d)$/) {
    584     my $num = $1;
     584    $num = $1;
    585585    if ($num == 9) {$$nameref =~ s/\d\d$/10/;}
    586586    else {$num ++; $$nameref =~ s/\d$/$num/;}
    … …  
    616616    $mgpp_passes_sections .= "-J " . $level_map{$doc_level} ." ";
    617617   
    618     foreach $level (keys %{$self->{'levels'}}) {
     618    foreach my $level (keys %{$self->{'levels'}}) {
    619619    if ($level ne $doc_level) {
    620620        $mgpp_passes_sections .= "-K " . $level_map{$level}. " ";
    … …  
    779779    opendir (DIR, $tmpdir) || die
    780780        "mgppbuilder::build_index - couldn't read directory $tmpdir\n";
    781     foreach $file (readdir(DIR)) {
     781    foreach my $file (readdir(DIR)) {
    782782        next if $file =~ /^\./;
    783783        my ($suffix) = $file =~ /\.([^\.]+)$/;
    … …  
    854854    if (defined $self->{'collect_cfg'}->{'collectionmeta'}) {
    855855    $collmetadefined = 1;
    856     foreach $cmeta (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}})) {
     856    foreach my $cmeta (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}})) {
    857857        next if ($cmeta =~ /^\./); # for now, ignore ones with dots
    858858        my ($metadata_entry) = $self->create_language_db_map($cmeta, $cmeta);
    … …  
    866866    #    <SU>Subject
    867867    # these now come from collection meta. if that is not defined, usses the metadata name
    868     $field_entry="";
    869     foreach $longfield (@{$self->{'build_cfg'}->{'indexfields'}}){
    870     $shortfield = $self->{'buildproc'}->{'indexfieldmap'}->{$longfield};
     868    my $field_entry="";
     869    my $collmeta = "";
     870    foreach my $longfield (@{$self->{'build_cfg'}->{'indexfields'}}){
     871    my $shortfield = $self->{'buildproc'}->{'indexfieldmap'}->{$longfield};
    871872    next if $shortfield eq 1;
    872873   
    873874    # we need to check if some coll meta has been defined
    874     my $collmeta = ".$longfield";
     875    $collmeta = ".$longfield";
    875876    if ($collmetadefined && defined $self->{'collect_cfg'}->{'collectionmeta'}->{$collmeta}) {
    876         $metadata_entry = $self->create_language_db_map($collmeta, $shortfield);
     877        my $metadata_entry = $self->create_language_db_map($collmeta, $shortfield);
    877878        $field_entry .= $metadata_entry;
    878879    } else { #use the metadata names, or the text macros for allfields and textonly
    … …  
    889890   
    890891    # now add the level names
    891     $level_entry = "";
    892     foreach $level (@{$self->{'collect_cfg'}->{'levels'}}) {
    893     my $collmeta = ".$level"; # based on the original specification
     892    my $level_entry = "";
     893    foreach my $level (@{$self->{'collect_cfg'}->{'levels'}}) {
     894    $collmeta = ".$level"; # based on the original specification
    894895    $level =~ tr/A-Z/a-z/; # make it lower case
    895896    my $levelid = $level_map{$level}; # find the actual value we used in the index
    896897    if ($collmetadefined && defined $self->{'collect_cfg'}->{'collectionmeta'}->{$collmeta}) {
    897         $metadata_entry = $self->create_language_db_map($collmeta, $levelid);
     898        my $metadata_entry = $self->create_language_db_map($collmeta, $levelid);
    898899        $level_entry .= $metadata_entry;
    899900    } else {
    … …  
    905906   
    906907    # now add subcoll meta
    907     $subcoll_entry = "";
    908     foreach $subcoll (@{$self->{'index_mapping'}->{'subcollectionmaporder'}}) {
     908    my $subcoll_entry = "";
     909    my $shortname = "";
     910    my $one_entry = "";
     911    foreach my $subcoll (@{$self->{'index_mapping'}->{'subcollectionmaporder'}}) {
    909912    if (defined $self->{'collect_cfg'}->{'collectionmeta'}->{".$subcoll"}) {
    910         my $shortname = $self->{'index_mapping'}->{$subcoll};
     913        $shortname = $self->{'index_mapping'}->{$subcoll};
    911914        $one_entry = $self->create_language_db_map(".$subcoll", $shortname);
    912915        $subcoll_entry .= $one_entry;
    … …  
    917920    print $handle $subcoll_entry;
    918921     # now add language meta
    919     $lang_entry = "";
    920     foreach $lang (@{$self->{'index_mapping'}->{'languagemaporder'}}) {
     922    my $lang_entry = "";
     923    foreach my $lang (@{$self->{'index_mapping'}->{'languagemaporder'}}) {
    921924    if (defined $self->{'collect_cfg'}->{'collectionmeta'}->{".$lang"}) {
    922         my $shortname = $self->{'index_mapping'}->{$lang};
     925        $shortname = $self->{'index_mapping'}->{$lang};
    923926        $one_entry = $self->create_language_db_map(".$lang", $shortname);
    924927        $lang_entry .= $one_entry;
    … …  
    965968    my $default="";
    966969    #iterate through the languages
    967     foreach $lang (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}->{$metaname}})) {
     970    foreach my $lang (keys (%{$self->{'collect_cfg'}->{'collectionmeta'}->{$metaname}})) {
    968971    if ($first) {
    969972        $first=0;
    … …  
    10161019    my @specifiedfieldorder = ();
    10171020    # go through the index definition and add each thing to a map, so we can easily check if it is already specified - when doing the metadata, we print out all the individual fields, but some may already be specified in the index definition, so we dont want to add those again.
    1018     foreach $field (@{$self->{'collect_cfg'}->{'indexes'}}) {
     1021    foreach my $field (@{$self->{'collect_cfg'}->{'indexes'}}) {
    10191022    # remove subcoll stuff
    10201023    my $parts = $field;
    10211024    $parts =~ s/:.*$//;
    10221025    my @fs = split(',', $parts);
    1023     foreach $f(@fs) {
     1026    foreach my $f(@fs) {
    10241027        if (!defined $specifiedfields->{$f}) {
    10251028        $specifiedfields->{$f}=1;
    … …  
    10301033   
    10311034    #add all fields bit
    1032     foreach $field (@specifiedfieldorder) {
     1035    foreach my $field (@specifiedfieldorder) {
    10331036    if ($field eq "metadata") {
    1034         foreach $newfield (keys %{$self->{'buildproc'}->{'indexfields'}}) {
     1037        foreach my $newfield (keys %{$self->{'buildproc'}->{'indexfields'}}) {
    10351038        if (!defined $specifiedfields->{$newfield}) {
    10361039            push (@indexfieldmap, "$newfield\-\>$self->{'buildproc'}->{'indexfieldmap'}->{$newfield}");
    … …  
    10701073    }
    10711074    # we read the stuff in from the build.cfg file - if its there
    1072     $buildconfigfile = &util::filename_cat($self->{'build_dir'}, "build.cfg");
     1075    my $buildconfigfile = &util::filename_cat($self->{'build_dir'}, "build.cfg");
    10731076   
    10741077    if (!-e $buildconfigfile) {
    … …  
    10801083    }
    10811084    }
    1082     $buildcfg = &colcfg::read_build_cfg( $buildconfigfile);
     1085    my $buildcfg = &colcfg::read_build_cfg( $buildconfigfile);
    10831086    if (defined $buildcfg->{'indexfields'}) {
    1084     foreach $field (@{$buildcfg->{'indexfields'}}) {
     1087    foreach my $field (@{$buildcfg->{'indexfields'}}) {
    10851088        push (@indexfields, "$field");
    10861089    }
    10871090    }
    10881091    if (defined $buildcfg->{'indexfieldmap'}) {
    1089     foreach $field (@{$buildcfg->{'indexfieldmap'}}) {
     1092    foreach my $field (@{$buildcfg->{'indexfieldmap'}}) {
    10901093        push (@indexfieldmap, "$field");
    1091         ($f, $v) = $field =~ /^(.*)\-\>(.*)$/;
     1094        my ($f, $v) = $field =~ /^(.*)\-\>(.*)$/;
    10921095        $self->{'buildproc'}->{'indexfieldmap'}->{$f} = $v;
    10931096    }
    … …  
    11221125    # store the level info
    11231126    my @indexlevels = ();
    1124     foreach $l (@{$self->{'levelorder'}}) {
     1127    foreach my $l (@{$self->{'levelorder'}}) {
    11251128    push (@indexlevels, $level_map{$l});
    11261129    }
    … …  
    11381141    # store the mapping between the index names and the directory names
    11391142    my @indexmap = ();
    1140     foreach $index (@{$self->{'index_mapping'}->{'indexmaporder'}}) {
     1143    foreach my $index (@{$self->{'index_mapping'}->{'indexmaporder'}}) {
    11411144    if (not defined ($self->{'notbuilt'}->{$index})) {
    11421145        push (@indexmap, "$index\-\>$self->{'index_mapping'}->{'indexmap'}->{$index}");
    … …  
    11461149
    11471150    my @subcollectionmap = ();
    1148     foreach $subcollection (@{$self->{'index_mapping'}->{'subcollectionmaporder'}}) {
     1151    foreach my $subcollection (@{$self->{'index_mapping'}->{'subcollectionmaporder'}}) {
    11491152    push (@subcollectionmap, "$subcollection\-\>" .
    11501153          $self->{'index_mapping'}->{'subcollectionmap'}->{$subcollection});
    … …  
    11531156
    11541157    my @languagemap = ();
    1155     foreach $language (@{$self->{'index_mapping'}->{'languagemaporder'}}) {
     1158    foreach my $language (@{$self->{'index_mapping'}->{'languagemaporder'}}) {
    11561159    push (@languagemap, "$language\-\>" .
    11571160          $self->{'index_mapping'}->{'languagemap'}->{$language});
    … …  
    11611164    #$build_cfg->{'notbuilt'} = $self->{'notbuilt'};
    11621165    my @notbuilt = ();
    1163     foreach $nb (keys %{$self->{'notbuilt'}}) {
     1166    foreach my $nb (keys %{$self->{'notbuilt'}}) {
    11641167    push (@notbuilt, $nb);
    11651168    }

  • trunk/gsdl/perllib/mgppbuildproc.pm

    r8402 r8716  
    3939
    4040BEGIN {
    41     @ISA = ('docproc');
     41    @mgppbuildproc::ISA = ('docproc');
    4242}
    4343
    4444#this must be the same as in mgppbuilder
    45 %level_map = ('document'=>'Doc',
     45my %level_map = ('document'=>'Doc',
    4646          'section'=>'Sec',
    4747          'paragraph'=>'Para');
    … …  
    418418        print $handle "<contains>";
    419419        my $firstchild = 1;
    420         foreach $child (@$children) {
     420        foreach my $child (@$children) {
    421421            print $handle ";" unless $firstchild;
    422422            $firstchild = 0;
    … …  
    485485    while ($text =~ /<([^>]*)>/ && $text ne "") {
    486486       
    487         $tag = $1;
     487        my $tag = $1;
    488488        $outtext .= $`." "; #add everything before the matched tag
    489489        $text = $'; #everything after the matched tag
    … …  
    632632                my $shortname = "";
    633633                my $metadata = $doc_obj->get_all_metadata ($section);
    634                 foreach $pair (@$metadata) {
     634                foreach my $pair (@$metadata) {
    635635                my ($mfield, $mvalue) = (@$pair);
    636636                # check fields here, maybe others dont want - change to use dontindex!!
    … …  
    670670                $self->{'indexfieldmap'}->{$shortname} = 1;
    671671                }
    672                 foreach $item (@{$doc_obj->get_metadata ($section, $real_field)}) {
     672                foreach my $item (@{$doc_obj->get_metadata ($section, $real_field)}) {
    673673                $new_text .= "$paratag<$shortname>$item</$shortname>\n";
    674674                }
    … …  
    695695#now ignores non-letdig characters
    696696sub create_shortname {
    697     $self = shift(@_);
     697    my $self = shift(@_);
    698698   
    699699    my ($realname) = @_;
    … …  
    710710
    711711    #if already used, take the first and third letdigs and so on
    712     $count = 1;
     712    my $count = 1;
    713713    while (defined $self->{'indexfieldmap'}->{$shortname}) {
    714714    if ($realname =~ /^[^\w]*(\w)([^\w]*\w){$count}[^\w]*(\w)/) {

  • trunk/gsdl/perllib/parsargv.pm

    r2359 r8716  
    6666
    6767 
    68  sub parse
     68sub parse
    6969{
    7070    my $arglist = shift;
    … …  
    9595     
    9696    die "Variable for $spec is not a valid type."
    97         unless ref($var) eq 'SCALAR' || ref($var) eq 'ARRAY';
     97        unless ref($var) eq 'SCALAR' || ref($var) eq 'ARRAY'
     98        || (ref($var) eq 'REF' && ref($$var) eq 'GLOB');
    9899
    99100    my $delimiter;

  • trunk/gsdl/perllib/plugins/ArcPlug.pm

    r6408 r8716  
    3939
    4040BEGIN {
    41     @ISA = ('BasPlug');
     41    @ArcPlug::ISA = ('BasPlug');
    4242}
    4343

  • trunk/gsdl/perllib/plugins/BasPlug.pm

    r8678 r8716  
    143143sub get_arguments
    144144{
    145     local $self = shift(@_);
    146     local $optionlistref = $self->{'option_list'};
    147     local @optionlist = @$optionlistref;
    148     local $pluginoptions = pop(@$optionlistref);
    149     local $pluginarguments = $pluginoptions->{'args'};
     145    my $self = shift(@_);
     146    my $optionlistref = $self->{'option_list'};
     147    my @optionlist = @$optionlistref;
     148    my $pluginoptions = pop(@$optionlistref);
     149    my $pluginarguments = $pluginoptions->{'args'};
    150150    return $pluginarguments;
    151151}
    … …  
    154154sub print_xml_usage
    155155{
    156     local $self = shift(@_);
     156    my $self = shift(@_);
    157157
    158158    # XML output is always in UTF-8
    … …  
    166166sub print_xml
    167167{
    168     local $self = shift(@_);
    169 
    170     local $optionlistref = $self->{'option_list'};
    171     local @optionlist = @$optionlistref;
    172     local $pluginoptions = pop(@$optionlistref);
     168    my $self = shift(@_);
     169
     170    my $optionlistref = $self->{'option_list'};
     171    my @optionlist = @$optionlistref;
     172    my $pluginoptions = pop(@$optionlistref);
    173173    return if (!defined($pluginoptions));
    174174
    … …  
    197197sub print_txt_usage
    198198{
    199     local $self = shift(@_);
     199    my $self = shift(@_);
    200200
    201201    # Print the usage message for a plugin (recursively)
    202     local $descoffset = $self->determine_description_offset(0);
     202    my $descoffset = $self->determine_description_offset(0);
    203203    $self->print_plugin_usage($descoffset, 1);
    204204}
    … …  
    207207sub determine_description_offset
    208208{
    209     local $self = shift(@_);
    210     local $maxoffset = shift(@_);
    211 
    212     local $optionlistref = $self->{'option_list'};
    213     local @optionlist = @$optionlistref;
    214     local $pluginoptions = pop(@$optionlistref);
     209    my $self = shift(@_);
     210    my $maxoffset = shift(@_);
     211
     212    my $optionlistref = $self->{'option_list'};
     213    my @optionlist = @$optionlistref;
     214    my $pluginoptions = pop(@$optionlistref);
    215215    return $maxoffset if (!defined($pluginoptions));
    216216
    217217    # Find the length of the longest option string of this plugin
    218     local $pluginargs = $pluginoptions->{'args'};
     218    my $pluginargs = $pluginoptions->{'args'};
    219219    if (defined($pluginargs)) {
    220     local $longest = &PrintUsage::find_longest_option_string($pluginargs);
     220    my $longest = &PrintUsage::find_longest_option_string($pluginargs);
    221221    if ($longest > $maxoffset) {
    222222        $maxoffset = $longest;
    … …  
    233233sub print_plugin_usage
    234234{
    235     local $self = shift(@_);
    236     local $descoffset = shift(@_);
    237     local $isleafclass = shift(@_);
    238 
    239     local $optionlistref = $self->{'option_list'};
    240     local @optionlist = @$optionlistref;
    241     local $pluginoptions = pop(@$optionlistref);
     235    my $self = shift(@_);
     236    my $descoffset = shift(@_);
     237    my $isleafclass = shift(@_);
     238
     239    my $optionlistref = $self->{'option_list'};
     240    my @optionlist = @$optionlistref;
     241    my $pluginoptions = pop(@$optionlistref);
    242242    return if (!defined($pluginoptions));
    243243
    244     local $pluginname = $pluginoptions->{'name'};
    245     local $pluginargs = $pluginoptions->{'args'};
    246     local $plugindesc = $pluginoptions->{'desc'};
     244    my $pluginname = $pluginoptions->{'name'};
     245    my $pluginargs = $pluginoptions->{'args'};
     246    my $plugindesc = $pluginoptions->{'desc'};
    247247
    248248    # Produce the usage information using the data structure above
    … …  
    257257    if (defined($pluginargs)) {
    258258    # Calculate the column offset of the option descriptions
    259     local $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
     259    my $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
    260260
    261261    if ($isleafclass) {
    … …  
    486486
    487487    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
    488 
     488   
    489489    # do plugin specific processing of doc_obj
    490     return -1  unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli));
    491    
     490    unless (defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli))) {
     491    $text = '';
     492    undef $text;
     493    return -1;
     494    }
     495    $text='';
     496    undef $text;
     497
    492498    # do any automatic metadata extraction
    493499    $self->auto_extract_metadata ($doc_obj);
    … …  
    495501    # add an OID
    496502    # see if there is a plugin-specific set_OID function...
    497     if (defined ($self->can(set_OID))) {
     503    if (defined ($self->can('set_OID'))) {
    498504    # it will need $doc_obj to set the Identifier metadata...
    499505    $self->set_OID($doc_obj);
    … …  
    507513
    508514    $self->{'num_processed'} ++;
    509 
     515    undef $doc_obj;
    510516    return 1; # processed the file
    511517}

  • trunk/gsdl/perllib/plugins/GAPlug.pm

    r7900 r8716  
    2929# to their DTD.
    3030
    31 # 12/05/02 Added usage datastructure - John Thompson
    32 
    3331package GAPlug;
    3432
    … …  
    3634
    3735sub BEGIN {
    38     @ISA = ('XMLPlug');
     36    @GAPlug::ISA = ('XMLPlug');
    3937}
    4038

  • trunk/gsdl/perllib/plugins/HTMLPlug.pm

    r8668 r8716  
    4545
    4646sub BEGIN {
    47     @ISA = ('BasPlug');
     47    @HTMLPlug::ISA = ('BasPlug');
    4848}
    4949

  • trunk/gsdl/perllib/plugins/OAIPlug.pm

    r8684 r8716  
    3333
    3434sub BEGIN {
    35     @ISA = ('BasPlug');
     35    @OAIPlug::ISA = ('BasPlug');
    3636}
    3737

  • trunk/gsdl/perllib/plugins/PDFPlug.pm

    r8278 r8716  
    3131use unicode;
    3232
     33sub BEGIN {
    3334@PDFPlug::ISA = ('ConvertToPlug');
     35}
    3436
    3537my $arguments =

  • trunk/gsdl/perllib/plugins/RecPlug.pm

    r8512 r8716  
    100100
    101101BEGIN {
    102     @ISA = ('BasPlug');
     102    @RecPlug::ISA = ('BasPlug');
    103103    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
    104104}
    … …  
    238238
    239239    # Re-order the files in the list so any directories ending with .all are moved to the end
    240     for ($i = scalar(@dir) - 1; $i >= 0; $i--) {
     240    for (my $i = scalar(@dir) - 1; $i >= 0; $i--) {
    241241    if (-d &util::filename_cat($dirname, $dir[$i]) && $dir[$i] =~ /\.all$/) {
    242242        push(@dir, splice(@dir, $i, 1));
    … …  
    302302
    303303        # Any new files are added to the end of @dir to get processed by the loop
     304        my $j;
    304305        foreach my $subfilenow (@dirnow) {
    305306        for ($j = 0; $j < $num_files; $j++) {

  • trunk/gsdl/perllib/plugins/SplitPlug.pm

    r8121 r8716  
    4141
    4242use BasPlug;
    43 # SplitPlug is a sub-class of BasPlug.
    44 @SplitPlug::ISA = ('BasPlug');
    4543use gsprintf 'gsprintf';
    4644use util;
    4745
     46# SplitPlug is a sub-class of BasPlug.
     47sub BEGIN {
     48@SplitPlug::ISA = ('BasPlug');
     49}
    4850
    4951

  • trunk/gsdl/perllib/plugins/UnknownPlug.pm

    r8519 r8716  
    6161
    6262sub BEGIN {
    63     @ISA = ('BasPlug');
     63    @UnknownPlug::ISA = ('BasPlug');
    6464}
    6565

  • trunk/gsdl/perllib/plugins/XMLPlug.pm

    r8121 r8716  
    3030
    3131sub BEGIN {
    32     @ISA = ('BasPlug');
     32    @XMLPlug::ISA = ('BasPlug');
    3333    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
    3434}
    … …  
    232232sub close_document {
    233233    my $self = shift(@_);
    234 
     234    my $doc_obj = $self->{'doc_obj'};
    235235    # include any metadata passed in from previous plugins
    236236    # note that this metadata is associated with the top level section
    237     $self->extra_metadata ($self->{'doc_obj'},
    238                $self->{'doc_obj'}->get_top_section(),
     237    $self->extra_metadata ($doc_obj,
     238               $doc_obj->get_top_section(),
    239239               $self->{'metadata'});
    240240   
    241241    # do any automatic metadata extraction
    242     $self->auto_extract_metadata ($self->{'doc_obj'});
     242    $self->auto_extract_metadata ($doc_obj);
    243243   
    244244    # add an OID
    245     $self->{'doc_obj'}->set_OID();
     245    $doc_obj->set_OID();
    246246   
    247247    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
    … …  
    249249
    250250    # process the document
    251     $self->{'processor'}->process($self->{'doc_obj'});
     251    $self->{'processor'}->process($doc_obj);
    252252   
    253253    $self->{'num_processed'} ++;

  • trunk/gsdl/perllib/printusage.pm

    r7023 r8716  
    8282    my $options = shift(@_);
    8383
    84     foreach $option (@$options) {
     84    foreach my $option (@$options) {
    8585    my $optionname = $option->{'name'};
    8686    my $optiondesc = &gsprintf::lookup_string($option->{'desc'});
    … …  
    110110        &gsprintf(STDERR, "      <List>\n");
    111111        my $optionvalueslist = $option->{'list'};
    112         foreach $optionvalue (@$optionvalueslist) {
     112        foreach my $optionvalue (@$optionvalueslist) {
    113113        &gsprintf(STDERR, "        <Value>\n");
    114114        &gsprintf(STDERR, "          <Name>$optionvalue->{'name'}</Name>\n");
    … …  
    128128        if ($optionname =~ m/^input_encoding$/i) {
    129129        my $e = $encodings::encodings;
    130         foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
     130        foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    131131            &gsprintf(STDERR, "        <Value>\n");
    132132            &gsprintf(STDERR, "          <Name>$enc</Name>\n");
    … …  
    203203    my $optiondescoffset = shift(@_);
    204204
    205     foreach $option (@$options) {
     205    foreach my $option (@$options) {
    206206    # Display option name
    207207    my $optionname = $option->{'name'};
    … …  
    235235    if (defined($optionvalueslist)) {
    236236        &gsprintf(STDERR, "\n");
    237         foreach $optionvalue (@$optionvalueslist) {
     237        foreach my $optionvalue (@$optionvalueslist) {
    238238        my $optionvaluename = $optionvalue->{'name'};
    239239        &gsprintf(STDERR, " " x $optiondescoffset);
    … …  
    249249    if ($optionname =~ m/^input_encoding$/i) {
    250250        my $e = $encodings::encodings;
    251         foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
     251        foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
    252252        &gsprintf(STDERR, " " x $optiondescoffset);
    253253        &gsprintf(STDERR, "$enc:");
    … …  
    284284    my @words = split(/ /, $text);
    285285
    286     foreach $word (@words) {
     286    foreach my $word (@words) {
    287287    # If printing this word would exceed the column end, start a new line
    288288    if (($linelength + length($word)) >= $columnend) {
    … …  
    306306
    307307    my $maxlength = 0;
    308     foreach $option (@$options) {
     308    foreach my $option (@$options) {
    309309    my $optionname = $option->{'name'};
    310310    my $optiontype = $option->{'type'};

  • trunk/gsdl/perllib/remproc.pm

    r537 r8716  
    3131
    3232BEGIN {
    33     @ISA = ('docproc');
     33    @remproc::ISA = ('docproc');
    3434}
    3535

  • trunk/gsdl/perllib/strings.rb

    r8679 r8716  
    405405DateList.metadata:The metadata that contains the dates to classify by. The format is expected to be yyyymmdd.
    406406
    407 DateList.newest_first:Sort the documents in reverse chronological order (newest first).
     407DateList.reverse_sort:Sort the documents in reverse chronological order (newest first).
    408408
    409409DateList.nogroup:Make each year an individual entry in the horizontal list, instead of spanning years with few entries. (This can also be used with the -bymonth option to make each month a separate entry instead of merging).
    … …  
    419419Hierarchy.metadata:Metadata field used for classification. List will be sorted by this element, unless -sort is used.
    420420
     421Hierarchy.reverse_sort:Sort leaf nodes in reverse order (use with -sort).
    421422Hierarchy.sort:Metadata field to sort by. Use '-sort nosort' for no sorting.
    422423

  • trunk/gsdl/perllib/unicode.pm

    r8217 r8716  
    9090    my $out = "";
    9191   
    92     foreach $num (@$in) {
     92    foreach my $num (@$in) {
    9393    next unless defined $num;
    9494    if ($num < 0x80) {
    … …  
    120120    my $i = 0;
    121121    my ($c1, $c2, $c3);
    122     $len = length($in);
     122    my $len = length($in);
    123123    while ($i < $len) {
    124124    if (($c1 = ord(substr ($in, $i, 1))) < 0x80) {
    … …  
    171171    my $out = "";
    172172
    173     foreach $num (@$in) {
     173    foreach my $num (@$in) {
    174174    $out .= chr (($num & 0xff00) >> 8);
    175175    $out .= chr ($num & 0xff);
    … …  
    219219    }
    220220
    221     if ($translations{$encodename}->{'count'} == 1) {
     221    if ($unicode::translations{$encodename}->{'count'} == 1) {
    222222    return &singlebyte2unicode ($encodename, $textref);
    223223    } else {
    … …  
    364364    my $low = $from % 256;
    365365
    366     return 0 unless defined $translations{$encoding};
    367 
    368     my $block = $translations{$encoding}->{'map'};
     366    return 0 unless defined $unicode::translations{$encoding};
     367
     368    my $block = $unicode::translations{$encoding}->{'map'};
    369369
    370370    if (ref ($block->[$high]) ne "ARRAY") {
    … …  
    382382# value. This data structure aims to allow fast translation and
    383383# efficient storage.
    384 %translations = ();
     384%unicode::translations = ();
    385385
    386386# @array256 is used for initialisation, there must be
    387387# a better way...
    388388# What about this?: @array256 = (0) x 256;
    389 @array256 = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
     389@unicode::array256 = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    390390         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    391391         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    … …  
    409409   
    410410    # check to see if the encoding has already been loaded
    411     return 1 if (defined $translations{$encoding});
     411    return 1 if (defined $unicode::translations{$encoding});
    412412
    413413    return 0 unless open (MAPFILE, $mapfile);
    414414    binmode (MAPFILE);
    415415
    416     $translations{$encoding} = {'map' => [@array256], 'count' => 0};
    417     my $block = $translations{$encoding};
     416    $unicode::translations{$encoding} = {'map' => [@unicode::array256], 'count' => 0};
     417    my $block = $unicode::translations{$encoding};
    418418
    419419    my ($in,$i,$j);
    420420    while (read(MAPFILE, $in, 1) == 1) {
    421421    $i = unpack ("C", $in);
    422     $block->{'map'}->[$i] = [@array256];
     422    $block->{'map'}->[$i] = [@unicode::array256];
    423423    for ($j=0; $j<256 && read(MAPFILE, $in, 2)==2; $j++) {
    424424        my ($n1, $n2) = unpack ("CC", $in);

  • trunk/gsdl/perllib/util.pm

    r8682 r8716  
    3737    # make sure the files we want to delete exist
    3838    # and are regular files
    39     foreach $file (@files) {
     39    foreach my$file (@files) {
    4040    if (!-e $file) {
    4141        print STDERR "util::rm $file does not exist\n";
    … …  
    6262
    6363    # recursively remove the files
    64     foreach $file (@files) {
     64    foreach my $file (@files) {
    6565    $file =~ s/[\/\\]+$//; # remove trailing slashes
    6666   
    … …  
    112112
    113113    # move the files
    114     foreach $file (@srcfiles) {
     114    foreach my $file (@srcfiles) {
    115115    my $tempdest = $dest;
    116116    if (-d $tempdest) {
    … …  
    147147
    148148    # copy the files
    149     foreach $file (@srcfiles) {
     149    foreach my $file (@srcfiles) {
    150150    my $tempdest = $dest;
    151151    if (-d $tempdest) {
    … …  
    190190
    191191    # copy the files
    192     foreach $file (@srcfiles) {
     192    foreach my $file (@srcfiles) {
    193193
    194194    if (!-e $file) {
    … …  
    209209        my @filedir = readdir (INDIR);
    210210        closedir (INDIR);
    211         foreach $f (@filedir) {
     211        foreach my $f (@filedir) {
    212212            next if $f =~ /^\.\.?$/;
    213213            # copy all the files in this directory
    … …  
    252252    my $dirsofar = "";
    253253    my $first = 1;
    254     foreach $dirname (split ("/", $dir)) {
     254    foreach my $dirname (split ("/", $dir)) {
    255255    $dirsofar .= "/" unless $first;
    256256    $first = 0;
    … …  
    442442    }
    443443
    444     @file1stat = stat ($file1);
    445     @file2stat = stat ($file2);
     444    my @file1stat = stat ($file1);
     445    my @file2stat = stat ($file2);
    446446
    447447    if (-d $file1) {
Note: See TracChangeset for help on using the changeset viewer.