PageRenderTime 37ms CodeModel.GetById 12ms app.highlight 21ms RepoModel.GetById 1ms app.codeStats 0ms

/src/yolk-syndication.adb

http://github.com/ThomasLocke/yolk
Ada | 551 lines | 352 code | 87 blank | 112 comment | 18 complexity | 6791835e80893e9a87883e4d24f0cac6 MD5 | raw file
  1-------------------------------------------------------------------------------
  2--                                                                           --
  3--                   Copyright (C) 2010-, Thomas Løcke                   --
  4--                                                                           --
  5--  This library is free software;  you can redistribute it and/or modify    --
  6--  it under terms of the  GNU General Public License  as published by the   --
  7--  Free Software  Foundation;  either version 3,  or (at your  option) any  --
  8--  later version. This library is distributed in the hope that it will be   --
  9--  useful, but WITHOUT ANY WARRANTY;  without even the implied warranty of  --
 10--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
 11--                                                                           --
 12--  As a special exception under Section 7 of GPL version 3, you are         --
 13--  granted additional permissions described in the GCC Runtime Library      --
 14--  Exception, version 3.1, as published by the Free Software Foundation.    --
 15--                                                                           --
 16--  You should have received a copy of the GNU General Public License and    --
 17--  a copy of the GCC Runtime Library Exception along with this program;     --
 18--  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
 19--  <http://www.gnu.org/licenses/>.                                          --
 20--                                                                           --
 21-------------------------------------------------------------------------------
 22
 23with Ada.Streams;
 24with DOM.Core.Nodes;
 25with Yolk.Syndication.DOM_Builder;
 26
 27package body Yolk.Syndication is
 28
 29   -------------------
 30   --  Equal_Entry  --
 31   -------------------
 32
 33   function Equal_Entry
 34     (Left, Right : in Atom_Entry)
 35      return Boolean
 36   is
 37   begin
 38      return Left.Id.URI = Right.Id.URI;
 39   end Equal_Entry;
 40
 41   ----------------------
 42   --  New_Atom_Entry  --
 43   ----------------------
 44
 45   function New_Atom_Entry
 46     (Base_URI : in String := None;
 47      Language : in String := None)
 48      return Atom_Entry
 49   is
 50   begin
 51      return An_Entry : Atom_Entry := Null_Atom_Entry do
 52         if Base_URI /= None then
 53            An_Entry.Common.Base_URI := U (Base_URI);
 54         end if;
 55
 56         if Language /= None then
 57            An_Entry.Common.Language := U (Language);
 58         end if;
 59      end return;
 60   end New_Atom_Entry;
 61
 62   -----------------------------
 63   --  New_Atom_Entry_Source  --
 64   -----------------------------
 65
 66   function New_Atom_Entry_Source
 67     (Base_URI : in String := None;
 68      Language : in String := None)
 69      return Atom_Entry_Source
 70   is
 71   begin
 72      return Source : Atom_Entry_Source := Null_Atom_Entry_Source do
 73         if Base_URI /= None then
 74            Source.Common.Base_URI := U (Base_URI);
 75         end if;
 76
 77         if Language /= None then
 78            Source.Common.Language := U (Language);
 79         end if;
 80         null;
 81      end return;
 82   end New_Atom_Entry_Source;
 83
 84   ---------------------
 85   --  New_Atom_Feed  --
 86   ---------------------
 87
 88   function New_Atom_Feed
 89     (Base_URI    : in String := None;
 90      Language    : in String := None;
 91      Max_Age     : in Duration := 5_616_000.0;
 92      Max_Entries : in Positive := 100;
 93      Min_Entries : in Positive := 10)
 94      return Atom_Feed
 95   is
 96      Common : constant Atom_Common := (Base_URI => U (Base_URI),
 97                                        Language => U (Language));
 98   begin
 99      return Feed : Atom_Feed do
