-
Notifications
You must be signed in to change notification settings - Fork 0
/
filter_descendants.pl
executable file
·121 lines (93 loc) · 2.91 KB
/
filter_descendants.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
#!/usr/bin/perl
#########################################################################
# Copyright (C) Claus Schrammel <claus@f05fk.net> #
# #
# This program is free software: you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation, either version 3 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program. If not, see <http://www.gnu.org/licenses/>. #
# #
# SPDX-License-Identifier: GPL-3.0-or-later #
#########################################################################
use strict;
use GED::GED;
if (scalar(@ARGV) != 3)
{
print "usage: $0 origin.ged dest.ged start\n";
exit 1;
}
my $origin = shift;
my $dest = shift;
my $ged = new GED::GED($origin);
my $start = shift;
if ($start =~ m/^I/)
{
&keep_individual($ged->getIndividual($start));
}
if ($start =~ m/^F/)
{
&keep_family($ged->getFamily($start));
}
&remove_entries();
$ged->save($dest);
exit 0;
sub keep_family
{
my $family = shift;
# exit if not exists
return if (!defined $family);
# exit if already visited
return if ($family->{keep} == 1);
$family->{keep} = 1;
&keep_spouse($family->getHusband());
&keep_spouse($family->getWife());
foreach my $child ($family->getChildren()) {
&keep_individual($child);
}
}
sub keep_spouse
{
my $individual = shift;
# exit if not exists
return if (!defined $individual);
# exit if already visited
return if ($individual->{keep} == 1);
$individual->{keep} = 0.5;
}
sub keep_individual
{
my $individual = shift;
# exit if not exists
return if (!defined $individual);
# exit if already visited
return if ($individual->{keep} == 1);
$individual->{keep} = 1;
foreach my $family ($individual->getFamiliesSpouse()) {
&keep_family($family);
}
}
sub remove_entries
{
foreach my $family ($ged->getFamilies())
{
if (!$family->{keep})
{
$family->remove();
}
}
foreach my $individual ($ged->getIndividuals())
{
if (!$individual->{keep})
{
$individual->remove();
}
}
}