File: xml-dtd.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 (192 lines) | stat: -rw-r--r-- 4,580 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
/*
 * @progname       xml-dtd.ll
 * @version        1.0
 * @author         Rafal T. Prinke
 * @category       
 * @output         XML DTD
 * @description

       This report produces an XML DTD (Document Type Definition)
       from a LifeLines database. It is intended for comparing
       tag usage and checking for structural inconsistencies
       in a GEDCOM file - especially when sharing the same file
       with others in a research project.

       The LL report produces "tagpairs.txt" file which contains
       a list of unique parent-child tags. Then the perl program
       "dtd.pl" must be run, which will sort that list to
       "tagpairs2.txt" and then write out "llines.dtd" file.

       The perl program is appended at the end of this file.
       It is rather clumsy but works. The resulting DTD does
       not produce errors and can be further processed
       with XML software - but could be better.

       It may also be used in connection with my other
       LL report - xmlize2.ll version 2.2 - which produces
       an XML instance from a LifeLines database.

   xml-dtd.ll - v. 0.2 Rafal T. Prinke,  8 May  2001
                v. 1.0 Rafal T. Prinke, 30 June 2001

*/


global(tagi)
global(content)

proc main ()
{

  list(tagi)
  table(content)


  forindi(pers,x) {
      call out(pers)
  }
  forfam(fm,x) {
      call out(fm)
  }
  foreven(evn, n) {
      call out(evn)
  }
  forsour(src, n) {
      call out(src)
  }
  forothr(oth, n) {
      call out(oth)
  }

newfile("tagpairs.txt",0)
forlist(tagi,o,p) { getel(tagi,p) "\n" }

}


proc out(item)

{
    traverse(root(item),y,level) {
      set(para,concat(tag(parent(y)),"-",tag(y)))
      set(pcdat,concat(tag(y),"-#PCDATA"))
      set(xxref,concat(tag(y),"-|ID"))
      set(xxpnt,concat(tag(y),"-|IDREF"))

/*** parent-child tag pair ***/

      if(eqstr(substring(para,1,1),"-")) {
          set(para,concat("LLGEDCOM-",tag(y)))
      }
      if(not(lookup(content,para))) {
         push(tagi,para)
         insert(content,para,1)
      }

/*** references, xrefs and pcdata ***/


      if(value(y)) {
         if(reference(value(y))) {
            if(not(lookup(content,xxpnt))) {
                push(tagi,xxpnt)
                insert(content,xxpnt,1) }
            }
         else {
            if(not(lookup(content,pcdat))) {
                push(tagi,pcdat)
                insert(content,pcdat,1) }
            }
      }

      if(xref(y)) {
         if(not(lookup(content,xxref))) {
            push(tagi,xxref)
            insert(content,xxref,1)
         }
      }
   }
}


/*** start of dtd.pl ***

#!C:\Perl\bin\perl.exe

$parent = "q";
$firstline = 1;
$attr = 0;

open FILE,"tagpairs.txt";
@tagi = <FILE>;
@stagi = sort @tagi;
close FILE;

open FILE,">tagpairs2.txt";
print FILE @stagi;
close FILE;

open FILE,"tagpairs2.txt";

open DTD,">llines.dtd";
close DTD;

open DTD,">>llines.dtd";

while ($line = <FILE>) {
  chop $line;
  @pair = split(/-/, $line);
  if ($parent eq $pair[0]) {
         if (substr($pair[1],0,1) ne "|") {
            print DTD " | ", $pair[1];
            $attr = 0;
         }
         else {
            if ($attr == 0) { print DTD ")*>" }
            print DTD "\n<!ATTLIST ", $pair[0], " ", substr($pair[1],1),
" ", substr($pair[1],1), " #REQUIRED >";
            $attr = 1;
         }
  }

  else { if ($firstline == 0) {
            if (substr($pair[1],0,1) ne "|") {
                if ($attr == 0) { print DTD ")*>" }
                print DTD "\n", "<!ELEMENT ", $pair[0], " (", $pair[1];
                $parent = $pair[0];
                $attr = 0;
            }
            else {
                if ($attr == 0) { print DTD ")*>" }
                print DTD "\n<!ELEMENT ", $pair[0], " EMPTY>\n<!ATTLIST
", $pair[0], " ", substr($pair[1],1), " ", substr($pair[1],1), "
#REQUIRED >";
                $attr = 1;
                $parent = $pair[0];
            }
         }
         else {
            if (substr($pair[1],0,1) ne "|") {
                $firstline = 0;
                print DTD "<!ELEMENT ", $pair[0], " (", $pair[1];
                $parent = $pair[0];
                $attr = 0;
            }
            else {
                $firstline = 0;
                if ($attr == 0) { print DTD ")*>" }
                print DTD "\n<!ELEMENT ", $pair[0], " EMPTY>\n<!ATTLIST
", $pair[0], " ", substr($pair[1],1), " ", substr($pair[1],1), "
#REQUIRED >";
                $attr = 1;
                $parent = $pair[0];
            }
         }
  }
}

if ($attr == 0) { print DTD ")*>" }

close DTD;

*** end of dtd.pl ***/