← Back to branch summary

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

« back to all changes in this revision

Viewing changes to reports/paf-import.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/paf-import.ll
 
1
/*
 
2
 * @progname       paf-import.ll
 
3
 * @version        1994-11-12
 
4
 * @author         Kurt Baudendistel (baud@research.att.com)
 
5
 * @category       
 
6
 * @output         GEDCOM
 
7
 * @description
 
8
 *
 
9
 *        Convert paf gedcom to lifelines-standard gedcom,
 
10
 *        transforming name formats and notes.
 
11
 *
 
12
 *        First, some silly formating:
 
13
 *
 
14
 *        1. _'s in NAMEs are converted to spaces.
 
15
 *        2. Leading commas are stripped from PLACes
 
16
 *        3. Recognizable posttitles are moved from TITL entries to NAME
 
17
 *           entries.
 
18
 *
 
19
 *        Then, the meat of the problem
 
20
 *
 
21
 *        4. Bang-tagged NOTEs of the form
 
22
 *
 
23
 *                1 NOTE !BIRTH-CHRISTENING: ...
 
24
 *                2 CONT ...
 
25
 *
 
26
 *           are converted to SOURs in the appropriate event, and the
 
27
 *           original NOTE is deleted. The following NOTEs are recognized and
 
28
 *           translated into the corresponding event (an event is created
 
29
 *           if it does not exist):
 
30
 *
 
31
 *              NAME            -> NAME
 
32
 *              BIRTH           -> BIRT
 
33
 *              PARENTS         -> BIRT
 
34
 *              FATHER          -> BIRT
 
35
 *              MOTHER          -> BIRT
 
36
 *              ADOPTION        -> ADOP
 
37
 *              CHRISTENING     -> CHR
 
38
 *              DEATH           -> DEAT
 
39
 *              BURIAL          -> BURI
 
40
 *              MARRIAGE        -> MARR (in first associated family)
 
41
 *              MARRIAGE(N)     -> MARR (in numbered associated family)
 
42
 *              MARRIAGES       -> MARR (in all associated families)
 
43
 *              DIVORCE         -> DIV  (in first associated family)
 
44
 *              DIVORCE(N)      -> DIV  (in numbered associated family)
 
45
 *              DIVORCES        -> DIV  (in all associated families)
 
46
 *              DIVORCEFINAL    -> DIVF (in first associated family)
 
47
 *              DIVORCEFINAL(N) -> DIVF (in numbered associated family)
 
48
 *              DIVORCEFINALS   -> DIVF (in all associated families)
 
49
 *              ANNULMENT       -> ANUL (in first associated family)
 
50
 *              ANNULMENT(N)    -> ANUL (in numbered associated family)
 
51
 *              ANNULMENTS      -> ANUL (in all associated families)
 
52
 *
 
53
 *           The NOTE is not deleted if any of the components are not
 
54
 *           recognized. Plain bang-tagged NOTEs are converted to TEXT.
 
55
 *
 
56
 *           Multiple NOTEs produce multiple SOURs, just as you would expect.
 
57
 *
 
58
 *        5. Non-bang-tagged NOTEs of the form
 
59
 *
 
60
 *                1 NOTE BIRTH: ...
 
61
 *                2 CONT ...
 
62
 *
 
63
 *           are converted to NOTEs in the appropriate event for those
 
64
 *           events listed above, and the original NOTE is deleted. Note
 
65
 *           multiple NOTE targets (as in BIRTH-CHRISTENING) are not allowed
 
66
 *           for non-bang-tagged NOTEs, and that containing nodes (like
 
67
 *           PLAC) are not created if they do not exist -- the NOTE is simply
 
68
 *           lost.
 
69
 *
 
70
 *           For the following NOTEs, a record is created of the
 
71
 *           indicated type (death here can be replaced by any event):
 
72
 *
 
73
 *              DEATHSITE       -> DEAT - PLAC - SITE
 
74
 *              DEATHAGE        -> DEAT - AGE
 
75
 *              DEATHCAUSE      -> DEAT - CAUS
 
76
 *              CEMETERY        -> (same as BURIALSITE)
 
77
 *              EDITOR          -> SOUR (at level 1)
 
78
 *              RESEARCHER      -> SOUR (at level 1)
 
79
 *              OCCUPATION      -> OCCU
 
80
 *
 
81
 *           Of course, the original note is deleted.
 
82
 *
 
83
 *      From:   paf                     baud@research.att.com
 
84
 *
 
85
 *      12 NOV 1994 (2.3.6)             baud@research.att.com
 
86
 */
 
