#!/usr/bin/perl -w
use POSIX;
##########################
# Transform Persondata
##########################
# Parse date entry and expand each date field to 8 fields
# Likewise the articles about places and first/last names
##########################
my %months=(
January => 1,
February => 2,
March => 3,
April => 4,
May => 5,
June => 6,
July => 7,
August => 8,
September => 9,
October => 10,
November => 11,
December => 12
);
my %monthname = reverse %months;
my $MONTH = "(" . join("|",keys %months) . ")";
my $YEAR = "(\\d{1,4})";
my $PREFIX = "([^0-9]+)";
# Clean up date entry for standardised persondata date format
sub clean_date {
my $d = shift;
# Put spaces between wikilinks
$d =~ s/([\]])([\[])/$1 $2/g;
# Deal with piped links
$d =~ s/[\[]{2}([^\]]*)[|](.*)[\]]{2}/$2/g;
# Remove square brackets
$d =~ s/[\[\]]//g;
# Deal with templates
$d =~ s/{{([Bb]irth|[Dd]eath) date( and age)?\s?\|\s?(\d{1,4})\|\s?(\d{1,2})\|\s?(\d{1,2})(.*)/$3-$4-$5/g;
# DD.MM.YYYY => DD MMM YYYY
if ($d =~ /^0?(\d{1,2})\.(\d{1,2})\.(\d{1,4})$/) {
my $month = int $2;
$d = "$1 ".$monthname{$month}." $3";
}
# YYYY-MM-DD => DD MMM YYYY
if ($d =~ /^(\d{1,4})-(\d{1,2})-0?(\d{1,2})$/) {
my $month = int $2;
$d = "$3 ".$monthname{$month}." $1";
}
# AD/CE is implicit
$d =~ s/A\. ?D\.//; # TODO: doesn't completely work?? e.g. [[Libanios]]
$d =~ s/A ?D//;
$d =~ s/\bC\. ?E\.//;
$d =~ s/\bC ?E//;
# Remove trailing punctuation
$d =~ s/(,|\||;|=)$//;
# Remove HTML comments
$d =~ s/<!--(.*)-->//;
# Add forgotten spaces
$d =~ s/([a-z])(\d)/$1 $2/g;
$d =~ s/(\d)([a-z])/$1 $2/g;
$d =~ s/\.([^ ])/. $1/g;
#Remove spaces from ordinals
$d =~ s/(\d) (th|st|nd|rd|s\b)/$1$2/g;
# remove double spaces
$d =~ s/\s+/ /g;
# remove spaces at beginning and end
$d =~ s/^\s+//;
$d =~ s/\s+$//;
# Fields with only question marks => "unknown"
$d =~ s/^\?$/unknown/;
# Uniform capitalisation
$d =~ s/Unknown/unknown/g;
$d =~ s/After/after/g;
# question marks should always have brackets and a space before them
$d =~ s/\(\?\)/\?/g;
$d =~ s/([^ ])\?+/$1 \?/g;
$d =~ s/\?/(\?)/g;
# Instead of a question mark at the end, 'probably' at the beginning
$d =~ s/^(.+) \(\?\)$/probably $1/;
$d =~ s/^\(\?\)$/probably/;
# Slash without space
$d =~ s/ ?\/ ?/\//g;
# Remove bolding/italics
$d =~ s/\'{2,5}//g;
# Shortened month names
$d =~ s/Jan[\.\s]+/January /;
$d =~ s/Feb[\.\s]+/February /;
$d =~ s/Mar[\.\s]+/March /;
$d =~ s/Apr[\.\s]+/April /;
$d =~ s/Jun[\.\s]+/June /;
$d =~ s/Jul[\.\s]+/July /;
$d =~ s/Aug[\.\s]+/August /;
$d =~ s/Sep[\.\s]+/September /;
$d =~ s/Sept[\.\s]+/September /;
$d =~ s/Oct[\.\s]+/October /;
$d =~ s/Nov[\.\s]+/November /;
$d =~ s/Dec[\.\s]+/December /;
# Write out "Century"
$d =~ s/C\./century/g;
# "End of the 5th century" => "End 5th century" (simpler)
$d =~ s/ of the//;
$d =~ s/(approx\.?|[Cc]irca\.?\s?|\bca?[\.\s]+|about|around|~)/circa /;
$d =~ s/([Pp]ossibly|[Pp]robably)/probably/g;
$d =~ s/([Ss]till )?[Ll]iving( [Pp]erson)?//;
$d =~ s/[Nn]\/?[Aa]//;
$d =~ s/[Nn]ot [Aa]pplicable//;
# Remove double spaces
$d =~ s/\s+/ /g;
#----------Error fixing---------
# Other typing errors
#$d =~ s/^Um/um/;
#$d =~ s/chr/Chr/;
return $d;
}
sub ilog10 { $x=shift; return int log10($x); }
my @fields = ( "day", "month", "year", "century", "decade", "year1", "year2", "note" );
sub parse_date {
my $date = shift;
my %d;
if (! $date ) {
$d{"note"} = "";
# Normal date entry
} elsif ($date =~ /^$PREFIX?(\d+ )?$MONTH,? $YEAR( BCE?\.?)?$/) {
$d{note} = $1 if defined $1;
$d{day} = substr($2,0,-1) if defined $2;
if (defined $3) {
$d{month} = $months{$3};
}
$d{year} = int $4;
$d{year} = -$d{year} if defined $5; # B.C.
} elsif ($date =~ /^$PREFIX?$MONTH (\d+)?,?\s?$YEAR( BCE?\.?)?$/) {
$d{note} = $1 if defined $1;
$d{day} = substr($3,0) if defined $3;
if (defined $2) {
$d{month} = $months{$2};
}
$d{year} = int $4;
$d{year} = -$d{year} if defined $5; # B.C.
} elsif ($date =~ /^$PREFIX?$YEAR( BCE?\.?)?$/) {
$d{note} = trim($1) if defined $1;
$d{year} = int $2;
$d{year} = -$d{year} if defined $3; # B.C.
# Century
#} elsif ($date =~ /^(around |probably |[Bb]eginning |[Mm]iddle |[Ee]nd )?(\d{1,2})\. [Cc]entury( BCE?\.?)?$/) {
} elsif ($date =~ /^$PREFIX?(\d{1,2})(\.|th|st|nd|rd) [Cc]entury( BCE?\.?)?$/) {
$d{note} = trim($1) if defined $1;
$d{century} = $2;
$d{century} = -$d{century} if defined $4;
# Decade
} elsif ($date =~ /^(\d{1,4}) ?'?s( BCE?\.?)?$/) {
$d{decade} = (int $1 / 10) * 10;
$d{decade} = -$d{decade} if defined $3;
$d{century} = int ($d{decade} / 10) + 1;
} elsif ($date =~ /^$PREFIX?$YEAR or $YEAR$/) { # TODO: or != until, TODO: B.C.
$d{note} = trim($1) if defined $1;
$d{year1} = int $2;
$d{year2} = int $3;
} elsif ($date =~ /^$PREFIX?$YEAR\/(\d{1,4})$/) { # TODO: B.C.
$d{note} = trim($1) if defined $1;
$d{year1} = int $2;
$d{year2} = int $3;
# Example: 1632/33 => 1632/1633
$c = ilog10($d{year1}) - ilog10($d{year2});
if ( $c < 0 ) { # Errr
$d{year1} = "";
$d{year2} = "";
$d{note} = $date;
} else {
$d{year2} = substr($d{year1},0,$c) . $d{year2};
}
# Interval of several years # TODO: not tested!
} elsif ( $date =~ /^$PREFIX?between $YEAR( and )$YEAR( BCE?\.?)?$/ or
$date =~ /^$PREFIX?$YEAR( to |-)$YEAR$( BCE?\.?)?/ )
{
$d{note} = trim($1) if defined $1;
$d{year1} = int $2;
$d{year2} = int $4;
if (defined $5) {
($d{year1}, $d{year2}) = (-$d{year2}, -$d{year1});
}
#} elsif ($date =~ /^$PREFIX?$YEAR( to |-)$YEAR$/) {
# $d{note} = trim($1) if defined $1;
# $d{year1} = int $2;
# $d{year2} = int $4;
} else {
$d{note} = $date;
}
if (defined $d{year1} and defined $d{year2}) {
# if years need to be switched
#if ($d{year1} > $d{year2}) {
# ($d{year1}, $d{year2}) = ($d{year2}, $d{year1});
#}
# if century can be defined
if ( (int $d{year1} / 100) eq (int $d{year2} / 100)) {
$d{century} = (int $d{year1} / 100) + 1;
}
# if decade can be defined
if ( $d{century} and (int $d{year1} / 10) eq (int $d{year2} / 10)) {
$d{decade} = (int $d{year1} / 10) * 10;
}
}
# calculate decade and century
if (defined $d{year}) {
$d{decade} = (int $d{year} / 10) * 10;
}
# calculate century
if (defined $d{decade}) {
if( $d{decade} != 0 ){
$d{century} = (int $d{decade} / 100) + (int $d{decade} / abs $d{decade});
}
else{
if (defined $d{year}) {
$d{century} = (int $d{decade} / 100) + (int $d{year} / abs $d{year});
}
else{
}
}
}
# Initialise undefined fields
foreach my $f (@fields) {
$d{$f} = '' if not defined $d{$f};
}
return %d;
}
sub parse_location {
my $p = trim(shift);
# [[a]] or [[b]] <- so what is it?!
# [[...]]
# [[...]], ...
# [[...]] , ...
# [[...]]/ ... <- preferably not like this
if ($p =~ /^\[\[([^\]]+)\]\].*?$/) {
my $a = $1;
$a =~ s/\|.*$//;
#print "$p|$a\n";
return $a;
} else {
#print "!$p\n";
return "";
}
}
#For PND number (assigned to German-speaking authors).
#Small number of articles on en wiki have this
sub parse_pnd {
my $p = trim(shift);
my $pnd_nr = "";
my $pnd_date = "";
if ($p =~ /^(\d)(\d)(\d)(\d)(\d)(\d)(\d)(\d)([\dX])/) {
my $check = $9;
$check = 10 if $check eq "X";
# pruefziffer
if ( ((2*$1+3*$2+4*$3+5*$4+6*$5+7*$6+8*$7+9*$8) % 11) eq $check ) {
# TODO: Number range 10000000 bis 14999999
if ($1 == 1 && $2>=0 && $2<=4) {
$pnd_nr = "$1$2$3$4$5$6$7$8$9";
}
}
}
if ($p =~ /(\d){1,2}\.(\d{1,2})\.(\d\d\d\d)/) {
$pnd_date = "$3-$2-$1";
}
return ($pnd_nr, $pnd_date);
}
sub unbracket {
my $p = shift;
# Insert missing spaces between wikilinks
$p =~ s/([\]])([\[])/$1 $2/g;
# remove square brackets
$p =~ s/[\[\]]//g;
return $p;
}
sub trim {
my $p = shift;
if ($p) {
# remove empty spaces at beginning and end
$p =~ s/^\s+//;
$p =~ s/\s+$//;
}
return $p;
}
##########################
while(my $line = <>) {
my @pd = split("\t",$line);
chop($pd[-1]); # remove end-of-line
my @pd_transformed;
$pd_transformed[0] = trim($pd[0]); # pd_id
$pd_transformed[1] = trim($pd[1]); # pd_article
$pd_transformed[2] = trim($pd[2]); # pd_name
$pd_transformed[3] = trim($pd[3]); # pd_alternative
$pd_transformed[4] = trim($pd[4]); # pd_description
$pd_transformed[5] = unbracket(trim($pd[5])); # pd_born
$pd_transformed[6] = trim($pd[6]); # pd_born_in
$pd_transformed[7] = unbracket(trim($pd[7])); # pd_died
$pd_transformed[8] = trim($pd[8]); # pd_died_in
$pd_transformed[9] = trim($pd[9]); # pd_pnd
# extract checked pnd-nr and additional date
($pd_transformed[10], $pd_transformed[11]) = parse_pnd($pd[9]); # pnr_nr, pnd_date
if ( trim($pd[2]) =~ /^([^,]+),([^,]+)$/ ) {
$pd_transformed[12] = trim($2); # n_given
$pd_transformed[13] = trim($1); # n_surname
$pd_transformed[14] = ''; # n_suffix
}
elsif ( trim($pd[2]) =~ /^([^,]+),([^,]+),([^,]+)$/ ) {
$pd_transformed[12] = trim($2); # n_given
$pd_transformed[13] = trim($1); # n_surname
$pd_transformed[14] = trim($3); # n_suffix
}
else {
$pd_transformed[12] = ''; # n_given
$pd_transformed[13] = ''; # n_surname
$pd_transformed[14] = ''; # n_suffix
}
$pd_transformed[15] = parse_location($pd[6]); # b_place
$pd_transformed[16] = parse_location($pd[8]); # d_place
my %born = parse_date(clean_date($pd[5]));
$pd_transformed[17] = $born{day}; # b_day
$pd_transformed[18] = $born{month}; # b_month
$pd_transformed[19] = $born{year}; # b_year
$pd_transformed[20] = $born{decade}; # b_decade
$pd_transformed[21] = $born{century}; # b_century
$pd_transformed[22] = $born{year1}; # b_year1
$pd_transformed[23] = $born{year2}; # b_year2
$pd_transformed[24] = $born{note}; # b_note
my %died = parse_date(clean_date($pd[7]));
$pd_transformed[25] = $died{day}; # d_day
$pd_transformed[26] = $died{month}; # d_month
$pd_transformed[27] = $died{year}; # d_year
$pd_transformed[28] = $died{decade}; # d_decade
$pd_transformed[29] = $died{century}; # d_century
$pd_transformed[30] = $died{year1}; # d_year1
$pd_transformed[31] = $died{year2}; # d_year2
$pd_transformed[32] = $died{note}; # d_note
print join("\t",@pd_transformed) . "\n";
}
