File: paf-export.ll

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 (517 lines) | stat: -rw-r--r-- 18,217 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
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
/*
 * @progname       paf-export.ll
 * @version        1994-11-12
 * @author         Kurt Baudendistel (baud@research.att.com)
 * @category       
 * @output         GEDCOM
 * @description
 *
 *      Convert lifelines-standard gedcom to paf gedcom.
 *      This report generates paf-compatible gedcom from a lines-compatible
 *      database, including the conversion of SOUR entries into the bang-
 *      tagged NOTEs used by paf for documentation (see 5).  This produces
 *      paf 2.2 output -- you can convert to 2.1 by loading and unloading
 *      it using paf 2.2.
 *
 *      First, some silly truncation and format conformance stuff:
 *
 *      1. NAMEs are truncated to four fields (3 given and 1 surname) of
 *         16 characters each. The 3rd given name field is filled with
 *         multiple names concatenated by underscores, up to the 16 character
 *         limit.  Characters trailing the surname are inserted as a TITL
 *         entry, taking precendence over or being subverted by another TITL
 *         entry (according to the order of the two -- the first takes
 *         precedence).
 *      2. PLACes are truncated to four fields of 16 characters each.
 *         Leading commas are inserted to fill to four fields.
 *      3. SEX is set to M, F, or blank.
 *      4. DATEs are truncated to 23 characters. Date format checking is
 *         not (yet) performed. If you've done this elsewhere, please let
 *         me know and I'll stick it in.
 *      5. No effort is made to conform to the 80 character per line limit.
 *
 *         Let's define "contify" to mean read a line, check its length, and
 *         line break it using CONTs at a space so that the maximum line length
 *         is approached but not violated.  Contification is best handled in
 *         a post-processing phase that simply reads in the file, contify's it,
 *         and outputs it again. This could be done, but is not.
 *
 *         Should this simply check line lengths and contify those over 80
 *         characters, or should the system concatenate and then contify all
 *         lines? The latter is much more elegant and suitable for systems
 *         that assume post-processing, as with LaTeX, but the former is
 *         required to maintain "formatting" in ascii text while providing
 *         the automatic capability for producing paf-compatible files. I
 *         would argue that if the former is the case, that no contification
 *         should take place at all -- if the user wants some control over
 *         the formatting, then s/he should take full responsibility to
 *         maintain the formatting completely. And that's where we leave
 *         it, no contification is done.
 *
 *      Next, only a restricted subset of the entries are output:
 *
 *      6. Only the following entries are output:
 *         - Level 1 records, only the first of multiple is output:
 *              NAME, TITL, SEX, BIRT, CHR, DEAT, BURI
 *         - Level 2 records, only the first of multiple is output:
 *              DATE, PLAC
 *         - Level 1 records, multiple outputs allowed:
 *              NOTE, FAMS, FAMC, AFN, REFN, HUSB, WIFE, CHIL, MARR,
 *              BAPL, ENDL, TEMP, SLGC, SLGS
 *         - Level 1 DIV, DIVF, and ANUL records are translated into DIV Y
 *           along with bang-tagged NOTEs (notes are not yet supported),
 *           multiple outputs are allowed.
 *         - Level 1 OCCU are converted to NOTEs.
 *         - Level 2 SOUR records are translated into bang-tagged NOTEs
 *           attached to the individual or to the head of the family,
 *           husband or wife if there is no husband, for marriage/divorce
 *           sources, multiple outputs are allowed.
 *
 *           The format of the NOTEs is as described in the 1993 Edition of
 *           of the PAF Documentation Guidelines produced by the Silicon
 *           Valley Users Group, where the text of each gedcom record is
 *           inserted as shown:
 *
 *              m SOUR text -> !event: text
 *              m @xx@ SOUR -> !event: AUTHor or NAME, TITLe; PERIod;
 *                                     PUBRisher and publication information,
 *                                     ADDR, DATE; PAGEs; REPOsitory; NOTEs
 *              m SOUR @xx@ -> !event: See xx.
 *
 *           Generally, source references must be converted to definitions
 *           before they can be used to produce legal NOTEs according to the
 *           PAF DC (I use an awk script for this in lieu of real lifelines
 *           support for sources in 2.3.6).
 *
 *           TITL is replaced by "TITL," PUBL when the PUBL record exists --
 *           this structure is used to give the TITLe of an article in a
 *           PUBLication.
 *
 *           Actually, this is not quite correct:
 *           . The PDG does not require the bang, but rather uses it to signal
 *             ``public'' notes -- we assume that all notes are public, though,
 *             and so require it.
 *           . The PDG requires ;;;;; before text in a plain note, but this
 *             seems like overkill.
 *
 *         No other entries are output!
 *
 *      8. CONTs are only handled correctly for NOTEs and SOURs.
 *
 *      Finally, some output formatting is available:
 *
 *      9. Submitter information can be optionally included. If used, this
 *         should be a file of the form
 *
 *              0 @xx@ SUBM
 *              1 NAME Kurt Baudendistel
 *              1 ADDR 420 River Rd, Apt D7
 *              2 CONT Chatham, NJ  07928
 *              2 CONT baud@research.att.com
 *              1 PHON (908) 582-2168
 *
 *         Note that errors in this file format will not be checked -- it
 *         is simply inserted in the gedcom output.
 *
 *      Possible future upgrades:
 *
 *      A. When multiple records, such as BIRT are found, output the later
 *         ones as NOTEs.
 *      B. Contify.
 *      C. Convert date formats to legal ones, including bumping non-date
 *         information, such as "See Notes" into NOTEs.
 *      D. Output submitter information that is stored in the database.
 *
 *      This capability is easy to use inside any other program that
 *      generates a restricted set of families/individuals. Simply include
 *      the pafX functions given below main and use pafindi/paffam instead
 *      of the standard outindi/outfam given in simpleged.
 *
 *      From:   simpleged               ttw@beltway.att.com
 *              pafcompat               eggertj@ll.mit.edu
 *
 *      12 NOV 1994 (2.3.6)             baud@research.att.com
 */

