Complain if the birth place is known but not in the birth record

nigelhorne · Aug 11, 2024 · ea91dc3 · ea91dc3
1 parent dea4b1b
commit ea91dc3
Showing 1 changed file with 94 additions and 84 deletions.
diff --git a/gedcom b/gedcom
@@ -2156,91 +2156,97 @@ sub print_person
 		$placeofbirth =~ s/^,\s*//g;
 	}
 
-	if($placeofbirth && ($placeofbirth =~ /(.+[a-z]) USA$/i)) {
-		complain({ person => $person, warning => "Comma missing before USA in birth location '$placeofbirth'" });
-		$placeofbirth = "$1, USA";
-		$birth_country = 'United States';
-	} elsif($placeofbirth && ($placeofbirth =~ /.+,\s?(.+)$/)) {
-		my $c = $1;
-
-		if($c =~ /\s+$/) {
-			complain({ person => $person, warning => "Removing trailing spaces from place of birth '$c'" });
-			$c =~ s/\s+$//;
-		}
-		if($c =~ /\)$/) {
-			complain({ person => $person, warning => 'Trailing bracket in birth location' });
-			$c =~ s/\)$//;
-		}
-
-		if(length($c) > 3) {
-			$c = sortoutcase($c);
-		}
-
-		if($c eq 'England') {
-			$birth_country = 'United Kingdom';
-		} elsif($c eq 'USA') {
-			$birth_country = 'United States';
-		} elsif($c eq 'United States Of America') {
-			$birth_country = 'United States';
-		} elsif($c eq 'U.S.A.') {
-			$birth_country = 'United States';
-		} elsif($c eq 'Scotland') {
-			$birth_country = 'United Kingdom';
-		} elsif($c eq 'Wales') {
-			$birth_country = 'United Kingdom';
-		} elsif($c eq 'Isle of Man') {
-			$birth_country = 'United Kingdom';
-		} elsif($c eq 'Northern Ireland') {
-			$birth_country = 'United Kingdom';
-		} elsif(($c eq 'Preußen') || ($c eq 'Deutschland')) {	# Prussia
-			$birth_country = 'Germany';
-		} elsif(($c eq 'Holland') || ($c eq 'The Netherlands')) {
-			$birth_country = 'Netherlands';
-		} elsif($c eq 'NL') {
-			$birth_country = 'Netherlands';
-			complain({ person => $person, warning => 'Assuming country of birth is Netherlands' });
-		} elsif(($c =~ /[A-Z]{2}/) && ($us->{code2state}{$c})) {
-			complain({ person => $person, warning => "$c: assuming country of birth is USA" });
-			$birth_country = 'United States';
-			$placeofbirth .= ', USA';
-		} elsif($us->{state2code}{uc($c)}) {
-			complain({ person => $person, warning => "$c: assuming country of birth is USA" });
+	if($placeofbirth) {
+		if(!defined($birth->place())) {
+			complain({ person => $person, warning => "Birthplace is set to $placeofbirth but birth place is empty" });
+			$birth->set('place', $placeofbirth);
+		}
+		if($placeofbirth =~ /(.+[a-z]) USA$/i) {
+			complain({ person => $person, warning => "Comma missing before USA in birth location '$placeofbirth'" });
+			$placeofbirth = "$1, USA";
 			$birth_country = 'United States';
-			$placeofbirth .= ', USA';
-		} elsif(($c =~ /[A-Z]{2}/) && ($ca_en->{code2province}{$c}) || $ca_fr->{code2province}{$c}) {
-			complain({ person => $person, warning => "$c: assuming country of birth is Canada" });
-			$birth_country = 'Canada';
-			$placeofbirth .= ', Canada';
-		} elsif($ca_en->{province2code}{uc($c)} || $ca_fr->{province2code}{uc($c)}) {
-			complain({ person => $person, warning => "$c: assuming country of birth is Canada" });
-			$birth_country = 'Canada';
-			$placeofbirth .= ', Canada';
-		} elsif(($c =~ /[A-Z]{2,3}/) && ($au->{code2state}{$c})) {
-			complain({ person => $person, warning => "$c: assuming country of birth is Australia" });
-			$birth_country = 'Australia';
-			$placeofbirth .= ', Australia';
-		} elsif($au->{state2code}{uc($c)}) {
-			complain({ person => $person, warning => "$c: assuming country of birth is Australia" });
-			$birth_country = 'Australia';
-			$placeofbirth .= ', Australia';
-		} elsif(uc($c) eq 'NFLD') {
-			complain({ person => $person, warning => 'Assuming country of birth is Canada' });
-			$birth_country = 'Canada';
-			$placeofbirth .= ', Canada';
-		} elsif(($c eq 'Norfolk') || ($c eq 'Kent') || ($c eq 'Sussex') || ($c eq 'Northumberland') || ($c eq 'London') || ($c eq 'Lancashire')) {
-			$birth_country = 'United Kingdom';
-			complain({ person => $person, warning => 'Assuming country of birth is UK' });
-		} elsif($c =~ 'England,?\sUK') {
-			$birth_country = 'United Kingdom';
-		} elsif($c eq 'Scot') {
-			complain({ person => $person, warning => "$c: birth country should be Scotland'" });
-			$birth_country = 'United Kingdom';
-		} elsif($c eq 'Slovenija') {
-			$birth_country = 'Slovenia';
-		} elsif(my $b = Locale::Object::Country->new(name => $c)) {
-			$birth_country = $b->name();
-		} else {
-			complain({ person => $person, warning => "Unknown birth country: '$c' in '$placeofbirth'" });
+		} elsif($placeofbirth =~ /.+,\s?(.+)$/) {
+			my $c = $1;
+
+			if($c =~ /\s+$/) {
+				complain({ person => $person, warning => "Removing trailing spaces from place of birth '$c'" });
+				$c =~ s/\s+$//;
+			}
+			if($c =~ /\)$/) {
+				complain({ person => $person, warning => 'Trailing bracket in birth location' });
+				$c =~ s/\)$//;
+			}
+
+			if(length($c) > 3) {
+				$c = sortoutcase($c);
+			}
+
+			if($c eq 'England') {
+				$birth_country = 'United Kingdom';
+			} elsif($c eq 'USA') {
+				$birth_country = 'United States';
+			} elsif($c eq 'United States Of America') {
+				$birth_country = 'United States';
+			} elsif($c eq 'U.S.A.') {
+				$birth_country = 'United States';
+			} elsif($c eq 'Scotland') {
+				$birth_country = 'United Kingdom';
+			} elsif($c eq 'Wales') {
+				$birth_country = 'United Kingdom';
+			} elsif($c eq 'Isle of Man') {
+				$birth_country = 'United Kingdom';
+			} elsif($c eq 'Northern Ireland') {
+				$birth_country = 'United Kingdom';
+			} elsif(($c eq 'Preußen') || ($c eq 'Deutschland')) {	# Prussia
+				$birth_country = 'Germany';
+			} elsif(($c eq 'Holland') || ($c eq 'The Netherlands')) {
+				$birth_country = 'Netherlands';
+			} elsif($c eq 'NL') {
+				$birth_country = 'Netherlands';
+				complain({ person => $person, warning => 'Assuming country of birth is Netherlands' });
+			} elsif(($c =~ /[A-Z]{2}/) && ($us->{code2state}{$c})) {
+				complain({ person => $person, warning => "$c: assuming country of birth is USA" });
+				$birth_country = 'United States';
+				$placeofbirth .= ', USA';
+			} elsif($us->{state2code}{uc($c)}) {
+				complain({ person => $person, warning => "$c: assuming country of birth is USA" });
+				$birth_country = 'United States';
+				$placeofbirth .= ', USA';
+			} elsif(($c =~ /[A-Z]{2}/) && ($ca_en->{code2province}{$c}) || $ca_fr->{code2province}{$c}) {
+				complain({ person => $person, warning => "$c: assuming country of birth is Canada" });
+				$birth_country = 'Canada';
+				$placeofbirth .= ', Canada';
+			} elsif($ca_en->{province2code}{uc($c)} || $ca_fr->{province2code}{uc($c)}) {
+				complain({ person => $person, warning => "$c: assuming country of birth is Canada" });
+				$birth_country = 'Canada';
+				$placeofbirth .= ', Canada';
+			} elsif(($c =~ /[A-Z]{2,3}/) && ($au->{code2state}{$c})) {
+				complain({ person => $person, warning => "$c: assuming country of birth is Australia" });
+				$birth_country = 'Australia';
+				$placeofbirth .= ', Australia';
+			} elsif($au->{state2code}{uc($c)}) {
+				complain({ person => $person, warning => "$c: assuming country of birth is Australia" });
+				$birth_country = 'Australia';
+				$placeofbirth .= ', Australia';
+			} elsif(uc($c) eq 'NFLD') {
+				complain({ person => $person, warning => 'Assuming country of birth is Canada' });
+				$birth_country = 'Canada';
+				$placeofbirth .= ', Canada';
+			} elsif(($c eq 'Norfolk') || ($c eq 'Kent') || ($c eq 'Sussex') || ($c eq 'Northumberland') || ($c eq 'London') || ($c eq 'Lancashire')) {
+				$birth_country = 'United Kingdom';
+				complain({ person => $person, warning => 'Assuming country of birth is UK' });
+			} elsif($c =~ 'England,?\sUK') {
+				$birth_country = 'United Kingdom';
+			} elsif($c eq 'Scot') {
+				complain({ person => $person, warning => "$c: birth country should be Scotland'" });
+				$birth_country = 'United Kingdom';
+			} elsif($c eq 'Slovenija') {
+				$birth_country = 'Slovenia';
+			} elsif(my $b = Locale::Object::Country->new(name => $c)) {
+				$birth_country = $b->name();
+			} else {
+				complain({ person => $person, warning => "Unknown birth country: '$c' in '$placeofbirth'" });
+			}
 		}
 	}
 
@@ -2251,6 +2257,10 @@ sub print_person
 	}
 
 	if($placeofdeath) {
+		if(!defined($death->place())) {
+			complain({ person => $person, warning => "Deathplace is set to $placeofdeath but death place is empty" });
+			$death->set('place', $placeofdeath);
+		}
 		if(lc($placeofdeath) eq 'unknown') {
 			$placeofdeath = undef;
 			complain({ person => $person, warning => "Assuming place of death ', , ' means unknown place" });