← Back to branch summary

~ubuntu-branches/ubuntu/trusty/lifelines/trusty

« back to all changes in this revision

Viewing changes to reports/pointers.ll

  • Committer: Bazaar Package Importer
  • Author(s): Felipe Augusto van de Wiel (faw)
  • Date: 2007-05-23 23:49:53 UTC
  • mfrom: (3.1.3 edgy)
  • Revision ID: james.westby@ubuntu.com-20070523234953-ogno9rnbmth61i7p
Tags: 3.0.50-2etch1
http://bugs.debian.org/418347
http://bugs.debian.org/405500
http://bugs.debian.org/356671
* Changing docs/ll-reportmanual.xml and docs/ll-userguide.xml to fix
  documentation build problems (Closes: #418347).

* lifelines-reports
  - Adding a dependency to lifelines >= 3.0.50 to prevent file conflict.
    (Closes: #405500).

* Updating French translation. Thanks to Bernard Adrian. (Closes: #356671).

Show diffs side-by-side

added added

removed removed

Lines of Context:
reports/pointers.ll
 
1
/*
 
2
 * @progname       pointers
 
3
 * @version        1.0
 
4
 * @author         Chandler
 
5
 * @category
 
6
 * @output         Text
 
7
 * @description
 
8
 
 
9
Test a database for reciprocity of pointers between persons and families.
 
10
Report any failures, primarily the following:
 
11
 
 
12
 Person Inn is a spouse/child in Fnn, but Fnn has no corresponding pointer.
 
13
 Family Fnn has HUSB/WIFE/CHIL Inn, but Inn has no corresponding pointer.
 
14
 
 
15
Some failures are supposed to be impossible, but are covered here
 
16
nonetheless:
 
17
 
 
18
 Family Fnn has HUSB/WIFE/CHIL Inn, but Inn does not exist.
 
19
 Family Fnn has a null HUSB/WIFE/CHIL line.
 
20
 Person Inn is a spouse/child in Fnn, but Fnn does not exist.
 
21
 Person Inn has a null FAMS/FAMC line.
 
22
 
 
23
Version 1.0 - 2003 Jul 2 - John F. Chandler
 
24
 
 
25
This program works only with LifeLines.
 
26
 
 
27
*/
 
28
 
 
29
global(pointers)
 
30
 
 
31
proc main() {
 
32
table(spou)     /* each entry is the list of spouses in the keyed family */
 
33
table(chil)     /* each entry is the list of children in the keyed family */
 
34
 
 
35
"Testing database " qt() database() qt() " for pointer reciprocity\n"
 
36
 
 
37
set(pointers,0)
 
38
 
 
39
/* loop through persons and note all the families they belong to */
 
40
forindi(i,n) {
 
41
        set(k,save(key(i)))
 
42
        fornodes(root(i),node) {
 
43
                set(type,tag(node))
 
44
                if(eqstr(type,"FAMC")) {
 
45
                        call tally(type,"child",chil,node,k)
 
46
                } elsif(eqstr(type,"FAMS")) {
 
47
                        call tally(type,"spouse",spou,node,k)
 
48
                }
 
49
        }
 
50
}
 
51
/* loop through families and compare the members against the list
 
52
   compiled by scanning persons -- flag any mismatches */
 
53
forfam(f,n) {
 
54
        set(id,save(key(f)))
 
55
        set(cl,lookup(chil,id))
 
56
        set(sl,lookup(spou,id))
 
57
        fornodes(root(f),node) {
 
58
                set(type,tag(node))
 
59
                if(eqstr(type,"CHIL")) { call checkoff(type,cl,id,node) }
 
60
                elsif(or(eqstr(type,"HUSB"),eqstr(type,"WIFE"))) {
 
61
                        call checkoff(type,sl,id,node)
 
62
                }
 
63
        }
 
64
/* any remaining list elements are errors */
 
65
        if(sl) {
 
66
                while(k,dequeue(sl)) {
 
67
                        "\nPerson " k " is a spouse in " id
 
68
                        ", but " id " has no corresponding pointer."
 
69
                }
 
70
        }
 
71
        if(cl) {
 
72
                while(k,dequeue(cl)) {
 
73
                        "\nPerson " k " is a child in " id
 
74
                        ", but " id " has no corresponding pointer."
 
75
                }
 
76
        }
 
77
}
 
78
"\n\nFinished after checking " d(pointers) " pointers.\n"
 
79
 
 
80
}
 
81
 
 
82
/* check a family member against the expected list.
 
83
   anyone not on the list is an error.
 
84
   remove each person from the list when found here. */
 
85
proc checkoff(type,list,id,node) {
 
86
        incr(pointers)
 
87
        if(eq(mod(pointers,500),0)) { print(".") }
 
88
        if(k,value(node)) {
 
89
                set(key,substring(k,2,sub(strlen(k),1)))
 
90
                if(list) {
 
91
                        set(count,length(list))
 
92
                        while(gt(count,0)) {
 
93
                                decr(count)
 
94
                                set(c,dequeue(list))
 
95
                                if(eqstr(c,key)) { set(count,-1) }
 
96
                                else { enqueue(list,c) }
 
97
                        }
 
98
                }
 
99
                if(eq(count,0)) {
 
100
                        "\nFamily " id " has " type " " key ", but " key
 
101
                        if(reference(k)) { " has no corresponding pointer." }
 
102
                        else { " does not exist." }
 
103
                }
 
104
        } else { "\nFamily " id " has a null " type " line." }
 
105
}
 
106
 
 
107
/* build a list of persons who belong to families */
 
108
proc tally(type,member,table,node,k) {
 
109
        incr(pointers)
 
110
        if(eq(mod(pointers,500),0)) { print(".") }
 
111
        set(id,value(node))
 
112
        if(reference(id)) {
 
113
                set(id,save(substring(id,2,sub(strlen(id),1))))
 
114
                if(l,lookup(table,id)) { enqueue(l,k) }
 
115
                else {
 
116
                        list(l)
 
117
                        enqueue(l,k)
 
118
                        insert(table,id,l)
 
119
                }
 
120
        } elsif(id) {
 
121
                "\nPerson " k " is a " member " in " id
 
122
                ", but " id " does not exist."
 
123
        } else { "\nPerson " k " has a null " type " line." }
 
124
}
 
125