PageRenderTime 73ms CodeModel.GetById 9ms app.highlight 58ms RepoModel.GetById 1ms app.codeStats 0ms

/src/yolk-syndication-dom_builder.adb

http://github.com/ThomasLocke/yolk
Ada | 902 lines | 689 code | 125 blank | 88 comment | 32 complexity | db1317569458d766cba1cbd727cea09c 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.Calendar.Formatting;
 24with Ada.Strings.Fixed;
 25with DOM.Core.Documents;
 26with DOM.Core.Elements;
 27with DOM.Core.Nodes;
 28with DOM.Readers;
 29with Input_Sources.Strings;
 30with Sax.Readers;
 31with Unicode.CES.Utf8;
 32
 33package body Yolk.Syndication.DOM_Builder is
 34
 35   -----------------------
 36   --  Atom_Date_Image  --
 37   -----------------------
 38
 39   function Atom_Date_Image
 40     (Time_Stamp : in Ada.Calendar.Time)
 41      return String
 42   is
 43      use Ada.Calendar.Formatting;
 44
 45      Atom_Time : String (1 .. 20);
 46   begin
 47      Atom_Time (1 .. 19) := Image (Date                  => Time_Stamp,
 48                                    Include_Time_Fraction => False);
 49      Atom_Time (11) := 'T';
 50      Atom_Time (20) := 'Z';
 51
 52      return Atom_Time;
 53   end Atom_Date_Image;
 54
 55   -----------------
 56   --  Attribute  --
 57   -----------------
 58
 59   procedure Attribute
 60     (Elem  : in DOM.Core.Node;
 61      Name  : in String;
 62      Value : in String)
 63   is
 64      use DOM.Core.Elements;
 65   begin
 66      if Value /= "" then
 67         Set_Attribute (Elem  => Elem,
 68                        Name  => Name,
 69                        Value => Value);
 70      end if;
 71   end Attribute;
 72
 73   --------------------------------
 74   --  Create_Category_Elements  --
 75   --------------------------------
 76
 77   procedure Create_Category_Elements
 78     (Doc    : in DOM.Core.Document;
 79      List   : in Category_List.List;
 80      Parent : in DOM.Core.Node)
 81   is
 82      use DOM.Core;
 83      use DOM.Core.Documents;
 84      use DOM.Core.Elements;
 85      use DOM.Core.Nodes;
 86
 87      Category_Node : Node;
 88   begin
 89      for A_Category of List loop
 90         Category_Node := Append_Child
 91           (N         => Parent,
 92            New_Child => Create_Element (Doc      => Doc,
 93                                         Tag_Name => "category"));
 94
 95         Set_Attribute (Elem  => Category_Node,
 96                        Name  => "term",
 97                        Value => To_String (A_Category.Term));
 98
 99         Attribute (Elem  => Category_Node,
100                    Name  => "xml:base",
101                    Value => To_String (A_Category.Common.Base_URI));
102
103         Attribute (Elem  => Category_Node,
104                    Name  => "xml:lang",
105                    Value => To_String (A_Category.Common.Language));
106
107         Attribute (Elem  => Category_Node,
108                    Name  => "label",
109                    Value => To_String (A_Category.Label));
110
111         Attribute (Elem  => Category_Node,
112                    Name  => "scheme",
113                    Value => To_String (A_Category.Scheme));
114      end loop;
115   end Create_Category_Elements;
116
117   ------------------------------
118   --  Create_Content_Element  --
119   ------------------------------
120
121   procedure Create_Content_Element
122     (Doc           : in DOM.Core.Document;
123      Entry_Content : in Atom_Entry_Content;
124      Parent        : in DOM.Core.Node)
125   is
126      use DOM.Core;
127      use DOM.Core.Documents;
128      use DOM.Core.Nodes;
129
130      Content_Node : Node;
131   begin
132      case Entry_Content.Content_Kind is
133         when Text | Html | Xhtml =>
134            Create_Text_Construct
135              (Common    => Entry_Content.Common,
136               Data      => To_String (Entry_Content.Content),
137               Doc       => Doc,
138               Elem_Name => "content",
139               Parent    => Parent,
140               Text_Kind => Entry_Content.Content_Kind);
141         when others =>
142            Content_Node := Append_Child
143              (N         => Parent,
144               New_Child => Create_Element (Doc      => Doc,
145                                            Tag_Name => "content"));
146
147            Attribute (Elem  => Content_Node,
148                       Name  => "xml:base",
149                       Value => To_String (Entry_Content.Common.Base_URI));
150
151            Attribute (Elem  => Content_Node,
152                       Name  => "xml:lang",
153                       Value => To_String (Entry_Content.Common.Language));
154
155            Attribute (Elem  => Content_Node,
156                       Name  => "type",
157                       Value => To_String (Entry_Content.Mime_Type));
158
159            if Entry_Content.Source /= Null_Unbounded_String then
160               Attribute (Elem  => Content_Node,
161                          Name  => "src",
162                          Value => To_String (Entry_Content.Source));
163            else
164               Content_Node := Append_Child
165                 (N         => Content_Node,
166                  New_Child => Create_Text_Node
167                    (Doc  => Doc,
168                     Data => To_String (Entry_Content.Content)));
169            end if;
170      end case;
171   end Create_Content_Element;
172
173   -----------------------------
174   --  Create_Entry_Elements  --
175   -----------------------------
176
177   procedure Create_Entry_Elements
178     (Doc     : in DOM.Core.Document;
179      Entries : in Entry_List.List;
180      Parent  : in DOM.Core.Node)
181   is
182      use DOM.Core;
183      use DOM.Core.Documents;
184      use DOM.Core.Nodes;
185
186      Entry_Node : Node;
187   begin
188      for An_Entry of Entries loop
189         Entry_Node := Append_Child
190           (N         => Parent,
191            New_Child => Create_Element (Doc      => Doc,
192                                         Tag_Name => "entry"));
193
194         Attribute (Elem  => Entry_Node,
195                    Name  => "xml:base",
196                    Value => To_String (An_Entry.Common.Base_URI));
197
198         Attribute (Elem  => Entry_Node,
199                    Name  => "xml:lang",
200                    Value => To_String (An_Entry.Common.Language));
201
202         --  entry:author elements
203         Create_Person_Elements (Doc       => Doc,
204                                 Elem_Name => "author",
205                                 List      => An_Entry.Authors,
206                                 Parent    => Entry_Node);
207
208         --  entry:category elements
209         Create_Category_Elements (Doc    => Doc,
210                                   List   => An_Entry.Categories,
211                                   Parent => Entry_Node);
212
213         --  entry:content element
214         if An_Entry.Content.Content /= Null_Unbounded_String then
215            Create_Content_Element (Doc            => Doc,
216                                    Entry_Content  => An_Entry.Content,
217                                    Parent         => Entry_Node);
218         end if;
219
220         --  entry:contributor elements
221         Create_Person_Elements (Doc       => Doc,
222                                 Elem_Name => "contributor",
223                                 List      => An_Entry.Contributors,
224                                 Parent    => Entry_Node);
225
226         --  entry:id element
227         if An_Entry.Id.URI /= Null_Unbounded_String then
228            Create_Generic_Element (Common    => An_Entry.Id.Common,
229                                    Data      => To_String (An_Entry.Id.URI),
230                                    Doc       => Doc,
231                                    Elem_Name => "id",
232                                    Parent    => Entry_Node);
233         end if;
234
235         --  entry:link elements
236         Create_Link_Elements (Doc    => Doc,
237                               List   => An_Entry.Links,
238                               Parent => Entry_Node);
239
240         --  entry:published element
241         if An_Entry.Updated.Is_Set then
242            Create_Generic_Element
243              (Common    => An_Entry.Published.Common,
244               Data      => Atom_Date_Image
245                 (Time_Stamp => An_Entry.Published.Time_Stamp),
246               Doc       => Doc,
247               Elem_Name => "published",
248               Parent    => Entry_Node);
249         end if;
250
251         --  entry:rights
252         if An_Entry.Rights.Text_Content /= Null_Unbounded_String then
253            Create_Text_Construct
254              (Common    => An_Entry.Rights.Common,
255               Data      => To_String (An_Entry.Rights.Text_Content),
256               Doc       => Doc,
257               Elem_Name => "rights",
258               Parent    => Entry_Node,
259               Text_Kind => An_Entry.Rights.Text_Kind);
260         end if;
261
262         --  entry:source element
263         if An_Entry.Source /= Null_Atom_Entry_Source then
264            Create_Entry_Source_Element (Doc    => Doc,
265                                         Source => An_Entry.Source,
266                                         Parent => Entry_Node);
267         end if;
268
269         --  entry:summary element
270         if An_Entry.Summary.Text_Content /= Null_Unbounded_String then
271            Create_Text_Construct
272              (Common    => An_Entry.Summary.Common,
273               Data      => To_String (An_Entry.Summary.Text_Content),
274               Doc       => Doc,
275               Elem_Name => "summary",
276               Parent    => Entry_Node,
277               Text_Kind => An_Entry.Summary.Text_Kind);
278         end if;
279
280         --  entry:title element
281         if An_Entry.Title.Text_Content /= Null_Unbounded_String then
282            Create_Text_Construct
283              (Common    => An_Entry.Title.Common,
284               Data      => To_String (An_Entry.Title.Text_Content),
285               Doc       => Doc,
286               Elem_Name => "title",
287               Parent    => Entry_Node,
288               Text_Kind => An_Entry.Title.Text_Kind);
289         end if;
290
291         --  entry:updated element
292         if An_Entry.Updated.Is_Set then
293            Create_Generic_Element
294              (Common    => An_Entry.Common,
295               Data      => Atom_Date_Image
296                 (Time_Stamp => An_Entry.Updated.Time_Stamp),
297               Doc       => Doc,
298               Elem_Name => "updated",
299               Parent    => Entry_Node);
300         end if;
301      end loop;
302   end Create_Entry_Elements;
303
304   -----------------------------------
305   --  Create_Entry_Source_Element  --
306   -----------------------------------
307
308   procedure Create_Entry_Source_Element
309     (Doc    : in DOM.Core.Document;
310      Source : in Atom_Entry_Source;
311      Parent : in DOM.Core.Node)
312   is
313      use DOM.Core;
314      use DOM.Core.Documents;
315      use DOM.Core.Nodes;
316
317      Source_Node : Node;
318   begin
319      Source_Node := Append_Child
320        (N         => Parent,
321         New_Child => Create_Element (Doc      => Doc,
322                                      Tag_Name => "source"));
323
324      Attribute (Elem  => Source_Node,
325                 Name  => "xml:base",
326                 Value => To_String (Source.Common.Base_URI));
327
328      Attribute (Elem  => Source_Node,
329                 Name  => "xml:lang",
330                 Value => To_String (Source.Common.Language));
331
332      Create_Person_Elements (Doc       => Doc,
333                              Elem_Name => "author",
334                              List      => Source.Authors,
335                              Parent    => Source_Node);
336
337      Create_Category_Elements (Doc    => Doc,
338                                List   => Source.Categories,
339                                Parent => Source_Node);
340
341      Create_Person_Elements (Doc       => Doc,
342                              Elem_Name => "contributor",
343                              List      => Source.Contributors,
344                              Parent    => Source_Node);
345
346      Create_Generator_Element (A_Generator => Source.Generator,
347                                Doc         => Doc,
348                                Parent      => Source_Node);
349
350      if Source.Icon.URI /= Null_Unbounded_String then
351         Create_Generic_Element (Common    => Source.Icon.Common,
352                                 Data      => To_String (Source.Icon.URI),
353                                 Doc       => Doc,
354                                 Elem_Name => "icon",
355                                 Parent    => Source_Node);
356      end if;
357
358      if Source.Id.URI /= Null_Unbounded_String then
359         Create_Generic_Element (Common    => Source.Id.Common,
360                                 Data      => To_String (Source.Id.URI),
361                                 Doc       => Doc,
362                                 Elem_Name => "id",
363                                 Parent    => Source_Node);
364      end if;
365      Create_Link_Elements (Doc    => Doc,
366                            List   => Source.Links,
367                            Parent => Source_Node);
368
369      if Source.Logo.URI /= Null_Unbounded_String then
370         Create_Generic_Element (Common    => Source.Logo.Common,
371                                 Data      => To_String (Source.Logo.URI),
372                                 Doc       => Doc,
373                                 Elem_Name => "logo",
374                                 Parent    => Source_Node);
375      end if;
376
377      if Source.Rights.Text_Content /= Null_Unbounded_String then
378         Create_Text_Construct
379           (Common    => Source.Rights.Common,
380            Data      => To_String (Source.Rights.Text_Content),
381            Doc       => Doc,
382            Elem_Name => "rights",
383            Parent    => Source_Node,
384            Text_Kind => Source.Rights.Text_Kind);
385      end if;
386
387      if Source.Subtitle.Text_Content /= Null_Unbounded_String then
388         Create_Text_Construct
389           (Common    => Source.Subtitle.Common,
390            Data      => To_String (Source.Subtitle.Text_Content),
391            Doc       => Doc,
392            Elem_Name => "subtitle",
393            Parent    => Source_Node,
394            Text_Kind => Source.Subtitle.Text_Kind);
395      end if;
396
397      if Source.Title.Text_Content /= Null_Unbounded_String then
398         Create_Text_Construct
399           (Common    => Source.Title.Common,
400            Data      => To_String (Source.Title.Text_Content),
401            Doc       => Doc,
402            Elem_Name => "title",
403            Parent    => Source_Node,
404            Text_Kind => Source.Title.Text_Kind);
405      end if;
406
407      if Source.Updated.Is_Set then
408         Create_Generic_Element
409           (Common    => Source.Updated.Common,
410            Data      =>
411              Atom_Date_Image (Time_Stamp => Source.Updated.Time_Stamp),
412            Doc       => Doc,
413            Elem_Name => "updated",
414            Parent    => Source_Node);
415      end if;
416   end Create_Entry_Source_Element;
417
418   ---------------------------
419   --  Create_Feed_Element  --
420   ---------------------------
421
422   procedure Create_Feed_Element
423     (Authors      : in Person_List.List;
424      Categories   : in Category_List.List;
425      Common       : in Atom_Common;
426      Contributors : in Person_List.List;
427      Doc          : in DOM.Core.Document;
428      Entries      : in Entry_List.List;
429      Generator    : in Atom_Generator;
430      Icon         : in Atom_Icon;
431      Id           : in Atom_Id;
432      Links        : in Link_List.List;
433      Logo         : in Atom_Logo;
434      Rights       : in Atom_Text;
435      Subtitle     : in Atom_Text;
436      Title        : in Atom_Text;
437      Updated      : in Atom_Date)
438   is
439      use DOM.Core;
440      use DOM.Core.Documents;
441      use DOM.Core.Elements;
442      use DOM.Core.Nodes;
443
444      Feed_Node : Node;
445   begin
446      --  feed element
447      Feed_Node := Append_Child
448        (N         => Doc,
449         New_Child => Create_Element (Doc      => Doc,
450                                      Tag_Name => "feed"));
451
452      Set_Attribute (Elem  => Feed_Node,
453                     Name  => "xmlns",
454                     Value => XMLNS);
455
456      Attribute (Elem  => Feed_Node,
457                 Name  => "xml:base",
458                 Value => To_String (Common.Base_URI));
459
460      Attribute (Elem  => Feed_Node,
461                 Name  => "xml:lang",
462                 Value => To_String (Common.Language));
463
464      --  feed:author elements
465      Create_Person_Elements (Doc       => Doc,
466                              Elem_Name => "author",
467                              List      => Authors,
468                              Parent    => Feed_Node);
469
470      --  feed:category elements
471      Create_Category_Elements (Doc    => Doc,
472                                List   => Categories,
473                                Parent => Feed_Node);
474
475      --  feed:contributor elements
476      Create_Person_Elements (Doc       => Doc,
477                              Elem_Name => "contributor",
478                              List      => Contributors,
479                              Parent    => Feed_Node);
480
481      --  feed:generator element
482      Create_Generator_Element (A_Generator => Generator,
483                                Doc         => Doc,
484                                Parent      => Feed_Node);
485
486      --  feed:icon element
487      if Icon.URI /= Null_Unbounded_String then
488         Create_Generic_Element (Common    => Icon.Common,
489                                 Data      => To_String (Icon.URI),
490                                 Doc       => Doc,
491                                 Elem_Name => "icon",
492                                 Parent    => Feed_Node);
493      end if;
494
495      --  feed:id element
496      if Id.URI /= Null_Unbounded_String then
497         Create_Generic_Element (Common    => Id.Common,
498                                 Data      => To_String (Id.URI),
499                                 Doc       => Doc,
500                                 Elem_Name => "id",
501                                 Parent    => Feed_Node);
502      end if;
503
504      --  feed:link elements
505      Create_Link_Elements (Doc    => Doc,
506                            List   => Links,
507                            Parent => Feed_Node);
508
509      --  feed:logo
510      if Logo.URI /= Null_Unbounded_String then
511         Create_Generic_Element (Common    => Logo.Common,
512                                 Data      => To_String (Logo.URI),
513                                 Doc       => Doc,
514                                 Elem_Name => "logo",
515                                 Parent    => Feed_Node);
516      end if;
517
518      --  feed:rights
519      if Rights.Text_Content /= Null_Unbounded_String then
520         Create_Text_Construct (Common    => Rights.Common,
521                                Data      => To_String (Rights.Text_Content),
522                                Doc       => Doc,
523                                Elem_Name => "rights",
524                                Parent    => Feed_Node,
525                                Text_Kind => Rights.Text_Kind);
526      end if;
527
528      --  feed:subtitle
529      if Subtitle.Text_Content /= Null_Unbounded_String then
530         Create_Text_Construct (Common    => Subtitle.Common,
531                                Data      => To_String (Subtitle.Text_Content),
532                                Doc       => Doc,
533                                Elem_Name => "subtitle",
534                                Parent    => Feed_Node,
535                                Text_Kind => Subtitle.Text_Kind);
536      end if;
537
538      --  feed:title element
539      if Title.Text_Content /= Null_Unbounded_String  then
540         Create_Text_Construct (Common    => Title.Common,
541                                Data      => To_String (Title.Text_Content),
542                                Doc       => Doc,
543                                Elem_Name => "title",
544                                Parent    => Feed_Node,
545                                Text_Kind => Title.Text_Kind);
546      end if;
547
548      --  feed:updated element
549      if Updated.Is_Set then
550         Create_Generic_Element
551           (Common    => Updated.Common,
552            Data      => Atom_Date_Image (Time_Stamp => Updated.Time_Stamp),
553            Doc       => Doc,
554            Elem_Name => "updated",
555            Parent    => Feed_Node);
556      end if;
557
558      --  feed:entry elements
559      Create_Entry_Elements (Doc     => Doc,
560                             Entries => Entries,
561                             Parent  => Feed_Node);
562   end Create_Feed_Element;
563
564   --------------------------------
565   --  Create_Generator_Element  --
566   --------------------------------
567
568   procedure Create_Generator_Element
569     (A_Generator : in Atom_Generator;
570      Doc         : in DOM.Core.Document;
571      Parent      : in DOM.Core.Node)
572   is
573      use DOM.Core;
574      use DOM.Core.Documents;
575      use DOM.Core.Nodes;
576
577      Generator_Node : Node;
578   begin
579      if A_Generator.Agent /= Null_Unbounded_String then
580         Generator_Node := Append_Child
581           (N         => Parent,
582            New_Child => Create_Element (Doc      => Doc,
583                                         Tag_Name => "generator"));
584
585         Attribute (Elem  => Generator_Node,
586                    Name  => "xml:base",
587                    Value => To_String (A_Generator.Common.Base_URI));
588
589         Attribute (Elem  => Generator_Node,
590                    Name  => "xml:lang",
591                    Value => To_String (A_Generator.Common.Language));
592
593         Attribute (Elem  => Generator_Node,
594                    Name  => "uri",
595                    Value => To_String (A_Generator.URI));
596
597         Attribute (Elem  => Generator_Node,
598                    Name  => "version",
599                    Value => To_String (A_Generator.Version));
600
601         Generator_Node := Append_Child
602           (N         => Generator_Node,
603            New_Child => Create_Text_Node
604              (Doc  => Doc,
605               Data => To_String (A_Generator.Agent)));
606      end if;
607   end Create_Generator_Element;
608
609   ------------------------------
610   --  Create_Generic_Element  --
611   ------------------------------
612
613   procedure Create_Generic_Element
614     (Common    : in Atom_Common;
615      Data      : in String;
616      Doc       : in DOM.Core.Document;
617      Elem_Name : in String;
618      Parent    : in DOM.Core.Node)
619   is
620      use DOM.Core;
621      use DOM.Core.Documents;
622      use DOM.Core.Nodes;
623
624      Elem_Node : Node;
625   begin
626      Elem_Node := Append_Child
627        (N         => Parent,
628         New_Child => Create_Element (Doc      => Doc,
629                                      Tag_Name => Elem_Name));
630
631      Attribute (Elem  => Elem_Node,
632                 Name  => "xml:base",
633                 Value => To_String (Common.Base_URI));
634
635      Attribute (Elem  => Elem_Node,
636                 Name  => "xml:lang",
637                 Value => To_String (Common.Language));
638
639      Elem_Node := Append_Child
640        (N         => Elem_Node,
641         New_Child => Create_Text_Node (Doc  => Doc,
642                                        Data => Data));
643      pragma Unreferenced (Elem_Node);
644      --  We need this because XML/Ada have no Append_Child procedures,
645      --  which obviously is annoying as hell.
646   end Create_Generic_Element;
647
648   ----------------------------
649   --  Create_Link_Elements  --
650   ----------------------------
651
652   procedure Create_Link_Elements
653     (Doc    : in DOM.Core.Document;
654      List   : in Link_List.List;
655      Parent : in DOM.Core.Node)
656   is
657      use Ada.Strings;
658      use DOM.Core;
659      use DOM.Core.Documents;
660      use DOM.Core.Elements;
661      use DOM.Core.Nodes;
662
663      Link_Node : Node;
664   begin
665      for A_Link of List loop
666         Link_Node := Append_Child
667           (N         => Parent,
668            New_Child => Create_Element (Doc      => Doc,
669                                         Tag_Name => "link"));
670
671         Attribute (Elem  => Link_Node,
672                    Name  => "xml:base",
673                    Value => To_String (A_Link.Common.Base_URI));
674
675         Attribute (Elem  => Link_Node,
676                    Name  => "xml:lang",
677                    Value => To_String (A_Link.Common.Language));
678
679         case A_Link.Rel is
680         when Alternate =>
681            Set_Attribute (Elem  => Link_Node,
682                           Name  => "rel",
683                           Value => "alternate");
684         when Related =>
685            Set_Attribute (Elem  => Link_Node,
686                           Name  => "rel",
687                           Value => "related");
688         when Self =>
689            Set_Attribute (Elem  => Link_Node,
690                           Name  => "rel",
691                           Value => "self");
692         when Enclosure =>
693            Set_Attribute (Elem  => Link_Node,
694                           Name  => "rel",
695                           Value => "enclosure");
696         when Via =>
697            Set_Attribute (Elem  => Link_Node,
698                           Name  => "rel",
699                           Value => "via");
700         end case;
701
702         Set_Attribute (Elem  => Link_Node,
703                        Name  => "href",
704                        Value => To_String (A_Link.Href));
705
706         Attribute (Elem  => Link_Node,
707                    Name  => "hreflang",
708                    Value => To_String (A_Link.Hreflang));
709
710         if A_Link.Length > 0 then
711            Set_Attribute
712              (Elem  => Link_Node,
713               Name  => "length",
714               Value => Fixed.Trim
715                 (Source => Natural'Image (A_Link.Length),
716                  Side   => Left));
717         end if;
718
719         Attribute (Elem  => Link_Node,
720                    Name  => "type",
721                    Value => To_String (A_Link.Mime_Type));
722
723         Attribute (Elem  => Link_Node,
724                    Name  => "title",
725                    Value => To_String (A_Link.Title));
726      end loop;
727   end Create_Link_Elements;
728
729   -------------------------------
730   --  Create_Node_From_String  --
731   -------------------------------
732
733   function Create_Node_From_String
734     (XML_String : in String)
735      return DOM.Core.Node
736   is
737      use DOM.Core;
738      use DOM.Core.Nodes;
739      use DOM.Readers;
740      use Input_Sources.Strings;
741      use Sax.Readers;
742
743      Input  : String_Input;
744      Reader : Tree_Reader;
745   begin
746      return Fragment : Node do
747         Open (Str      => XML_String,
748               Encoding => Unicode.CES.Utf8.Utf8_Encoding,
749               Input    => Input);
750
751         Set_Feature (Parser => Reader,
752                      Name   => Validation_Feature,
753                      Value  => False);
754         Set_Feature (Parser => Reader,
755                      Name   => Namespace_Feature,
756                      Value  => False);
757
758         Parse (Parser => Reader,
759                Input  => Input);
760
761         Close (Input => Input);
762
763         Fragment := Get_Tree (Read => Reader);
764
765      exception
766         when others =>
767            raise Not_Valid_XML with XML_String;
768      end return;
769   end Create_Node_From_String;
770
771   ------------------------------
772   --  Create_Person_Elements  --
773   ------------------------------
774
775   procedure Create_Person_Elements
776     (Doc       : in DOM.Core.Document;
777      Elem_Name : in String;
778      List      : in Person_List.List;
779      Parent    : in DOM.Core.Node)
780   is
781      use DOM.Core;
782      use DOM.Core.Documents;
783      use DOM.Core.Nodes;
784
785      Elem_Node   : Node;
786      Person_Node : Node;
787   begin
788      for A_Person of List loop
789         Person_Node := Append_Child
790           (N         => Parent,
791            New_Child => Create_Element (Doc      => Doc,
792                                         Tag_Name => Elem_Name));
793
794         Attribute (Elem  => Person_Node,
795                    Name  => "xml:base",
796                    Value => To_String (A_Person.Common.Base_URI));
797
798         Attribute (Elem  => Person_Node,
799                    Name  => "xml:lang",
800                    Value => To_String (A_Person.Common.Language));
801
802         Elem_Node := Append_Child
803           (N         => Person_Node,
804            New_Child => Create_Element (Doc      => Doc,
805                                         Tag_Name => "name"));
806         Elem_Node := Append_Child
807           (N         => Elem_Node,
808            New_Child => Create_Text_Node (Doc  => Doc,
809                                           Data => To_String (A_Person.Name)));
810
811         if A_Person.Email /= Null_Unbounded_String then
812            Elem_Node := Append_Child
813              (N         => Person_Node,
814               New_Child => Create_Element (Doc      => Doc,
815                                            Tag_Name => "email"));
816            Elem_Node := Append_Child
817              (N         => Elem_Node,
818               New_Child => Create_Text_Node
819                 (Doc  => Doc,
820                  Data => To_String (A_Person.Email)));
821         end if;
822
823         if A_Person.URI /= Null_Unbounded_String then
824            Elem_Node := Append_Child
825              (N         => Person_Node,
826               New_Child => Create_Element (Doc      => Doc,
827                                            Tag_Name => "uri"));
828            Elem_Node := Append_Child
829              (N         => Elem_Node,
830               New_Child => Create_Text_Node
831                 (Doc  => Doc,
832                  Data => To_String (A_Person.URI)));
833         end if;
834      end loop;
835   end Create_Person_Elements;
836
837   -----------------------------
838   --  Create_Text_Construct  --
839   -----------------------------
840
841   procedure Create_Text_Construct
842     (Common    : in Atom_Common;
843      Data      : in String;
844      Doc       : in DOM.Core.Document;
845      Elem_Name : in String;
846      Parent    : in DOM.Core.Node;
847      Text_Kind : in Text_Kinds)
848   is
849      use DOM.Core;
850      use DOM.Core.Documents;
851      use DOM.Core.Elements;
852      use DOM.Core.Nodes;
853
854      Elem_Node : Node;
855   begin
856      Elem_Node := Append_Child
857        (N         => Parent,
858         New_Child => Create_Element (Doc      => Doc,
859                                      Tag_Name => Elem_Name));
860
861      Attribute (Elem  => Elem_Node,
862                 Name  => "xml:base",
863                 Value => To_String (Common.Base_URI));
864
865      Attribute (Elem  => Elem_Node,
866                 Name  => "xml:lang",
867                 Value => To_String (Common.Language));
868
869      case Text_Kind is
870      when Text =>
871         Set_Attribute (Elem  => Elem_Node,
872                        Name  => "type",
873                        Value => "text");
874         Elem_Node := Append_Child
875           (N         => Elem_Node,
876            New_Child => Create_Text_Node
877              (Doc  => Doc,
878               Data => Data));
879      when Html =>
880         Set_Attribute (Elem  => Elem_Node,
881                        Name  => "type",
882                        Value => "html");
883         Elem_Node := Append_Child
884           (N         => Elem_Node,
885            New_Child => Create_Text_Node
886              (Doc  => Doc,
887               Data => Data));
888      when Xhtml =>
889         Set_Attribute (Elem  => Elem_Node,
890                        Name  => "type",
891                        Value => "xhtml");
892
893         Elem_Node := Append_Child
894           (N         => Elem_Node,
895            New_Child => Create_Node_From_String
896              (XML_String =>
897               "<div " & DIVNS & ">" & Data & "</div>"));
898
899      end case;
900   end Create_Text_Construct;
901
902end Yolk.Syndication.DOM_Builder;