Skip to content

Commit

Permalink
More work on relatives living close by
Browse files Browse the repository at this point in the history
  • Loading branch information
@nigelhorne
nigelhorne committed Aug 8, 2024
1 parent 02c8f6c commit c77dab7
Show file tree
Hide file tree
Showing 2 changed files with 60 additions and 43 deletions.
98 changes: 55 additions & 43 deletions gedcom
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5370,6 +5370,7 @@ sub print_person
my $printed_person = 0;
my $gis = GIS::Distance->new('MathTrig');
my $p2 = place({ record => $residence, nopreposition => 1 });
$p2 =~ s/^\s+//g;
my @people_near_p2;
my $p3; # previous place

Expand All @@ -5390,6 +5391,7 @@ sub print_person
# This stops verbosity when the list is:
# high street, 33 high street, high street
next unless($p1 =~ /^\s?\d/);
$p1 =~ s/^\s+//g;

my $peek = $iterator->peek();
next if($peek && ($peek->{'person'}->xref() eq $l->{'person'}->xref()));
Expand Down Expand Up @@ -5425,7 +5427,8 @@ sub print_person
# p1 is the place of the relative we're considering ($l)
# p2 is the place of the current person
# p3 is the place of the previous relative we're considering
if($p3 && $peek && (place({ record => $peek->{'record'}, nopreposition => 1 }) eq $p3)) {
# if($p3 && $peek && (place({ record => $peek->{'record'}, nopreposition => 1 }) eq " $p3")) {
if($p3 && $peek && (places_are_the_same({ person => $person, first => $l->{'record'}, second => $peek->{'record'}, exact => 1 }))) {
if((!defined($people_near_p2[0])) || ($people_near_p2[0]->{'person'}->xref() ne $l->{'person'}->xref())) {
push @people_near_p2, $l;
}
Expand All @@ -5435,6 +5438,11 @@ sub print_person
# Ignore children living with or close to siblings
next;
}
if(!defined($p3)) {
# First time we've looked at this place
$p3 = $p1;
next;
}
$p3 = $p1;
my $first_string;
my $future_spouse;
Expand Down Expand Up @@ -5475,14 +5483,14 @@ sub print_person
if($l->{'person'}->surname() eq $lastname) {
$first_string .= given_names($l->{'person'});
} else {
$first_string .= $l->{'person'}->as_string();
$first_string .= $l->{'person'}->as_string({ middle_names => 1 });
}
my @people_living_together = ($first_string);
if(scalar(@people_near_p2)) {
while(my $p = pop(@people_near_p2)) {
if(my $r = $person->relationship($p->{'person'})) {
push @people_living_together,
"$r " . $p->{'person'}->as_string();
"$r " . $p->{'person'}->as_string({ middle_names => 1 });
}
}
}
Expand Down Expand Up @@ -5694,9 +5702,12 @@ sub print_person
if(scalar(@people) == 1) {
$residencestring .= i18n(" $r, ") .
given_names($people[0]);
} elsif($r =~ /(.+)-in-law$/) {
die $1, 's-in-law';
} else {
# Handle more than one
die "TODO: $r", 's';
$residencestring .= i18n(" ${r}s, ") .
conjunction(map { given_names($_) } @people);
}
} else {
$residencestring .= i18n(" $r, ") .
Expand All @@ -5705,8 +5716,7 @@ sub print_person
delete $living_with{$r};
}

