File: ged_write.li

package info (click to toggle)
lifelines 3.0.50-2
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 11,140 kB
  • ctags: 6,517
  • sloc: ansic: 57,468; xml: 8,014; sh: 4,255; makefile: 848; yacc: 601; perl: 170; sed: 16
file content (255 lines) | stat: -rw-r--r-- 7,475 bytes parent folder | download | duplicates (5)
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
/*
 * @progname       ged_write.li
 * @version        3
 * @author         Paul B. McBride (pbmcbride@rcn.com)
 * @category       
 * @output         GEDCOM
 * @description

  LifeLines GEDCOM file generating subroutine library.
  This file defines a procedure ged_write() which extends the gengedcom()
  builtin function of LifeLines by adding header and trailer records,
  and outputting other level 0 record types which are referenced
  within the individual and family records that would be output by
  gengedcom(). If these records are not output to the GEDCOM file then
  LifeLines would report links to undefined records, and not load the file
  into the database. This is particularly useful for SOURce records
  but also handles REPO, NOTE, EVENt, SUBMitter, other references
  to INDIvidual and FAMily records, etc.

  The gengedcom() function of LifeLines outputs a GEDCOM file for
  the specified set of INDIviduals. It handles standard links for
  FAMilies, and from FAMilies back to INDIviduals. It does not generate
  the "0 HEAD" records, or the "0 TRLR" record. Also if there are
  other links ("@xx@") to records of other types, or links to INDIviduals
  in other structure elements, the records they point to are not output.
Requirements:
  LifeLines 3.0.5 or later or 3.0.3-*win32*
Notes:
  To use this with 3.0.2 to 3.0.4:
    1) remove lines with "free(...)"
    2) add an inlist(...)" function. (see example at end)
Files:
  Two other files are also required, samples of which are at the end
  of this file:
  	header.ged, submit.ged
Bugs:
  Links to FAMilies with tags other than "FAMC" and "FAMS"
  may cause duplicate FAMily records in some cases.

08 Sep 1995 v1	add SOUR records to GEDCOM file
08 Feb 1996 v2	add REPO records and other records linked within SOUR records
17 Feb 2000 v3	resolve all other links to records (if possible)
*/

global(ged_other_list)
global(ged_other_set)
global(ged_other_setlist)

proc ged_write(gset)
{
	copyfile("header.ged")	/* header file (references @SM1@) */

	"1 DATE " stddate(gettoday()) nl()

	copyfile("submit.ged")	/* submitter file (defines @SM1@) */

	/* find other records and people referenced by the set */

	set(slen, lengthset(gset))
	print("Writing GEDCOM file for ", d(slen), " people...")
	call ged_other_init()
	call ged_other_addset(gset)
	if(ne(lengthset(gset), slen)) {
	  print(" ", d(sub(lengthset(gset),slen)), " added...")
	}

 	gengedcom(gset)	/* output set as GEDCOM file (INDI and FAM records) */

	/* add other types of records (including SOURces) */

	call ged_other_write()

	"0 TRLR" nl()		/* trailer */

	print(nl())
}

proc ged_other_init()
{
	/* for earlier versions of LifeLines remove lines with free() */
	if(ged_other_list) { free(ged_other_list) }
	if(ged_other_set) { free(ged_other_set) }
	if(ged_other_setlist) { free(ged_other_setlist) }
	/* end of lines to be removed for earlier versions of LifeLines */

	list(ged_other_list)
	indiset(ged_other_set)
	list(ged_other_setlist)
}

proc ged_other_addset(s)
{
	/* make a list of each person and family in the set. These 
	 * are the INDI and FAM records that gengedcom() will output.
	 */
        forindiset (s, i, a, n) {
		set(v, save(concat("@", key(i), "@")))
		enqueue(ged_other_setlist, v)
		families(i, f, sp, m) {
		  set(v, save(concat("@", key(f), "@")))
		  enqueue(ged_other_setlist, v)
		  call ged_other_add(root(f))
		}
	}
	/* process each INDI and FAM record to see if it contains references
	 * to other records. We need to add any other record that is referenced
	 * to the GEDCOM file.
	 */
        forindiset (s, i, a, n) {
		call ged_other_add(root(i))
		families(i, f, sp, m) {
		  call ged_other_add(root(f))
		}
	}
	/* add any new people into the original set */
        forindiset (ged_other_set, i, a, n) {
		addtoset(s, i, 1)
	}
}