/* main function */

proc main ()
{
  "0 HEAD \n"
  "1 SOUR LIFELINES\n"
  "2 VER 2.3.6\n"
  "2 NAME PAF-EXPORT REPORT\n"
  "1 DEST PAF\n"
  "2 VER 2.2\n"
  "1 DATE " date (gettoday ()) "\n"

  getstrmsg (submitterFile,
    "What is the name of the submitter information file (null okay)?")
  if (strcmp ("", submitterFile)) {
    "1 COPR Copyright " date (gettoday ()) ". Permission is granted to repro"
      "duce any subset\n2 CONT of the data contained herein under the condit"
      "ion that this copyright\n2 CONT notice is preserved, that the origina"
      "l source citations referenced\n2 CONT in the subset are included, and"
      " that the submitter of this file is\n2 CONT credited with original au"
      "thorship as appropriate.\n"
    copyfile (submitterFile)
  }
  "1 CHAR ASCII\n"

  print ("Processing nodes (x10) ...\n")
  forindi (indi, num) {
    if (eq (mod (num, 10), 0)) {
      print ("i")
    }
    call pafindi (indi)
  }

  forfam (fam, num) {
    if (eq (mod (num, 10), 0)) {
      print ("f")
    }
    call paffam (fam)
  }

  "0 TRLR \n"
}

/* pafX functions */

global (paftitl)