# if($opts{'w'} && scalar(keys %living_with)) {
if(scalar(keys %living_with)) {
if($opts{'w'} && scalar(keys %living_with)) {
warn $residencestring;
$Data::Dumper::Maxdepth = 2;
die $person->as_string({ include_years => 1, middle_names => 1 }), ": TODO ($rdate): ", Data::Dumper->new([\%living_with])->Dump();
Expand Down Expand Up @@ -9533,21 +9543,22 @@ sub year
return ($string =~ /\d$/) ? "in $string" : "on $string";
}

sub place {
my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
sub place
{
my $params = get_params(undef, @_);

return if($opts{'O'});

my $place = $params{'place'};
my $address = $params{'address'};
my $place = $params->{'place'};
my $address = $params->{'address'};

# if(!defined($params{'encode'})) {
# $params{'encode'} = 1;
# if(!defined($params->{'encode'})) {
# $params->{'encode'} = 1;
# }
$params{'encode'} = 0;
$params->{'encode'} = 0;

if(!defined($place)) {
$place = $params{'record'};
$place = $params->{'record'};
return unless($place);

if(ref($place) eq 'Gedcom::Record') {
Expand All @@ -9560,15 +9571,15 @@ sub place {
$place = undef if($place eq '-');
}
if(!defined($place)) {
if($opts{'w'} && (!$params{'allow_empty'}) && $params{'record'}->type() && ($params{'record'}->type() ne 'Story')) {
if($opts{'w'} && (!$params->{'allow_empty'}) && $params->{'record'}->type() && ($params->{'record'}->type() ne 'Story')) {
if(my $date = $p->date()) {
if($date =~ /^bet\s*(.+)/i) {
complain({ person => $params{'person'}, warning => "Location for the event between $1 is empty" });
complain({ person => $params->{'person'}, warning => "Location for the event between $1 is empty" });
} else {
complain({ person => $params{'person'}, warning => 'Location for "' . lcfirst($params{'record'}->type()) . "\" on $date is empty" });
complain({ person => $params->{'person'}, warning => 'Location for "' . lcfirst($params->{'record'}->type()) . "\" on $date is empty" });
}
} else {
complain({ person => $params{'person'}, warning => 'Location is empty' });
complain({ person => $params->{'person'}, warning => 'Location is empty' });
}
}
return;
Expand Down Expand Up @@ -9616,12 +9627,12 @@ sub place {
}
}

my $there = $params{'there'};
my $there = $params->{'there'};

if($there && ($place eq $there)) {
if($address) {
if($place =~ /^(.+?),.+,/) {
if($params{'nopreposition'}) {
if($params->{'nopreposition'}) {
return " $address, $1";
}
if($language eq 'French') {
Expand All @@ -9647,7 +9658,7 @@ sub place {
if(($place =~ /(.+?)\s*United States$/i) || ($place =~ /(.+?)\s*United States of America$/i)) {
$place = "$1 USA";
} elsif($place =~ /States\s.*$/) {
complain({ person => $params{'person'}, warning => "Unexpected text at the end of the place '$place'" });
complain({ person => $params->{'person'}, warning => "Unexpected text at the end of the place '$place'" });
} elsif($place =~ /(.*)(^|,\s*)(.+),\s*Canada$/i) {
my $town = $1;
my $province = $3;
Expand Down Expand Up @@ -9705,7 +9716,7 @@ sub place {
}
$rc->set({ lang => $lang, string => $place });
} else {
complain({ person => $params{'person'}, warning => "Unknown Canadian province $province" });
complain({ person => $params->{'person'}, warning => "Unknown Canadian province $province" });
}
} elsif($place =~ /(.*)(^|,\s*.+),\s*(UK|England|Wales|Scotland)$/i) {
# Translate the city from English
Expand All @@ -9723,8 +9734,8 @@ sub place {
}
}

if($params{'person'}) {
validate_place({ person => $params{'person'}, place => $rc });
if($params->{'person'}) {
validate_place({ person => $params->{'person'}, place => $rc });
}

if($birth_country && (!$opts{'r'}) && ($place =~ /(.+),\s*\Q$birth_country\E$/i)) {
Expand All @@ -9733,22 +9744,22 @@ sub place {

# utf8::decode($place);
if($place =~ /,,/) {
complain({ person => $params{'person'}, warning => "Consecutive commas found in '$place'" });
complain({ person => $params->{'person'}, warning => "Consecutive commas found in '$place'" });
$place =~ s/,,/,/g;
$place =~ s/,(\S)/, $1/g;
}
if($place =~ /,(\S)/) {
complain({ person => $params{'person'}, warning => "Space missing after comma in '$place'" });
complain({ person => $params->{'person'}, warning => "Space missing after comma in '$place'" });
$place =~ s/,(\S)/, $1/g;
}

if((!$opts{'r'}) && ($place =~ /^\d/)) {
if(my $places_printed = $params{'places_printed'}) {
if(my $places_printed = $params->{'places_printed'}) {
$places_printed->{" at$place"} = 1;
if($place =~ /(.+),(.+?),(.+?),(.+?),(.+?)$/) {
if($places_printed->{" in$3,$4,$5"}) {
$places_printed->{"at $1,$2,$3"} = 1;
if($params{'nopreposition'}) {
if($params->{'nopreposition'}) {
return "$1,$2,$3";
}
if($language eq 'French') {
Expand All @@ -9764,34 +9775,34 @@ sub place {
if($language eq 'French') {
return " \N{U+00E0} $place";
}
if($params{'nopreposition'}) {
if($params->{'nopreposition'}) {
return " $place";
}
return " at $place";
}

if($place eq 'USA') {
if($language eq 'French') {
if($params{'nopreposition'}) {
if($params->{'nopreposition'}) {
return " \N{U+00C9}tats-Unis";
}
return " aux \N{U+00C9}tats-Unis";
}
if($language eq 'German') {
if($params{'nopreposition'}) {
if($params->{'nopreposition'}) {
return ' der Vereinigten Staaten';
}
return ' in den Vereinigten Staaten';
}
if($params{'nopreposition'}) {
if($params->{'nopreposition'}) {
return ' USA';
}
return ' in the USA';
}

if($address) {
# utf8::decode($address);
if($params{'nopreposition'}) {
if($params->{'nopreposition'}) {
$place = " $address, $place";
$rc->en(" $address, " . $rc->en());
} elsif($language eq 'French') {
Expand All @@ -9804,7 +9815,7 @@ sub place {
} else {
$place = " at $address, $place";
}
} elsif($params{'nopreposition'}) {
} elsif($params->{'nopreposition'}) {
$place = " $place";
} elsif($place =~ /^Isle of /) {
$place = " on the $place";
Expand All @@ -9815,7 +9826,7 @@ sub place {
}
$rc->set({ lang => $lang, string => $place });

if((!$opts{'r'}) && (my $places_printed = $params{'places_printed'})) {
if((!$opts{'r'}) && (my $places_printed = $params->{'places_printed'})) {
if(($language eq 'French') && ($place =~ /(.+), London, England/)) {
$place = "$1, Londres, Angleterre";
$rc->fr($place);
Expand All @@ -9828,8 +9839,8 @@ sub place {
}
if($place =~ /(.+),(.+?),(.+?),(.+?)$/) {
my $str = "$2,$3,$4";
if($params{'person'} && $address) {
validate_place({ person => $params{'person'}, place => $place });
if($params->{'person'} && $address) {
validate_place({ person => $params->{'person'}, place => $place });
}
if($places_printed->{" in$str"}) {
if(($4 eq ' USA') || ($4 eq ' Canada')) {
Expand Down Expand Up @@ -9858,7 +9869,7 @@ sub place {
}
$str = "$3,$4";
if($places_printed->{" in$str"} || $places_printed->{" at$str"}) {
if($params{'encode'}) {
if($params->{'encode'}) {
return wide_to_html("$1,$2,$3");
}
return "$1,$2,$3";
Expand All @@ -9875,7 +9886,7 @@ sub place {
} else {
$rc->fr("$1,$2");
}
if($params{'encode'}) {
if($params->{'encode'}) {
$rc->encode();
}
return $rc;
Expand Down Expand Up @@ -9924,7 +9935,7 @@ sub place {
$en =~ s/^ in //;
if(my $code = $lcm->country2code($en, 'LOCALE_CODE_ALPHA_2', 'en')) {
$place = $lcm->code2country($code, $lang);
if(!$params{'nopreposition'}) {
if(!$params->{'nopreposition'}) {
if($language eq 'French') {
my $preposition;
if($place =~ /e$/) {
Expand Down Expand Up @@ -9952,7 +9963,7 @@ sub place {

$rc =~ s/\.$//;

if($params{'encode'}) {
if($params->{'encode'}) {
$rc->encode();
}

Expand Down Expand Up @@ -10311,7 +10322,7 @@ sub places_are_the_same
# $place2 = "$1 Road";
# }
return 1 if(lc($place1) eq lc($place2));
return 1 if(place(record => $record1) eq place(record => $record2));
return 1 if(place(record => $record1, nopreposition => 1) eq place(record => $record2, nopreposition => 1));
return 0 if($params->{'exact'});
if(compare($place1, $place2) > 0.5) {
if($person) {
Expand Down Expand Up @@ -13608,7 +13619,7 @@ sub get_params
} else {
my @c = caller(1);
my $func = $c[3]; # calling function name
Carp::croak('Usage: ', __PACKAGE__, "->$func($default => " . '$val)');
Carp::croak('Usage: ', __PACKAGE__, "->$func()");
}
} elsif((scalar(@_) == 0) && defined($default)) {
my @c = caller(1);
Expand All @@ -13633,6 +13644,7 @@ and::and
arrived::arrived
at::at
aunt::aunt
aunts::aunts
before %s::before %s
between::between
birthplace::birthplace
Expand Down
5 changes: 5 additions & 0 deletions tests/runtest
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,11 @@
#!/usr/bin/env bash

set -x

unset https_proxy
unset GMAP_KEY
unset REDIS_SERVER
unset HTTP_PROXY

LANG=en_GB ./gedcom -dlh 'Nigel Horne' "$*" | grep --colour ' '
LANG=en_GB ./gedcom -dlh 'Nigel Horne' "$*" | egrep --colour '\. [A-Z]'
Expand Down

0 comments on commit c77dab7

Please sign in to comment.