-- 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;
with Ada.Directories; use Ada.Directories;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
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 AtomFeed;
with Config; use Config;
package body Sitemaps is
-- ****iv* Sitemaps/Sitemaps.Sitemap
-- FUNCTION
-- The content of the sitemap of the project
-- SOURCE
Sitemap: Document; --## rule line off GLOBAL_REFERENCES
-- ****
-- ****if* Sitemaps/Sitemaps.Get_Sitemap
-- FUNCTION
-- Get the project sitemap content
-- RESULT
-- The Document with sitemap of the current project
-- SOURCE
function Get_Sitemap return Document is
-- ****
begin
return Sitemap;
end Get_Sitemap;
-- ****if* Sitemaps/Sitemaps.Set_Sitemap
-- FUNCTION
-- Set the project sitemap content
-- PARAMETERS
-- New_Sitemap - The sitemap which will be used as the project sitemap
-- SOURCE
procedure Set_Sitemap(New_Sitemap: Document) is
-- ****
begin
Sitemap := New_Sitemap;
end Set_Sitemap;
-- ****iv* Sitemaps/Sitemaps.Main_Node
-- FUNCTION
-- The main XML node of the project's sitemap
-- SOURCE
Main_Node: DOM.Core.Element; --## rule line off GLOBAL_REFERENCES
-- ****
-- ****if* Sitemaps/Set_Main_Node
-- FUNCTION
-- Set the new main XML node for the sitemap of the project
-- PARAMETERS
-- New_Main_Node - The XML node which will be set as the new main sitemap
-- node
-- SOURCE
procedure Set_Main_Node(New_Main_Node: DOM.Core.Element) is
-- ****
begin
Main_Node := New_Main_Node;
end Set_Main_Node;
-- ****iv* Sitemaps/Sitemaps.Sitemap_File_Name
-- FUNCTION
-- The name of the file which contains the project's sitemap
-- SOURCE
Sitemap_File_Name: Unbounded_String; --## rule line off GLOBAL_REFERENCES
-- ****
-- ****if* Sitemaps/Get_Sitemap_File_Name
-- FUNCTION
-- Get the name of file which contains the project's sitemap
-- RESULT
-- Unbounded_String with the name of sitemap file
-- SOURCE
function Get_Sitemap_File_Name return Unbounded_String is
-- ****
begin
return Sitemap_File_Name;
end Get_Sitemap_File_Name;
procedure Start_Sitemap is
use DOM.Core.Elements;
use DOM.Readers;
use Input_Sources.File;
Sitemap_File: File_Input;
--## rule off IMPROPER_INITIALIZATION
Reader: Tree_Reader;
New_Sitemap: DOM_Implementation;
Nodes_List: Node_List;
Local_Sitemap: Document;
Local_Main_Node: DOM.Core.Element;
--## rule on IMPROPER_INITIALIZATION
begin
if not Yass_Config.Sitemap_Enabled then
return;
end if;
Sitemap_File_Name :=
Yass_Config.Output_Directory &
To_Unbounded_String(Source => Dir_Separator & "sitemap.xml");
-- Load existing sitemap data
if Exists(Name => To_String(Source => Get_Sitemap_File_Name)) then
Open
(Filename => To_String(Source => Get_Sitemap_File_Name),
Input => Sitemap_File);
--## rule off IMPROPER_INITIALIZATION
Parse(Parser => Reader, Input => Sitemap_File);
Close(Input => Sitemap_File);
Local_Sitemap := Get_Tree(Read => Reader);
--## rule on IMPROPER_INITIALIZATION
Nodes_List :=
DOM.Core.Documents.Get_Elements_By_Tag_Name
(Doc => Local_Sitemap, Tag_Name => "urlset");
Local_Main_Node := Item(List => Nodes_List, Index => 0);
Set_Attribute
(Elem => Local_Main_Node, Name => "xmlns",
Value => "http://www.sitemaps.org/schemas/sitemap/0.9");
-- Create new sitemap data
else
Local_Sitemap := Create_Document(Implementation => New_Sitemap);
Local_Main_Node :=
Create_Element(Doc => Local_Sitemap, Tag_Name => "urlset");
Set_Attribute
(Elem => Local_Main_Node, Name => "xmlns",
Value => "http://www.sitemaps.org/schemas/sitemap/0.9");
Local_Main_Node :=
Append_Child(N => Local_Sitemap, New_Child => Local_Main_Node);
end if;
Set_Sitemap(New_Sitemap => Local_Sitemap);
Set_Main_Node(New_Main_Node => Local_Main_Node);
end Start_Sitemap;
procedure Add_Page_To_Sitemap
(File_Name, Change_Frequency, Page_Priority: String) is
use Ada.Calendar;
use AtomFeed;
Url: constant String :=
To_String(Source => Yass_Config.Base_Url) & "/" &
Slice
(Source => To_Unbounded_String(Source => File_Name),
Low =>
Length(Source => Yass_Config.Output_Directory & Dir_Separator) +
1,
High => File_Name'Length);
Urls_List: Node_List;
Children_List: Node_List; --## rule line off IMPROPER_INITIALIZATION
Added, Frequency_Updated, Priority_Updated: Boolean := False;
Url_Node, Url_Data, Old_Main_Node, Remove_Frequency,
Remove_Priority: DOM.Core.Element;
Url_Text: Text;
Last_Modified: constant String := To_HTTP_Date(Date => Clock);
Local_Sitemap: constant Document := Get_Sitemap;
Local_Main_Node: DOM.Core.Element := Main_Node;
begin
if not Yass_Config.Sitemap_Enabled then
return;
end if;
Urls_List :=
DOM.Core.Documents.Get_Elements_By_Tag_Name
(Doc => Local_Sitemap, Tag_Name => "loc");
Load_Existing_Urls_Loop :
for I in 0 .. Length(List => Urls_List) - 1 loop
if Node_Value
(N => First_Child(N => Item(List => Urls_List, Index => I))) /=
Url then
goto End_Of_Loop;
end if;
-- Update sitemap entry if exists
Url_Node := Parent_Node(N => Item(List => Urls_List, Index => I));
Children_List := Child_Nodes(N => Url_Node);
Update_Entry_Loop :
for J in 0 .. Length(List => Children_List) - 1 loop
if Node_Name(N => Item(List => Children_List, Index => J)) =
"lastmod" then
Url_Text :=
First_Child(N => Item(List => Children_List, Index => J));
Set_Node_Value(N => Url_Text, Value => Last_Modified);
elsif Node_Name(N => Item(List => Children_List, Index => J)) =
"changefreq" then
if Change_Frequency'Length > 0 then
Url_Text :=
First_Child(N => Item(List => Children_List, Index => J));
Set_Node_Value(N => Url_Text, Value => Change_Frequency);
else
Remove_Frequency := Item(List => Children_List, Index => J);
end if;
Frequency_Updated := True;
elsif Node_Name(N => Item(List => Children_List, Index => J)) =
"priority" then
if Page_Priority'Length > 0 then
Url_Text :=
First_Child(N => Item(List => Children_List, Index => J));
Set_Node_Value(N => Url_Text, Value => Page_Priority);
else
Remove_Priority := Item(List => Children_List, Index => J);
end if;
Priority_Updated := True;
end if;
end loop Update_Entry_Loop;
if Change_Frequency'Length > 0 and not Frequency_Updated then
Url_Data :=
Append_Child
(N => Url_Node,
New_Child =>
Create_Element
(Doc => Local_Sitemap, Tag_Name => "changefreq"));
Url_Text :=
Append_Child
(N => Url_Data,
New_Child =>
Create_Text_Node
(Doc => Local_Sitemap, Data => Change_Frequency));
end if;
if Page_Priority'Length > 0 and not Priority_Updated then
Url_Data :=
Append_Child
(N =>
Create_Element
(Doc => Local_Sitemap, Tag_Name => "priority"),
New_Child => Url_Data);
Url_Text :=
Append_Child
(N => Url_Data,
New_Child =>
Create_Text_Node
(Doc => Local_Sitemap, Data => Page_Priority));
end if;
if Remove_Frequency /= null then
Url_Node :=
Remove_Child(N => Url_Node, Old_Child => Remove_Frequency);
end if;
if Remove_Priority /= null then
Url_Node :=
Remove_Child(N => Url_Node, Old_Child => Remove_Priority);
end if;
Added := True;
exit Load_Existing_Urls_Loop;
<>
end loop Load_Existing_Urls_Loop;
-- Add new sitemap entry
if not Added then
Url_Node := Create_Element(Doc => Local_Sitemap, Tag_Name => "url");
Old_Main_Node := Local_Main_Node;
Local_Main_Node :=
Append_Child(N => Local_Main_Node, New_Child => Url_Node);
--## rule off ASSIGNMENTS
Local_Main_Node := Old_Main_Node;
Url_Data :=
Append_Child
(N => Url_Node,
New_Child =>
Create_Element(Doc => Local_Sitemap, Tag_Name => "loc"));
Url_Text :=
Append_Child
(N => Url_Data,
New_Child =>
Create_Text_Node(Doc => Local_Sitemap, Data => Url));
Url_Data :=
Append_Child
(N => Url_Node,
New_Child =>
Create_Element(Doc => Local_Sitemap, Tag_Name => "lastmod"));
Url_Text :=
Append_Child
(N => Url_Data,
New_Child =>
Create_Text_Node(Doc => Local_Sitemap, Data => Last_Modified));
--## rule on ASSIGNMENTS
if Change_Frequency /= "" then
Url_Data :=
Append_Child
(N => Url_Node,
New_Child =>
Create_Element
(Doc => Local_Sitemap, Tag_Name => "changefreq"));
Url_Text :=
Append_Child
(N => Url_Data,
New_Child =>
Create_Text_Node
(Doc => Local_Sitemap, Data => Change_Frequency));
end if;
if Page_Priority /= "" then
Url_Data :=
Append_Child
(N => Url_Node,
New_Child =>
Create_Element
(Doc => Local_Sitemap, Tag_Name => "priority"));
Url_Text :=
Append_Child
(N => Url_Data,
New_Child =>
Create_Text_Node
(Doc => Local_Sitemap, Data => Page_Priority));
end if;
end if;
Set_Sitemap(New_Sitemap => Local_Sitemap);
Set_Main_Node(New_Main_Node => Local_Main_Node);
end Add_Page_To_Sitemap;
procedure Save_Sitemap is
use Ada.Text_IO;
use Ada.Text_IO.Text_Streams;
Sitemap_File: File_Type;
begin
if not Yass_Config.Sitemap_Enabled then
return;
end if;
-- If the sitemap file not exists - create or open existing robot.txt file and append address to the sitemap
if not Exists(Name => To_String(Source => Get_Sitemap_File_Name)) then
if Exists
(Name =>
Containing_Directory
(Name => To_String(Source => Get_Sitemap_File_Name)) &
Dir_Separator & "robots.txt") then
Open
(File => Sitemap_File, Mode => Append_File,
Name =>
Containing_Directory
(Name => To_String(Source => Get_Sitemap_File_Name)) &
Dir_Separator & "robots.txt");
else
Create
(File => Sitemap_File, Mode => Append_File,
Name =>
Containing_Directory
(Name => To_String(Source => Get_Sitemap_File_Name)) &
Dir_Separator & "robots.txt");
end if;
Put_Line
(File => Sitemap_File,
Item =>
"Sitemap: " & To_String(Source => Yass_Config.Base_Url) &
"/sitemap.xml");
Close(File => Sitemap_File);
end if;
-- Save the sitemap to the file
Create
(File => Sitemap_File, Mode => Out_File,
Name => To_String(Source => Get_Sitemap_File_Name));
Write
(Stream => Stream(File => Sitemap_File), N => Get_Sitemap, Pretty_Print => True);
Close(File => Sitemap_File);
end Save_Sitemap;
end Sitemaps;