2
* @progname paf-export.ll
4
* @author Kurt Baudendistel (baud@research.att.com)
9
* Convert lifelines-standard gedcom to paf gedcom.
10
* This report generates paf-compatible gedcom from a lines-compatible
11
* database, including the conversion of SOUR entries into the bang-
12
* tagged NOTEs used by paf for documentation (see 5). This produces
13
* paf 2.2 output -- you can convert to 2.1 by loading and unloading
16
* First, some silly truncation and format conformance stuff:
18
* 1. NAMEs are truncated to four fields (3 given and 1 surname) of
19
* 16 characters each. The 3rd given name field is filled with
20
* multiple names concatenated by underscores, up to the 16 character
21
* limit. Characters trailing the surname are inserted as a TITL
22
* entry, taking precendence over or being subverted by another TITL
23
* entry (according to the order of the two -- the first takes
25
* 2. PLACes are truncated to four fields of 16 characters each.
26
* Leading commas are inserted to fill to four fields.
27
* 3. SEX is set to M, F, or blank.
28
* 4. DATEs are truncated to 23 characters. Date format checking is
29
* not (yet) performed. If you've done this elsewhere, please let
30
* me know and I'll stick it in.
31
* 5. No effort is made to conform to the 80 character per line limit.
33
* Let's define "contify" to mean read a line, check its length, and
34
* line break it using CONTs at a space so that the maximum line length
35
* is approached but not violated. Contification is best handled in
36
* a post-processing phase that simply reads in the file, contify's it,
37
* and outputs it again. This could be done, but is not.
39
* Should this simply check line lengths and contify those over 80
40
* characters, or should the system concatenate and then contify all
41
* lines? The latter is much more elegant and suitable for systems
42
* that assume post-processing, as with LaTeX, but the former is
43
* required to maintain "formatting" in ascii text while providing
44
* the automatic capability for producing paf-compatible files. I
45
* would argue that if the former is the case, that no contification
46
* should take place at all -- if the user wants some control over
47
* the formatting, then s/he should take full responsibility to
48
* maintain the formatting completely. And that's where we leave
49
* it, no contification is done.
51
* Next, only a restricted subset of the entries are output:
53
* 6. Only the following entries are output:
54
* - Level 1 records, only the first of multiple is output:
55
* NAME, TITL, SEX, BIRT, CHR, DEAT, BURI
56
* - Level 2 records, only the first of multiple is output:
58
* - Level 1 records, multiple outputs allowed:
59
* NOTE, FAMS, FAMC, AFN, REFN, HUSB, WIFE, CHIL, MARR,
60
* BAPL, ENDL, TEMP, SLGC, SLGS
61
* - Level 1 DIV, DIVF, and ANUL records are translated into DIV Y
62
* along with bang-tagged NOTEs (notes are not yet supported),
63
* multiple outputs are allowed.
64
* - Level 1 OCCU are converted to NOTEs.
65
* - Level 2 SOUR records are translated into bang-tagged NOTEs
66
* attached to the individual or to the head of the family,
67
* husband or wife if there is no husband, for marriage/divorce
68
* sources, multiple outputs are allowed.
70
* The format of the NOTEs is as described in the 1993 Edition of
71
* of the PAF Documentation Guidelines produced by the Silicon
72
* Valley Users Group, where the text of each gedcom record is
75
* m SOUR text -> !event: text
76
* m @xx@ SOUR -> !event: AUTHor or NAME, TITLe; PERIod;
77
* PUBRisher and publication information,
78
* ADDR, DATE; PAGEs; REPOsitory; NOTEs
79
* m SOUR @xx@ -> !event: See xx.
81
* Generally, source references must be converted to definitions
82
* before they can be used to produce legal NOTEs according to the
83
* PAF DC (I use an awk script for this in lieu of real lifelines
84
* support for sources in 2.3.6).
86
* TITL is replaced by "TITL," PUBL when the PUBL record exists --
87
* this structure is used to give the TITLe of an article in a
90
* Actually, this is not quite correct:
91
* . The PDG does not require the bang, but rather uses it to signal
92
* ``public'' notes -- we assume that all notes are public, though,
94
* . The PDG requires ;;;;; before text in a plain note, but this
95
* seems like overkill.
97
* No other entries are output!
99
* 8. CONTs are only handled correctly for NOTEs and SOURs.
101
* Finally, some output formatting is available:
103
* 9. Submitter information can be optionally included. If used, this
104
* should be a file of the form
107
* 1 NAME Kurt Baudendistel
108
* 1 ADDR 420 River Rd, Apt D7
109
* 2 CONT Chatham, NJ 07928
110
* 2 CONT baud@research.att.com
111
* 1 PHON (908) 582-2168
113
* Note that errors in this file format will not be checked -- it
114
* is simply inserted in the gedcom output.
116
* Possible future upgrades:
118
* A. When multiple records, such as BIRT are found, output the later
121
* C. Convert date formats to legal ones, including bumping non-date
122
* information, such as "See Notes" into NOTEs.
123
* D. Output submitter information that is stored in the database.
125
* This capability is easy to use inside any other program that
126
* generates a restricted set of families/individuals. Simply include
127
* the pafX functions given below main and use pafindi/paffam instead
128
* of the standard outindi/outfam given in simpleged.
130
* From: simpleged ttw@beltway.att.com
131
* pafcompat eggertj@ll.mit.edu
133
* 12 NOV 1994 (2.3.6) baud@research.att.com
143
"2 NAME PAF-EXPORT REPORT\n"
146
"1 DATE " date (gettoday ()) "\n"
148
getstrmsg (submitterFile,
149
"What is the name of the submitter information file (null okay)?")
150
if (strcmp ("", submitterFile)) {
151
"1 COPR Copyright " date (gettoday ()) ". Permission is granted to repro"
152
"duce any subset\n2 CONT of the data contained herein under the condit"
153
"ion that this copyright\n2 CONT notice is preserved, that the origina"
154
"l source citations referenced\n2 CONT in the subset are included, and"
155
" that the submitter of this file is\n2 CONT credited with original au"
156
"thorship as appropriate.\n"
157
copyfile (submitterFile)
161
print ("Processing nodes (x10) ...\n")
162
forindi (indi, num) {
163
if (eq (mod (num, 10), 0)) {
170
if (eq (mod (num, 10), 0)) {
185
set (root, inode (indi))
193
if (eq (nfamilies (indi), 1)) {
194
set (fams_counter, 0)
196
set (fams_counter, 1)
198
"0 " xref (root) " " tag (root) "\n"
199
fornodes (root, node) {
200
if (and (noname, not (strcmp ("NAME", tag (node))))) {
201
"1 NAME" call pafname (value (node)) "\n"
202
if (and (notitl, strlen (paftitl))) {
203
"1 TITL" paftitl "\n"
207
} elsif (and (notitl, not (strcmp ("TITL", tag (node))))) {
208
"1 TITL " value (node) "\n"
210
} elsif (and (nosex, not (strcmp ("SEX", tag (node))))) {
211
"1 SEX " call pafsex (value (node)) "\n"
213
} elsif (and (nobirt, not (strcmp ("BIRT", tag (node))))) {
214
call pafevent (node, 1, 1, 0, 0)
216
} elsif (and (nobapt, not (strcmp ("CHR", tag (node))))) {
217
call pafevent (node, 1, 1, 0, 0)
219
} elsif (and (nodeat, not (strcmp ("DEAT", tag (node))))) {
220
call pafevent (node, 1, 1, 0, 0)
222
} elsif (and (noburi, not (strcmp ("BURI", tag (node))))) {
223
call pafevent (node, 1, 1, 0, 0)
225
} elsif (not (strcmp ("BAPL", tag (node)))) {
226
"1 BAPL" call pafevent (node, 1, 1, 0, 0)"\n"
227
} elsif (not (strcmp ("ENDL", tag (node)))) {
228
"1 ENDL" call pafevent (node, 1, 1, 0, 0)"\n"
229
} elsif (not (strcmp ("TEMP", tag (node)))) {
230
"1 TEMP" call pafevent (node, 1, 1, 0, 0)"\n"
231
} elsif (not (strcmp ("SLGC", tag (node)))) {
232
"1 SLGC" call pafevent (node, 1, 1, 0, 0)"\n"
233
} elsif (not (strcmp ("SLGS", tag (node)))) {
234
"1 SLGS" call pafevent (node, 1, 1, 0, 0)"\n"
235
} elsif (not (strcmp ("FAMC", tag (node)))) {
236
"1 FAMC " value (node) "\n"
237
} elsif (not (strcmp ("FAMS", tag (node)))) {
238
"1 FAMS " value (node) "\n"
239
set (f, fam (value (node)))
240
if (or (not (husband (f)), eq (husband (f), indi))) {
241
call pafevent (marriage (f), 0, 1, 0, fams_counter)
242
fornodes (fnode (f), subnode) {
243
if (or (or (not (strcmp ("DIV", tag (subnode))),
244
not (strcmp ("DIVF", tag (subnode)))),
245
not (strcmp ("ANUL", tag (subnode))))) {
246
call pafevent (subnode, 0, 1, 1, fams_counter)
251
} elsif (not (strcmp ("OCCU", tag (node)))) {
252
"1 NOTE OCCUPATION: " call values (node) "\n"
253
} elsif (not (strcmp ("NOTE", tag (node)))) {
254
"1 NOTE " call values (node) "\n"
255
} elsif (not (strcmp ("AFN", tag (node)))) {
256
"1 AFN" value (node) "\n"
257
} elsif (not (strcmp ("REFN", tag (node)))) {
258
"1 REFN" value (node) "\n"
265
set (root, fnode (fam))
266
"0 " xref (root) " " tag (root) "\n"
267
fornodes (root, node) {
268
if (not (strcmp ("HUSB", tag (node)))) {
269
"1 HUSB " value (node) "\n"
270
} elsif (not (strcmp ("WIFE", tag (node)))) {
271
"1 WIFE " value (node) "\n"
272
} elsif (not (strcmp ("CHIL", tag (node)))) {
273
"1 CHIL " value (node) "\n"
274
} elsif (not (strcmp ("MARR", tag (node)))) {
275
call pafevent (node, 1, 0, 0, 0)
276
} elsif (not (strcmp ("DIV", tag (node)))) {
278
} elsif (not (strcmp ("DIVF", tag (node)))) {
280
} elsif (not (strcmp ("ANUL", tag (node)))) {
286
proc pafevent (event, eventflag, sourceflag, noteflag, count)
289
insert (tagnotes,"BIRT","BIRTH")
290
insert (tagnotes,"CHR", "CHRISTENING")
291
insert (tagnotes,"DEAT","DEATH")
292
insert (tagnotes,"BURI","BURIAL")
293
insert (tagnotes,"MARR","MARRIAGE")
294
insert (tagnotes,"DIV", "DIVORCE")
295
insert (tagnotes,"DIVF", "DIVORCEFINAL")
296
insert (tagnotes,"ANUL", "ANNULMENT")
299
set (tagname, lookup (tagnotes, tag (event)))
300
if (not (strcmp ("", tagname))) { set (tagname, tag (event)) }
303
"1 " tag (event) "\n"
306
fornodes (event, evt) {
307
if (not (strcmp ("DATE", tag (evt)))) {
308
if (eq (datecount, 1)) {
309
"2 DATE " call pafdate (value (evt)) "\n"
312
} elsif (not (strcmp ("PLAC", tag (evt)))) {
313
if (eq (placecount, 1)) {
314
"2 PLAC " call pafplac (value (evt)) "\n"
330
fornodes (event, evt) {
331
if (not (strcmp ("DATE", tag (evt)))) {
332
if (gt (datecount, countlimit)) {
333
"1 NOTE " tagname "DATE"
334
if (count) { "(" d (count) ")" }
335
": " call pafdate (value (evt)) "\n"
338
} elsif (not (strcmp ("PLAC", tag (evt)))) {
339
if (gt (placecount, countlimit)) {
340
"1 NOTE " tagname "PLACE"
341
if (count) { "(" d (count) ")" }
342
": " call pafplac (value (evt)) "\n"
344
if (or (not (strcmp ("SITE", tag (child (evt)))),
345
not (strcmp ("CEME", tag (child (evt)))))) {
347
if (not (strcmp (tagname, "BURIAL"))) {
353
if (count) { "(" d (count) ")" }
355
call values (child (evt)) "\n"
358
} elsif (not (strcmp ("CAUS", tag (evt)))) {
359
"1 NOTE " tagname "CAUSE: " call values (evt) "\n"
360
} elsif (not (strcmp ("AGE", tag (evt)))) {
361
"1 NOTE " tagname "AGE: " call values (evt) "\n"
362
} elsif (not (strcmp ("SOUR", tag (evt)))) {
364
if (count) { "(" d (count) ")" }
365
": " call pafsour (evt) "\n"
366
} elsif (not (strcmp ("NOTE", tag (evt)))) {
368
if (count) { "(" d (count) ")" }
369
"NOTE:\n2 CONT " call values (evt) "\n"
380
set (k1, index (name,"/", 1))
381
set (k2, index (name,"/", 2))
385
set (j, index (name," ", c))
386
if (or (eq (j, 0), gt (j, k1))) {
393
set (n, sub (sub (n, m), 1))
394
if (lt (n, 0)) { set (n, 0) }
396
trim (substring (name, i, sub (j, 1)), n)
402
substring (name, k1, k2)
403
set (paftitl, substring (name, add (k2, 1), strlen (name)))
408
if (or (not (strcmp ("M", name)), not (strcmp ("F", name)))) { name }
421
set (I, add (strlen (name), 1))
423
while (and (lt (i,I), lt (c, 5))) {
424
set (j, index (name,",", c))
428
set (plac, concat (plac, trim (substring (name, i, sub (j, 1)), 16)))
429
set (plac, concat (plac,","))
434
set (plac, concat (",", plac))
437
substring (plac, 1, sub (strlen (plac), 1))
440
proc pafsour (root) {
442
if (not (strcmp ("NAME", tag (n)))) { set (auth, n) }
443
elsif (not (strcmp ("AUTH", tag (n)))) { set (auth, n) }
444
elsif (not (strcmp ("TITL", tag (n)))) { set (titl, n) }
445
elsif (not (strcmp ("PUBL", tag (n)))) { set (publ, n) }
446
elsif (not (strcmp ("PERI", tag (n)))) { set (peri, n) }
447
elsif (not (strcmp ("PUBR", tag (n)))) { set (pubr, n) }
448
elsif (not (strcmp ("ADDR", tag (n)))) { set (addr, n) }
449
elsif (not (strcmp ("PHON", tag (n)))) { set (phon, n) }
450
elsif (not (strcmp ("DATE", tag (n)))) { set (date, n) }
451
elsif (not (strcmp ("VOLU", tag (n)))) { set (vol, n) }
452
elsif (not (strcmp ("VOL", tag (n)))) { set (vol, n) }
453
elsif (not (strcmp ("NUM", tag (n)))) { set (num, n) }
454
elsif (not (strcmp ("PAGE", tag (n)))) { set (page, n) }
455
elsif (not (strcmp ("REPO", tag (n)))) { set (repo, n) }
456
elsif (not (strcmp ("SOUR", tag (n)))) { set (sour, n) }
457
elsif (not (strcmp ("FILM", tag (n)))) { set (film, n) }
458
elsif (not (strcmp ("NOTE", tag (n)))) { set (note, n) }
460
set (any, or (auth, or (titl, or (publ, or (peri, or (pubr, or (addr,
461
or (phon, or (date, or (vol, or (num, or (page, or (repo,
464
if (auth) { call values (auth) }
467
if (titl) { "\n2 CONT \"" call values (titl) ",\"" }
468
"\n2 CONT " call values (publ)
471
"\n2 CONT " call values (titl)
473
";" if (peri) { "\n2 CONT " call values (peri) }
474
";" if (pubr) { "\n2 CONT " call values (pubr) }
475
if (addr) { if (pubr) { "," } "\n2 CONT " call values (addr) }
477
if (or (pubr, addr)) { "," }
478
"\n2 CONT " call values (phon)
481
if (or (pubr, or (addr, phon))) { "," }
482
"\n2 CONT " call values (date)
484
";" if (film) { "\n2 CONT " "Film Number " call values (film) }
485
if (vol) { "\n2 CONT " "Volume " call values (vol) }
486
if (num) { "\n2 CONT " "Number " call values (num) }
487
if (page) { "\n2 CONT " "Page(s) " call values (page) }
488
";" if (repo) { "\n2 CONT " call values (repo) }
489
if (and (film, not (repo))) {
490
"\n2 CONT Church of Jesus Christ of Latter Day Saints, "
493
";" if (note) { "\n2 CONT " call values (note) }
495
if (v, value (root)) {
496
if (and (eq (index (v, "@", 1), 1), eq (index (v, "@", 2), strlen (v)))) {
498
"See " substring (v, 2, sub (strlen (v), 1)) "."
501
"\n2 CONT " call values (root)
505
"\n2 CONT " call pafsour (sour)
513
if (not (strcmp ("CONT", tag (n)))) {
514
"\n2 CONT " value (n)