root/trunk/gsdl/perllib/DateExtract.pm @ 1954

Revision 1954, 8.3 KB (checked in by jmt14, 19 years ago)

*** empty log message ***

  • Property svn:keywords set to Author Date Id Revision
Line 
1package DateExtract;
2
3use BasPlug;
4use sorttools;
5use util;
6
7#75% of the instances of the word century use full name ordinals
8my %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             
17
18#definitions for a date grammar.
19my $fulOrd = join('|',(keys %ordinals));
20
21my @months = ("january","february","march","april","may","june","july",
22              "august","september","october","november","december");
23
24my $shortmth = "";
25foreach $m (@months) { $shortmth .= (substr($m,0,3)."\\.?|"); }
26chop($shortmth);
27
28my $longmth = join('|',@months);
29
30
31my $Qualifier = "(B(\\.)?C(\\.)?(E(\\.)?)?)|(A(\\.)?D(\\.)?)|(C(\\.)E(\\.)?)";
32my $Century = "Cent(\\.|ur(y|ies))";
33my $Ord = "st|nd|rd|th";
34my $seasonref = "(spring|fall|autumn|winter|summer)";
35my $sep = " ?- ?";
36my $tri_digit = "(in|since|(the year)|($seasonref of)) \\d{3}\\D( ($Qualifier))?";
37my $centurydate = "(((\\d{1,2})($Ord))|($fulOrd)) ($Century)( ($Qualifier))?";
38my $qualified = "(($Qualifier) ?(\\d{1,4}))|((\\d{1,4}) ?($Qualifier))";
39my $millenium = "[1-9]\\d{3}";
40my $range = "(($millenium)($sep)($millenium))|(($millenium)($sep)(\\d{1,2}))|(($qualified)($sep)($qualified))|(($Qualifier) ?(\\d{1,3})($sep)(\\d{1,3}))|((\\d{1,3})($sep)(\\d{1,3}) ?($Qualifier))";
41
42my $pgnum = "(p(p|g)?\\.? ?\\d+((-|,)(\\d+))?)|(page \\d+)|(pages \\d+((-|,)(\\d+))?)";
43my $lgnum = "\\d{1,3},(\\d{3})+";
44my $colon = ":\\d+";
45my $money = "\$(\\d{1,3}(((,\\d{3})+)|\\d+))";  $money = "\\" . $money;
46my $microfilm = " reel([^\\.\\)])*(\\.|\\))";
47my $lastaltered = "last (edited|updated)";
48my $references = "reference(s?)(:?)\\n";
49my $cited = "work(s?) cited";
50my $biblio = "bibliography(:?)( ?)\\n";
51
52my $direction = "(N(\\.|o\\.|th\\.|orth))|(S(\\.|th\\.|outh))|(E(\\.|ast))|(W(\\.|est))";
53my $street_id = "(st\\.)|(street[^A-Za-z])|(ave\\.)|(avenue[^A-Za-z])|(boulevard[^A-Za-z])|(blvd\\.)|(rd\\.)|(road[^A-Za-z])";
54my $streetname = "(\\d{1,2}(<SUP>)?($Ord)(</SUP>)?)|([A-Za-z]+( [A-Za-z]+)?)|([A-Za-z]+-[A-Za-z]+($Ord))";
55my $address = "\\d{1,4} (($direction) )?($streetname) ($street_id)";
56
57my $bracket = "\\($millenium\\)";
58my $ref_end = ", ?$millenium\\)";
59my $colonsp = ": $millenium";
60my $reprint = "[Rr]eprint of \\d{4} edition";
61my $comma = ", $millenium\\.";
62my $fullstop = "\\. $millenium\\.";
63my $semi = "; $millenium\\.";
64
65my $lookalikes = "($pgnum)|($lgnum)|($colon)|($money)|($microfilm)|($address)";
66my $spurious = "($lastaltered)";
67my $bibheader = "($references)|($cited)|($biblio)";
68
69
70sub get_date_metadata {
71    #get the text of the document, the "document object" concerned,
72    #and the current section within the document
73    local ($text, $doc, $cursection, $keep_bib, $max_year, $max_century) = @_;
74   
75    #format a prechristian maximum century value to be negative so that it can
76    #be used in numeric comparison
77    if($max_century =~ /B/)
78    {
79        $max_century = $`;
80        $max_century =~ /\d+/;
81        $max_century = $&;
82        $max_century *=-1
83    }
84   
85    local $extr = &remove_excess($text);   
86    #print "EXTRACTION TEXT:\n $extr";
87    $extr = &remove_tags($extr);
88    if(!$keep_bib){
89        $extr = &remove_biblio($extr);
90    }
91 
92
93    local @datelist = ();
94    while($extr =~ m!($range)|($millenium)|($qualified)|($centurydate)|($tri_digit)!i)
95    {
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       
148    }
149   
150    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        }
161    }
162}
163sub convert_bc {
164    local ($full,$num) = @_;
165    if ($full =~ /B/) { $num *= -1; }
166    $num;
167}
168
169sub post_process {
170    local ($max_year, @list) = @_;
171    @cleanlist = ();
172    $prev = 0;
173    foreach $e (@list) {
174        if ($e!=$prev && $e <= $max_year) {
175            push(@cleanlist, $e);
176        }
177        $prev = $e;
178    }
179    @cleanlist;
180}
181
182
183#removes all html tags from that data, as they will not contain dates which
184#are part of the content of the document, and therefore interesting, but do
185#contain date lookalikes
186sub remove_tags {
187    local ($tmp) = @_;
188   
189    local $parsed = "";
190    #while there is still text to be parsed and tags are still found
191    while($tmp=~ m!<([^>])*(>|$)! && $tmp ne "")
192    {
193        $parsed .= $`;#keep all that is not in a tag
194        $tmp = $';    #restart the search after then end of the tag
195    }
196    $parsed .= $tmp; #add anything after the last match
197    $parsed;
198}
199
200
201sub remove_excess {
202    local ($tmp) = @_;
203    local $parsed = "";
204   
205
206    if(($tmp =~ m!($spurious)|($lookalikes)!i) == 0 )
207    {
208        $parsed = $tmp;
209    }
210    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           
230    }
231    #print "Parsed:\n $parsed\n\n";
232    $parsed;
233   
234}
235
236sub remove_biblio{
237    local ($tmp) = @_;
238    local $parsed = "";
239   
240    if($tmp =~ m!$bibheader!i)
241    {
242        $tmp=$`;
243    }
244   
245    $tmp =~ s/( |\t)+/ /g;
246    if(($tmp =~ m!($ref_end)|($bracket)|($colonsp)|($reprint)|($comma)|($fullstop)|($semi)|($seasonref) ($millenium)!i) == 0)
247    {
248        $parsed = $tmp;
249    }
250    else{
251
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;
270    }
271    $parsed;
272}
273
274
2751;
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
Note: See TracBrowser for help on using the browser.