Author: Marc Hoffmann
How to create a simple parsing framework to parse any kind of data?
Answer:
Welcome to the second part of my article "Building an Easy-to-Use Parser/Parsing
Framework". This time, I want to show you how to create a real working dtd parser
as exemplified in the first part. If you don't read my first article, please make
up for this now:
Building an Easy-to-Use Parser/Parsing Framework (Part I)
As mentioned earlier, we need a dtd document which holds up all our parsed
informations in an easy-to-access object model. Take a look at the following
interface section:
1 type
2 { TDTDAttributeTyp }
3
4 TDTDAttributeTyp =
5 (atData, atID, atIDRef, atEnumeration);
6
7 { TDTDAttributeStatus }
8
9 TDTDAttributeStatus =
10 (asDefault, asImplied, asRequired, asFixed);
11
12 { TDTDChildTyp }
13
14 TDTDChildTyp =
15 (ctElement, ctChoice, ctSequence);
16
17 { TDTDElementTyp }
18
19 TDTDElementTyp =
20 (etAny, etEmpty, etData, etContainer);
21
22 { TDTDElementStatus }
23
24 TDTDElementStatus =
25 (esRequired, esRequiredSeq, esOptional, esOptionalSeq);
26
27 { TDTDItem }
28
29 TDTDItem = class(TCollectionItem)
30 private
31 { Private declarations }
32 FName: string;
33 public
34 { Public declarations }
35 procedure Assign(Source: TPersistent); override;
36 published
37 { Published declarations }
38 property Name: string read FName write FName;
39 end;
40
41 { TDTDItems }
42
43 TDTDItems = class(TCollection)
44 private
45 { Private declarations }
46 function GetItem(Index: Integer): TDTDItem;
47 procedure SetItem(Index: Integer; Value: TDTDItem);
48 public
49 { Public declarations }
50 function Add: TDTDItem;
51 function Find(const Name: string): TDTDItem;
52 property Items[Index: Integer]: TDTDItem read GetItem write SetItem;
53 default;
54 end;
55
56 { TDTDEntity }
57
58 TDTDEntity = class(TDTDItem)
59 private
60 { Private declarations }
61 public
62 { Public declarations }
63 procedure Assign(Source: TPersistent); override;
64 published
65 { Published declarations }
66 end;
67
68 { TDTDEntities }
69
70 TDTDEntities = class(TDTDItems)
71 private
72 { Private declarations }
73 function GetItem(Index: Integer): TDTDEntity;
74 procedure SetItem(Index: Integer; Value: TDTDEntity);
75 public
76 { Public declarations }
77 function Add: TDTDEntity;
78 function Find(const Name: string): TDTDEntity;
79 property Items[Index: Integer]: TDTDEntity read GetItem write SetItem;
80 default;
81 end;
82
83 { TDTDEnum }
84
85 TDTDEnum = class(TDTDItem)
86 private
87 { Private declarations }
88 public
89 { Public declarations }
90 procedure Assign(Source: TPersistent); override;
91 published
92 { Published declarations }
93 end;
94
95 { TDTDEnums }
96
97 TDTDEnums = class(TDTDItems)
98 private
99 { Private declarations }
100 function GetItem(Index: Integer): TDTDEnum;
101 procedure SetItem(Index: Integer; Value: TDTDEnum);
102 public
103 { Public declarations }
104 function Add: TDTDEnum;
105 function Find(const Name: string): TDTDEnum;
106 property Items[Index: Integer]: TDTDEnum read GetItem write SetItem;
107 default;
108 end;
109
110 { TDTDAttribute }
111
112 TDTDAttribute = class(TDTDItem)
113 private
114 { Private declarations }
115 FTyp: TDTDAttributeTyp;
116 FStatus: TDTDAttributeStatus;
117 FDefault: string;
118 FEnums: TDTDEnums;
119 procedure SetEnums(Value: TDTDEnums);
120 public
121 { Public declarations }
122 constructor Create(Collection: TCollection); override;
123 destructor Destroy; override;
124 procedure Assign(Source: TPersistent); override;
125 published
126 { Published declarations }
127 property Typ: TDTDAttributeTyp read FTyp write FTyp;
128 property Status: TDTDAttributeStatus read FStatus write FStatus;
129 property default: string read FDefault write FDefault;
130 property Enums: TDTDEnums read FEnums write SetEnums;
131 end;
132
133 { TDTDAttributes }
134
135 TDTDAttributes = class(TDTDItems)
136 private
137 { Private declarations }
138 function GetItem(Index: Integer): TDTDAttribute;
139 procedure SetItem(Index: Integer; Value: TDTDAttribute);
140 public
141 { Public declarations }
142 function Add: TDTDAttribute;
143 function Find(const Name: string): TDTDAttribute;
144 property Items[Index: Integer]: TDTDAttribute read GetItem write
145 SetItem; default;
146 end;
147
148 { TDTDProperty }
149
150 TDTDProperty = class(TDTDItem)
151 private
152 { Private declarations }
153 FStatus: TDTDElementStatus;
154 public
155 { Public declarations }
156 procedure Assign(Source: TPersistent); override;
157 published
158 { Published declarations }
159 property Status: TDTDElementStatus read FStatus write FStatus;
160 end;
161
162 { TDTDProperties}
163
164 TDTDProperties = class(TDTDItems)
165 private
166 { Private declarations }
167 function GetItem(Index: Integer): TDTDProperty;
168 procedure SetItem(Index: Integer; Value: TDTDProperty);
169 public
170 { Public declarations }
171 function Add: TDTDProperty;
172 function Find(const Name: string): TDTDProperty;
173 property Items[Index: Integer]: TDTDProperty read GetItem write
174 SetItem; default;
175 end;
176
177 { TDTDChild }
178
179 TDTDChilds = class;
180
181 TDTDChild = class(TDTDProperty)
182 private
183 { Private declarations }
184 FTyp: TDTDChildTyp;
185 FChilds: TDTDChilds;
186 procedure SetChilds(const Value: TDTDChilds);
187 public
188 { Public declarations }
189 constructor Create(Collection: TCollection); override;
190 destructor Destroy; override;
191 procedure Assign(Source: TPersistent); override;
192 published
193 { Published declarations }
194 property Typ: TDTDChildTyp read FTyp write FTyp;
195 property Childs: TDTDChilds read FChilds write SetChilds;
196 end;
197
198 { TDTDChilds}
199
200 TDTDChilds = class(TDTDProperties)
201 private
202 { Private declarations }
203 function GetItem(Index: Integer): TDTDChild;
204 procedure SetItem(Index: Integer; Value: TDTDChild);
205 public
206 { Public declarations }
207 function Add: TDTDChild;
208 function Find(const Name: string): TDTDChild;
209 property Items[Index: Integer]: TDTDChild read GetItem write SetItem;
210 default;
211 end;
212
213 { TDTDElement }
214
215 TDTDElement = class(TDTDProperty)
216 private
217 { Private declarations }
218 FTyp: TDTDElementTyp;
219 FAttributes: TDTDAttributes;
220 FChilds: TDTDChilds;
221 procedure SetAttributes(Value: TDTDAttributes);
222 procedure SetChilds(Value: TDTDChilds);
223 public
224 { Public declarations }
225 constructor Create(Collection: TCollection); override;
226 destructor Destroy; override;
227 procedure Assign(Source: TPersistent); override;
228 published
229 { Published declarations }
230 property Typ: TDTDElementTyp read FTyp write FTyp;
231 property Attributes: TDTDAttributes read FAttributes write
232 SetAttributes;
233 property Childs: TDTDChilds read FChilds write SetChilds;
234 end;
235
236 { TDTDElements }
237
238 TDTDElements = class(TDTDProperties)
239 private
240 { Private declarations }
241 function GetItem(Index: Integer): TDTDElement;
242 procedure SetItem(Index: Integer; Value: TDTDElement);
243 public
244 { Public declarations }
245 function Add: TDTDElement;
246 function Find(const Name: string): TDTDElement;
247 property Items[Index: Integer]: TDTDElement read GetItem write
248 SetItem; default;
249 end;
250
251 { TDTDDocument }
252
253 TDTDDocument = class(TPersistent)
254 private
255 { Private declarations }
256 FEntities: TDTDEntities;
257 FElements: TDTDElements;
258 procedure SetEntities(Value: TDTDEntities);
259 procedure SetElements(Value: TDTDElements);
260 public
261 { Public declarations }
262 constructor Create;
263 destructor Destroy; override;
264 procedure Assign(Source: TPersistent); override;
265 published
266 { Published declarations }
267 property Entities: TDTDEntities read FEntities write SetEntities;
268 property Elements: TDTDElements read FElements write SetElements;
269 end;
This model implements all needed objects to parse a dtd file. Notice, that not all
dtd grammars are reflected in this model, it's up to you to improve my work - but
it's enough to parse all standard dtd files.
Next, we need to create our dtd parser, which will be inherited by
TValidationParser as professed in Part I:
270 type
271 { EDTDParser }
272
273 EDTDParser = class(Exception);
274
275 { TDTDParser }
276
277 TDTDParser = class(TValidationParser)
278 private
279 { Private declarations }
280 procedure ParseElement(Parser: TStringParser; Document: TDTDDocument;
281 const Pass: Integer);
282 procedure ParseAttlist(Parser: TStringParser; Document: TDTDDocument);
283 procedure ParseFile(const FileName: string; Document: TDTDDocument;
284 const Pass: Integer = 0);
285 public
286 { Public declarations }
287 procedure Parse(const FileName: string; var Document: TDTDDocument);
288 end;
The new exception class EDTDParser will be raised, if the passed filename is
physical not available. One of the weightily methods is Parse. The first parameter
must be an existing filename of the dtd file to be parsed. The second parameter is
the document which holds our object model and must be pre-initialized. The
implementation of this method is as followed:
289
290 procedure TDTDParser.Parse(const FileName: string; var Document: TDTDDocument);
291 var
292 TmpDocument: TDTDDocument;
293 begin
294 if not assigned(Document) then
295 raise EDTDParser.Create('Document not assigned!');
296 TmpDocument := TDTDDocument.Create;
297 try
298 ParseFile(FileName, TmpDocument);
299 if Errors.Count = 0 then
300 Document.Assign(TmpDocument);
301 finally
302 TmpDocument.Free;
303 end;
304 end;
In Line 5 we're looking if the passed document was successfully initialized; if
not, an exception (EDTDParser) will be raised. After comparing that, we create a
new temporary instance of a dtd document (Line 7) and parse the passed filename
(Line 9). If no errors occured (Line 10) we make a copy of the filled dtd document
by assigning it to the passed one (Line 11).
Consecutively we take a look to the ParseFile procedure, which initializes the main
parsing process and looks for the basic keywords: (Note: The italic lines are not
part of the sourcecode - they are used to explain the unique sections)
305
306 procedure TDTDParser.ParseFile(const FileName: string;
307 Document: TDTDDocument; const Pass: Integer = 0);
308 var
309 Parser: TStringParser;
310 begin
311 {Create a new instance of the TStringParser.}
312 Parser := TStringParser.Create;
313 try
314 {Check, if the passed filename already exists.}
315 if not Parser.LoadFromFile(FileName) then
316 begin
317 AddErrorFmt('File "%s" not found', [FileName], Parser);
318 Exit;
319 end;
320 {Initialize an endless loop.}
321 while True do
322 begin
323 {Skip to the next valid Tag-Begin-Token "<" or EOF.}
324 while not (Parser.Token in [toEOF, '<']) do
325 Parser.SkipToken;
326 {Break look, if current Token is EOF - End of File.}
327 if Parser.Token = toEOF then
328 Break;
329 {Get the next Token - after Tag-Begin "<".}
330 Parser.SkipToken;
331 {Check for valid identification Tag "!" or "?".}
332 if Parser.Token <> '!' then
333 begin
334 {Only add an error if the current Pass is one "1".}
335 if not (Parser.Token in ['?']) and (Pass = 1) then
336 AddError('InvalidToken', Parser);
337 Continue;
338 end;
339 {Check for valid Symbol or Comment Line.}
340 if Parser.SkipToken <> toSymbol then
341 begin
342 if (Parser.Token <> '-') and (Pass = 1) then
343 AddError('InvalidToken', Parser);
344 Continue;
345 end;
346 {Check for "Entity" Tag.}
347 if UpperCase(Parser.TokenString) = 'ENTITY' then
348 Continue;
349 {Check for "Element" Tag.}
350 if UpperCase(Parser.TokenString) = 'ELEMENT' then
351 ParseElement(Parser, Document, Pass)
352 else
353 {Check for "Attribute" Tag.} if UpperCase(Parser.TokenString) = 'ATTLIST'
354 then
355 begin
356 if Pass = 1 then
357 ParseAttlist(Parser, Document);
358 end
359 {Add an error on invalid Symbols.}
360 else if Pass = 1 then
361 AddErrorFmt('Invalid Symbol "%s"', [Parser.TokenString], Parser);
362 end;
363 {Initialize Pass 2 - if currently finished Pass 1.}
364 if Pass = 0 then
365 ParseFile(FileName, Document, 1);
366 finally
367 Parser.Free;
368 end;
369 end;
The ParseFile method simply starts parsing the main structure of a dtd file and
tries to extract some basic keywords like Entity, Element or Attribute. If one of
the last two keywords were found, a special (ParseElement or ParseAttlist) method
is called to create the corresponding object and to extract additional
informations. If the parser founds any syntax or grammar errors, respectively items
are created.
The method ParseElement includes the functionality to parse and extract further
informations, like Type or Rule:
(Note: The italic lines are not part of the sourcecode - they are used to explain
the unique sections)
370
371 procedure TDTDParser.ParseElement(Parser: TStringParser;
372 Document: TDTDDocument; const Pass: Integer);
373 var
374 Element: TDTDElement;
375 Child: TDTDChild;
376 Rule: string;
377 begin
378 {Get the next Token.}
379 Parser.SkipToken;
380 {On first pass, create a new element.}
381 if Pass = 0 then
382 Element := Document.Elements.Add
383 {On second pass, find previous created element.}
384 else
385 Element := Document.Elements.Find(Parser.TokenString);
386 {Set the new element name.}
387 Element.Name := Parser.TokenString;
388 try
389 {Add an error if the current Token isn't a symbol.}
390 if Parser.Token <> toSymbol then
391 Abort;
392 {Check for element rule, like "any", "empty" or "sequence"...}
393 Rule := UpperCase(Parser.SkipTokenString);
394 {...Found Rule: "ANY".}
395 if (Rule = 'ANY') and (Parser.SkipToken = '>') then
396 begin
397 Element.Typ := etAny;
398 Exit;
399 end;
400 {...Found Rule: "EMPTY".}
401 if (Rule = 'EMPTY') and (Parser.SkipToken = '>') then
402 begin
403 Element.Typ := etEmpty;
404 Exit;
405 end;
406 if (Rule = '(') then
407 begin
408 {...Found Rule: "PCDATA".}
409 if Parser.SkipToken in [toEOF, '>'] then
410 Abort;
411 if Parser.Token = '#' then
412 begin
413 if UpperCase(Parser.SkipToToken('>')) = 'PCDATA)' then
414 begin
415 Element.Typ := etData;
416 Exit;
417 end;
418 Abort;
419 end;
420 {...Found Rule: "sequence/container".}
421 Element.Typ := etContainer;
422 repeat
423 {Create Child objects, if pass = 1.}
424 Child := nil;
425 if not (Parser.Token in ['|', ',', ')']) then
426 begin
427 if Pass = 0 then
428 begin
429 Child := Element.Childs.Add;
430 Child.Name := Parser.TokenString;
431 Child.Typ := ctElement;
432 end
433 else if Document.Elements.Find(Parser.TokenString) = nil then
434 AddErrorFmt('Invalid Element Target "%s"', [Parser.TokenString],
435 Parser);
436 end;
437 Parser.SkipToken;
438 {Check Child Status (=sequence style).}
439 if Parser.Token in ['+', '?', '*'] then
440 begin
441 if Child <> nil then
442 case Parser.Token of
443 '+':
444 Child.Status := esRequiredSeq;
445 '?':
446 Child.Status := esOptional;
447 '*':
448 Child.Status := esOptionalSeq;
449 end;
450 Parser.SkipToken;
451 end;
452 until Parser.SkipToken in [toEOF, '>'];
453 Exit;
454 end;
455 {Add an error only on pass 1.}
456 if Pass = 1 then
457 AddErrorFmt('Invalid Element Rule "%s"', [Rule], Parser);
458 except
459 {Add an error only on pass 1.}
460 if Pass = 1 then
461 AddError('InvalidElementFormat', Parser);
462 end;
463 end;
The method ParseAttlist includes the functionality to parse and extract further
informations, like Type or Enumerations: (Note: The italic lines are not part of
the sourcecode - they are used to explain the unique sections)
464
465 procedure TDTDParser.ParseAttlist(Parser: TStringParser; Document: TDTDDocument);
466 var
467 Attribute: TDTDAttribute;
468 Element: TDTDElement;
469 Target, Typ: string;
470 begin
471 {Get the next Token.}
472 Target := Parser.SkipTokenString;
473 try
474 {Add an error if the current Token isn't a symbol.}
475 if Parser.Token <> toSymbol then
476 Abort;
477 {Try to find the element target.}
478 Element := Document.Elements.Find(Target);
479 {Add an error if no element was found.}
480 if Element = nil then
481 begin
482 AddErrorFmt('Invalid Element Target "%s"', [Target], Parser);
483 Exit;
484 end;
485 {Get the next Token.}
486 Parser.SkipToken;
487 repeat
488 {Add an error if the current Token isn't a symbol.}
489 if Parser.Token <> toSymbol then
490 Abort;
491 {Create a new Attribute under the located element.}
492 Attribute := Element.Attributes.Add;
493 {Set the new name.}
494 Attribute.Name := Parser.TokenString;
495 {Check for Attribute Type...}
496 Typ := Parser.SkipTokenString;
497 {...Found Type "CDDATA".}
498 if UpperCase(Typ) = 'CDATA' then
499 Attribute.Typ := atData
500 else
501 {...Found Type "ID".} if UpperCase(Typ) = 'ID' then
502 Attribute.Typ := atID
503 else
504 {...Found Type "IDREF".} if UpperCase(Typ) = 'IDREF' then
505 Attribute.Typ := atIDRef
506 else
507 {...Found Type "enumeration".} if Typ = '(' then
508 begin
509 Attribute.Typ := atEnumeration;
510 {Seperate enumeration parts and attach them}
511 {to the parent attribute.}
512 repeat
513 Parser.SkipToken;
514 if not (Parser.Token in ['|', ')']) then
515 Attribute.Enums.Add.Name := Parser.TokenString;
516 until Parser.Token in [toEOF, ')'];
517 {Add an error, if current token is "EOF".}
518 if Parser.Token = toEOF then
519 begin
520 AddErrorFmt('Invalid Enumeration End in Attribute "%s"',
521 [Attribute.Name], Parser);
522 Exit;
523 end;
524 end
525 else
526 begin
527 AddErrorFmt('Invalid Attribute Typ "%s"', [Typ], Parser);
528 Exit;
529 end;
530 {Check for Restrictions...}
531 Parser.SkipToken;
532 if Parser.Token = '#' then
533 begin
534 {...Found Restriction "IMPLIED".}
535 Typ := UpperCase(Parser.SkipTokenString);
536 if Typ = 'IMPLIED' then
537 begin
538 Attribute.Status := asImplied;
539 Parser.SkipToken;
540 end;
541 {...Found Restriction "REQUIRED".}
542 if Typ = 'REQUIRED' then
543 begin
544 Attribute.Status := asRequired;
545 Parser.SkipToken;
546 end;
547 {...Found Restriction "FIXED".}
548 if Typ = 'FIXED' then
549 begin
550 Attribute.Status := asFixed;
551 Parser.SkipToken;
552 end;
553 end;
554 {Extract an optional default value.}
555 if Parser.Token = '"' then
556 begin
557 if Attribute.Status = asImplied then
558 Abort;
559 Attribute.default := Trim(Parser.SkipToToken('"'));
560 Parser.SkipToken;
561 end;
562 until Parser.Token = '>';
563 except
564 AddErrorFmt('Invalid Attribute Format "%s"', [Target], Parser);
565 end;
566 end;
Note: The above methods only detects simple dtd grammas. To parse all possible tags
and additional grammars you had to include a more complex algorithm to do that -
for our purposes (and this article) it's enough. If you are not familiar with the
dtd syntax, check out the site W3Schoolshttp://www.w3schools.com/.
Okay, at this point we have finished our object-model and parser implementation.
All we need now is an example application which will take use of this units. Our
demo application will parse a dtd file, detects the structure and creates a simple
xml output with a given startup node. Take a look at the following dtd:
Our demo application will create the following xml output:
|
