pipes
pipes.ads
pipes.adb
pipes
pipes
util
hash_tables/
heaps/
images/
lists/
maths/
messages/
pipes/
primes/
readers/
strings/
writers/
ada
bin/
engine/
fonts/
internal/
text/
util/
Home
Showcase
Snapshots
Ada Source
PHP Source
Fonts
Sourceforge
Summary
Downloads
Browse CVS
Donate
Activity

Hosted by
SourceForge.net Logo

 -- $Date: 2004/01/02 10:05:59 $
-- $Revision: 1.3 $
-- $Author: jcrocholl $

with Interfaces.C; use Interfaces.C;
with Interfaces.C_Streams;
use Interfaces;

with Ada.IO_Exceptions;
use Ada;

package body Pipes is

   function popen
     (Command : in Char_Array;
      Mode    : in Char_Array)
     return C_File;
   pragma Import(C, popen);

   function pclose
     (File : in C_File)
     return Integer;
   pragma Import(C, pclose);

   function fgetc
     (File : in C_File)
     return Integer;
   pragma Import(C, fgetc);

   function fputc
     (C    : in Integer;
      File : in C_File)
     return Integer;
   pragma Import(C, fputc);

   function Std_In return Pipe is
      Result : Pipe := new Pipe_Stream;
   begin
      Result.File := C_File(C_Streams.stdin);
      Result.Mode := Read_Only;
      return Result;
   end Std_In;

   function Std_Out return Pipe is
      Result : Pipe := new Pipe_Stream;
   begin
      Result.File := C_File(C_Streams.stdout);
      Result.Mode := Write_Only;
      return Result;
   end Std_Out;

   -- One-way pipe to external program.
   function Execute
     (Command : in String;    -- Name of the program to execute.
      Mode    : in Pipe_Mode) -- Input or output?
     return Pipe              -- The newly created pipe stream.
   is
      Result : Pipe := new Pipe_Stream;
   begin
      case Mode is
      when Read_Only =>
         Result.File := popen(To_C(Command), To_C("r"));
      when Write_Only =>
         Result.File := popen(To_C(Command), To_C("w"));
      end case;
      Result.Mode := Mode;
      return Result;
   end Execute;

   -- Close a pipe.
   procedure Close
     (Stream : in out Pipe) -- Close this pipe.
   is
      Result : Integer;
   begin
      Result := pclose(Stream.File);
   end Close;

   -- Read from a pipe.
   -- You can use Sometype'Read(Pipe, Value).
   procedure Read
     (Stream : in out Pipe_Stream;        -- Read from this stream.
      Item   : out Stream_Element_Array;  -- Read into this array.
      Last   : out Stream_Element_Offset) -- Last read element's index.
   is
      use type Stream_Element;
   begin
      if Stream.Mode = Write_Only then
         raise IO_Exceptions.Mode_Error;
      end if;
      for Index in Item'Range loop
         Item(Index) := Stream_Element(fgetc(Stream.File));
         Last := Index;
      end loop;
   end Read;

   -- Write to a pipe.
   -- You can use Sometype'Write(Pipe, Value).
   procedure Write
     (Stream : in out Pipe_Stream;         -- Write to this stream.
      Item   : in Stream_Element_Array) is -- Write this array.
      Result : Integer;
   begin
      if Stream.Mode = Read_Only then
         raise IO_Exceptions.Mode_Error;
      end if;
      for Index in Item'range loop
         Result := fputc(Integer(Item(Index)), Stream.File);
      end loop;
   end Write;

end Pipes;