Changeset 1954 for trunk/gsdl


Ignore:
Timestamp:
2001-02-13T10:58:26+13:00 (23 years ago)
Author:
jmt14
Message:

* empty log message *

Location:
trunk/gsdl/perllib
Files:
1 added
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsdl/perllib/DateExtract.pm

    r1467 r1954  
    77#75% of the instances of the word century use full name ordinals
    88my %ordinals = ("first" => 1, "second" => 2, "third" => 3, "fourth" => 4,
    9          "fifth" => 5, "sixth" => 6, "seventh" => 7, "eighth" => 8,
    10          "ninth" => 9, "tenth" => 10, "eleventh" => 11, "twelfth" => 12,
    11          "thirteenth" => 13, "fourteenth" => 14, "fifteenth" => 15,
    12          "sixteenth" => 16, "seventeenth" => 17, "eighteenth" => 18,
    13          "nineteenth" => 19, "twentieth" => 20);
    14 
    15 
    16          
     9             "fifth" => 5, "sixth" => 6, "seventh" => 7, "eighth" => 8,
     10             "ninth" => 9, "tenth" => 10, "eleventh" => 11, "twelfth" => 12,
     11             "thirteenth" => 13, "fourteenth" => 14, "fifteenth" => 15,
     12             "sixteenth" => 16, "seventeenth" => 17, "eighteenth" => 18,
     13             "nineteenth" => 19, "twentieth" => 20);
     14
     15
     16             
    1717
    1818#definitions for a date grammar.
    … …  
    2020
    2121my @months = ("january","february","march","april","may","june","july",
    22           "august","september","october","november","december");
     22              "august","september","october","november","december");
    2323
    2424my $shortmth = "";
    … …  
    7777    if($max_century =~ /B/)
    7878    {
    79     $max_century = $`;
    80     $max_century =~ /\d+/;
    81     $max_century = $&;
    82     $max_century *=-1
     79        $max_century = $`;
     80        $max_century =~ /\d+/;
     81        $max_century = $&;
     82        $max_century *=-1
    8383    }
    8484   
    … …  
    8787    $extr = &remove_tags($extr);
    8888    if(!$keep_bib){
    89     $extr = &remove_biblio($extr);
     89        $extr = &remove_biblio($extr);
    9090    }
    9191 
    … …  
    9494    while($extr =~ m!($range)|($millenium)|($qualified)|($centurydate)|($tri_digit)!i)
    9595    {
    96     $extr = $';
    97     my $fulldate = $&;
    98     if ($fulldate =~ /$centurydate/i)
    99     {
    100         if($max_century!=-1)
    101         {
    102 
    103         local $date = $fulldate; if($date =~ /\d+/) {$date = $&;}
    104         else
    105         {
    106             $date=$fulldate; $date =~ m! ($Century)!i; $date = $`;
    107             $date =~ tr/A-Z/a-z/;
    108             $date = $ordinals{$date};
    109         }
    110         if($max_century >= $date){
    111             $date = ($date-1)*100 +1;
    112             #if it BC, make it negative
    113             $date = &convert_bc($fulldate,$date);
    114             $end = $date + 99;
    115             @century = ($date..$end);
    116             @datelist = (@datelist,@century);
    117         }
    118         }
    119     }
    120    
    121     elsif($fulldate =~ /$range/)
    122     {
    123         $fulldate =~ /$sep/;
    124         my @addlist = ();
    125         #print "Range: $fulldate\n";
    126         $fullfirst = $`;
    127         $fullsecond = $';
    128         $fullfirst =~ /\d+/; $first = $&;
    129         $fullsecond =~ /\d+/; $second = $&;
    130         $len1 = length($first);
    131         $len2 = length($second);
    132         $second = (substr($first,0,($len1-$len2))).$second;
    133         $first = &convert_bc($fullfirst,$first);
    134         $second = &convert_bc($fullsecond,$second);
    135         @addlist = ($first..$second);
    136         @datelist = (@datelist,@addlist);
    137        
    138     }
    139     else {
    140        
    141         my $date = $fulldate; $date =~ /\d+/; $date = $&; 
    142         $date = &convert_bc($fulldate,$date);
    143         #add the date metadata
    144         push(@datelist,$date);
    145         #print "datelist @datelist\n"
    146     }
    147    
     96        $extr = $';
     97        my $fulldate = $&;
     98        if ($fulldate =~ /$centurydate/i)
     99        {
     100            if($max_century!=-1)
     101            {
     102
     103                local $date = $fulldate; if($date =~ /\d+/) {$date = $&;}
     104                else
     105                {
     106                    $date=$fulldate; $date =~ m! ($Century)!i; $date = $`;
     107                    $date =~ tr/A-Z/a-z/;
     108                    $date = $ordinals{$date};
     109                }
     110                if($max_century >= $date){
     111                    $date = ($date-1)*100 +1;
     112                    #if it BC, make it negative
     113                    $date = &convert_bc($fulldate,$date);
     114                    $end = $date + 99;
     115                    @century = ($date..$end);
     116                    @datelist = (@datelist,@century);
     117                }
     118            }
     119        }
     120       
     121        elsif($fulldate =~ /$range/)
     122        {
     123            $fulldate =~ /$sep/;
     124            my @addlist = ();
     125            #print "Range: $fulldate\n";
     126            $fullfirst = $`;
     127            $fullsecond = $';
     128            $fullfirst =~ /\d+/; $first = $&;
     129            $fullsecond =~ /\d+/; $second = $&;
     130            $len1 = length($first);
     131            $len2 = length($second);
     132            $second = (substr($first,0,($len1-$len2))).$second;
     133            $first = &convert_bc($fullfirst,$first);
     134            $second = &convert_bc($fullsecond,$second);
     135            @addlist = ($first..$second);
     136            @datelist = (@datelist,@addlist);
     137           
     138        }
     139        else {
     140           
     141            my $date = $fulldate; $date =~ /\d+/; $date = $&; 
     142            $date = &convert_bc($fulldate,$date);
     143            #add the date metadata
     144            push(@datelist,$date);
     145            #print "datelist @datelist\n"
     146        }
     147       
    148148    }
    149149   
    150150    if(@datelist){
    151     @datelist = sort { $a <=> $b } @datelist;
    152     @datelist = &post_process($max_year, @datelist);
    153     foreach $date (@datelist)
    154     {
    155         if($date>0){
    156         $doc->add_metadata($cursection,"Coverage",$date);}
    157         else{
    158         $doc->add_metadata($cursection,"Coverage","bc".(-1*$date));}
    159        
    160     }
     151        @datelist = sort { $a <=> $b } @datelist;
     152        @datelist = &post_process($max_year, @datelist);
     153        foreach $date (@datelist)
     154        {
     155            if($date>0){
     156                $doc->add_metadata($cursection,"Coverage",$date);}
     157            else{
     158                $doc->add_metadata($cursection,"Coverage","bc".(-1*$date));}
     159               
     160        }
    161161    }
    162162}
    … …  
    172172    $prev = 0;
    173173    foreach $e (@list) {
    174     if ($e!=$prev && $e <= $max_year) {
    175         push(@cleanlist, $e);
    176     }
    177     $prev = $e;
     174        if ($e!=$prev && $e <= $max_year) {
     175            push(@cleanlist, $e);
     176        }
     177        $prev = $e;
    178178    }
    179179    @cleanlist;
    … …  
    191191    while($tmp=~ m!<([^>])*(>|$)! && $tmp ne "")
    192192    {
    193     $parsed .= $`;#keep all that is not in a tag
    194     $tmp = $';    #restart the search after then end of the tag
     193        $parsed .= $`;#keep all that is not in a tag
     194        $tmp = $';    #restart the search after then end of the tag
    195195    }
    196196    $parsed .= $tmp; #add anything after the last match
    … …  
    206206    if(($tmp =~ m!($spurious)|($lookalikes)!i) == 0 )
    207207    {
    208     $parsed = $tmp;
     208        $parsed = $tmp;
    209209    }
    210210    else {
    211     while ($tmp =~ m!($spurious)|($lookalikes)!i
    212            && $tmp ne "")
    213     {
    214         $parsed .= $`;
    215         $storage = $&;
    216         $tmp = $';
    217         #match the pattern which indicates most recent alteration
    218         if ($storage =~ m!$lastaltered!i)
    219         {
    220         #match a four digit year or up until the first /
    221         #(as in last edited 3/97).
    222         $tmp =~ m!($millenium)|(\/)!;
    223         $tmp = $';
    224         }
    225        
    226     }
    227    
    228     $parsed .= $tmp;
    229        
     211        while ($tmp =~ m!($spurious)|($lookalikes)!i
     212               && $tmp ne "")
     213        {
     214            $parsed .= $`;
     215            $storage = $&;
     216            $tmp = $';
     217            #match the pattern which indicates most recent alteration
     218            if ($storage =~ m!$lastaltered!i)
     219            {
     220                #match a four digit year or up until the first /
     221                #(as in last edited 3/97).
     222                $tmp =~ m!($millenium)|(\/)!;
     223                $tmp = $';
     224            }
     225               
     226        }
     227       
     228        $parsed .= $tmp;
     229           
    230230    }
    231231    #print "Parsed:\n $parsed\n\n";
    … …  
    240240    if($tmp =~ m!$bibheader!i)
    241241    {
    242     $tmp=$`;
     242        $tmp=$`;
    243243    }
    244244   
    … …  
    246246    if(($tmp =~ m!($ref_end)|($bracket)|($colonsp)|($reprint)|($comma)|($fullstop)|($semi)|($seasonref) ($millenium)!i) == 0)
    247247    {
    248     $parsed = $tmp;
     248        $parsed = $tmp;
    249249    }
    250250    else{
    251251
    252     #print "removing bib\n";
    253     while ($tmp =~ m!($ref_end)|($bracket)|($colonsp)|($reprint)|($comma)|($fullstop)|($semi)|(($seasonref) ($millenium))|($bibheader)!i && $tmp ne "")
    254     {
    255        
    256         $parsed .= $`;
    257         $tmp = $';
    258         if($&=~m!($comma)|($fullstop)!)
    259         {
    260        
    261         local  $date = $&;
    262         if($parsed =~ m!((\d)($Ord)$)|(($shortmth)$)|(($longmth)$)!i)
    263         {
    264             $parsed .= $date;
    265         }
    266         } 
    267        
    268     }
    269            $parsed .= $tmp;
     252        #print "removing bib\n";
     253        while ($tmp =~ m!($ref_end)|($bracket)|($colonsp)|($reprint)|($comma)|($fullstop)|($semi)|(($seasonref) ($millenium))|($bibheader)!i && $tmp ne "")
     254        {
     255           
     256            $parsed .= $`;
     257            $tmp = $';
     258            if($&=~m!($comma)|($fullstop)!)
     259            {
     260               
     261                local  $date = $&;
     262                if($parsed =~ m!((\d)($Ord)$)|(($shortmth)$)|(($longmth)$)!i)
     263                {
     264                    $parsed .= $date;
     265                }
     266            } 
     267           
     268        }
     269                   $parsed .= $tmp;
    270270    }
    271271    $parsed;
    … …  
    292292
    293293
     294
     295
     296
     297
     298
     299
     300
     301

  • trunk/gsdl/perllib/parsargv.pm

    r1240 r1954  
    7373
    7474    my @rest = @_;
     75
    7576
    7677    # if the last argument is the string "allow_extra_options" then options
    … …  
    9293    while (($spec, $var) = splice(@rest, 0, 2))
    9394        {
     95     
    9496    die "Variable for $spec is not a valid type."
    9597        unless ref($var) eq 'SCALAR' || ref($var) eq 'ARRAY';
    … …  
    107109    my ($name, $regex, $default) = split(/$delimiter/, $spec, 3);
    108110   
     111   
    109112    if ($name)
    110     {
     113    {   
    111114        if ($default && $default !~ /$regex/)
    112115        {
    … …  
    225228
    2262291;
     230
     231
     232
     233
     234
     235
     236
     237

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

    r1903 r1954  
    2525
    2626package BasPlug;
    27 
     27use Kea;
    2828use parsargv;
    2929use multiread;
    … …  
    130130    $self->{'outhandle'} = STDERR;
    131131    my $year = (localtime)[5]+1900;
    132 
     132   
     133 
    133134    # general options available to all plugins
    134135    if (!parsargv::parse(\@_,
    135136             q^process_exp/.*/^, \$self->{'process_exp'},
    136137             q^block_exp/.*/^, \$self->{'block_exp'},
     138             q^extract_acronyms^, \$self->{'extract_acronyms'},
     139             q^extract_keyphrases^, \$self->{'kea'}, #with extra options
     140             q^extract_keyphrase_options/.*/^, \$self->{'kea_options'}, #no extra options
    137141             qq^input_encoding/$enc/auto^, \$self->{'input_encoding'},
    138142             qq^default_encoding/$denc/iso_8859_1^, \$self->{'default_encoding'},
    139              q^extract_acronyms^, \$self->{'extract_acronyms'},
    140143             q^extract_email^, \$self->{'extract_email'},
    141144             q^markup_acronyms^, \$self->{'markup_acronyms'},
    142              q^extract_language^, \$self->{'extract_language'},
    143145             q^default_language/.{2}/en^, \$self->{'default_language'},
    144146             q^first/.*/^, \$self->{'first'},
    … …  
    233235
    234236sub read {
    235     my $self = shift (@_);
     237    my $self = shift (@_); 
     238 
    236239    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
    237240
    … …  
    283286    return 0;
    284287    }
    285 
     288   
    286289    # include any metadata passed in from previous plugins
    287290    # note that this metadata is associated with the top level section
    … …  
    290293    # do plugin specific processing of doc_obj
    291294    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
    292 
     295   
    293296    # do any automatic metadata extraction
    294297    $self->auto_extract_metadata ($doc_obj);
    295 
     298   
    296299    # add an OID
    297300    $doc_obj->set_OID();
    … …  
    501504
    502505# extract metadata
    503 sub auto_extract_metadata {
     506sub auto_extract_metadata {
     507 
     508
    504509    my $self = shift (@_);
    505510    my ($doc_obj) = @_;
    … …  
    512517        $thissection = $doc_obj->get_next_section ($thissection);
    513518    }
    514     }   
     519    }
     520
     521
     522#adding kea keyphrases
     523    if ($self->{'kea'}) { 
     524   
     525    my $thissection = $doc_obj->get_top_section();
     526    my $text = "";
     527    my @list;
     528
     529    while (defined $thissection) { #loop through sections to gather whole doc
     530        my $sectiontext = $doc_obj->get_text($thissection);   
     531        $text = $text.$sectiontext;
     532        $thissection = $doc_obj->get_next_section ($thissection);
     533    }
     534       
     535    if($self->{'kea_options'}) { #if kea options flag is set, call Kea with specified options
     536        @list = &Kea::extract_KeyPhrases ($text, $self->{'kea_options'});
     537    } else { #otherwise call Kea with no options
     538        @list = &Kea::extract_KeyPhrases ($text);
     539    }
     540     
     541    if(@list){ #if a list of kea keyphrases was returned (ie not empty)
     542        my $keyphrases = $list[0]; #first arg is keyphrase list
     543        my $stems = $list[1]; #second  arg is stemmed keyphrase list
     544        print STDERR "keyphrases: $keyphrases\n";
     545        print STDERR "stems: $stems\n";
     546        $thissection = $doc_obj->get_top_section(); #add metadata to top section
     547        $doc_obj->add_metadata($thissection, "kea", $keyphrases);
     548        $doc_obj->add_metadata($thissection, "stems", $stems);
     549    }
     550    } #end of kea
     551
    515552    if ($self->{'first'}) {
    516553    my $thissection = $doc_obj->get_top_section();

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

    r1929 r1954  
    7373
    7474    my $generate_format;
    75     if (!parsargv::parse($args,
     75    my $kea_arg;
     76
     77    if (!parsargv::parse($args, 
     78             q^extract_keyphrases^, \$kea_arg->{'kea'}, #with extra options
     79             q^extract_keyphrase_options/.*/^, \$kea_arg->{'kea_options'}, #no extra options
    7680             q^convert_to/(html|text)/html^, \$generate_format,
    7781             "allow_extra_options")) {
    … …  
    8286    die "\n";
    8387    }
    84 
    85     return ($plugin_name,$generate_format);
     88   
     89    return ($plugin_name,$generate_format, $kea_arg);
    8690}
    8791
    8892sub new {
    8993    my $class = shift (@_);
    90     my ($plugin_name,$generate_format) = $class->parse_args(\@_);
     94    my ($plugin_name,$generate_format, $kea_arg) = $class->parse_args(\@_);
    9195    my $self;
    9296
    … …  
    107111    }
    108112
     113    #if kea data to be extracted...
     114    $self->{'kea'} = 1 if($kea_arg->{'kea'});
     115    $self->{'kea_options'} = 1 if($kea_arg->{'kea_options'});
     116 
    109117    return bless $self, $class;
    110118}
    … …  
    212220   
    213221    my $ret_val = BasPlug::read($self,@_);
    214 
     222 
    215223    $self->cleanup_tmp_area();
    216224   

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

    r1424 r1954  
    4141    my $self = new BasPlug ("GMLPlug", @_);
    4242
    43     return bless $self, $class;
    44 }
     43    return bless $self, $class;}
    4544
    4645sub get_default_process_exp {

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

    r1415 r1954  
    3737sub new {
    3838    my $class = shift (@_);
    39 
     39     
    4040    my $self = new ConvertToPlug ($class, @_, "--", "-title_sub", 'Page\s+\d+');
    4141   
    … …  
    70701;
    7171
     72
     73
     74
Note: See TracChangeset for help on using the changeset viewer.