-- Source code for an article published at the Ada Home <http://www.adahome.com/>
--
--   A Thick Ada 95 Binding for Unix Child Processes and Pipes
--     by Jim Rogers
--   February 1998
--
-- See <http://www.adahome.com/articles/1998-02/co_childproc.html>


--------------------------------------------------------------------------------
-- This package defines a thick Ada binding to the UNIX popen and pclose
-- commands
--------------------------------------------------------------------------------

with Interfaces.C_Streams; use Interfaces.C_Streams;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package Ada_Home.Unix.Pipe_Commands is

   type stream is private;

   type IO_MODE is (read_file, write_file);

   function execute (Command : in string; IO_type : in IO_Mode)
     return stream;

   function read_next (FromFile : in stream)
     return unbounded_string;

   procedure write_next (ToFile : in stream; Message : in string);

   procedure close (OpenFile : in stream);

   Access_Error : exception; -- Raised when attempt is made to violate IO_MODE
   End_Of_File  : exception; -- Raised on detection of End_of_file during read

private

   type stream is record
      FileStream : Files;
      Mode       : IO_Mode;
   end record;

end Ada_Home.Unix.Pipe_Commands;




-- Source code for an article published at the Ada Home <http://www.adahome.com/>
--
--   A Thick Ada 95 Binding for Unix Child Processes and Pipes
--     by Jim Rogers
--   February 1998
--
-- See <http://www.adahome.com/articles/1998-02/co_childproc.html>


--------------------------------------------------------------------------------
-- Implementation of a thick Ada binding to the UNIX popen and pclose
-- commands
--------------------------------------------------------------------------------

with Interfaces.C; use Interfaces.C;
with Ada.Characters.Latin_1;

package body Ada_Home.Unix.Pipe_Commands is

   LF : constant Interfaces.C_Streams.int
      := Character'Pos (Ada.Characters.Latin_1.LF); -- Unix end of line

   function popen (Command : char_array; Mode : char_array)
     return Files;
   pragma import (C, popen);

   function pclose (FileStream : FILEs)
     return Interfaces.C_Streams.int;
   pragma import (C, pclose);


   function execute (Command : in string; IO_type : in IO_Mode)
     return stream is
      Result : stream;
   begin
      case IO_Type is
        when read_file  => Result.FileStream := popen(to_C(Command), to_C("r"));
        when write_file => Result.FileStream := popen(to_C(Command), to_C("w"));
      end case;
      Result.Mode := IO_Type;
      return Result;
   end execute;

   function read_next (FromFile : in stream)
     return unbounded_string is
      Result : Unbounded_String := Null_Unbounded_String;
      char_buf : Interfaces.C_Streams.int;
      temp : character;
   begin
      if Fromfile.Mode = write_file then
         raise Access_Error;
      end if;
      loop
         char_buf := fgetc (FromFile.FileStream);
         if char_buf = EOF then
            raise End_Of_File;
         end if;
         exit when char_buf = LF; -- end of line?
         temp := character'val (char_buf);
         Result := Result & temp;
      end loop;
      return Result;
   end read_next;

   procedure write_next (ToFile : in stream; Message : in string) is
      rc : Interfaces.C_Streams.int;
   begin
      if ToFile.Mode = read_file then
         raise Access_Error;
      end if;
      for I in Message'Range loop
         rc := fputc (character'pos(Message(I)), ToFile.FileStream);
      end loop;
      rc := fputc (LF, ToFile.FileStream); -- add end of line
   end write_next;

   procedure close (OpenFile : in stream) is
      rc : Interfaces.C_Streams.int;
   begin
      rc := pclose (OpenFile.FileStream);
   end close;

end Ada_Home.Unix.Pipe_Commands;




-- Source code for an article published at the Ada Home <http://www.adahome.com/>
--
--   A Thick Ada 95 Binding for Unix Child Processes and Pipes
--     by Jim Rogers
--   February 1998
--
-- See <http://www.adahome.com/articles/1998-02/co_childproc.html>


----------------------------------------------------------------------------
-- Test commands package
----------------------------------------------------------------------------

with Ada_Home.Unix.Pipe_Commands; use Ada_Home.Unix.Pipe_Commands;

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

procedure Pipe_Commands_Test is

   command : constant string := "ps -u";
   FileStream : stream;
   command2 : constant string := "cat ada_home-unix-pipe_commands.ads";
   command3 : constant string := "tee foo.test";
   command4 : constant string := "tee foo2.test";
   Message : constant string := "This is the string I am writing.";

   procedure print_buf(FileStream : in stream) is
      Buffer : unbounded_String;
   begin
      loop
         begin
           Buffer := read_next(FileStream);
           put_line(to_string(Buffer));
         exception
           when Ada_Home.Unix.Pipe_Commands.End_of_file => exit;
         end;
      end loop;
   end print_buf;

begin
   put_line("Status of user processes:");
   FileStream := execute(command, read_file);
   print_buf(FileStream);
   close(FileStream);

   new_line(2);
   put_line("Listing a file with command '" & command2 & "':");
   FileStream := execute(command2, read_file);
   print_buf(FileStream);
   close(FileStream);

   new_line(2);
   put("Today's date is: ");
   FileStream := execute("date", read_file);
   print_buf(FileStream);
   close(FileStream);

   new_line(2);
   put_line("Output through a pipe to the tee command:");
   put_line("(look in foo.test for the same string.)");
   FileStream := execute(command3, write_file);
   write_next(FileStream, Message);
   close(FileStream);

   new_line(2);
   put_line("Attempt illegal input from a pipe to the tee command:");
   FileStream := execute(command4, write_file);
   begin
      print_buf(FileStream);
   exception
      when Access_Error =>
         put_line ("Detected improper attempt to read from a pipe opened for write only.");
   end;
   close(FileStream);
end Pipe_Commands_Test;




package Ada_Home is
end Ada_Home;

package Ada_Home.Unix is
end Ada_Home.Unix;