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 | -----------------------------------------------------------------------
-- gen-model -- Model for Code Generator
-- Copyright (C) 2009, 2010, 2011, 2012, 2018, 2019, 2020, 2021, 2022 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with DOM.Core.Nodes;
with Gen.Utils;
package body Gen.Model is
Trim_Chars : constant Ada.Strings.Maps.Character_Set
:= Ada.Strings.Maps.To_Set (" " & ASCII.HT & ASCII.LF & ASCII.CR);
-- ------------------------------
-- Get the object unique name.
-- ------------------------------
function Get_Name (From : in Definition) return String is
begin
return To_String (From.Def_Name);
end Get_Name;
function Name (From : in Definition) return UString is
begin
return From.Def_Name;
end Name;
-- ------------------------------
-- Set the object unique name.
-- ------------------------------
procedure Set_Name (Def : in out Definition;
Name : in String) is
begin
Def.Def_Name := To_UString (Name);
end Set_Name;
procedure Set_Name (Def : in out Definition;
Name : in UString) is
begin
Def.Def_Name := Name;
end Set_Name;
-- ------------------------------
-- Get the value identified by the name.
-- If the name cannot be found, the method should return the Null object.
-- ------------------------------
overriding
function Get_Value (From : in Definition;
Name : in String) return UBO.Object is
begin
if Name = "comment" then
return From.Comment;
elsif Name = "rowIndex" then
return UBO.To_Object (From.Row_Index);
elsif Name = "name" then
return UBO.To_Object (From.Def_Name);
else
return From.Attrs.Get_Value (Name);
end if;
end Get_Value;
-- ------------------------------
-- Get the value identified by the name.
-- If the name cannot be found, the method should return the Null object.
-- ------------------------------
function Get_Attribute (From : in Definition;
Name : in String) return String is
V : constant UBO.Object := From.Get_Value (Name);
begin
return UBO.To_String (V);
end Get_Attribute;
-- ------------------------------
-- Get the value identified by the name.
-- If the name cannot be found, the method should return the Null object.
-- ------------------------------
function Get_Attribute (From : in Definition;
Name : in String) return UString is
begin
return To_UString (From.Get_Attribute (Name));
end Get_Attribute;
-- ------------------------------
-- Set the comment associated with the element.
-- ------------------------------
procedure Set_Comment (Def : in out Definition;
Comment : in String) is
Trimmed_Comment : constant String
:= Ada.Strings.Fixed.Trim (Comment, Trim_Chars, Trim_Chars);
begin
Def.Comment := UBO.To_Object (Trimmed_Comment);
end Set_Comment;
-- ------------------------------
-- Get the comment associated with the element.
-- ------------------------------
function Get_Comment (Def : in Definition) return UBO.Object is
begin
return Def.Comment;
end Get_Comment;
-- ------------------------------
-- Set the location (file and line) where the model element is defined in the XMI file.
-- ------------------------------
procedure Set_Location (Node : in out Definition;
Location : in String) is
begin
Node.Location := To_UString (Location);
end Set_Location;
-- ------------------------------
-- Get the location file and line where the model element is defined.
-- ------------------------------
function Get_Location (Node : in Definition) return String is
begin
return To_String (Node.Location);
end Get_Location;
-- ------------------------------
-- Initialize the definition from the DOM node attributes.
-- ------------------------------
procedure Initialize (Def : in out Definition;
Name : in UString;
Node : in DOM.Core.Node) is
use type DOM.Core.Node;
Attrs : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (Node);
begin
Def.Def_Name := Name;
Def.Comment := UBO.To_Object (Gen.Utils.Get_Comment (Node));
for I in 0 .. DOM.Core.Nodes.Length (Attrs) loop
declare
A : constant DOM.Core.Node := DOM.Core.Nodes.Item (Attrs, I);
begin
if A /= null then
declare
Name : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Name (A);
Value : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Value (A);
begin
Def.Attrs.Include (Name, UBO.To_Object (Value));
end;
end if;
end;
end loop;
end Initialize;
-- ------------------------------
-- Validate the definition by checking and reporting problems to the logger interface.
-- ------------------------------
procedure Validate (Def : in out Definition;
Log : in out Util.Log.Logging'Class) is
begin
if Length (Def.Def_Name) = 0 then
Log.Error (Def.Get_Location & ": name is empty");
end if;
end Validate;
procedure Set_Index (Def : in out Definition;
Index : in Natural) is
begin
Def.Row_Index := Index;
end Set_Index;
end Gen.Model;
|