/src/yolk-syndication.adb
http://github.com/ThomasLocke/yolk · Ada · 551 lines · 352 code · 87 blank · 112 comment · 18 complexity · 6791835e80893e9a87883e4d24f0cac6 MD5 · raw file
- -------------------------------------------------------------------------------
- -- --
- -- Copyright (C) 2010-, Thomas Løcke --
- -- --
- -- This library is free software; you can redistribute it and/or modify --
- -- it under terms of the GNU General Public License as published by the --
- -- Free Software Foundation; either version 3, or (at your option) any --
- -- later version. This library 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. --
- -- --
- -- As a special exception under Section 7 of GPL version 3, you are --
- -- granted additional permissions described in the GCC Runtime Library --
- -- Exception, version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
- -- <http://www.gnu.org/licenses/>. --
- -- --
- -------------------------------------------------------------------------------
- with Ada.Streams;
- with DOM.Core.Nodes;
- with Yolk.Syndication.DOM_Builder;
- package body Yolk.Syndication is
- -------------------
- -- Equal_Entry --
- -------------------
- function Equal_Entry
- (Left, Right : in Atom_Entry)
- return Boolean
- is
- begin
- return Left.Id.URI = Right.Id.URI;
- end Equal_Entry;
- ----------------------
- -- New_Atom_Entry --
- ----------------------
- function New_Atom_Entry
- (Base_URI : in String := None;
- Language : in String := None)
- return Atom_Entry
- is
- begin
- return An_Entry : Atom_Entry := Null_Atom_Entry do
- if Base_URI /= None then
- An_Entry.Common.Base_URI := U (Base_URI);
- end if;
- if Language /= None then
- An_Entry.Common.Language := U (Language);
- end if;
- end return;
- end New_Atom_Entry;
- -----------------------------
- -- New_Atom_Entry_Source --
- -----------------------------
- function New_Atom_Entry_Source
- (Base_URI : in String := None;
- Language : in String := None)
- return Atom_Entry_Source
- is
- begin
- return Source : Atom_Entry_Source := Null_Atom_Entry_Source do
- if Base_URI /= None then
- Source.Common.Base_URI := U (Base_URI);
- end if;
- if Language /= None then
- Source.Common.Language := U (Language);
- end if;
- null;
- end return;
- end New_Atom_Entry_Source;
- ---------------------
- -- New_Atom_Feed --
- ---------------------
- function New_Atom_Feed
- (Base_URI : in String := None;
- Language : in String := None;
- Max_Age : in Duration := 5_616_000.0;
- Max_Entries : in Positive := 100;
- Min_Entries : in Positive := 10)
- return Atom_Feed
- is
- Common : constant Atom_Common := (Base_URI => U (Base_URI),
- Language => U (Language));
- begin
- return Feed : Atom_Feed do
- Feed.PAF.Set_Common (Value => Common);
- Feed.PAF.Set_Max_age (Value => Max_Age);
- Feed.PAF.Set_Max_Entries (Value => Max_Entries);
- Feed.PAF.Set_Min_Entries (Value => Min_Entries);
- end return;
- end New_Atom_Feed;
- ---------------------------
- -- Protected_Atom_Feed --
- ---------------------------
- protected body Protected_Atom_Feed is
- ------------------
- -- Add_Author --
- ------------------
- procedure Add_Author
- (Value : in Atom_Person)
- is
- begin
- Authors.Append (Value);
- end Add_Author;
- --------------------
- -- Add_Category --
- --------------------
- procedure Add_Category
- (Value : in Atom_Category)
- is
- begin
- Categories.Append (Value);
- end Add_Category;
- -----------------------
- -- Add_Contributor --
- -----------------------
- procedure Add_Contributor
- (Value : in Atom_Person)
- is
- begin
- Contributors.Append (Value);
- end Add_Contributor;
- -----------------
- -- Add_Entry --
- -----------------
- procedure Add_Entry
- (Value : in Yolk.Syndication.Atom_Entry)
- is
- use Ada.Calendar;
- use Entry_List;
- procedure Insert_Entry
- (Value : in Atom_Entry;
- Done : out Boolean);
- -- Insert the Value into List sorted by Atom_Entry.Updated
- --------------------
- -- Insert_Entry --
- --------------------
- procedure Insert_Entry
- (Value : in Atom_Entry;
- Done : out Boolean)
- is
- Appendable : Boolean := False;
- C : Cursor;
- begin
- if Entries.Is_Empty then
- Appendable := True;
- else
- if Value.Updated.Time_Stamp <=
- Entries.Last_Element.Updated.Time_Stamp
- then
- Appendable := True;
- end if;
- end if;
- if Appendable then
- Entries.Append (New_Item => Value);
- Done := True;
- elsif Value.Updated.Time_Stamp >=
- Entries.First_Element.Updated.Time_Stamp
- then
- Entries.Prepend (New_Item => Value);
- Done := True;
- else
- C := Entries.First;
- while Has_Element (C) loop
- if Value.Updated.Time_Stamp >=
- Element (C).Updated.Time_Stamp
- then
- Entries.Insert (Before => C,
- New_Item => Value);
- Done := True;
- exit;
- end if;
- Next (C);
- end loop;
- end if;
- end Insert_Entry;
- C : Cursor;
- Counter : Natural := Natural (Entries.Length);
- Entry_Added : Boolean := False;
- Now : constant Time := Clock;
- begin
- C := Find (Container => Entries,
- Item => Value);
- if C /= No_Element then
- Entries.Delete (Position => C);
- end if;
- if Entries.Length >= Count_Type (Max_Entries) then
- Entries.Delete_Last
- (Count => Entries.Length - (Count_Type (Max_Entries - 1)));
- end if;
- C := Entries.Last;
- loop
- exit when Counter <= Min_Entries;
- if Now - Element (C).Updated.Time_Stamp > Max_Entry_Age then
- Entries.Delete (Position => C);
- C := Entries.Last;
- else
- Previous (C);
- end if;
- Counter := Counter - 1;
- end loop;
- if Entries.Length < Count_Type (Max_Entries)
- or Clock - Value.Updated.Time_Stamp <= Max_Entry_Age
- then
- Insert_Entry (Value => Value,
- Done => Entry_Added);
- end if;
- if Entry_Added
- and then Value.Updated.Time_Stamp < Updated.Time_Stamp
- then
- Updated.Time_Stamp := Value.Updated.Time_Stamp;
- end if;
- end Add_Entry;
- ----------------
- -- Add_Link --
- ----------------
- procedure Add_Link
- (Value : in Atom_Link)
- is
- begin
- Links.Append (Value);
- end Add_Link;
- -------------------------
- -- Amount_Of_Entries --
- -------------------------
- function Amount_Of_Entries return Natural
- is
- begin
- return Natural (Entries.Length);
- end Amount_Of_Entries;
- ------------------------
- -- Clear_Entry_List --
- ------------------------
- procedure Clear_Entry_List
- is
- begin
- Entries.Clear;
- end Clear_Entry_List;
- --------------------
- -- Delete_Entry --
- --------------------
- procedure Delete_Entry
- (Id : in String)
- is
- use Entry_List;
- C : Cursor;
- begin
- C := Entries.First;
- while Has_Element (C) loop
- if Element (C).Id.URI = U (Id) then
- Entries.Delete (C);
- end if;
- Next (C);
- end loop;
- end Delete_Entry;
- ---------------
- -- Get_DOM --
- ---------------
- function Get_DOM return DOM.Core.Document
- is
- use DOM.Core;
- use Yolk.Syndication.DOM_Builder;
- Doc : Document;
- Impl : DOM_Implementation;
- begin
- Doc := Create_Document (Implementation => Impl);
- Create_Feed_Element (Authors => Authors,
- Categories => Categories,
- Common => Common,
- Contributors => Contributors,
- Doc => Doc,
- Entries => Entries,
- Generator => Generator,
- Icon => Icon,
- Id => Id,
- Links => Links,
- Logo => Logo,
- Rights => Rights,
- Subtitle => Subtitle,
- Title => Title,
- Updated => Updated);
- return Doc;
- end Get_DOM;
- ------------------
- -- Get_String --
- ------------------
- function Get_String
- (Pretty_Print : in Boolean := False)
- return String
- is
- use Ada.Streams;
- use DOM.Core.Nodes;
- type String_Stream_Type is new Root_Stream_Type with record
- Str : Unbounded_String;
- Read_Index : Natural := 1;
- end record;
- procedure Read
- (Stream : in out String_Stream_Type;
- Item : out Stream_Element_Array;
- Last : out Stream_Element_Offset);
- procedure Write
- (Stream : in out String_Stream_Type;
- Item : Stream_Element_Array);
- ----------
- -- Read --
- ----------
- procedure Read
- (Stream : in out String_Stream_Type;
- Item : out Stream_Element_Array;
- Last : out Stream_Element_Offset)
- is
- Str : constant String := Slice
- (Stream.Str,
- Stream.Read_Index,
- Stream.Read_Index + Item'Length - 1);
- J : Stream_Element_Offset := Item'First;
- begin
- for S in Str'Range loop
- Item (J) := Stream_Element (Character'Pos (Str (S)));
- J := J + 1;
- end loop;
- Last := Item'First + Str'Length - 1;
- Stream.Read_Index := Stream.Read_Index + Item'Length;
- end Read;
- -----------
- -- Write --
- -----------
- procedure Write
- (Stream : in out String_Stream_Type;
- Item : Stream_Element_Array)
- is
- Str : String (1 .. Integer (Item'Length));
- S : Integer := Str'First;
- begin
- for J in Item'Range loop
- Str (S) := Character'Val (Item (J));
- S := S + 1;
- end loop;
- Append (Stream.Str, Str);
- end Write;
- Output : aliased String_Stream_Type;
- Doc : DOM.Core.Document := Get_DOM;
- begin
- DOM.Core.Nodes.Write (Stream => Output'Access,
- N => Doc,
- Print_Comments => False,
- Print_XML_Declaration => False,
- Pretty_Print => Pretty_Print);
- Free (Doc);
- return PI & To_String (Output.Str);
- end Get_String;
- ------------------
- -- Set_Common --
- ------------------
- procedure Set_Common
- (Value : in Atom_Common)
- is
- begin
- Common := Value;
- end Set_Common;
- ---------------------
- -- Set_Generator --
- ---------------------
- procedure Set_Generator
- (Value : in Atom_Generator)
- is
- begin
- Generator := Value;
- end Set_Generator;
- ----------------
- -- Set_Icon --
- ----------------
- procedure Set_Icon
- (Value : in Atom_Icon)
- is
- begin
- Icon := Value;
- end Set_Icon;
- --------------
- -- Set_Id --
- --------------
- procedure Set_Id
- (Value : in Atom_Id)
- is
- begin
- Id := Value;
- end Set_Id;
- ----------------
- -- Set_Logo --
- ----------------
- procedure Set_Logo
- (Value : in Atom_Logo)
- is
- begin
- Logo := Value;
- end Set_Logo;
- -------------------
- -- Set_Max_Age --
- -------------------
- procedure Set_Max_Age
- (Value : in Duration)
- is
- begin
- Max_Entry_Age := Value;
- end Set_Max_Age;
- -----------------------
- -- Set_Max_Entries --
- -----------------------
- procedure Set_Max_Entries
- (Value : in Positive)
- is
- begin
- Max_Entries := Value;
- end Set_Max_Entries;
- -----------------------
- -- Set_Min_Entries --
- -----------------------
- procedure Set_Min_Entries
- (Value : in Positive)
- is
- begin
- Min_Entries := Value;
- end Set_Min_Entries;
- ------------------
- -- Set_Rights --
- ------------------
- procedure Set_Rights
- (Value : in Atom_Text)
- is
- begin
- Rights := Value;
- end Set_Rights;
- --------------------
- -- Set_Subtitle --
- --------------------
- procedure Set_Subtitle
- (Value : in Atom_Text)
- is
- begin
- Subtitle := Value;
- end Set_Subtitle;
- -----------------
- -- Set_Title --
- -----------------
- procedure Set_Title
- (Value : Atom_Text)
- is
- begin
- Title := Value;
- end Set_Title;
- -------------------
- -- Set_Updated --
- -------------------
- procedure Set_Updated_Time
- (Value : in Atom_Date)
- is
- use Ada.Calendar;
- begin
- Updated := Value;
- end Set_Updated_Time;
- end Protected_Atom_Feed;
- end Yolk.Syndication;