proc pafindi (indi)
{
  set (root, inode (indi))
  set (noname, 1)
  set (notitl, 1)
  set (nosex, 1)
  set (nobirt, 1)
  set (nobapt, 1)
  set (nodeat, 1)
  set (noburi, 1)
  if (eq (nfamilies (indi), 1)) {
    set (fams_counter, 0)
  } else {
    set (fams_counter, 1)
  }
  "0 " xref (root) " " tag (root) "\n"
  fornodes (root, node) {
    if (and (noname, not (strcmp ("NAME", tag (node))))) {
      "1 NAME" call pafname (value (node)) "\n"
      if (and (notitl, strlen (paftitl))) {
        "1 TITL" paftitl "\n"
        set (notitl, 0)
      }
      set (noname, 0)
    } elsif (and (notitl, not (strcmp ("TITL", tag (node))))) {
      "1 TITL " value (node) "\n"
      set (notitl, 0)
    } elsif (and (nosex, not (strcmp ("SEX", tag (node))))) {
      "1 SEX " call pafsex (value (node)) "\n"
      set (nosex, 0)
    } elsif (and (nobirt, not (strcmp ("BIRT", tag (node))))) {
      call pafevent (node, 1, 1, 0, 0)
      set (nobirt, 0)
    } elsif (and (nobapt, not (strcmp ("CHR", tag (node))))) {
      call pafevent (node, 1, 1, 0, 0)
      set (nobapt, 0)
    } elsif (and (nodeat, not (strcmp ("DEAT", tag (node))))) {
      call pafevent (node, 1, 1, 0, 0)
      set (nodeat, 0)
    } elsif (and (noburi, not (strcmp ("BURI", tag (node))))) {
      call pafevent (node, 1, 1, 0, 0)
      set (noburi, 0)
    } elsif (not (strcmp ("BAPL", tag (node)))) {
      "1 BAPL" call pafevent (node, 1, 1, 0, 0)"\n"
    } elsif (not (strcmp ("ENDL", tag (node)))) {
      "1 ENDL" call pafevent (node, 1, 1, 0, 0)"\n"
    } elsif (not (strcmp ("TEMP", tag (node)))) {
      "1 TEMP" call pafevent (node, 1, 1, 0, 0)"\n"
    } elsif (not (strcmp ("SLGC", tag (node)))) {
      "1 SLGC" call pafevent (node, 1, 1, 0, 0)"\n"
    } elsif (not (strcmp ("SLGS", tag (node)))) {
      "1 SLGS" call pafevent (node, 1, 1, 0, 0)"\n"
    } elsif (not (strcmp ("FAMC", tag (node)))) {
      "1 FAMC " value (node) "\n"
    } elsif (not (strcmp ("FAMS", tag (node)))) {
      "1 FAMS " value (node) "\n"
      set (f, fam (value (node)))
      if (or (not (husband (f)), eq (husband (f), indi))) {
        call pafevent (marriage (f), 0, 1, 0, fams_counter)
        fornodes (fnode (f), subnode) {
          if (or (or (not (strcmp ("DIV", tag (subnode))),
                      not (strcmp ("DIVF", tag (subnode)))),
                      not (strcmp ("ANUL", tag (subnode))))) {
            call pafevent (subnode, 0, 1, 1, fams_counter)
          }
        }
      }
      incr (fams_counter)
    } elsif (not (strcmp ("OCCU", tag (node)))) {
      "1 NOTE OCCUPATION: " call values (node) "\n"
    } elsif (not (strcmp ("NOTE", tag (node)))) {
      "1 NOTE " call values (node) "\n"
    } elsif (not (strcmp ("AFN", tag (node)))) {
      "1 AFN" value (node) "\n"
    } elsif (not (strcmp ("REFN", tag (node)))) {
      "1 REFN" value (node) "\n"
    }
  }
}

proc paffam (fam)
{
  set (root, fnode (fam))
  "0 " xref (root) " " tag (root) "\n"
  fornodes (root, node) {
    if (not (strcmp ("HUSB", tag (node)))) {
      "1 HUSB " value (node) "\n"
    } elsif (not (strcmp ("WIFE", tag (node)))) {
      "1 WIFE " value (node) "\n"
    } elsif (not (strcmp ("CHIL", tag (node)))) {
      "1 CHIL " value (node) "\n"
    } elsif (not (strcmp ("MARR", tag (node)))) {
      call pafevent (node, 1, 0, 0, 0)
    } elsif (not (strcmp ("DIV", tag (node)))) {
      "1 DIV Y\n"
    } elsif (not (strcmp ("DIVF", tag (node)))) {
      "1 DIV Y\n"
    } elsif (not (strcmp ("ANUL", tag (node)))) {
      "1 DIV Y\n"
    }
  }
}