87
 
 
88
global (tTagTranslation)
 
89
global (tTitleTransformation)
 
90
global (sourceListTable)
 
91
global (siteListTable)
 
92
global (ageListTable)
 
93
global (causeListTable)
 
94
global (noteListTable)
 
95
global (tIndiEvents)
 
96
global (tFamEvents)
 
97
global (tNotesToDelete)
 
98
 
 
99
proc main ()
 
100
{
 
101
  "0 HEAD \n"
 
102
  "1 SOUR LIFELINES\n"
 
103
  "2 VER 2.3.6\n"
 
104
  "2 NAME PAF-IMPORT REPORT\n"
 
105
  "1 DEST LIFELINES\n"
 
106
  "1 DATE " date (gettoday ()) "\n"
 
107
  "1 CHAR ASCII\n"
 
108
 
 
109
  table (tTagTranslation)
 
110
  insert (tTagTranslation, "NAME", "NAME")
 
111
  insert (tTagTranslation, "BIRTH", "BIRT")
 
112
  insert (tTagTranslation, "PARENTS", "BIRT")
 
113
  insert (tTagTranslation, "FATHER", "BIRT")
 
114
  insert (tTagTranslation, "MOTHER", "BIRT")
 
115
  insert (tTagTranslation, "ADOPTION", "ADOP")
 
116
  insert (tTagTranslation, "CHRISTENING", "CHR")
 
117
  insert (tTagTranslation, "DEATH", "DEAT")
 
118
  insert (tTagTranslation, "BURIAL", "BURI")
 
119
  insert (tTagTranslation, "MARRIAGE", "MARR")
 
120
  insert (tTagTranslation, "DIVORCE", "DIV")
 
121
  insert (tTagTranslation, "DIVORCEFINAL", "DIVF")
 
122
  insert (tTagTranslation, "ANNULMENT", "ANUL")
 
123
  insert (tTagTranslation, "EDITOR", "SOUR")
 
124
  insert (tTagTranslation, "RESEARCHER", "SOUR")
 
125
  insert (tTagTranslation, "OCCUPATION", "OCCU")
 
126
 
 
127
  table (tTitleTransformation)
 
128
  insert (tTitleTransformation, "Jr", "")
 
129
  insert (tTitleTransformation, "Sr", "")
 
130
  insert (tTitleTransformation, "I", "")
 
131
  insert (tTitleTransformation, "II", "")
 
132
  insert (tTitleTransformation, "III", "")
 
133
  insert (tTitleTransformation, "IV", "")
 
134
  insert (tTitleTransformation, "V", "")
 
135
  insert (tTitleTransformation, "MD", "Dr")
 
136
  insert (tTitleTransformation, "DDS", "Dr")
 
137
  insert (tTitleTransformation, "PhD", "Dr")
 
138
  insert (tTitleTransformation, "SJ", "Father")
 
139
  insert (tTitleTransformation, "SM", "Brother")
 
140
 
 
141
  table (sourceListTable)
 
142
  table (siteListTable)
 
143
  table (ageListTable)
 
144
  table (causeListTable)
 
145
  table (noteListTable)
 
146
 
 
147
  table (tIndiEvents)
 
148
  insert (tIndiEvents, "NAME", 1)
 
149
  insert (tIndiEvents, "BIRT", 1)
 
150
  insert (tIndiEvents, "ADOP", 1)
 
151
  insert (tIndiEvents, "CHR", 1)
 
152
  insert (tIndiEvents, "DEAT", 1)
 
153
  insert (tIndiEvents, "BURI", 1)
 
154
  insert (tIndiEvents, "SOUR", 1)
 
155
  insert (tIndiEvents, "OCCU", 1)
 
156
 
 
157
  table (tFamEvents)
 
158
  insert (tFamEvents, "MARR", 1)
 
159
  insert (tFamEvents, "DIV", 1)
 
160
  insert (tFamEvents, "DIVF", 1)
 
161
  insert (tFamEvents, "ANUL", 1)
 
162
 
 
163
  table (tNotesToDelete)
 
164
 
 
165
  print ("Scanning for sources and event notes (x10) ...\n")
 
166
  forindi (indi, num) {
 
167
    if (eq (mod(num,10),0)) {
 
168
      print ("i")
 
169
    }
 
170
    call unpafSources (indi)
 
171
    call unpafOthers (indi, "SITE", siteListTable)
 
172
    call unpafOthers (indi, "AGE", ageListTable)
 
173
    call unpafOthers (indi, "CAUSE", causeListTable)
 
174
    call unpafOthers (indi, "", noteListTable)
 
175
  }
 
176
 
 
177
  print ("\n\nProcessing nodes (x10) ...\n")
 
178
  forindi (indi, num) {
 
179
    if (eq (mod(num,10),0)) {
 
180
      print ("i")
 
181
    }
 
182
    call unpafNode (key (indi), inode (indi))
 
183
  }
 
184
 
 
185
  forfam (fam, num) {
 
186
    if (eq (mod(num,10),0)) {
 
187
      print ("f")
 
188
    }
 
189
    call unpafNode (key (fam), fnode (fam))
 
190
  }
 
191
 
 
192
  "0 TRLR \n"
 
193
}
 
