ADDED src/natools-s_expressions-file_readers.adb Index: src/natools-s_expressions-file_readers.adb ================================================================== --- src/natools-s_expressions-file_readers.adb +++ src/natools-s_expressions-file_readers.adb @@ -0,0 +1,189 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +package body Natools.S_Expressions.File_Readers is + + package Stream_IO renames Ada.Streams.Stream_IO; + + + overriding procedure Finalize (Object : in out Autoclose) is + begin + if Stream_IO.Is_Open (Object.File) then + Stream_IO.Close (Object.File); + end if; + end Finalize; + + + ------------------------- + -- S-Expression Reader -- + ------------------------- + + function Reader (Name : String) return S_Reader is + begin + return Object : S_Reader do + Stream_IO.Open (Object.Holder.File, Stream_IO.In_File, Name); + Object.Next; + end return; + end Reader; + + + procedure Set_Filename (Object : in out S_Reader; Name : in String) is + begin + if Stream_IO.Is_Open (Object.Holder.File) then + Stream_IO.Close (Object.Holder.File); + end if; + + Stream_IO.Open (Object.Holder.File, Stream_IO.In_File, Name); + Object.Rewind; + end Set_Filename; + + + procedure Rewind (Object : in out S_Reader) is + begin + Stream_IO.Set_Index (Object.Holder.File, 1); + Object.Next; + end Rewind; + + + overriding procedure Read_More + (Object : in out S_Reader; + Buffer : out Atom_Buffers.Atom_Buffer) + is + Data : Ada.Streams.Stream_Element_Array (0 .. 127); + Last : Ada.Streams.Stream_Element_Offset; + begin + Stream_IO.Read (Object.Holder.File, Data, Last); + + if Last in Data'Range then + Buffer.Append (Data (Data'First .. Last)); + end if; + end Read_More; + + + + ----------------- + -- Atom Reader -- + ----------------- + + function Reader (Name : String) return Atom_Reader is + begin + return Object : Atom_Reader do + Stream_IO.Open (Object.File, Stream_IO.In_File, Name); + end return; + end Reader; + + + procedure Set_Filename (Object : in out Atom_Reader; Name : in String) is + begin + if Stream_IO.Is_Open (Object.File) then + Stream_IO.Close (Object.File); + end if; + + Stream_IO.Open (Object.File, Stream_IO.In_File, Name); + end Set_Filename; + + + function Length (Object : Atom_Reader) return Count is + begin + return Count (Stream_IO.Size (Object.File)); + end Length; + + + function Read (Object : Atom_Reader) return Atom is + Result : Atom (1 .. Object.Length); + Last : Count; + begin + Stream_IO.Set_Index (Object.File, 1); + Stream_IO.Read (Object.File, Result, Last); + pragma Assert (Last = Result'Last); + return Result; + end Read; + + + procedure Read + (Object : in Atom_Reader; + Data : out Atom; + Length : out Count) is + begin + Stream_IO.Set_Index (Object.File, 1); + Stream_IO.Read (Object.File, Data, Length); + Length := Object.Length; + end Read; + + + procedure Read + (Object : in Atom_Reader; + Buffer : out Atom_Buffers.Atom_Buffer; + Block_Size : in Count := 1024) + is + Block : Atom (1 .. Block_Size); + Last : Count; + begin + Buffer.Soft_Reset; + Stream_IO.Set_Index (Object.File, 1); + loop + Stream_IO.Read (Object.File, Block, Last); + exit when Last not in Block'Range; + Buffer.Append (Block (Block'First .. Last)); + end loop; + end Read; + + + procedure Query + (Object : in Atom_Reader; + Process : not null access procedure (Data : in Atom)) + is + Buffer : Atom_Access := null; + Last : Count; + begin + Buffer := new Atom (1 .. Object.Length); + Stream_IO.Set_Index (Object.File, 1); + Stream_IO.Read (Object.File, Buffer.all, Last); + pragma Assert (Last = Buffer'Last); + Process (Buffer.all); + Unchecked_Deallocation (Buffer); + exception + when others => + Unchecked_Deallocation (Buffer); + raise; + end Query; + + + procedure Block_Query + (Object : in Atom_Reader; + Block_Size : in Count; + Process : not null access procedure (Block : in Atom)) + is + Block : Atom (1 .. Block_Size); + Last : Count; + begin + Stream_IO.Set_Index (Object.File, 1); + loop + Stream_IO.Read (Object.File, Block, Last); + exit when Last not in Block'Range; + Process.all (Block (Block'First .. Last)); + end loop; + end Block_Query; + + + overriding procedure Finalize (Object : in out Atom_Reader) is + begin + if Stream_IO.Is_Open (Object.File) then + Stream_IO.Close (Object.File); + end if; + end Finalize; + +end Natools.S_Expressions.File_Readers; ADDED src/natools-s_expressions-file_readers.ads Index: src/natools-s_expressions-file_readers.ads ================================================================== --- src/natools-s_expressions-file_readers.ads +++ src/natools-s_expressions-file_readers.ads @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.S_Expressions.File_Readers provides types that read into files -- +-- on disk (using Stream_IO) and expose their data as S-expressions or as -- +-- atoms. -- +------------------------------------------------------------------------------ + +with Natools.S_Expressions.Atom_Buffers; +with Natools.S_Expressions.Lockable; + +private with Ada.Finalization; +private with Ada.Streams.Stream_IO; +private with Natools.S_Expressions.Parsers; + +package Natools.S_Expressions.File_Readers is + + type S_Reader is limited new Lockable.Descriptor with private; + -- Make a disk file available as a S-expression + + function Reader (Name : String) return S_Reader; + -- Create a S_Reader associated with file Name + + procedure Set_Filename (Object : in out S_Reader; Name : in String); + -- Reset Object with the new file Name + + procedure Rewind (Object : in out S_Reader); + -- Return to the beginning of the file + + + type Atom_Reader is tagged limited private; + -- Make a disk file available as a single atom + + function Reader (Name : String) return Atom_Reader; + -- Create an Atom_Reader associated with file Name; + + procedure Set_Filename (Object : in out Atom_Reader; Name : in String); + -- Reset Object with the new file Name + + function Length (Object : Atom_Reader) return Count; + -- Return the file length + + function Read (Object : Atom_Reader) return Atom; + -- Read the whole file and return it as a single atom + + procedure Read + (Object : in Atom_Reader; + Data : out Atom; + Length : out Count); + -- Read the whole file and store it in Data, along with its Length. + -- If Data is too small, only the file prefix is read. + + procedure Read + (Object : in Atom_Reader; + Buffer : out Atom_Buffers.Atom_Buffer; + Block_Size : in Count := 1024); + -- Read the whole file into Buffer + + generic + type Atom_Access is access Atom; + with procedure Unchecked_Deallocation (X : in out Atom_Access); + procedure Query + (Object : in Atom_Reader; + Process : not null access procedure (Data : in Atom)); + -- Read the whole file into a memory zone allocated through Atom_Access, + -- and call Process on it. + + procedure Block_Query + (Object : in Atom_Reader; + Block_Size : in Count; + Process : not null access procedure (Block : in Atom)); + -- Read file block by block, and call Process on each of them + +private + + type Autoclose is new Ada.Finalization.Limited_Controlled with record + File : Ada.Streams.Stream_IO.File_Type; + end record; + + overriding procedure Finalize (Object : in out Autoclose); + -- Close the underlying file if it was opened. + -- Used because a compiler bug in GNAT prevents adding + -- Ada.Finalization.Limited_Controlled as an ancestor of Parser, + -- so close-on-finalization has to be provided through composition. + + type S_Reader is limited new Parsers.Parser with record + Holder : Autoclose; + end record; + + overriding procedure Read_More + (Object : in out S_Reader; + Buffer : out Atom_Buffers.Atom_Buffer); + + + type Atom_Reader is new Ada.Finalization.Limited_Controlled with record + File : Ada.Streams.Stream_IO.File_Type; + end record; + + overriding procedure Finalize (Object : in out Atom_Reader); + +end Natools.S_Expressions.File_Readers;