100         Feed.PAF.Set_Common (Value => Common);
101         Feed.PAF.Set_Max_age (Value => Max_Age);
102         Feed.PAF.Set_Max_Entries (Value => Max_Entries);
103         Feed.PAF.Set_Min_Entries (Value => Min_Entries);
104      end return;
105   end New_Atom_Feed;
106
107   ---------------------------
108   --  Protected_Atom_Feed  --
109   ---------------------------
110
111   protected body Protected_Atom_Feed is
112      ------------------
113      --  Add_Author  --
114      ------------------
115
116      procedure Add_Author
117        (Value : in Atom_Person)
118      is
119      begin
120         Authors.Append (Value);
121      end Add_Author;
122
123      --------------------
124      --  Add_Category  --
125      --------------------
126
127      procedure Add_Category
128        (Value : in Atom_Category)
129      is
130      begin
131         Categories.Append (Value);
132      end Add_Category;
133
134      -----------------------
135      --  Add_Contributor  --
136      -----------------------
137
138      procedure Add_Contributor
139        (Value : in Atom_Person)
140      is
141      begin
142         Contributors.Append (Value);
143      end Add_Contributor;
144
145      -----------------
146      --  Add_Entry  --
147      -----------------
148
149      procedure Add_Entry
150        (Value : in Yolk.Syndication.Atom_Entry)
151      is
152         use Ada.Calendar;
153         use Entry_List;
154
155         procedure Insert_Entry
156           (Value : in     Atom_Entry;
157            Done  :    out Boolean);
158         --  Insert the Value into List sorted by Atom_Entry.Updated
159
160         --------------------
161         --  Insert_Entry  --
162         --------------------
163
164         procedure Insert_Entry
165           (Value : in     Atom_Entry;
166            Done  :    out Boolean)
167         is
168            Appendable  : Boolean := False;
169            C           : Cursor;
170         begin
171            if Entries.Is_Empty then
172               Appendable := True;
173            else
174               if Value.Updated.Time_Stamp <=
175                 Entries.Last_Element.Updated.Time_Stamp
176               then
177                  Appendable := True;
178               end if;
179            end if;
180
181            if Appendable then
182               Entries.Append (New_Item => Value);
183               Done := True;
184            elsif Value.Updated.Time_Stamp >=
185              Entries.First_Element.Updated.Time_Stamp
186            then
187               Entries.Prepend (New_Item => Value);
188               Done := True;
189            else
190               C := Entries.First;
191               while Has_Element (C) loop
192                  if Value.Updated.Time_Stamp >=
193                    Element (C).Updated.Time_Stamp
194                  then
195                     Entries.Insert (Before   => C,
196                                     New_Item => Value);
197                     Done := True;
198                     exit;
199                  end if;
200
201                  Next (C);
202               end loop;
203            end if;
204         end Insert_Entry;
205
206         C           : Cursor;
207         Counter     : Natural       := Natural (Entries.Length);
208         Entry_Added : Boolean       := False;
209         Now         : constant Time := Clock;
210      begin
211         C := Find (Container => Entries,
212                    Item      => Value);
213         if  C /= No_Element then
214            Entries.Delete (Position => C);
215         end if;
216
217         if Entries.Length >= Count_Type (Max_Entries) then
218            Entries.Delete_Last
219              (Count => Entries.Length - (Count_Type (Max_Entries - 1)));
220         end if;
221
222         C := Entries.Last;
223         loop
224            exit when Counter <= Min_Entries;
225
226            if Now - Element (C).Updated.Time_Stamp > Max_Entry_Age then
227               Entries.Delete (Position => C);
228               C := Entries.Last;
229            else
230               Previous (C);
231            end if;
232
233            Counter := Counter - 1;
234         end loop;
235
236         if Entries.Length < Count_Type (Max_Entries)
237           or Clock - Value.Updated.Time_Stamp <= Max_Entry_Age
238         then
239            Insert_Entry (Value => Value,
240                          Done  => Entry_Added);
241         end if;
242
243         if Entry_Added
244           and then Value.Updated.Time_Stamp < Updated.Time_Stamp
245         then
246            Updated.Time_Stamp := Value.Updated.Time_Stamp;
247         end if;
248      end Add_Entry;
249
250      ----------------
251      --  Add_Link  --
252      ----------------
253
254      procedure Add_Link
255        (Value : in Atom_Link)
256      is
257      begin
258         Links.Append (Value);
259      end Add_Link;
260
261      -------------------------
262      --  Amount_Of_Entries  --
263      -------------------------
264
265      function Amount_Of_Entries return Natural
266      is
267      begin
268         return Natural (Entries.Length);
269      end Amount_Of_Entries;
270
271      ------------------------
272      --  Clear_Entry_List  --
273      ------------------------
274
275      procedure Clear_Entry_List
276      is
277      begin
278         Entries.Clear;
279      end Clear_Entry_List;
280
281      --------------------
282      --  Delete_Entry  --
283      --------------------
284
285      procedure Delete_Entry
286        (Id : in String)
287      is
288         use Entry_List;
289
290         C : Cursor;
291      begin
292         C := Entries.First;
293         while Has_Element (C) loop
294            if Element (C).Id.URI = U (Id) then
295               Entries.Delete (C);
296            end if;
297
298            Next (C);
299         end loop;
300      end Delete_Entry;
301
302      ---------------
303      --  Get_DOM  --
304      ---------------
305
306      function Get_DOM return DOM.Core.Document
307      is
308         use DOM.Core;
309         use Yolk.Syndication.DOM_Builder;
310
311         Doc       : Document;
312         Impl      : DOM_Implementation;
313      begin
314         Doc := Create_Document (Implementation => Impl);
315
316         Create_Feed_Element (Authors      => Authors,
317                              Categories   => Categories,
318                              Common       => Common,
319                              Contributors => Contributors,
320                              Doc          => Doc,
321                              Entries      => Entries,
322                              Generator    => Generator,
323                              Icon         => Icon,
324                              Id           => Id,
325                              Links        => Links,
326                              Logo         => Logo,
327                              Rights       => Rights,
328                              Subtitle     => Subtitle,
329                              Title        => Title,
330                              Updated      => Updated);
331
332         return Doc;
333      end Get_DOM;
334
335      ------------------
336      --  Get_String  --
337      ------------------
338
339      function Get_String
340        (Pretty_Print : in Boolean := False)
341         return String
342      is
343         use Ada.Streams;
344         use DOM.Core.Nodes;
345
346         type String_Stream_Type is new Root_Stream_Type with record
347            Str        : Unbounded_String;
348            Read_Index : Natural := 1;
349         end record;
350
351         procedure Read
352           (Stream : in out String_Stream_Type;
353            Item   :    out Stream_Element_Array;
354            Last   :    out Stream_Element_Offset);
355
356         procedure Write
357           (Stream : in out String_Stream_Type;
358            Item   : Stream_Element_Array);
359
360         ----------
361         -- Read --
362         ----------
363
364         procedure Read
365           (Stream : in out String_Stream_Type;
366            Item   :    out Stream_Element_Array;
367            Last   :    out Stream_Element_Offset)
368         is
369            Str : constant String := Slice
370              (Stream.Str,
371               Stream.Read_Index,
372               Stream.Read_Index + Item'Length - 1);
373            J   : Stream_Element_Offset := Item'First;
374         begin
375            for S in Str'Range loop
376               Item (J) := Stream_Element (Character'Pos (Str (S)));
377               J := J + 1;
378            end loop;
379
380            Last := Item'First + Str'Length - 1;
381            Stream.Read_Index := Stream.Read_Index + Item'Length;
382         end Read;
383
384         -----------
385         -- Write --
386         -----------
387
388         procedure Write
389           (Stream : in out String_Stream_Type;
390            Item   : Stream_Element_Array)
391         is
392            Str : String (1 .. Integer (Item'Length));
393            S   : Integer := Str'First;
394         begin
395            for J in Item'Range loop
396               Str (S) := Character'Val (Item (J));
397               S := S + 1;
398            end loop;
399
400            Append (Stream.Str, Str);
401         end Write;
402
403         Output   : aliased String_Stream_Type;
404         Doc      : DOM.Core.Document := Get_DOM;
405      begin
406         DOM.Core.Nodes.Write (Stream                 => Output'Access,
407                               N                      => Doc,
408                               Print_Comments         => False,
409                               Print_XML_Declaration  => False,
410                               Pretty_Print           => Pretty_Print);
411
412         Free (Doc);
413
414         return PI & To_String (Output.Str);
415      end Get_String;
416
417      ------------------
418      --  Set_Common  --
419      ------------------
420
421      procedure Set_Common
422        (Value : in Atom_Common)
423      is
424      begin
425         Common := Value;
426      end Set_Common;
427
428      ---------------------
429      --  Set_Generator  --
430      ---------------------
431
432      procedure Set_Generator
433        (Value : in Atom_Generator)
434      is
435      begin
436         Generator := Value;
437      end Set_Generator;
438
439      ----------------
440      --  Set_Icon  --
441      ----------------
442
443      procedure Set_Icon
444        (Value : in Atom_Icon)
445      is
446      begin
447         Icon := Value;
448      end Set_Icon;
449
450      --------------
451      --  Set_Id  --
452      --------------
453
454      procedure Set_Id
455        (Value : in Atom_Id)
456      is
457      begin
458         Id := Value;
459      end Set_Id;
460
461      ----------------
462      --  Set_Logo  --
463      ----------------
464
465      procedure Set_Logo
466        (Value : in Atom_Logo)
467      is
468      begin
469         Logo := Value;
470      end Set_Logo;
471
472      -------------------
473      --  Set_Max_Age  --
474      -------------------
475
476      procedure Set_Max_Age
477        (Value : in Duration)
478      is
479      begin
480         Max_Entry_Age := Value;
481      end Set_Max_Age;
482
483      -----------------------
484      --  Set_Max_Entries  --
485      -----------------------
486
487      procedure Set_Max_Entries
488        (Value : in Positive)
489      is
490      begin
491         Max_Entries := Value;
492      end Set_Max_Entries;
493
494      -----------------------
495      --  Set_Min_Entries  --
496      -----------------------
497
498      procedure Set_Min_Entries
499        (Value : in Positive)
500      is
501      begin
502         Min_Entries := Value;
503      end Set_Min_Entries;
504
505      ------------------
506      --  Set_Rights  --
507      ------------------
508
509      procedure Set_Rights
510        (Value : in Atom_Text)
511      is
512      begin
513         Rights := Value;
514      end Set_Rights;
515
516      --------------------
517      --  Set_Subtitle  --
518      --------------------
519
520      procedure Set_Subtitle
521        (Value : in Atom_Text)
522      is
523      begin
524         Subtitle := Value;
525      end Set_Subtitle;
526
527      -----------------
528      --  Set_Title  --
529      -----------------
530
531      procedure Set_Title
532        (Value : Atom_Text)
533      is
534      begin
535         Title := Value;
536      end Set_Title;
537
538      -------------------
539      --  Set_Updated  --
540      -------------------
541
542      procedure Set_Updated_Time
543        (Value : in Atom_Date)
544      is
545         use Ada.Calendar;
546      begin
547         Updated := Value;
548      end Set_Updated_Time;
549   end Protected_Atom_Feed;
550
551end Yolk.Syndication;