proc pafevent (event, eventflag, sourceflag, noteflag, count)
{
  table (tagnotes)
  insert (tagnotes,"BIRT","BIRTH")
  insert (tagnotes,"CHR", "CHRISTENING")
  insert (tagnotes,"DEAT","DEATH")
  insert (tagnotes,"BURI","BURIAL")
  insert (tagnotes,"MARR","MARRIAGE")
  insert (tagnotes,"DIV", "DIVORCE")
  insert (tagnotes,"DIVF", "DIVORCEFINAL")
  insert (tagnotes,"ANUL", "ANNULMENT")

  if (event) {
    set (tagname, lookup (tagnotes, tag (event)))
    if (not (strcmp ("", tagname))) { set (tagname, tag (event)) }

    if (eventflag) {
      "1 " tag (event) "\n"
      set (datecount, 1)
      set (placecount, 1)
      fornodes (event, evt) {
        if (not (strcmp ("DATE", tag (evt)))) {
          if (eq (datecount, 1)) {
            "2 DATE " call pafdate (value (evt)) "\n"
          }
          incr (datecount)
        } elsif (not (strcmp ("PLAC", tag (evt)))) {
          if (eq (placecount, 1)) {
            "2 PLAC " call pafplac (value (evt)) "\n"
          }
          incr (placecount)
        }
      }
    }

    if (noteflag) {
      set (countlimit, 0)
    } else {
      set (countlimit, 1)
    }

    if (sourceflag) {
      set (datecount, 1)
      set (placecount, 1)
      fornodes (event, evt) {
        if (not (strcmp ("DATE", tag (evt)))) {
          if (gt (datecount, countlimit)) {
            "1 NOTE " tagname "DATE"
            if (count) { "(" d (count) ")" }
            ": " call pafdate (value (evt)) "\n"
          }
          incr (datecount)
        } elsif (not (strcmp ("PLAC", tag (evt)))) {
          if (gt (placecount, countlimit)) {
            "1 NOTE " tagname "PLACE"
            if (count) { "(" d (count) ")" }
            ": " call pafplac (value (evt)) "\n"
          }
          if (or (not (strcmp ("SITE", tag (child (evt)))),
                  not (strcmp ("CEME", tag (child (evt)))))) {
            "1 NOTE "
            if (not (strcmp (tagname, "BURIAL"))) {
              "CEMETERY"
            } else {
              tagname
              "SITE"
            }
            if (count) { "(" d (count) ")" }
            ": "
            call values (child (evt)) "\n"
          }
          incr (placecount)
        } elsif (not (strcmp ("CAUS", tag (evt)))) {
          "1 NOTE " tagname "CAUSE: " call values (evt) "\n"
        } elsif (not (strcmp ("AGE", tag (evt)))) {
          "1 NOTE " tagname "AGE: " call values (evt) "\n"
        } elsif (not (strcmp ("SOUR", tag (evt)))) {
          "1 NOTE !" tagname
          if (count) { "(" d (count) ")" }
          ": " call pafsour (evt) "\n"
        } elsif (not (strcmp ("NOTE", tag (evt)))) {
          "1 NOTE " tagname
          if (count) { "(" d (count) ")" }
          "NOTE:\n2 CONT " call values (evt) "\n"
        }
      }
    }
  }
}

proc pafname (name)
{
  set (c, 1)
  set (i, 1)
  set (k1, index (name,"/", 1))
  set (k2, index (name,"/", 2))
  set (n, 16)
  set (m, 0)
  while (lt (i, k1)) {
    set (j, index (name," ", c))
    if (or (eq (j, 0), gt (j, k1))) {
      set (j, k1)
    }
    if (lt (c, 4)) {
      " "
    } else {
      "_"
      set (n, sub (sub (n, m), 1))
      if (lt (n, 0)) { set (n, 0) }
    }
    trim (substring (name, i, sub (j, 1)), n)
    set (m, sub (j, i))
    set (i, add (j, 1))
    set (c, add (c, 1))
  }
  " "
  substring (name, k1, k2)
  set (paftitl, substring (name, add (k2, 1), strlen (name)))
}

proc pafsex (name)
{
  if (or (not (strcmp ("M", name)), not (strcmp ("F", name)))) { name }
  else { " " }
}

proc pafdate (name)
{
  trim (name, 23)
}