194
 
 
195
proc unpafSources (indi)
 
196
{
 
197
  fornodes (inode (indi), node) {
 
198
    if (not (strcmp (tag (node), "NOTE"))) {
 
199
      set (note, value (node))
 
200
      if (eq (index (note, "!", 1), 1)) {
 
201
        if (colon, index (note, ":", 1)) {
 
202
          set (nTag, save (concat (substring (note, 2, sub (colon, 1)), "-")))
 
203
          set (deleteFlag, 1)
 
204
          while (strcmp (nTag, "")) {
 
205
            set (mark, index (nTag, "-", 1))
 
206
            set (bTag, save (substring (nTag, 1, sub (mark, 1))))
 
207
            set (nTag, save (substring (nTag, add (mark, 1), strlen (nTag))))
 
208
            set (openLoc, add (index (bTag, "("/*)*/, 1), 1))
 
209
            set (closLoc, sub (index (bTag, /*(*/")", 1), 1))
 
210
            if (le (openLoc, closLoc)) {
 
211
              if (bNum, atoi (substring (bTag, openLoc, closLoc))) {
 
212
                set (bTag, save (trim (bTag, sub (openLoc, 2))))
 
213
              } else {
 
214
                set (bNum, 1)
 
215
              }
 
216
            } else {
 
217
              set (bNum, 1)
 
218
            }
 
219
            if (evt, lookup (tTagTranslation, bTag)) {
 
220
              set (sourceKey, "")
 
221
              if (lookup (tIndiEvents, evt)) {
 
222
                if (eq (bNum, 1)) {
 
223
                  set (sourceKey, save (concat (key (indi), evt)))
 
224
                }
 
225
              } elsif (lookup (tFamEvents, evt)) {
 
226
                set (foundFlag, 0)
 
227
                families (indi, fvar, svar, num) {
 
228
                  if (eq (bNum, num)) {
 
229
                    set (sourceKey, save (concat (key (fvar), evt)))
 
230
                    set (foundFlag, 1)
 
231
                  }
 
232
                }
 
233
                if (not (foundFlag)) {
 
234
                  set (deleteFlag, 0)
 
235
                }
 
236
              }
 
237
              if (strcmp (sourceKey, "")) {
 
238
                call insertListTable (sourceListTable, sourceKey, node)
 
239
              }
 
240
            } else {
 
241
              set (deleteFlag, 0)
 
242
            }
 
243
          }
 
244
          if (deleteFlag) {
 
245
            insert (tNotesToDelete, save (value (node)), 1)
 
246
          }
 
247
        }
 
248
      }
 
249
    }
 
250
  }
 
251
}
 
