Changeset 1954

Show
Ignore:
Timestamp:
13.02.2001 10:58:26 (19 years ago)
Author:
jmt14
Message:

*** empty log message ***

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

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