--|
--|Item: Ada PCTE Binding
--|$Revision: 0.2 $
--|$State: Prototype $
--|
--|The Version Description Document (VDD) included with this release provides
--|detailed information regarding the condition of the software.  The "User 
--|Feedback" section of the VDD describes how to obtain additional information.
--|
--|Distribution Statement "A", per DoD Directive 5230.24
--|Authorized for public release; distribution is unlimited.
--|
--|Copyright (c) 1992, Paramax Systems Corporation, Reston, Virginia 
--|Copyright is assigned to the U.S. Government, upon delivery thereto, 
--|in accordance with the DFAR Special Works Clause.
--|
--|Developed by:  Paramax Systems Corporation,
--|
--|This software, developed under the Software Technology for Adaptable,
--|Reliable Systems (STARS) program, is approved for release under 
--|Distribution "A" of the Scientific and Technical Information Program 
--|Classification Scheme (DoD Directive 5230.24) unless otherwise indicated.  
--|Sponsored by the U.S. Defense Advanced Research Projects Agency (DARPA) 
--|under contract F19628-88-D-0031, the STARS program is supported by the 
--|military services, SEI, and MITRE, with the U.S. Air Force as the executive 
--|contracting agent.
--|
--|Permission to use, copy, modify, and comment on this software and its
--|documentation for purposes stated under Distribution "A" and without fee
--|is hereby granted, provided that this notice appears in each whole or
--|partial copy.  This software retains Contractor indemnification to
--|the Government regarding copyrights pursuant to the above referenced
--|STARS contract.  The Government disclaims all responsibility against
--|liability, including costs and expenses for violation of proprietary
--|rights, or copyrights arising out of the creation or use of this
--|software.
--|
--|In addition, the Government, Paramax, and its subcontractors disclaim all 
--|warranties with regard to this software, including all implied warranties 
--|of merchantability and fitness, and in no event shall the Government, 
--|Paramax, or its subcontractor(s) be liable for any special, indirect or 
--|consequential damages or any damages whatsoever resulting from the loss of 
--|use, data, or profits, whether in action of contract, negligence or other 
--|tortious action, arising in connection with the use or performance of this 
--|software.
--|
--|$Log $
--|
--                         Version Information
--                         ^^^^^^^^^^^^^^^^^^^
--
-- PCTE - Ada Language Interface.
-- Version: 0.2.
-- Release Date: November 30, 1992.
-- Compiled under SUN OS 4.1.2 using SunAda 1.0
--
--
--                         General Information
--                         ^^^^^^^^^^^^^^^^^^^
--
-- This is an alpha release of the Paramax STARS Ada binding to Emeraude's
-- PCTE 1.5 using the ECMA PCTE Ada binding specifications.  The binding
-- is incomplete in this release.  See the Version Description Document
-- provided with this alpha release for information on which interfaces
-- have been implemented.  It is expected that future releases will
-- expand the number of interfaces implemented.  The interfaces defined
-- herein are subject to change.
--
-- For further information, contact the authors:
--
--
--                   Robert Smith
--                   Paramax Systems Corp.
--                   Valley Forge Labs
--                   70 E. Swedesford Road
--                   Paoli, PA. 19301
--                   smith@prc.unisys.com (current)
--                   smith@vfl.paramax.com (future)
--                   +1 215 648-2402
--
--                   Michael Horton
--                   Paramax Systems Corp.
--                   Valley Forge Labs
--                   70 E. Swedesford Road
--                   Paoli, PA. 19301
--                   horton@prc.unisys.com (current)
--                   horton@vfl.paramax.com (future)
--                   +1 215 648-2527
--
--
with Pcte;
with Pcte_Contents;
with Pcte_Object;
with Pcte_Error;
with Pcte_Discretionary;
with Pcte_Process;

with pcte_object_create; -- used to encapsulate Pcte's create (avoid SunAda bug)
with pcte_support;

with unchecked_deallocation;

-- generic

--    type data_type is private;