252
 
 
253
proc unpafOthers (indi, kind, otherListTable)
 
254
{
 
255
  set (tail, save (concat (kind, ":")))
 
256
  fornodes (inode (indi), node) {
 
257
    if (not (strcmp (tag (node), "NOTE"))) {
 
258
      set (note, value (node))
 
259
      if (eq (index (note, "CEMETERY:", 1), 1)) {
 
260
        set (note,
 
261
          save (concat ("BURIALSITE", substring (note, 9, strlen (note)))))
 
262
      }
 
263
      set (tailIndex, index (note, tail, 1))
 
264
      set (spaceIndex, index (note, " ", 1))
 
265
      if (or (lt (tailIndex, spaceIndex),
 
266
              and (eq (spaceIndex, 0),
 
267
                   gt (tailIndex, 0)))) {
 
268
        set (bEnd, sub (tailIndex, 1))
 
269
        set (bTag, save (trim (note, bEnd)))
 
270
        set (bNum, atoi (substring (bTag, bEnd, bEnd)))
 
271
        if (ne (bNum, 0)) {
 
272
          decr (bEnd)
 
273
          set (bTag, save (trim (bTag, bEnd)))
 
274
        }
 
275
        incr (bNum)
 
276
        if (evt, lookup (tTagTranslation, bTag)) {
 
277
          set (otherKey, "")
 
278
          if (lookup (tIndiEvents, evt)) {
 
279
            if (eq (bNum, 1)) {
 
280
              set (otherKey, save (concat (key (indi), evt)))
 
281
            }
 
282
          } elsif (lookup (tFamEvents, evt)) {
 
283
            families (indi, fvar, svar, num) {
 
284
              if (eq (bNum, num)) {
 
285
                set (otherKey, save (concat (key (fvar), evt)))
 
286
              }
 
287
            }
 
288
          }
 
289
          if (strcmp (otherKey, "")) {
 
290
            call insertListTable (otherListTable, otherKey, node)
 
291
            insert (tNotesToDelete, save (value (node)), 1)
 
292
          }
 
293
        }
 
294
      }
 
295
    }
 
296
  }
 
297
}
 
298
 
 
299
proc insertListTable (listTable, tableKey, node) {
 
300
  list (evtList)
 
301
  set (note, value (node))
 
302
  set (first,
 
303
    save (substring (note, add (index (note, ":", 1), 1), strlen (note))))
 
304
  if (not (strcmp (trim (first, 1), " "))) {
 
305
    set (first, save (substring (first, 2, strlen (first))))
 
306
  }
 
307
  if (strlen (first)) {
 
308
    enqueue (evtList, first)
 
309
  }
 
310
  fornodes (node, n) {
 
311
    if (not (strcmp ("CONT", tag (n)))) {
 
312
      enqueue (evtList, save (value (n)))
 
313
    }
 
314
  }
 
315
  set (entryList, lookup (listTable, tableKey))
 
316
  if (not (entryList)) { list (entryList) }
 
317
  enqueue (entryList, evtList)
 
318
  insert (listTable, tableKey, entryList)
 
319
}
 
320
 
 
321
proc unpafNode (rootKey, root)
 
