biblicit 1.0 → 2.0.3

data/perl/ParsCit/lib/ParsCit/PostProcess.pm

@@ -1,367 +0,0 @@
-package ParsCit::PostProcess;
-#
-# Utilities for normalizing the output of CRF++ into standard
-# representations.
-#
-# Isaac Councill, 07/20/07
-#
-
-use strict;
-use utf8;
-
-##
-# Main normalization subroutine.  Reads in a CRF++ output file
-# and normalizes each field of individual citations.  An intermediate
-# XML representation is used to keep track of the tags discovered by
-# the model.  Returns a reference to the raw XML (may not be encoded
-# safely) and a reference to a list of hashes containing the normalized
-# citation subfields, keyed by tag name.
-##
-sub readAndNormalize {
-    my ($inFile) = @_;
-
-    my $status = 1;
-    my $msg = "";
-
-    open(IN, "<:utf8", $inFile) or return (undef, undef, 0,
-				    "couldn't open infile: $!");
-
-    my $currentTag;
-    my @currentTokens = ();
-
-    my $newCitation = 1;
-
-    my $xml = "";
-
-    while(<IN>) {
-	if (m/^\s*$/) { # blank line separates citations
-	    if ($newCitation <= 0) {
-		finishCitation(\$xml, \$currentTag, \@currentTokens);
-		@currentTokens = ();
-		$newCitation = 1;
-		next;
-	    }
-	}
-	if ($newCitation > 0) {
-	    $xml .= "<citation>\n";
-	    $newCitation = 0;
-	}
-	my @fields = split /\s+/;
-	my $token = $fields[0];
-	my $tag = $fields[$#fields];
-	if (!defined $currentTag) {
-	    $currentTag = $tag;
-	}
-	if ($tag eq $currentTag) {
-	    push @currentTokens, $token;
-	} else {
-	    $xml .= makeSegment($currentTag, @currentTokens);
-	    $currentTag = $tag;
-	    @currentTokens = ();
-	    push @currentTokens, $token;
-	}
-    }
-
-    close IN;
-
-    if ($newCitation <= 0) {
-	finishCitation(\$xml, \$currentTag, \@currentTokens);
-	@currentTokens = ();
-	$newCitation = 1;
-    }
-
-    my $rCiteInfo = normalizeFields(\$xml);
-
-    return \$xml, $rCiteInfo, $status, $msg;
-
-}  # readAndNormalize
-
-
-##
-# Utility for adding a closing tag to a citation in the
-# intermediate XML, and setting the currentTag value to undef.
-##
-sub finishCitation {
-    my ($r_xml, $r_currentTag, $r_currentTokens) = @_;
-    if (defined $$r_currentTag) {
-	$$r_xml .= makeSegment($$r_currentTag, @$r_currentTokens);
-    }
-    $$r_xml .= "</citation>\n";
-    $$r_currentTag = undef;
-
-}  # finishCitation
-
-
-##
-# Makes an XML segment based on the specifed tag and token list.
-##
-sub makeSegment {
-    my ($tag, @tokens) = @_;
-    my $segment = join " ", @tokens;
-    return "<$tag>$segment</$tag>\n";
-}
-
-
-##
-# Switching utility for reading through the intermediate XMl
-# and passing control to an appropriate normalization routine
-# for each field encountered.  Returns a reference to a list
-# of hashes containing normalized fields, keyed by tag name.
-##
-sub normalizeFields {
-    my ($rXML) = @_;
-    my @citeInfos = ();
-
-    $_ = $$rXML;
-    my @citeBlocks = m/<citation>(.*?)<\/citation>/gs;
-    foreach my $block (@citeBlocks) {
-	my %citeInfo;
-	while($block =~ m/<(.*?)>(.*?)<\/\1>/gs) {
-	    my ($tag, $content) = ($1, $2);
-	    if ($tag eq "author") {
-		$tag = "authors";
-		$content = normalizeAuthorNames($content);
-	    } elsif ($tag eq "date") {
-		$content = normalizeDate($content);
-	    } elsif ($tag eq "volume") {
-		$content = normalizeNumber($content);
-	    } elsif ($tag eq "number") {
-		$content = normalizeNumber($content);
-	    } elsif ($tag eq "pages") {
-		$content = normalizePages($content);
-	    } else {
-		$content = stripPunctuation($content);
-	    }
-	    # Heuristic - only get first instance of tag.
-	    # TODO: we can do better than that...
-	    unless (defined $citeInfo{$tag} || ! defined $content) {
-		$citeInfo{$tag} = $content;
-	    }
-	}
-	push @citeInfos, \%citeInfo;
-    }
-    return \@citeInfos;
-
-}  # normalizeFields
-
-
-sub stripPunctuation {
-    my $text = shift;
-    $text =~ s/^[^\p{IsLower}\p{IsUpper}0-9]+//;
-    $text =~ s/[^\p{IsLower}\p{IsUpper}0-9]+$//;
-    return $text;
-}
-
-
-##
-# Tries to split the author tokens into individual author names
-# and then normalizes these names individually.  Returns a
-# list of author names.
-##
-sub normalizeAuthorNames {
-    my ($authorText) = @_;
-
-    my @tokens = repairAndTokenizeAuthorText($authorText);
-
-    my @authors = ();
-    my @currentAuth = ();
-    my $beginAuth = 1;
-
-    foreach my $tok (@tokens) {
-	if ($tok =~ m/^(&|and)$/i) {
-	    if ($#currentAuth >= 0) {
-		my $auth = normalizeAuthorName(@currentAuth);
-		push @authors, $auth;
-	    }
-	    @currentAuth = ();
-	    $beginAuth = 1;
-	    next;
-	}
-	if ($beginAuth > 0) {
-	    push @currentAuth, $tok;
-	    $beginAuth = 0;
-	    next;
-	}
-	if ($tok =~ m/,$/) {
-	    push @currentAuth, $tok;
-	    if ($#currentAuth>0) {
-		my $auth = normalizeAuthorName(@currentAuth);
-		push @authors, $auth;
-		@currentAuth = ();
-		$beginAuth = 1;
-	    }
-	} else {
-	    push @currentAuth, $tok;
-	}
-    }
-    if ($#currentAuth >= 0) {
-	my $auth = normalizeAuthorName(@currentAuth);
-	push @authors, $auth;
-    }
-    return \@authors;
-
-}  # normalizeAuthorNames
-
-
-##
-# Strips unexpected punctuation and removes tokens that
-# are obviously not name words from the token list.
-##
-sub repairAndTokenizeAuthorText {
-    my ($authorText) = @_;
-
-    # Repair obvious parse errors and weird notations.
-    $authorText =~ s/et\.? al\.?.*$//;
-    $authorText =~ s/^.*?[\p{IsUpper}\p{IsLower}][\p{IsUpper}\p{IsLower}]+\. //;
-    $authorText =~ s/\(.*?\)//g;
-    $authorText =~ s/^.*?\)\.?//g;
-    $authorText =~ s/\(.*?$//g;
-
-    $authorText =~ s/\[.*?\]//g;
-    $authorText =~ s/^.*?\]\.?//g;
-    $authorText =~ s/\[.*?$//g;
-
-    $authorText =~ s/;/,/g;
-    $authorText =~ s/,/, /g;
-    $authorText =~ s/\:/ /g;
-    $authorText =~ s/[\:\"\<\>\/\?\{\}\[\]\+\=\(\)\*\^\%\$\#\@\!\~\_]//g;
-    $authorText = joinMultiWordNames($authorText);
-
-    my @origTokens = split '\s+', $authorText;
-    my @tokens = ();
-
-    for (my $i=0; $i<=$#origTokens; $i++) {
-	my $tok = $origTokens[$i];
-	if ($tok !~ m/[\p{IsUpper}\p{IsLower}&]/) {
-	    if ($i < $#origTokens/2) {
-		# Probably got junk up to now.
-		@tokens = ();
-		next;
-	    } else {
-		last;
-	    }
-	}
-	if ($tok =~ m/^(jr|sr|ph\.?d|m\.?d|esq)\.?\,?$/i) {
-	    if ($tokens[$#tokens] =~ m/\,$/) {
-		next;
-	    }
-	}
-	if ($tok =~ m/^[IVX][IVX]+\.?\,?$/) {
-	    next;
-	}
-	push @tokens, $tok;
-    }
-    return @tokens;
-
-}  #repairAndTokenizeAuthorText
-
-
-##
-# Tries to normalize an individual author name into the form
-# "First Middle Last", without punctuation.
-##
-sub normalizeAuthorName {
-    my @authTokens = @_;
-    if ($#authTokens < 0) {
-	return "";
-    }
-
-    my $tmpStr = join " ", @authTokens;
-    if ($tmpStr =~ m/(.+),\s*(.+)/) {
-	$tmpStr = "$2 $1";
-    }
-
-    $tmpStr =~ s/\.\-/-/g;
-    $tmpStr =~ s/[\,\.]/ /g;
-    $tmpStr =~ s/  +/ /g;
-    $tmpStr = trim($tmpStr);
-
-    if ($tmpStr =~ m/^[^\s][^\s]+(\s+[^\s]|\s+[^\s]\-[^\s])+$/) {
-	my @newTokens = split '\s+', $tmpStr;
-	my @newOrder = @newTokens[1..$#newTokens];
-	push @newOrder, $newTokens[0];
-	$tmpStr = join " ", @newOrder;
-    }
-
-    return $tmpStr;
-
-}  # normalizeAuthorName
-
-
-##
-# Utility for creating an intermediate representation of multi-word
-# name components, e.g., transforms "van der Wald" to "van_dir_Wald".
-# this helps keep things straight during normalization.  The
-# underscores can be stripped out later.
-##
-sub joinMultiWordNames {
-    my $authorText = shift;
-    $authorText =~ s/\b((?:van|von|der|den|de|di|le|el))\s/\1_/sgi;
-    return $authorText;
-
-} # joinMultiWordNames
-
-
-##
-# Normalizes a date field into just the year.  Looks for a string of
-# four digits.
-##
-sub normalizeDate {
-    my $dateText = shift;
-    if ($dateText =~ m/(\d{4})/) {
-	my $year = $1;
-	# check to see whether this is a sane year setting
-	my @timeData = localtime(time);
-	my $currentYear = $timeData[5]+1900;
-	if ($year <= $currentYear+3) {
-	    return $1;
-	}
-    }
-
-}  # normalizeDate
-
-
-##
-# If a field should be numeric only, this utility is used
-# to extract the first number string only.
-##
-sub normalizeNumber {
-    my $numText = shift;
-    if ($numText =~ m/(\d+)/) {
-	return $1;
-    } else {
-	return $numText;
-    }
-
-}  # normalizeNumber
-
-
-##
-# Normalizes page fields into the form "start--end".  If the page
-# field does not appear to be in a standard form, does nothing.
-##
-sub normalizePages {
-    my $pageText = shift;
-    if ($pageText =~ m/(\d+)[^\d]+?(\d+)/) {
-	if ($1>=$2) {
-	    return undef;
-	}
-	return "$1--$2";
-    } elsif ($pageText =~ m/(\d+)/) {
-	return $1;
-    } else {
-	return undef;
-    }
-
-}  # normalizePages
-
-
-sub trim {
-    my $str = shift;
-    $str =~ s/^\s+//;
-    $str =~ s/\s+$//;
-    return $str;
-}
-
-
-1;

data/perl/ParsCit/lib/ParsCit/PreProcess.pm

@@ -1,333 +0,0 @@
-package ParsCit::PreProcess;
-#
-# Utilities for finding and normalizing citations within
-# text files, including separating citation text from
-# body text and segmenting citations.
-#
-# Isaac Councill, 7/19/07
-#
-
-use strict;
-use utf8;
-use ParsCit::Citation;
-
-my %markerTypes = (
-		   'SQUARE' => '\\[.+?\\]',
-		   'PAREN' => '\\(.+?\\)',
-		   'NAKEDNUM' => '\\d+',
-		   'NAKEDNUMDOT' => '\\d+\\.',
-		   );
-
-
-##
-# Looks for reference section markers in the supplied text and
-# separates the citation text from the body text based on these
-# indicators.  If it looks like there is a reference section marker
-# too early in the document, this procedure will try to find later
-# ones.  If the final reference section is still too long, an empty
-# citation text string will be returned.  Returns references to
-# the citation text, normalized body text, and original body text.
-##
-sub findCitationText {
-    my ($rText) = @_;
-    my $text = $$rText;
-    my $bodyText = '0';
-    my $citeText = '0';
-
-    while ($text =~ m/\b(References?|REFERENCES?|Bibliography|BIBLIOGRAPHY|References?\s+and\s+Notes?|References?\s+Cited|REFERENCE?\s+CITED|REFERENCES?\s+AND\s+NOTES?):?\s*\n+/sg) {
-	$bodyText = substr $text, 0, pos $text;
-	$citeText = substr $text, pos $text unless (pos $text < 1);
-    }
-    if (length($citeText) >= 0.8*length($bodyText)) {
-	print STDERR "Citation text longer than article body: ignoring\n";
-	$citeText = "";
-	return \$citeText, \normalizeBodyText(\$bodyText), \$bodyText;
-    }
-    my ($sciteText, $tmp) = split(/^([\s\d\.]+)?(Acknowledge?ments?|Autobiographical|Tables?|Appendix|Exhibit|Annex|Fig|Notes?)(.*?)\n+/m, $citeText);
-    if (length($sciteText)>0) {
-	$citeText = $sciteText;
-    }
-
-    if ($citeText eq '0' || !defined $citeText) {
-	print STDERR "warning: no citation text found\n";
-    }
-
-    return (normalizeCiteText(\$citeText),
-	    normalizeBodyText(\$bodyText),
-	    \$bodyText);
-
-}  # findCitationText
-
-
-##
-# Removes lines that appear to be junk from the citation text.
-##
-sub normalizeCiteText {
-    my ($rCiteText) = @_;
-
-    my @lines = split "\n", $$rCiteText;
-    my @newLines = ();
-    foreach my $line (@lines) {
-	if ($line =~ m/^[\s\d]*$/) {
-	    next;
-	}
-	push @newLines, $line;
-    }
-    my $newText = join "\n", @newLines;
-    return \$newText;
-
-}  # normalizeCiteText
-
-
-##
-# Removes lines that appear to be junk from the body text,
-# de-hyphenates words where a hyphen occurs at the end of
-# a line, and normalizes strings of blank spaces to only
-# single blancks.
-##
-sub normalizeBodyText {
-    my ($rText) = @_;
-    my @lines = split "\n", $$rText;
-    my $text = "";
-    foreach my $line (@lines) {
-	if ($line =~ m/^\s*$/) {
-	    next;
-	}
-	if ($text =~ s/(\w)\-$/$1/) {
-	    $text .= $line;
-	} else {
-	    $text .= " ".$line;
-	}
-    }
-    $text =~ s/\s\s+/\s/g;
-    return \$text;
-
-} # normalizeBodyText
-
-
-##
-# Controls the process by which citations are segmented,
-# based on the result of trying to guess the type of
-# citation marker used in the reference section.  Returns
-# a reference to a list of citation objects.
-##
-sub segmentCitations {
-    my ($rCiteText) = @_;
-    my $markerType = guessMarkerType($rCiteText);
-
-    my $rCitations;
-
-    if ($markerType ne 'UNKNOWN') {
-	$rCitations = splitCitationsByMarker($rCiteText, $markerType);
-    } else {
-	$rCitations = splitUnmarkedCitations($rCiteText);
-    }
-
-    return $rCitations;
-
-}  # segmentCitations
-
-
-##
-# Segments citations that have explicit markers in the
-# reference section.  Whenever a new line starts with an
-# expression that matches what we'd expect of a marker,
-# a new citation is started.  Returns a reference to a
-# list of citation objects.
-##
-sub splitCitationsByMarker {
-    my ($rCiteText, $markerType) = @_;
-    my @citations;
-    my $currentCitation = new ParsCit::Citation();
-    my $currentCitationString;
-
-    # TODO: Might want to add a check that marker number is
-    # increasing as we'd expect, if the marker is numeric.
-
-    foreach my $line (split "\n", $$rCiteText) {
-	if ($line =~ m/^\s*($markerTypes{$markerType})\s*(.*)$/) {
-	    my ($marker, $citeString) = ($1, $2);
-	    if (defined $currentCitationString) {
-		$currentCitation->setString($currentCitationString);
-		push @citations, $currentCitation;
-		$currentCitationString = undef;
-	    }
-	    $currentCitation = new ParsCit::Citation();
-	    $currentCitation->setMarkerType($markerType);
-	    $currentCitation->setMarker($marker);
-	    $currentCitationString = $citeString;
-	} else {
-	    if ($currentCitationString =~ m/\w\-$/) {
-		# merge words when lines are hyphenated
-		$currentCitationString =~ s/\-$//;
-		$currentCitationString .= $line;
-	    } else {
-		$currentCitationString .= " ".$line;
-	    }
-	}
-    }
-    if (defined $currentCitation && defined $currentCitationString) {
-	$currentCitation->setString($currentCitationString);
-	push @citations, $currentCitation;
-    }
-    return \@citations;
-
-}  # splitCitationsByMarker
-
-
-##
-# Uses several heuristics to decide where individual citations
-# begin and end based on the length of previous lines, strings
-# that look like author lists, and punctuation.  Returns a
-# reference to a list of citation objects.
-##
-sub splitUnmarkedCitations {
-    my ($rCiteText) = @_;
-    my @content = split "\n", $$rCiteText;
-    my @citeStarts = ();
-    my $citeStart = 0;
-    my @citations = ();
-
-    for (my $i=0; $i<=$#content; $i++) {
-	if ($content[$i] =~ m/\b\(?[1-2][0-9]{3}[\p{IsLower}]?[\)?\s,\.]*(\s|\b)/s) {
-	    for (my $k=$i; $k > $citeStart; $k--) {
-		if ($content[$k] =~ m/\s*[\p{IsUpper}]/g) {
-
-		    # If length of previous line is extremely small,
-		    # start a new citation here.
-		    if (length($content[$k-1]) < 2) {
-			$citeStart = $k;
-			last;
-		    }
-
-		    # Start looking backwards for lines that could
-		    # be author lists - these usually start the
-		    # citation, have several separation characters (,;),
-		    # and shouldn't contain any numbers.
-		    my $beginningAuthorLine = -1;
-		    for (my $j=$k-1; $j>$citeStart; $j--) {
-			if ($content[$j] =~ m/\d/) {
-			    last;
-			}
-			$_ = $content[$j];
-			my $nSep = s/([,;])/\1/g;
-			if ($nSep >= 3) {
-			    if (($content[$j-1] =~ m/\.\s*$/) || $j==0) {
-				$beginningAuthorLine = $j;
-			    }
-			} else {
-			    last;
-			}
-		    }
-		    if ($beginningAuthorLine >= 0) {
-			$citeStart = $beginningAuthorLine;
-			last;
-		    }
-
-		    # Now that the backwards author search failed
-		    # to find any extra lines, start a new citation
-		    # here if the previous line ends with a ".".
-		    if ($content[$k-1] =~ m/\.\s*$/) {
-			$citeStart = $k;
-			last;
-		    }
-		}
-	    }
-	    push @citeStarts, $citeStart
-		unless (($citeStart <= $citeStarts[$#citeStarts]) &&
-			($citeStart != 0));
-	}
-    }
-    for (my $k=0; $k<$#citeStarts; $k++) {
-	my $firstLine = $citeStarts[$k];
-	my $lastLine = ($k==$#citeStarts) ? $#content : ($citeStarts[$k+1]-1);
-	my $citeString =
-	    mergeLines(join "\n", @content[$firstLine .. $lastLine]);
-	my $citation = new ParsCit::Citation();
-	$citation->setString($citeString);
-	push @citations, $citation;
-    }
-    return \@citations;
-
-}  # splitUnmarkedCitations
-
-
-##
-# Merges lines of text by dehyphenating where appropriate,
-# with normal spacing.
-##
-sub mergeLines {
-    my ($text) = shift;
-    my @lines = split "\n", $text;
-    my $mergedText = "";
-    foreach my $line (@lines) {
-	$line = trim($line);
-	if ($mergedText =~ m/\w\-$/) {
-	    $mergedText =~ s/\-$//;
-	    $mergedText .= $line;
-	} else {
-	    $mergedText .= " ".$line;
-	}
-    }
-    return trim($mergedText);
-
-}  # mergeLines
-
-
-##
-# Uses a list of regular expressions that match common citation
-# markers to count the number of matches for each type in the
-# text.  If a sufficient number of matches to a particular type
-# are found, we can be reasonably sure of the type.
-##
-sub guessMarkerType {
-    my ($rCiteText) = @_;
-    my $markerType = 'UNKNOWN';
-    my %markerObservations;
-    foreach my $type (keys %markerTypes) {
-	$markerObservations{$type} = 0;
-    }
-
-    my $citeText = "\n".$$rCiteText;
-    $_ = $citeText;
-    my $nLines = s/\n/\n/gs - 1;
-
-    while ($citeText =~ m/\n\s*($markerTypes{'SQUARE'}([^\n]){10})/sg) {
-	$markerObservations{'SQUARE'}++;
-    }
-
-    while ($citeText =~ m/\n\s*($markerTypes{'PAREN'}([^\n]){10})/sg) {
-	$markerObservations{'PAREN'}++;
-    }
-
-    while ($citeText =~ m/\n\s*($markerTypes{'NAKEDNUM'} [^\n]{10}) /sg) {
-	$markerObservations{'NAKEDNUM'}++;
-    }
-
-    while ($citeText =~ m/\n\s*$markerTypes{'NAKEDNUMDOT'}([^\n]){10}/sg) {
-	$markerObservations{'NAKEDNUMDOT'}++;
-    }
-
-    my @sortedObservations =
-	sort {$markerObservations{$b} <=> $markerObservations{$a}}
-    keys %markerObservations;
-
-    my $minMarkers = $nLines / 6;
-    if ($markerObservations{$sortedObservations[0]} >= $minMarkers) {
-	$markerType = $sortedObservations[0];
-    }
-    return $markerType;
-
-}  # guessMarkerType
-
-
-sub trim {
-    my $text = shift;
-    $text =~ s/^\s+//;
-    $text =~ s/\s+$//;
-    return $text;
-
-}  # trim
-
-
-1;