package body pcte_sequential_io is

   -- This version uses Emeraude PCTE 1.5 with the ECMA 162 Ada PCTE
   -- interface.  IO will be done to the contents of objects in a
   -- PCTE object base.


   -- type file_type is limited private;

   -- type file_mode is (in_file, out_file);

   type pcte_string_pointer is access Pcte.string;

   type file_type_rec is
      record
         object        : Pcte.reference.object;
         file_handle   : Pcte_contents.handle;   -- for IO operations
         origin_object : Pcte.reference.object;  -- for deletion
         link_name     : pcte_string_pointer;    -- for deletion
         mode          : file_mode;              -- track mode here; not Pcte
      end record;

   procedure free is new unchecked_deallocation (
       Pcte.string,
       pcte_string_pointer);

   procedure free is new unchecked_deallocation (
       file_type_rec,
       file_type);

   -- instantiate the generics to do reads and writes
   function pcte_read is new Pcte_contents.read (data_type);
   procedure pcte_write is new Pcte_contents.write (data_type);

   item_size : Pcte.natural := Pcte.natural (data_type'SIZE / 8);

   procedure create (
      file : in out file_type;
      mode : in     file_mode := out_file;
      name : in     string := "";
      form : in     string := "") is

      -- This must create an object and then open it.

      use Pcte_discretionary;
      use Pcte_error;

      status        : pcte_error.handle;
      position      : positive;
      is_slash      : boolean := false;
      pcte_mode     : Pcte_Discretionary.object.access_rights;
      new_object,
      origin_object : Pcte.reference.object;
      open_mode     : Pcte_Contents.opening_mode;
      file_handle   : Pcte_Contents.handle;
      link_name     : pcte_string_pointer;

   begin
      if file = null then
         file := new file_type_rec;
      end if;

      if name = "" then
         raise name_error;
      end if;

      pcte_error.set (status, true, false); -- record only

      -- now create the object
      case mode is
         when out_file =>
            pcte_mode (object.READ_CONTENTS) := object.GRANTED;
            pcte_mode (object.WRITE_CONTENTS) := object.GRANTED;
            open_mode := Pcte_Contents.WRITE_ONLY;

         when in_file  =>
            pcte_mode (object.READ_CONTENTS) := object.GRANTED;
            pcte_mode (object.WRITE_CONTENTS) := object.GRANTED;
            open_mode := Pcte_Contents.READ_ONLY;

      end case;

      pcte_support.split_filename (name, position, is_slash);
      if not is_slash then
         link_name := new Pcte.string'(name);
         Pcte.reference.set_absolute (
            origin_object,
            Pcte.reference.NOW,
            pcte_support.CURRENT_OBJECT,
            status);

         if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
            -- clean up after failure
            free (link_name);
            free (file);
            raise name_error;
         end if;

         pcte_object_create (
            origin_object,
            link_name.all,
            pcte_mode,
            new_object,
            status);

--         Pcte_Object.create (
--            PACT_FILE,
--            origin_object,
--            Pcte.link_reference (link_name.all),
--            pcte_mode,
--            new_object,
--            NO_REVERSE_KEY,
--            status);

         if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
            case  Pcte_Error.last_error (status) is
               when Pcte_Error.PATHNAME_DOES_NOT_DESIGNATE_AN_EXISTING_OBJECT=>
                  -- clean up after failure
                  free (link_name);
                  free (file);
                  raise name_error;

               when Pcte_Error.USAGE_MODE_ON_LINK_TYPE_WOULD_BE_VIOLATED |
                    Pcte_Error.OBJECT_TYPES_MISMATCH                     |
                    Pcte_Error.OBJECT_TYPE_IS_INVALID                    |
                    Pcte_Error.UPPER_BOUND_WOULD_BE_VIOLATED             =>
                  -- clean up after failure
                  free (link_name);
                  free (file);
                  raise use_error;

               when Pcte_Error.LINK_EXISTS =>
                  -- here we must delete and then create
                  -- if this fails just bail out and raise use_error
                  Pcte_Object.delete (
                     origin_object,
                     Pcte.link_reference (name),
                     status);

                  if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
                     -- clean up after failure
                     free (link_name);
                     free (file);
                     raise use_error;
                  end if;

                  pcte_object_create (
                     origin_object,
                     name,
                     pcte_mode,
                     new_object,
                     status);

--                  Pcte_Object.create (
--                     PACT_FILE,
--                     origin_object,
--                     Pcte.link_reference (name),
--                     pcte_mode,
--                     new_object,
--                     NO_REVERSE_KEY,
--                     status);
            
                  if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
                     -- clean up after failure
                     free (link_name);
                     free (file);
                     raise use_error;
                  end if;

               when others =>
                  -- clean up after failure
                  free (link_name);
                  free (file);
                  raise use_error;

            end case;

         end if;           
      else
         if name (name'FIRST) = pcte_support.COMMON_ROOT (1)    or
            name (name'FIRST) = pcte_support.HOME_OBJECT (1)    or
            name (name'FIRST) = pcte_support.CURRENT_OBJECT (1) then

            Pcte.reference.set_absolute (
               origin_object,
               Pcte.reference.NOW,
               pcte_support.head_of_string (name, position),
               status);
         else
            Pcte.reference.set_absolute (
               origin_object,
               Pcte.reference.NOW,
               pcte_support.CURRENT_OBJECT & "/"
               & pcte_support.head_of_string (name, position),
               status);
         end if;

         if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
            -- clean up after failure
            free (link_name);
            free (file);
            raise name_error;
         end if;

         link_name := new Pcte.string'(
                             pcte_support.tail_of_string (name, position));

         pcte_object_create (
            origin_object,
            link_name.all,
            pcte_mode,
            new_object,
            status);

--         Pcte_Object.create (
--            PACT_FILE,
--            origin_object,
--            Pcte.link_reference (link_name.all),
--            pcte_mode,
--            new_object,
--            NO_REVERSE_KEY,
--            status);

         if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
            case  Pcte_Error.last_error (status) is
               when Pcte_Error.PATHNAME_DOES_NOT_DESIGNATE_AN_EXISTING_OBJECT=>
                  -- clean up after failure
                  free (link_name);
                  free (file);
                  raise name_error;

               when Pcte_Error.USAGE_MODE_ON_LINK_TYPE_WOULD_BE_VIOLATED |
                    Pcte_Error.OBJECT_TYPES_MISMATCH                     |
                    Pcte_Error.OBJECT_TYPE_IS_INVALID                    |
                    Pcte_Error.UPPER_BOUND_WOULD_BE_VIOLATED             =>
                  -- clean up after failure
                  free (link_name);
                  free (file);
                  raise use_error;

               when Pcte_Error.LINK_EXISTS =>
                  -- here we must delete and then create
                  -- if this fails just bail out and raise use_error
                  Pcte_Object.delete (
                     origin_object,
                     Pcte.link_reference (link_name.all),
                     status);
                  if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
                     -- clean up after failure
                     free (link_name);
                     free (file);
                     raise use_error;
                  end if;

                  pcte_object_create (
                     origin_object,
                     link_name.all,
                     pcte_mode,
                     new_object,
                     status);

--                  Pcte_Object.create (
--                     PACT_FILE,
--                     origin_object,
--                     Pcte.link_reference (link_name.all),
--                     pcte_mode,
--                     new_object,
--                     NO_REVERSE_KEY,
--                     status);
            
                  if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
                     -- clean up after failure
                     free (link_name);
                     free (file);
                     raise use_error;
                  end if;

               when others =>
                  -- clean up after failure
                  free (link_name);
                  free (file);
                  raise use_error;

            end case;
         end if;           
      end if;

      -- now open the object with the specified mode
      Pcte_Contents.open (
         new_object,
         open_mode,
         pcte_support.BLOCKING,
         pcte_support.NO_INHERIT,
         file.file_handle,
         status);

      if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
         -- clean up after failure
         free (link_name);
         free (file);

         case Pcte_Error.last_error (status) is
            when Pcte_Error.OPENING_MODE_IS_INVALID |
                 Pcte_Error.LIMIT_WOULD_BE_EXCEEDED =>
               raise use_error;

            when others =>
               raise name_error;
         end case;
      end if;

      file.object := new_object;
      file.origin_object := origin_object;
      file.link_name := link_name;
      file.mode := mode;
   end create;


   procedure delete (
      file : in out file_type) is

      use Pcte_error;

      status : Pcte_error.handle;

   begin
      if file = null then
         raise use_error;
      end if;

      pcte_error.set (status, true, false); -- record only

      declare
         file_path : constant Pcte.string := Pcte.reference.get_path (
                                                file.object,
                                                status);
         position : positive;
         is_slash : boolean := false;
         origin   : Pcte.reference.object;

      begin
         -- we have a bad object
         if Pcte_error.last_error (status) /= Pcte_error.NO_ERROR then
            raise use_error;
         end if;

         pcte_support.split_filename (file_path, position, is_slash);
         if not is_slash then
            raise name_error;
         end if;

         Pcte.reference.set_absolute (
            origin,
            Pcte.reference.NOW,
            pcte_support.head_of_string (file_path, position),
            status);

         if Pcte_error.last_error (status) /= Pcte_error.NO_ERROR then
            raise name_error;
         end if;

         Pcte_object.delete (
            origin,
            Pcte.link_reference (
               pcte_support.tail_of_string (file_path, position)),
            status);

         if Pcte_error.last_error (status) /= Pcte_error.NO_ERROR then
            raise use_error;
         end if;

         -- ok, we've deleted it; now let's close it
         close (file);
      end;  -- declare block

   end delete;

   procedure open (
      file : in out file_type;
      mode : in     file_mode;
      name : in     string;
      form : in     string := "") is

      use Pcte_error;

      open_object : Pcte.reference.object;
      status      : Pcte_Error.handle;
      open_mode   : Pcte_Contents.opening_mode;

   begin
      if file = null then
         file := new file_type_rec;
      end if;

      if name = "" then
         raise name_error;
      end if;

      pcte_error.set (status, true, false); -- record only

      if name (name'FIRST) = pcte_support.COMMON_ROOT (1)    or
         name (name'FIRST) = pcte_support.HOME_OBJECT (1)    or
         name (name'FIRST) = pcte_support.CURRENT_OBJECT (1) then

         Pcte.reference.set_absolute (
            open_object,
            Pcte.reference.NOW,
            name,
            status);
      else
         Pcte.reference.set_absolute (
            open_object,
            Pcte.reference.NOW,
            pcte_support.CURRENT_OBJECT & "/" & name,
            status);
      end if;

      if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
         -- clean up after failure
         free (file);
         raise name_error;
      end if;

      case mode is
         when out_file =>
            open_mode := Pcte_Contents.WRITE_ONLY;

         when in_file  =>
            open_mode := Pcte_Contents.READ_ONLY;

      end case;

      -- now open the object with the specified mode
      Pcte_Contents.open (
         open_object,
         open_mode,
         pcte_support.BLOCKING,
         pcte_support.NO_INHERIT,
         file.file_handle,
         status);

      if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
         -- clean up after failure
         free (file);

         case Pcte_Error.last_error (status) is
            when Pcte_Error.OPENING_MODE_IS_INVALID |
                 Pcte_Error.LIMIT_WOULD_BE_EXCEEDED =>
               raise use_error;

            when others =>
               raise name_error;
         end case;
      end if;

      file.object := open_object;
      file.mode := mode;

   end open;

   procedure close (
      file : in out file_type) is

      use Pcte_error;

      status        : Pcte_Error.handle;

   begin
      if file = null then
         raise name_error;
      end if;

      pcte_error.set (status, true, false); -- record only

      Pcte_Contents.close (
         file.file_handle,
         status);

      if Pcte_Error.last_error (status) /= Pcte_Error.NO_ERROR then
         raise use_error;
      end if;

      -- This may not be appropriate, but don't think it is usable
      free (file.link_name);
      free (file);  

   end close;

   procedure read (
      file : in     file_type;
      item :    out data_type) is

      status        : Pcte_Error.handle;

   begin
      if file = null then
         raise status_error;
      end if;

      pcte_error.set (status, true, false); -- record only

      item := pcte_read (file.file_handle, item_size, status);

      case  Pcte_Error.last_error (status) is
         when Pcte_Error.NO_ERROR =>
            return;

         when Pcte_Error.CONTENTS_OPERATION_IS_INVALID =>
            raise mode_error;

         when Pcte_Error.DATA_ARE_NOT_AVAILABLE =>
            raise device_error;

         when Pcte_Error.CONTENTS_IS_NOT_OPEN =>
            raise status_error;

         when others =>
            raise data_error;

      end case;

   end read;

   procedure write (
      file : in file_type;
      item : in data_type) is

      nbytes : Pcte.natural;
      status : Pcte_Error.handle;

   begin
      if file = null then
         raise status_error;
      end if;

      pcte_error.set (status, true, false); -- record only

      pcte_write (file.file_handle, item_size, item, nbytes, status);

      case Pcte_Error.last_error (status) is
         when Pcte_Error.NO_ERROR =>
            return;

         when Pcte_Error.CONTENTS_IS_NOT_OPEN =>
            raise status_error;

         when Pcte_Error.LIMIT_WOULD_BE_EXCEEDED =>
            raise use_error;

         when Pcte_Error.OPERATION_IS_INTERRUPTED |
              Pcte_Error.DEVICE_SPACE_IS_FULL     |
              Pcte_Error.DEVICE_IS_UNKNOWN        =>
            raise device_error;

         when Pcte_Error.CONTENTS_OPERATION_IS_INVALID =>
            raise mode_error;

         when others =>
            raise use_error;

      end case;

   end write;

   function end_of_file (
      file : in file_type)
       return boolean is

      status : Pcte_error.handle;
      eof    : boolean;

   begin
      if file = null then
         raise status_error;
      end if;

      pcte_error.set (status, true, false); -- record only

      eof := Pcte_contents.end_of_contents (file.file_handle, status);

      case Pcte_error.last_error (status) is
         when Pcte_error.NO_ERROR =>
            return eof;

         when Pcte_error.CONTENTS_IS_NOT_OPEN =>
            raise status_error;

         when Pcte_error.POSITION_HANDLE_IS_INVALID =>
            raise use_error;

         when Pcte_error.CONTENTS_OPERATION_IS_INVALID =>
            raise use_error;

         when others =>
            raise use_error;

      end case;

   end end_of_file;

   function is_open (
      file : in file_type)
       return boolean is

   begin
      -- Either the file was never opened or the file was previously closed.
      -- In either case file should be a null pointer.
      if file = null then
         return false;
      else
         return true;
      end if;

   end is_open;

-- private

--    type file_type_rec;
--    type file_type is access file_type;

end pcte_sequential_io;