-- This source is licensed under the Sunset License v1.0 with Ada.Characters.Latin_1, Ada.Strings.Fixed, Ada.Strings.Maps, Ada.Text_IO, Datatypes; use Ada.Text_IO; package body CSV is package Latin renames Ada.Characters.Latin_1; package Strfix renames Ada.Strings.Fixed; package Strmap renames Ada.Strings.Maps; procedure Put_Cell (File_Handle : in Ada.Text_IO.File_Type; Data : in String) is begin Put_Cell (File_Handle, +Data); end Put_Cell; procedure Put_Cell (File_Handle : in Ada.Text_IO.File_Type; Data : in Ada.Strings.Unbounded.Unbounded_String) is Processed : SU.Unbounded_String := Data; Position : Natural; begin -- Deal with any lurking linefeed characters loop Position := SU.Index (Processed, Strmap.To_Set (Latin.LF)); exit when Position = 0; SU.Replace_Element (Processed, Position, ' '); end loop; -- Escape any quizzical quotation characters Position := SU.Index (Processed, Strmap.To_Set (Quote_Char)); while Position /= 0 loop SU.Insert (Processed, Position, Strfix."*" (1, Escape_Char)); Position := Position + 2; -- skip over the \" we already know about exit when Position > SU.Length (Processed); Position := SU.Index (Processed, Strmap.To_Set (Quote_Char), Position); end loop; -- Surround any suspicious separator characters if SU.Index (Processed, Strmap.To_Set (Separator_Char)) /= 0 then SU.Insert (Processed, 1, Strfix."*" (1, Quote_Char)); SU.Append (Processed, Quote_Char); end if; Put (File_Handle, -Processed); end Put_Cell; procedure Put_Header (File_Handle : in Ada.Text_IO.File_Type; Titles : in Datatypes.Field_ID_Vector) is begin for Position in Datatypes.Field_Ordinal range Titles.First_Index .. Datatypes.Field_Ordinal'Pred (Titles.Last_Index) loop Put_Cell (File_Handle, SU.Unbounded_String (Titles.Element (Position))); Put (File_Handle, Separator_Char); end loop; Put_Cell (File_Handle, SU.Unbounded_String (Titles.Last_Element)); New_Line (File_Handle); end Put_Header; procedure Put_Row (File_Handle : in Ada.Text_IO.File_Type; Cells : in Datatypes.Field_Vector; Quantity : in Positive) is use type Datatypes.Field_Ordinal; Counter : Positive := 1; Position : Datatypes.Field_Ordinal := Cells.First_Index; begin while Counter < Quantity loop if Position <= Cells.Last_Index then Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position))); end if; Put (File_Handle, Separator_Char); Position := Datatypes.Field_Ordinal'Succ (Position); Counter := Counter + 1; end loop; if Position <= Cells.Last_Index then Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position))); end if; New_Line (File_Handle); end Put_Row; end CSV;