-- 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 . 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 => " 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;