File: gedall.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 (177 lines) | stat: -rw-r--r-- 4,570 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
/*
 * @progname       gedall.ll
 * @version        2000-02-20
 * @author         Paul B. McBride (pbmcbride@rcn.com)
 * @category       
 * @output         GEDCOM
 * @description
 *
 * This LifeLines report program produces a GEDCOM file containing
 * the entire LifeLines database, including header, trailer, and
 * submitter records. It also gives the option to keep or remove user defined
 * tags, and to remove any other tags.
 *
 * modified Sep 2005 to use getproperties to automatically generate the header
 * by Stephen Dum dr.doom@verizon.net
 *
 * The default action is to remove all user defined tags. These are tags
 * which begin with an underscore, "_", character.
 *
 * When a tag line is removed, lines following it with higher level
 * numbers are also removed.
 *
 * This report program may require LifeLines 3.0.3 or later.
 *
 *   The gedcom header is generated in main() using property's
 *   obtained from the lifelines config file (~/.linesrc on unix else
 *   lines.cfg - or from properties set in the database) with values from
 *   the user defined properties
 *   user.fullname
 *   user.email
 *   user.address
 *
 * This report program was tested on databases created from the Test Book
 * sample GEDCOM files at http://www.gentech.org
 *
 * 20 Feb 2000 Paul B. McBride (pbmcbride@rcn.com)
 */

global(REMOVEUSERTAGS)
global(REMOVELISTEDTAGS)
global(REMOVETAG_LIST)

global(removed_line_count)
global(removed_udt_count)

proc main ()
{
  list(REMOVETAG_LIST)		/* list of tags to be removed */
  set(REMOVELISTEDTAGS, 0)	/* set to 1 if there are tags to be removed */
  set(REMOVEUSERTAGS, askyn("Remove user defined tags (_*)"))
  set(removed_udt_count, 0)
  set(removed_line_count, 0)

  while(1) {
    getstrmsg(remtag, "Enter any other tag to be removed")
    if(gt(strlen(remtag),0)) {
    	set(REMOVELISTEDTAGS, 1)
    	enqueue(REMOVETAG_LIST, remtag)
    }
    else { break() }
  }

  /* header file  */
  "0 HEAD " nl()
  "1 SOUR LIFELINES" nl()
  "2 VERS " version() nl()
  "2 NAME LifeLines" nl()
  /*
  "2 CORP ... "  nl()
  "3 ADDR .... " nl()
  */
  "1 SUBM @SM1@" nl()
  "1 GEDC " nl()
  "2 VERS 5.5" nl()
  "2 FORM Lineage-Linked" nl()
  "1 CHAR ASCII" nl()
  "1 DATE " stddate(gettoday()) nl()
  /* and referenced submitter */
  "0 @SM1@ SUBM" nl()
  "1 NAME " getproperty("user.fullname") nl()
  "1 ADDR " getproperty("user.address") nl()
  "2 CONT E-mail: " getproperty("user.email") nl()

  set(icnt, 0)
  forindi(p, n) {
    call ged_write_node(root(p))
    set(icnt, add(icnt,1))
  }
  print(d(icnt), " INDI records (I*)...\n")
  set(fcnt, 0)
  forfam(f, n) {
    call ged_write_node(root(f))
    set(fcnt, add(fcnt,1))
  }
  print(d(fcnt), " FAM records (F*)...\n")
  set(ecnt, 0)
  foreven(e, n) {
    call ged_write_node(root(e))
    set(ecnt, add(ecnt,1))
  }
  print(d(ecnt), " EVEN records (E*)...\n")
  set(scnt, 0)
  forsour(s, n) {
    call ged_write_node(root(s))
    set(scnt, add(scnt,1))
  }
  print(d(scnt), " SOUR records (S*)...\n")
  set(ocnt, 0)
  forothr(o, n) {
    call ged_write_node(root(o))
    set(ocnt, add(ocnt,1))
  }
  print(d(ocnt), " other level 0 records (X*)\n")

  if(gt(removed_udt_count, 0)) {
    print(d(removed_udt_count), " user defined tag structures were removed.\n")
  }
  if(gt(removed_line_count, 0)) {
    print(d(removed_line_count), " lines were removed, as requested.\n")
  }

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

proc ged_write_node(n)
{
  set(remlevel, 10000)	/* this value is larger than the largest level number */
  traverse(n, m, level) {
    if(le(level, remlevel)) {
      set(remlevel, 10000) /* end of previous tag removal if any */
      if(REMOVEUSERTAGS) {
        if(t, tag(m)) {
	  if(eqstr(trim(t, 1), "_")) {
	    set(remlevel, level) /* remove line, and subordinate tag lines */
	    set(removed_udt_count, add(removed_udt_count, 1))
	  }
	}
      }
    }
    if(lt(level, remlevel)) {
      if(REMOVELISTEDTAGS) {
        if(t, tag(m)) {
	  forlist(REMOVETAG_LIST, rt, n) {
	    if(eqstr(t, rt)) {
	      set(remlevel, level)
	      break()
	    }
	  }
	}
      }
    }
    if(lt(level, remlevel)) {
      /* output this line to the GEDCOM file */
      d(level)
      if (xref(m)) { " " xref(m) }
      " " tag(m)
      if (v, value(m)) {
	" " v
      }
      "\n"
    }
    else {
      set(removed_line_count, add(removed_line_count, 1))
    }
  }
}

func askyn(msg)
{
  set(prompt, concat(msg, "? [y/n] "))
  getstrmsg(str, prompt)
  if(and(gt(strlen(str), 0),
     or(eq(strcmp(str, "n"),0), eq(strcmp(str, "N"),0)))) {
    return(0)
  }
  return(1)
}