SimpleSaxParse/SimpleCallBack.p at master · patrickTingen/SimpleSaxParse · GitHub

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
/*
 * Prog: SimpleCallBack.p
 * Desc: Program to put contents from xml in a flat tt - sax handler
 * Auth: Patrick Tingen (PT)
 *
 * ---------- --- -------------------------------------------------------------------
 * 2004-03-01 PT  Created
 * 2007-04-16 PT  Added parent# and child# to tt.
 */
define variable gcPath       as character  no-undo initial ''.
define variable giElementId  as integer    no-undo initial 0.

define temp-table ttElement no-undo
  field iId       as integer   format '>>>9':u
  field iParentNr as integer   format '>>>9':u
  field iChildNr  as integer   format '>>>9':u
  field cName     as character format 'x(50)':u
  field cAttr     as character format 'x(8)':u
  field cValue    as character format 'x(30)':u
  field lOpen     as logical initial true
  index idxPrim as primary iId
  index idxOpen lOpen iId
  .

procedure emptyTable:
  /* Clear the table */
  define buffer bElement for ttElement.

  empty temp-table bElement.
end procedure. /* getTable */


procedure getTable:
  /* Export the table */
  define buffer bElement for ttElement.
  define output parameter table for bElement.
end procedure. /* getTable */


procedure startDocument:
  /* process new document */
  define buffer bElement for ttElement.

  create bElement.
  assign
    giElementId     = giElementId + 1
    bElement.iId    = giElementId
    bElement.cName  = '/':u
    bElement.lOpen  = true
    .
end procedure. /* startDocument */


procedure startElement:
  /* process new node */

  define input  parameter picNameSpaceURI as character  no-undo.
  define input  parameter picLocalName    as character  no-undo.
  define input  parameter picElement      as character  no-undo.
  define input  parameter pihAttributes   as handle     no-undo.

  define variable iAttrNr  as integer no-undo.
  define variable iChild   as integer no-undo.
  define variable iParent  as integer no-undo.
  define variable cParent  as character  no-undo.

  define buffer bElement for ttElement.

  /* add node to path */
  assign gcPath = gcPath + "/":U + picElement.

  /* Find out the child sequence number of this element within the scope of the parent */
  cParent = gcPath.
  entry(num-entries(cParent,'/':u),cParent,'/':u) = '':u.
  assign cParent = right-trim(cParent,"/":U).


  findParent:
  for each bElement
       by bElement.iId descending:

    /* When the parent is found, store its number & exit */
    if bElement.cName = cParent then
    do:
      iParent = bElement.iId.
      leave findParent.
    end.

    /* Count children */
    if bElement.cName = gcPath then iChild = iChild + 1.
  end. /* findParent */


  /* Parent might be the root */
  if iParent = 0 then iParent = 1.

  /* create a record for the node in the tt */
  create bElement.
  assign
    giElementId         = giElementId + 1
    bElement.iId       = giElementId
    bElement.iParentNr = iParent
    bElement.iChildNr  = iChild + 1
    bElement.cName     = gcPath
    bElement.lOpen     = true
    .

  do iAttrNr = 1 to pihAttributes:num-items:
    /* create a record for each attribute in the tt */
    create bElement.
    assign
      bElement.iId       = giElementId
      bElement.iParentNr = iParent
      bElement.iChildNr  = iChild + 1
      bElement.cName     = gcPath
      bElement.cAttr     = pihAttributes:get-localname-by-index(iAttrNr)
      bElement.cValue    = pihAttributes:get-value-by-index(iAttrNr)
      bElement.lOpen     = false
      .
  end. /* pihAttributes */
end procedure. /* startElement */


procedure characters:
  /* process node text */

  define input  parameter charData as memptr     no-undo.
  define input  parameter numChars as integer    no-undo.

  define variable cData as character  no-undo.
  define buffer bElement for ttElement.

  find last bElement where lOpen = true use-index idxOpen.

  assign
    cData            = get-string(charData, 1, get-size(charData))
    cData            = replace(cData,chr(10),'':u)
    cData            = replace(cData,chr(13),'':u)
    bElement.cValue = bElement.cValue + trim(cData)
    .

end procedure. /* characters */


procedure endElement:
  /* finish node */

  define input  parameter picNameSpaceURI as character  no-undo.
  define input  parameter picLocalName    as character  no-undo.
  define input  parameter picElement      as character  no-undo.

  define buffer bElement for ttElement.

  /* find node in tt */
  find last bElement where lOpen = true use-index idxOpen.
  assign bElement.lOpen = false.

  /* adjust path for next node */
  entry(num-entries(gcPath,'/':u),gcPath,'/':u) = '':u.
  assign gcPath = right-trim(gcPath,"/":U).

end procedure. /* endElement */


procedure EndDocument.
  /* that's all folks */
  define buffer bElement for ttElement.

  /* find node in tt */
  find last bElement where lOpen = true use-index idxOpen.
  assign bElement.lOpen = false.
end procedure. /* EndDocument */


procedure Error:
  define input parameter pcMessage as character no-undo.

  message "Schema validation error in " gcPath ": " pcMessage view-as alert-box.
  return error.
end procedure. /* Error */


procedure FatalError:
  define input parameter pcMessage as character no-undo.

  message "Fatal Error in " gcPath ": " pcMessage view-as alert-box.
  return error.
end procedure. /* FatalError */