/src/yolk-syndication.adb
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;