proc pafplac (name)
{
  set (c, 1)
  set (i, 1)
  set (I, add (strlen (name), 1))
  set (plac,"")
  while (and (lt (i,I), lt (c, 5))) {
    set (j, index (name,",", c))
    if (eq (j, 0)) {
      set (j,I)
    }
    set (plac, concat (plac, trim (substring (name, i, sub (j, 1)), 16)))
    set (plac, concat (plac,","))
    set (i, add (j, 1))
    set (c, add (c, 1))
  }
  while (lt (c, 5)) {
    set (plac, concat (",", plac))
    set (c, add (c, 1))
  }
  substring (plac, 1, sub (strlen (plac), 1))
}

proc pafsour (root) {
  fornodes (root, n) {
    if (not (strcmp ("NAME", tag (n)))) { set (auth, n) }
    elsif (not (strcmp ("AUTH", tag (n)))) { set (auth, n) }
    elsif (not (strcmp ("TITL", tag (n)))) { set (titl, n) }
    elsif (not (strcmp ("PUBL", tag (n)))) { set (publ, n) }
    elsif (not (strcmp ("PERI", tag (n)))) { set (peri, n) }
    elsif (not (strcmp ("PUBR", tag (n)))) { set (pubr, n) }
    elsif (not (strcmp ("ADDR", tag (n)))) { set (addr, n) }
    elsif (not (strcmp ("PHON", tag (n)))) { set (phon, n) }
    elsif (not (strcmp ("DATE", tag (n)))) { set (date, n) }
    elsif (not (strcmp ("VOLU", tag (n)))) { set (vol, n)  }
    elsif (not (strcmp ("VOL",  tag (n)))) { set (vol, n)  }
    elsif (not (strcmp ("NUM",  tag (n)))) { set (num,  n) }
    elsif (not (strcmp ("PAGE", tag (n)))) { set (page, n) }
    elsif (not (strcmp ("REPO", tag (n)))) { set (repo, n) }
    elsif (not (strcmp ("SOUR", tag (n)))) { set (sour, n) }
    elsif (not (strcmp ("FILM", tag (n)))) { set (film, n) }
    elsif (not (strcmp ("NOTE", tag (n)))) { set (note, n) }
  }
  set (any, or (auth, or (titl, or (publ, or (peri, or (pubr, or (addr,
               or (phon, or (date, or (vol, or (num, or (page, or (repo,
               note)))))))))))))
  if (any) {
    if (auth) { call values (auth) }
    if (publ) {
      if (auth) { "," }
      if (titl) { "\n2 CONT \"" call values (titl) ",\"" }
      "\n2 CONT " call values (publ)
    } elsif (titl) {
      if (auth) { "," }
      "\n2 CONT " call values (titl)
    }
    ";" if (peri) { "\n2 CONT " call values (peri) }
    ";" if (pubr) { "\n2 CONT " call values (pubr) }
        if (addr) { if (pubr) { "," } "\n2 CONT " call values (addr) }
        if (phon) {
          if (or (pubr, addr)) { "," }
          "\n2 CONT " call values (phon)
        }
        if (date) {
          if (or (pubr, or (addr, phon))) { "," }
          "\n2 CONT " call values (date)
        }
    ";" if (film) { "\n2 CONT " "Film Number " call values (film) }
        if (vol)  { "\n2 CONT " "Volume " call values (vol) }
        if (num)  { "\n2 CONT " "Number " call values (num) }
        if (page) { "\n2 CONT " "Page(s) " call values (page) }
    ";" if (repo) { "\n2 CONT " call values (repo) }
        if (and (film, not (repo))) {
          "\n2 CONT Church of Jesus Christ of Latter Day Saints, "
            "Salt Lake City, UT"
        }
    ";" if (note) { "\n2 CONT " call values (note) }
  }
  if (v, value (root)) {
    if (and (eq (index (v, "@", 1), 1), eq (index (v, "@", 2), strlen (v)))) {
      if (not (any)) {
        "See " substring (v, 2, sub (strlen (v), 1)) "."
      }
    } else {
      "\n2 CONT " call values (root)
    }
  }
  if (sour) {
    "\n2 CONT " call pafsour (sour)
  }
}

proc values (node)
{
  value (node)
  fornodes (node, n) {
    if (not (strcmp ("CONT", tag (n)))) {
      "\n2 CONT " value (n)
    }
  }
}