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
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415 | -- Copyright 2019-2021 Bartek thindil Jasicki
--
-- This file is part of YASS.
--
-- YASS is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- YASS is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with YASS. If not, see <http://www.gnu.org/licenses/>.
with Ada.Calendar.Formatting;
with Ada.Directories; use Ada.Directories;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with Ada.Text_IO.Text_Streams;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with DOM.Core; use DOM.Core;
with DOM.Core.Documents; use DOM.Core.Documents;
with DOM.Core.Elements;
with DOM.Core.Nodes; use DOM.Core.Nodes;
with DOM.Readers;
with Input_Sources.File;
with Config; use Config;
package body AtomFeed is
--## rule off GLOBAL_REFERENCES
-- ****iv* AtomFeed/AtomFeed.Feed_File_Name
-- FUNCTION
-- The name of the Atom feed file of the website
-- SOURCE
Feed_File_Name: Unbounded_String;
-- ****
-- ****iv* AtomFeed/AtomFeed.Entries_List
-- FUNCTION
-- The list of Atom entries for the website
-- SOURCE
Entries_List: FeedEntry_Container.Vector;
-- ****
--## rule on GLOBAL_REFERENCES
-- ****if* AtomFeed/AtomFeed.Get_Feed_File_Name
-- FUNCTION
-- Get the file name of the project's Atom feed
-- RESULT
-- The full path to the Atom feed file
-- SOURCE
function Get_Feed_File_Name return String is
-- ****
begin
return To_String(Source => Feed_File_Name);
end Get_Feed_File_Name;
-- ****if* AtomFeed/AtomFeed.Get_Entries_List
-- FUNCTION
-- Get the current list of Atom entries for the website
-- RESULT
-- List of Atom entries for the website
-- SOURCE
function Get_Entries_List return FeedEntry_Container.Vector is
-- ****
begin
return Entries_List;
end Get_Entries_List;
-- ****if* AtomFeed/AtomFeed.Set_Entries_List
-- FUNCTION
-- Set the new values for the list of current Atom entries for the website
-- PARAMETERS
-- New_List - The Atom entries list which will be used as the main list
-- SOURCE
procedure Set_Entries_List(New_List: FeedEntry_Container.Vector) is
-- ****
begin
Entries_List := New_List;
end Set_Entries_List;
function To_Time(Date: String) return Time is
New_Date: Unbounded_String;
begin
if Date'Length > 11 then
New_Date :=
To_Unbounded_String(Source => Date(Date'First .. Date'Last - 1));
Replace_Element(Source => New_Date, Index => 11, By => ' ');
else
New_Date := To_Unbounded_String(Source => Date & " 00:00:00");
end if;
return
Ada.Calendar.Formatting.Value(Date => To_String(Source => New_Date));
end To_Time;
function To_HTTP_Date(Date: Time) return String is
New_Date: String := Ada.Calendar.Formatting.Image(Date => Date) & "Z";
begin
New_Date(11) := 'T';
return New_Date;
end To_HTTP_Date;
procedure Start_Atom_Feed is
use DOM.Readers;
use Input_Sources.File;
Atom_File: File_Input;
--## rule off IMPROPER_INITIALIZATION
Reader: Tree_Reader;
Nodes_List, Children_Nodes, Author_Nodes: Node_List;
--## rule on IMPROPER_INITIALIZATION
Feed: Document;
Temp_Entry: Feed_Entry := Empty_Feed_Entry;
Data_Node, Author_Node: DOM.Core.Element;
Child_Index, Author_Node_Index: Positive := 1;
Local_Entries: FeedEntry_Container.Vector := Get_Entries_List;
begin
if Yass_Config.Atom_Feed_Source =
To_Unbounded_String(Source => "none") then
Site_Tags.Include(Key => "AtomLink", New_Item => "");
return;
end if;
Site_Tags.Include
(Key => "AtomLink",
New_Item =>
"<link rel=""alternate"" type=""application/rss+xml"" title=""" &
To_String(Source => Yass_Config.Site_Name) & " Feed"" href=""" &
To_String(Source => Yass_Config.Base_Url) & "/atom.xml"" />");
Feed_File_Name :=
Yass_Config.Output_Directory &
To_Unbounded_String(Source => Dir_Separator & "atom.xml");
if not Exists(Name => Get_Feed_File_Name) then
return;
end if;
Open(Filename => Get_Feed_File_Name, Input => Atom_File);
--## rule off IMPROPER_INITIALIZATION
Parse(Parser => Reader, Input => Atom_File);
Close(Input => Atom_File);
Feed := Get_Tree(Read => Reader);
--## rule on IMPROPER_INITIALIZATION
Nodes_List :=
DOM.Core.Documents.Get_Elements_By_Tag_Name
(Doc => Feed, Tag_Name => "entry");
Load_Atom_Entries_Loop :
for I in 0 .. Length(List => Nodes_List) - 1 loop
Temp_Entry := Empty_Feed_Entry;
Children_Nodes :=
Child_Nodes(N => Item(List => Nodes_List, Index => I));
Child_Index := 1;
Set_Atom_Entry_Loop :
while Child_Index < Length(List => Children_Nodes) loop
Data_Node := Item(List => Children_Nodes, Index => Child_Index);
if Node_Name(N => Data_Node) = "id" then
Temp_Entry.Id :=
To_Unbounded_String
(Source => Node_Value(N => First_Child(N => Data_Node)));
elsif Node_Name(N => Data_Node) = "title" then
Temp_Entry.Entry_Title :=
To_Unbounded_String
(Source => Node_Value(N => First_Child(N => Data_Node)));
elsif Node_Name(N => Data_Node) = "updated" then
Temp_Entry.Updated :=
To_Time(Date => Node_Value(N => First_Child(N => Data_Node)));
elsif Node_Name(N => Data_Node) = "author" then
Author_Nodes := Child_Nodes(N => Data_Node);
Author_Node_Index := 1;
Set_Author_Node_Loop :
while Author_Node_Index < Length(List => Author_Nodes) loop
Author_Node :=
Item(List => Author_Nodes, Index => Author_Node_Index);
if Node_Name(N => Author_Node) = "name" then
Temp_Entry.Author_Name :=
To_Unbounded_String
(Source =>
Node_Value(N => First_Child(N => Author_Node)));
elsif Node_Name(N => Author_Node) = "email" then
Temp_Entry.Author_Email :=
To_Unbounded_String
(Source =>
Node_Value(N => First_Child(N => Author_Node)));
end if;
Author_Node_Index := Author_Node_Index + 2;
end loop Set_Author_Node_Loop;
elsif Node_Name(N => Data_Node) = "summary" then
Temp_Entry.Summary :=
To_Unbounded_String
(Source => Node_Value(N => First_Child(N => Data_Node)));
elsif Node_Name(N => Data_Node) = "content" then
Temp_Entry.Content :=
To_Unbounded_String
(Source => Node_Value(N => First_Child(N => Data_Node)));
end if;
Child_Index := Child_Index + 2;
end loop Set_Atom_Entry_Loop;
Local_Entries.Append(New_Item => Temp_Entry);
end loop Load_Atom_Entries_Loop;
Set_Entries_List(New_List => Local_Entries);
end Start_Atom_Feed;
procedure Add_Page_To_Feed
(File_Name: String; Entries: in out FeedEntry_Container.Vector) is
use Ada.Strings.Fixed;
Url: constant String :=
To_String(Source => Yass_Config.Base_Url) & "/" &
Ada.Strings.Unbounded.Slice
(Source => To_Unbounded_String(Source => File_Name),
Low =>
Length(Source => Yass_Config.Output_Directory & Dir_Separator) +
1,
High => File_Name'Length);
Entry_Index: Natural := 0;
Local_Entries: FeedEntry_Container.Vector := Get_Entries_List;
begin
if Yass_Config.Atom_Feed_Source =
To_Unbounded_String(Source => "none") or
(Yass_Config.Atom_Feed_Source /= To_Unbounded_String(Source => "tags")
and then
Index
(Source => File_Name,
Pattern => To_String(Source => Yass_Config.Atom_Feed_Source),
From => 1) =
0) then
return;
end if;
if FeedEntry_Container.Length(Container => Entries) > 1
and then Entries(1).Updated < Entries(2).Updated then
Entries.Reverse_Elements;
end if;
Add_Page_To_Feed_Loop :
for AtomEntry of Entries loop
if AtomEntry.Id = Null_Unbounded_String then
AtomEntry.Id := To_Unbounded_String(Source => Url);
elsif Index(Source => AtomEntry.Id, Pattern => Url, From => 1) =
0 then
AtomEntry.Id :=
To_Unbounded_String(Source => Url) & "#" & AtomEntry.Id;
end if;
if AtomEntry.Updated =
Time_Of(Year => 1_901, Month => 1, Day => 1) then
AtomEntry.Updated := Modification_Time(Name => File_Name);
end if;
if AtomEntry.Content = Null_Unbounded_String then
AtomEntry.Content := AtomEntry.Id;
end if;
Delete_Entry_Loop :
for I in Local_Entries.First_Index .. Local_Entries.Last_Index loop
if Local_Entries(I).Entry_Title = AtomEntry.Entry_Title then
Local_Entries.Delete(Index => I);
exit Delete_Entry_Loop;
end if;
end loop Delete_Entry_Loop;
Entry_Index := Get_Entries_List.First_Index;
Move_Atom_Entries_Loop :
for I in Local_Entries.Iterate loop
if Local_Entries(I).Updated < AtomEntry.Updated then
Entry_Index := FeedEntry_Container.To_Index(Position => I);
Local_Entries.Insert(Before => I, New_Item => AtomEntry);
exit Move_Atom_Entries_Loop;
end if;
end loop Move_Atom_Entries_Loop;
if Entry_Index > Local_Entries.Last_Index then
Local_Entries.Append(New_Item => AtomEntry);
end if;
end loop Add_Page_To_Feed_Loop;
Set_Entries_List(New_List => Local_Entries);
end Add_Page_To_Feed;
procedure Save_Atom_Feed is
use Ada.Text_IO;
use Ada.Text_IO.Text_Streams;
use DOM.Core.Elements;
Atom_File: File_Type;
Feed: Document; --## rule line off GLOBAL_REFERENCES
New_Feed: DOM_Implementation; --## rule line off IMPROPER_INITIALIZATION
Main_Node, Entry_Node: DOM.Core.Element;
Entries_Amount: Natural := 0;
Local_Entries: constant FeedEntry_Container.Vector := Get_Entries_List;
-- Add XML node Node_Name with value Node_Value to parent XML node Parent_Node
procedure Add_Node
(Node_Name, Node_Value: String; Parent_Node: DOM.Core.Element) is
Feed_Text: Text;
Feed_Data: DOM.Core.Element;
begin
Feed_Data :=
Append_Child
(N => Parent_Node,
New_Child => Create_Element(Doc => Feed, Tag_Name => Node_Name));
Feed_Text := Create_Text_Node(Doc => Feed, Data => Node_Value);
if Append_Child(N => Feed_Data, New_Child => Feed_Text) /= null then
return;
end if;
end Add_Node;
-- Add link entry to parent node Parent_Node with url URL and relationship Relationship
procedure Add_Link
(Parent_Node: DOM.Core.Element; Url, Relationship: String) is
Link_Node: DOM.Core.Element;
begin
Link_Node :=
Append_Child
(N => Parent_Node,
New_Child => Create_Element(Doc => Feed, Tag_Name => "link"));
Set_Attribute
(Elem => Link_Node, Name => "rel", Value => Relationship);
Set_Attribute(Elem => Link_Node, Name => "href", Value => Url);
end Add_Link;
-- Add author to parent node Parent_Node with author name Name and author email Email
procedure Add_Author
(Parent_Node: DOM.Core.Element; Name, Email: String) is
Author_Node: DOM.Core.Element;
begin
Author_Node :=
Append_Child
(N => Parent_Node,
New_Child => Create_Element(Doc => Feed, Tag_Name => "author"));
if Name'Length > 0 then
Add_Node
(Node_Name => "name", Node_Value => Name,
Parent_Node => Author_Node);
end if;
if Email'Length > 0 then
Add_Node
(Node_Name => "email", Node_Value => Email,
Parent_Node => Author_Node);
end if;
end Add_Author;
begin
if Yass_Config.Atom_Feed_Source =
To_Unbounded_String(Source => "none") or
FeedEntry_Container.Length(Container => Get_Entries_List) = 0 then
return;
end if;
Feed :=
Create_Document
(Implementation =>
New_Feed); --## rule line off IMPROPER_INITIALIZATION
Main_Node := Create_Element(Doc => Feed, Tag_Name => "feed");
Set_Attribute
(Elem => Main_Node, Name => "xmlns",
Value => "http://www.w3.org/2005/Atom");
Main_Node := Append_Child(N => Feed, New_Child => Main_Node);
Add_Link
(Parent_Node => Main_Node,
Url => To_String(Source => Yass_Config.Base_Url) & "/atom.xml",
Relationship => "self");
Add_Node
(Node_Name => "id",
Node_Value => To_String(Source => Yass_Config.Base_Url) & "/",
Parent_Node => Main_Node);
Add_Node
(Node_Name => "title",
Node_Value => To_String(Source => Yass_Config.Site_Name),
Parent_Node => Main_Node);
Add_Node
(Node_Name => "updated",
Node_Value => To_HTTP_Date(Date => Local_Entries(1).Updated),
Parent_Node => Main_Node);
Add_Author
(Parent_Node => Main_Node,
Name => To_String(Source => Yass_Config.Author_Name),
Email => To_String(Source => Yass_Config.Author_Email));
Add_Entries_Loop :
for FeedEntry of Local_Entries loop
Entry_Node :=
Append_Child
(N => Main_Node,
New_Child => Create_Element(Doc => Feed, Tag_Name => "entry"));
Add_Node
(Node_Name => "id", Node_Value => To_String(Source => FeedEntry.Id),
Parent_Node => Entry_Node);
Add_Node
(Node_Name => "title",
Node_Value => To_String(Source => FeedEntry.Entry_Title),
Parent_Node => Entry_Node);
Add_Node
(Node_Name => "updated",
Node_Value => To_HTTP_Date(Date => FeedEntry.Updated),
Parent_Node => Entry_Node);
Add_Node
(Node_Name => "content",
Node_Value => To_String(Source => FeedEntry.Content),
Parent_Node => Entry_Node);
Add_Link
(Parent_Node => Entry_Node,
Url => To_String(Source => FeedEntry.Id),
Relationship => "alternate");
if FeedEntry.Author_Name /= Null_Unbounded_String or
FeedEntry.Author_Email /= Null_Unbounded_String then
Add_Author
(Parent_Node => Entry_Node,
Name => To_String(Source => FeedEntry.Author_Name),
Email => To_String(Source => FeedEntry.Author_Email));
end if;
if FeedEntry.Summary /= Null_Unbounded_String then
Add_Node
(Node_Name => "summary",
Node_Value => To_String(Source => FeedEntry.Summary),
Parent_Node => Entry_Node);
end if;
Entries_Amount := Entries_Amount + 1;
exit Add_Entries_Loop when Entries_Amount =
Yass_Config.Atom_Feed_Amount;
end loop Add_Entries_Loop;
Create(File => Atom_File, Mode => Out_File, Name => Get_Feed_File_Name);
Write
(Stream => Stream(File => Atom_File), N => Feed, Pretty_Print => True);
Close(File => Atom_File);
end Save_Atom_Feed;
end AtomFeed;
|