/* ged_other_add() adds the other records referenced */

proc ged_other_add(n)
{
         traverse(n, m, l) {
	   if(gt(l, 0)) {
	     	if(eq(l, 1)) {
                  if (eqstr("FAMC", tag(m))) { continue() }
                  if (eqstr("FAMS", tag(m))) { continue() }
                  if (eqstr("HUSB", tag(m))) { continue() }
                  if (eqstr("CHIL", tag(m))) { continue() }
                  if (eqstr("WIFE", tag(m))) { continue() }
	     	}
		set(v, value(m))
		if(reference(v)) {
		  if(eqstr(substring(v,2,2),"I")) {
		    /* process other references to individuals */
		    if(inlist(ged_other_setlist, v)) { continue() }
                    set(v, save(v))
                    enqueue(ged_other_setlist, v)
		    addtoset(ged_other_set, indi(v), 1)
		    call ged_other_add(dereference(v))
		    /* this persons families will also be included */
		    families(indi(v), f, sp, m) {
		  	set(fv, save(concat("@", key(f), "@")))
		  	enqueue(ged_other_setlist, fv)
		  	call ged_other_add(root(f))
		    }
		    continue()
		  }
		  if(eqstr(substring(v,2,2),"F")) {
		    /* process other references to families */
		    /* force a family to be included by adding in one
		     * of the parents.
		     */
		    if(inlist(ged_other_setlist, v)) { continue() }
                    set(v, save(v))
                    enqueue(ged_other_setlist, v)
		    call ged_other_add(dereference(v))
		    set(spseen, 0)
		    set(fs, 0)
		    fornodes(dereference(v), fn) {
		      if(or(eqstr(tag(fn), "HUSB"),eqstr(tag(fn), "WIFE"))) {
		        set(fv, value(fn))
			if(reference(fv)) {
			  set(fs, save(fv))
		          if(inlist(ged_other_setlist, fs)) {
			    /* this individual is already in the set, so
			     * this family will be output
			     */
			    set(spseen, 1)
			    break()
			  }
		        }
		      }
		    }
		    if(spseen) { continue() }
		    if(fs) {
		      /* force this family to be included by adding a parent
		       * to the set
		       */
                      enqueue(ged_other_setlist, fs)
		      addtoset(ged_other_set, indi(fs), 1)
		      call ged_other_add(dereference(fs))
		      /* this persons families will also be included */
		      families(indi(fs), f, sp, m) {
		  	  set(fv, save(concat("@", key(f), "@")))
		  	  enqueue(ged_other_setlist, fv)
		  	  call ged_other_add(root(f))
		      }
		      continue()
		    }
		    /* family had no parents. add it to the list of others */
		  }
                  if (inlist(ged_other_list, v)) { continue() }
                  set(v, save(v))
                  enqueue(ged_other_list, v)
		}
	   }
	 }
}

/* ged_other_write() outputs the current list of other records in GEDCOM format */

proc ged_other_write()
{
        forlist(ged_other_list, k, n) {
		if(reference(k)) {
                  set(r, dereference(k))
        	  traverse(r, s, l) {
                	d(l)
                	if (xref(s)) { " " xref(s) }
                	" " tag(s)
                	if (v, value(s)) {
			  " " v
			}
                	"\n"
		  }
		}
        }
}

/* sample inlist() function for other versions of LifeLines

func inlist(alist, str)
{
  forlist(alist, any, n) {
    if(eqstr(any, str)) { return(1) }
  }
  return(0)
} 
* end of sample inlist() function */

/* sample header.ged 
0 HEAD 
1 SOUR LIFELINES
2 VERS 3.0.5
2 NAME LifeLines
2 CORP T. T. Wetmore
3 ADDR ttw@shore.net
1 SUBM @SM1@
1 GEDC 
2 VERS 5.5
2 FORM Lineage-Linked
1 CHAR ASCII
* end of sample header.ged */

/* sample submit.ged
0 @SM1@ SUBM
1 NAME Your Name Here
1 ADDR Your Street Address
2 CONT Your City, State and Zip Code
2 CONT E-mail: your@email.address
* end of sample submit.ged */