322
{
 
323
  set (sourceList, 0)
 
324
  set (noteList, 0)
 
325
  set (sawBIRT, 0)
 
326
  traverse (root, node, level) {
 
327
    set (sawBIRT, or (sawBIRT, not (strcmp (tag (node), "BIRT"))))
 
328
    if (eq (level, 0)) {
 
329
      set (deletingFlag, 0)
 
330
      set (listTableKey, save (concat (rootKey, tag (node))))
 
331
      set (sourceList, lookup (sourceListTable, listTableKey))
 
332
      if (unbangedSourceList, lookup (noteListTable, listTableKey)) {
 
333
        while (evt, dequeue (unbangedSourceList)) {
 
334
          enqueue (sourceList, evt)
 
335
        }
 
336
      }
 
337
    } elsif (eq (level, 1)) {
 
338
      if (sourceList) {
 
339
        while (evt, dequeue (sourceList)) {
 
340
          call reTagNote (add (level, 1), "SOUR", evt)
 
341
        }
 
342
        set (sourceList, 0)
 
343
      }
 
344
      if (noteList) {
 
345
        while (evt, dequeue (noteList)) {
 
346
          call reTagNote (add (level, 1), "TEXT", evt)
 
347
        }
 
348
        set (noteList, 0)
 
349
      }
 
350
      set (listTableKey, save (concat (rootKey, tag (node))))
 
351
      set (sourceList, lookup (sourceListTable, listTableKey))
 
352
      set (noteList, lookup (noteListTable, listTableKey))
 
353
      set (deletingFlag, and (not (strcmp (tag (node), "NOTE")),
 
354
                              lookup (tNotesToDelete, value (node))))
 
355
    }
 
356
    if (not (deletingFlag)) {
 
357
      d (level) " "
 
358
      if (xref (node)) { xref (node) " " }
 
359
      set (text, value (node))
 
360
      if (not (strcmp (tag (node), "NAME"))) {
 
361
        while (ind, index (text, "_", 1)) {
 
362
          set (text,
 
363
            save (concat (concat (substring (text, 1, sub (ind,1)), " "),
 
364
              substring (text, add (ind, 1), strlen (text)))))
 
365
        }
 
366
        "NAME " text "\n"
 
367
      } elsif (not (strcmp (tag (node), "TITL"))) {
 
368
        if (titl, lookup (tTitleTransformation, text)) {
 
369
          "NAME // " text "\n"
 
370
          if (strlen (titl)) {
 
371
            d (level) " TITL " titl "\n"
 
372
          }
 
373
        } else {
 
374
          "TITL " text "\n"
 
375
        }
 
376
      } elsif (not (strcmp (tag (node), "PLAC"))) {
 
377
        while (not (strcmp (trim (text, 1), ","))) {
 
378
          set (text, save (substring (text, 2, strlen (text))))
 
379
        }
 
380
        "PLAC " text "\n"
 
381
        if (siteList, lookup (siteListTable, listTableKey)) {
 
382
          while (evt, dequeue (siteList)) {
 
383
            call reTagNote (add (level, 1), "SITE", evt)
 
384
          }
 
385
        }
 
386
      } elsif (not (strcmp (tag (node), "NOTE"))) {
 
387
        if (not (strcmp (trim (text, 1), "!"))) {
 
388
          "TEXT "
 
389
        } else {
 
390
          "NOTE "
 
391
        }
 
392
        text "\n"
 
393
      } else {
 
394
        tag (node) " " text "\n"
 
395
        if (ageList, lookup (ageListTable, listTableKey)) {
 
396
          while (evt, dequeue (ageList)) {
 
397
            call reTagNote (add (level, 1), "AGE", evt)
 
398
          }
 
399
        }
 
400
        if (causeList, lookup (causeListTable, listTableKey)) {
 
401
          while (evt, dequeue (causeList)) {
 
402
            call reTagNote (add (level, 1), "CAUS", evt)
 
403
          }
 
404
        }
 
405
      }
 
406
    }
 
407
  }
 
408
  set (listTableKey, save (concat (rootKey, BIRT)))
 
409
  set (sourceList, lookup (sourceListTable, listTableKey))
 
410
  set (noteList, lookup (noteListTable, listTableKey))
 
411
  if (and (or (sourceList, noteList), not (sawBIRT))) {
 
412
    "1 BIRT\n"
 
413
    if (sourceList) {
 
414
      while (evt, dequeue (sourceList)) {
 
415
          call reTagNote (2, "SOUR", evt)
 
416
      }
 
417
    }
 
418
    if (noteList) {
 
419
      while (evt, dequeue (noteList)) {
 
420
        call reTagNote (2, "TEXT", evt)
 
421
      }
 
422
    }
 
423
  }
 
424
}
 
425
 
 
426
proc reTagNote (relevel, retag, revalueList) {
 
427
  set (contLevel, add (relevel, 1))
 
428
  forlist (revalueList, revalue, rv) {
 
429
    d (relevel) " " retag " " revalue "\n"
 
430
    set (relevel, contLevel)
 
431
    set (retag, "CONT")
 
432
  }
 
433
}