Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/pdl/docmgr.src

Text File | 1988-05-03 | 566.7 KB | 19,189 lines

::::::::::::::
addp.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Declarations;

function Add_Property return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package STR is new SI.String_Argument(
                String_Type_Name => "string");

    Add_Property_Process : SI.Process_Handle;
    Library              : SP.String_Type;
    Keyword              : SP.String_Type;
    Value                : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Add_Property_Process,
    Name    => "Add_Property",
    Help    => "Add a Property Keyword/Value to the Item Library");

    LIB.Define_Argument(
    Proc => Add_Property_Process,
    Name => "library",
    Help => "Name of the item library");

    STR.Define_Argument(
    Proc    => Add_Property_Process,
    Name    => "keyword",
    Help    => "Property keyword");

    STR.Define_Argument(
    Proc    => Add_Property_Process,
    Name    => "value",
    Help    => "Property value");

    SP.Release;

    SI.Parse_Line(Add_Property_Process);

    Library := LIB.Get_Argument(
            Proc => Add_Property_Process,
            Name => "library");

    Keyword := STR.Get_Argument(
            Proc => Add_Property_Process,
            Name => "keyword");

    Value := STR.Get_Argument(
            Proc => Add_Property_Process,
            Name => "value");

    ILM.Add_Property(Library, Keyword, Value);
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Keyword =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) & """ invalid.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Value =>
        HL.Put_Error("Property value """ & SP.Value(SP.Upper(Value)) & """ invalid.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Keyword_Already_Exists =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) &
             """ already exists.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Add Property internal error.");
    return HL.Return_Code(HL.SEVERE);

end Add_Property;

::::::::::::::
addp.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;
with HIF_List_Utils;

function Add_Property_Interface(
    Library   : in String_Pkg.String_Type;
    Keyword   : in String_Pkg.String_Type;
    Value     : in String_Pkg.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;
    package HLU renames HIF_List_Utils;

    Node : HND.Node_Type;
    Trap : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    if not LU.Privileged(Privilege, Library) then
    raise No_Privilege;
    end if;
    LU.Open_Property_Node(Library, Keyword, Value, ADD, Node);
    HA.Set_Node_Attribute(Node   => Node,
              Attrib => SP.Value(Keyword),
              Value  => HLU.To_List(SP.Value(Value)));
    HNM.Close_Node_Handle(Node);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Property " & SP.Value(SP.Upper(Keyword)) &
        " with value " & SP.Value(SP.Upper(Value)) &
        " added to library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Keyword =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Keyword, Keyword);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Value =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Value, Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Keyword_Already_Exists =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Keyword_Already_Exists, Keyword);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Add_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Add_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Add_Property_Interface;
                                                                    pragma page;
::::::::::::::
addp.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Add_Property_Interface(        --| Add Property Keyword/Value
    Library   : in String_Pkg.String_Type;    --| Item library
    Keyword   : in String_Pkg.String_Type;    --| Property keyword
    Value     : in String_Pkg.String_Type;    --| Property value
    Privilege : in Privilege_Type := WORLD    --| Add privilege
    ) return Host_Lib.Severity_Code;

--| Requires:
--| The names of the library, and the keyword-value pair.

--| Effects:
--| Associates a keyword-value pair to the specified library.

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
adduser.ada
::::::::::::::
with String_Pkg;
with Host_Lib;
with File_Manager;
with HIF_System_Management;
with Standard_Interface;
with Tool_Identifier;

function Add_User return INTEGER is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package FM  renames File_Manager;
    package HSM renames HIF_System_Management;
    package SI  renames Standard_Interface;
    package SA  is new SI.String_Argument("string");

    Process   : SI.Process_Handle;
    Directory : SP.String_Type;

begin

    SI.Set_Tool_Identifier(Tool_Identifier);
    SI.Define_Process(
    "add_user",
    "Adds the named user to the set of documentation system users",
    Process);
    SA.Define_Argument(
    Process,
    "directory",
    "Name of the directory in which to store documentation information");
    SA.Define_Argument(
    Process,
    "user",
    HL.get_item(HL.user_name),
    "Name of the user to add");
    SI.Define_Help(
    Process,
    "This procedure can be used to add any user to the set of documentation");
    SI.Append_Help(
    Process,
    "system users.  If a person wants to be able to use the system they must");
    SI.Append_Help(
    Process,
    "be entered in the system with the same user name as they have on the");
    SI.Append_Help(
    Process,
    "host machine.  If this is not the case the person will not be recognized");
    SI.Append_Help(
    Process,
    "as a documentation system user.  Each user name must be unique");

    SI.Parse_Line(Process);

    Directory := SP.Create(FM.Path_Name(Directory => SP.Value(SA.Get_Argument(Process, "directory")),
                    File      => "",
                    Absolute  => TRUE));

    if FM.Is_Directory(SP.Value(Directory)) then
    HL.Put_Error("Directory already exists");
    return HL.Return_Code(HL.ERROR);
    end if;

    HSM.Add_User(User_Name      => SP.Value(SA.Get_Argument(Process, "user")),
         Partition_Name => SP.Value(Directory));

    return HL.Return_Code(HL.SUCCESS);

exception

    when FM.Device_Not_Ready =>
    HL.Put_Error("Device not ready");
    return HL.Return_Code(HL.ERROR);
    when FM.Directory_Not_Found =>
    HL.Put_Error("Directory not found");
    return HL.Return_Code(HL.ERROR);
    when FM.Privilege_Violation =>
    HL.Put_Error("Privilege violation");
    return HL.Return_Code(HL.ERROR);
    when FM.Parse_Error =>
    HL.Put_Error("Incorrect syntax for directory specification");
    return HL.Return_Code(HL.ERROR);
    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);
    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);
    when others =>
    HL.Put_Error("Fatal error in Add_User");
    return HL.Return_Code(HL.SEVERE);

end Add_User;
                                                                    pragma page;
::::::::::::::
canceli.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Declarations;

function Cancel_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILD renames Item_Library_Manager_Declarations;
    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(
                String_Type_Name => "item_name");

    Cancel_Item_Process : SI.Process_Handle;
    Library             : SP.String_Type;
    Item                : SP.String_Type;
    Checked_In_Version  : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Cancel_Item_Process,
    Name    => "Cancel_Item",
    Help    => "Cancel a Pending Return for an Item in the Item Library");

    LIB.Define_Argument(
    Proc => Cancel_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc => Cancel_Item_Process,
    Name => "item",
    Help => "Name of the item to cancel the pending return");

    SP.Release;

    SI.Parse_Line(Cancel_Item_Process);

    Library := LIB.Get_Argument(
            Proc => Cancel_Item_Process,
            Name => "library");

    Item := ITM.Get_Argument(
            Proc => Cancel_Item_Process,
            Name => "item");

    ILM.Check_In_Item(Library, Item, SP.Create(""), ILD.RETURN_ITEM, ILD.NO_UPDATE, Checked_In_Version);

    HL.Put_Message_Line("Item """ &
            SP.Value(SP.Upper(Item)) & '/' &
            SP.Value(Checked_In_Version) &
            """ canceled.");
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Not_Found =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Not_Checked_Out =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ not checked out.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Cancel Item internal error.");
    return HL.Return_Code(HL.SEVERE);

end Cancel_Item;

::::::::::::::
canceli.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;

function Cancel_Item_Interface(
    Library : in String_Pkg.String_Type;
    Item    : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;

    Returned : SP.String_Type;
    Trap     : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    LU.Check_In_Item(Library, Item, SP.Create(""), CANCEL_ITEM, Returned);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Item " & SP.Value(SP.Upper(Item)) & '/' & SP.Value(Returned) &
        " canceled in library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    LU.Unlock_Library(Library, WRITE_LOCK);
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Found, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Checked_Out =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Checked_Out, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Checked_Out =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Checked_Out, Item, Returned);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Cancel_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Cancel_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Cancel_Item_Interface;
                                                                    pragma page;
::::::::::::::
canceli.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function Cancel_Item_Interface(            --| Cancel a Pending Return
   Library : in String_Pkg.String_Type;        --| Item library
   Item    : in String_Pkg.String_Type        --| Item to cancel return
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library and the item name

--| Effects:
--| Checked out state for the given item in the library is canceled

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
catdecls.dat
::::::::::::::
with string_pkg;
with set_pkg;
with lists;
with ci_ids;

package catalog_decls is

--| Overview: Declarations of types and items which need to be global to
--| the whole catalog.  These items should be kept to a minimum.

package SP renames string_pkg;

type hist_record is
    record
    name    : SP.string_type;
    history : SP.string_type;
    creator : SP.string_type;
    date      : SP.string_type;
    submit  : SP.string_type;
    delete  : SP.string_type;
    end record;

package CI_sets is new set_pkg(ci_ids.ci_id_type, ci_ids.equal);
subtype CI_set is CI_sets.set;
package string_sets is new set_pkg(SP.string_type, SP.equal);
subtype string_set is string_sets.set;
package hist_lists is new lists(hist_record);
subtype hist_list is hist_lists.list;

end catalog_decls;
::::::::::::::
catmgr.bdy
::::::::::::::
with text_io;
with hif_node_defs;    use hif_node_defs;    -- use for current node
with hif_node_management;
with hif_attributes;
with hif_list_utils;    use hif_list_utils;    -- use for visible "="
with ci_ids;
with catalog_locks;
with ci_index_mgr;
with lists;
with string_utilities;
with host_lib;
with property_set;
with properties;
with version_lists;
with library_utilities;
with hif_utils;

package body catalog_manager is

---- Package Renames:
package ND  renames hif_node_defs;
package NM  renames hif_node_management;
package LU  renames hif_list_utils;
package Attr renames hif_attributes;
package ID  renames ci_ids;
package CL  renames catalog_locks;
package IM  renames ci_index_mgr;
package SU  renames string_utilities;
package HL  renames host_lib;
package VL  renames version_lists;
package UT  renames library_utilities;
package HU  renames hif_utils;

use string_pkg;            -- to use infix "&"
use library_declarations;    -- for visibility of fetch_type "="


---- Package instantiations:
package SS is new SU.generic_string_utilities(SP.string_type,
                          SP.create,
                          SP.value);

---- Types:
type pair is
    record
    key : SP.string_type;
    val : SP.string_type;
    end record;

package pair_lists is new lists(pair);
subtype p_list is pair_lists.list;

---- Items global to the package catalog_manager:
wait : duration := 0.0;        -- used for the locks
pairs : p_list := pair_lists.create;

---- Operations local to the package catalog_manager:

procedure check_properties (
    node : in ND.node_type;    -- node the properties are on
    stat : in out status_type    -- status of keywords
    );

procedure add_properties (
    name : in ID.ci_id_type    -- ci id of the ci to add the properties under
    );

function check_list (        --| check the checked out list to make sure
                --| this fetch can be done.
    ci_id : in ID.ci_id_type;    --| name of the ci being fetched
    mode  : in LD.fetch_type    --| type of fetch being done
    ) return boolean;

function check_list (        --| check the checked out list to make sure
                --| this store can be done.
    ci_id : in ID.ci_id_type;    --| name of the ci being stored
    mode  : in LD.fetch_type;    --| type of fetch done originally
    user  : in STRING        --| name of the user to check for
    ) return boolean;

procedure update_list (        --| Update the checked out list with this
                --| person's name and the type of update
    ci_id : in ID.ci_id_type;    --| name of the ci being fetched
    mode  : in LD.fetch_type    --| type of fetch being done
    );

procedure remove_name (        --| remove the user's name from the checked
                --| out list when a CI is stored
    ci_id : in ID.ci_id_type;    --| name of the ci being stored
    mode  : in LD.fetch_type;    --| type of fetch done originally
    user  : in STRING        --| name of the user to check for
    );

procedure find_versions (    --| recursively find all the versions of a
                --| ci starting at its root
    root : in ND.node_type;    --| node to start at
    name : in SP.string_type;    --| name of the root node
    list : in out SL.list    --| list returned
    );

function strip_v (        --| given a string of the form "v11", strip the
                --| 'v' just leaving the number.
    ver : in string        --| input version string
    ) return string;

---- Operations global to the package catalog_manager:

-- Operations on the catalog:
-- list_cis            list all the CI's in the cpcicat
-- verify_password         verify the password given is the correct one
-- set_password            set a new password

function list_cis (        --| list the contents of the catalog
    CIs : in SP.string_type      --| name to match
    := SP.create("*")
    ) return SL.list is
    node    : ND.node_type;
    ci_node : ND.node_type;
    iter    : NM.node_iterator;
    list    : SL.list;
    begin
    --? get a read lock on the root node
    NM.get_current_node (node);
    NM.iterate (iterator => iter,
            node     => node,
            key      => SP.value (cis),
            relation => "ci_root");
    while NM.more (iter) loop
        NM.get_next (iter, ci_node);
        SL.attach (list, SP.create (NM.primary_key (ci_node)));
        NM.close_node_handle (ci_node);
    end loop;
    NM.close_node_handle (node);
    --? unlock the read lock
    return list;
    end list_cis;

--| Effects: List the identifiers of CIs which match the pattern given.
--| The default is "*" which matches all identifiers in the catalog.
--| No versions are returned just identifiers.

function verify_password (    --| verify the privilege operations password
    p : in  SP.string_type    --| word to check
    ) return boolean is
    node : ND.node_type;
    pass_node : ND.node_type;
    begin
    --| Algorithm:  Open the password relation with the given password.
    --| If it is the correct password the relation exists and the open will
    --| be okay so close the node and return true.  If it is not the
    --| password the relation will not exist, so name error will be raised.
    --| in this case return false.
    --? get a read lock on the root
    NM.get_current_node (node);
    NM.open_node_handle (node => pass_node,
                 base => node,
                 key  => SP.value (p),
                 relation => "password");
    NM.close_node_handle (pass_node);
    NM.close_node_handle (node);
    --? remove read lock
    return true;
    exception when ND.name_error =>
    -- name error is raised when the path given for the node to be opened
    -- does not exist.
    return false;
    end verify_password;

--| Effects: Checks that the string given is the password for the catalog.
--| If it is the password true if returned, false otherwise.

procedure set_password (    --| set a new password
    next : in SP.string_type;    --| new password
    old  : in SP.string_type    --| old password for verification
    ) is
    node : ND.node_type;
    begin
    if CL.upgrade_lock (wait) then
    begin
        if verify_password (old) then
            NM.get_current_node (node);
        -- link first to make sure the new password gets in.
        -- it seems that it is less harmful to have an old
        -- password left around (due to aborting between the
        -- time one link is made and the other is severed) than
        -- to get left with out a password.  What would happen
        -- if the links were done the other way around.  I think
        -- it is reasonable to have check_consistency report if there
        -- is more than one password.  In which case a super user then
        -- just has to do a change_password from the old to the new
        -- again.
        begin
            NM.link (node, node, SP.value (next), "password");
        exception when name_error =>
            -- link was already there so there's no need for an error
            null;
        end;
        NM.unlink (node, SP.value (old), "password");
        NM.close_node_handle (node);
        else
            CL.remove_write;
        raise invalid_password;
        end if;
        CL.remove_write;
      exception
        when ND.status_error | ND.name_error | ND.use_error |
         ND.hif_internal_error | ND.IO_error | ND.lock_error  |
         ND.access_violation =>
        CL.remove_write;
        raise internal_hif_failure;
    end;
    else
        raise cant_lock;
    end if;
    end set_password;
    --| raises: invalid_password, cant_lock

--| Effects: Sets the password to be the new one if the word given as the
--| old one is the correct password in actuality.  Raises invalid password
--| if not.  If this is really invoked by the catalog interface invalid
--| password should never be raised.

-- Operations on a configuration item:
-- create_CI            create a new configuration item from a library
-- store            update a configuration item from an itemlib
-- cancel            cancel a fetch for update
-- fetch            fetch an itemlib from the catalog
-- delete (*)            delete a CI
-- modify_property        change the value associated with a property
-- describe            list all the keywords and values for a CI, and
--                 other information like history as asked for.
-- list_components        list the components of a CI
-- match_keys            match keywords on a CI

function create_CI (        --| create a new CI in the catalog
    name    : in SP.string_type;--| name of the new CI
    library : in SP.string_type;--| name of the library to find the CI in
    history : in SP.string_type --| description of the CI
    ) return status_type is
    --| Raises: name_in_use

--| Algorithm: The following is a basic outline of the procedure:
--|-
--| 1. Upgrade the user's lock to a write lock.
--| 2. lock the library ci is coming from.
--| 3. check the name to make sure it is not a duplicate.
--| 4. check the mode on the libray to make sure it is no_update. (this
--|     is because update implies that the catalog is waiting for this
--|    ci to be checked back in)
--| 5. Check that the properties on the library are both valid and include
--|    all the required keywords.
--| 6. purge the library.
--| 7. create the node that the ci will hang off of.
--| 8. copytree the library to that node.
--| 9. Add all the properties on the node to the index database.
--|10. Delete the library.
--|11. Unlock the catalog lock.
--|+
--| Between steps one and five no changes have been made to either library
--| or catalog so they are completely safe.  If any of the checks fail the
--| idea is to report it and continue in order to report as many errors as
--| possible.  After step five we begin changing the library and the catalog
--| but all of the changes should be recoverable.  Purging the library
--| should be ok since the user was trying to check it in anyway the old
--| versions weren't needed.  If at any time between step 7 and 10 the
--| process is aborted the library hasn't been deleted so the catalog can
--| be cleaned up by deleting the incomplete CI and then recreating it.
--| the properties are added to the index after the ci is copied since
--| check_consistency can tell when all the properties on a CI are not in
--| the database, but it can't do the opposite.

    status   : status_type := ok;
    ci_id    : ID.ci_id_type;
    ci_node  : ND.node_type;
    ci_root  : ND.node_type;
    lib_node : ND.node_type;
    last     : natural;
    time     : HL.time_value;
    attrib   : string(1..80);
    len      : natural;
    deleted  : boolean := false;
    remain   : LD.LL.list;
    priv     : LD.privilege_type := LD.WORLD;

    begin
    if CL.upgrade_lock (wait) then
    begin

        begin
            ci_id := ID.get_ci_id (name & " 1");  -- the version is always 1
        exception when ID.invalid_ci_id =>
            status := error;
            errors(non_ada) := true;
        end;

        begin
            -- try to open the node.  This should fail since the node
        -- shouldn't exist.  If it does check it for the attribute
        -- deleted.  If it is deleted then it is ok, otherwise
        -- report it as a duplicate name.  However, it can't be
        -- checked if the ci_id is invalid.
        if not errors(non_ada) then
                NM.open_node_handle (ci_node, ID.get_hif_path (ci_id));
            HU.get_node_attribute (ci_node, "deleted", attrib, len);
            if attrib(1..len) /= "" then
                deleted := true;
            else
                status := error;
                errors(dup_name) := true;    -- name already is used
            --  only close the node handle if it is a duplicate
            --  it will be used below if it was deleted.
                NM.close_node_handle (ci_node);
             end if;
        end if;
        exception when ND.name_error =>
        null;
        end;

        if not
          (LD.fetch_type'value(UT.get_library_attribute(library,"MODE"))
            = LD.no_update) then
            status := error;
            errors(create_mode) := true;
        end if;

        if UT.is_item_checked_out (library) then
        status := error;
        errors(ready) := true;
        end if;

        -- we are starting to look at things the user could change so
        -- lock the library
        if UT.lock_library (library, LD.write_lock) then
        NM.open_node_handle (lib_node,
            SP.value (UT.node_name (library, SP.create("*"))));
        check_properties (lib_node, status);
        -- only continue with the creation if there are no errors

            -- purge the library and rename all items to be version 1
        UT.purge (library, privilege=>priv, remainder=>remain);
        if not LD.LL.isempty (remain) then
            status := error;
            errors(purge) := true;
        else
            -- remain is empty if we get here so re-use it.  Rename
            -- version should not fail if you were able to purge.
            begin
                UT.rename_version (library,
                              SP.create("*"),
                              SP.create("0"),
                              SP.create("1"),
                           privilege=>priv,
                           remainder=>remain);
            exception when LD.item_not_found =>
            -- means it was an empty library
            null;
            end;
        end if;

        if status = ok then

         -- if the node is not one of a deleted one then the hif
        -- nodes have to be created.  In the case where this was
        -- a ci that was deleted the nodes already exist because
        -- that's where the deleted attribute is! So just remove
        -- the attribute so that it reflects the new status of the
        -- node.

            if not deleted then
            begin
                  NM.create_node (node => ci_root,
                        name => "'current_node'ci_root(" &
                             SP.value (name) & ")",
                        form => "");
                  NM.create_node (node => ci_node,
                        name => ID.get_hif_path (ci_id),
                        form => "");
              NM.close_node_handle (ci_root);
            exception when ND.name_error=>
              NM.create_node (node => ci_node,
                        name => ID.get_hif_path (ci_id),
                        form => "");
              NM.close_node_handle (ci_root);
            end;
            else
        --      the ci_node already exists.  It has to because
        --    that's where we read the deleted attribute.
        --    I would have put the create nodes in with the
        --     requirement "no_effect_if_exists", but there
        --     seems to be some problem with that call.
        --    Since it is going to be recreated delete the
        --    "deleted" attribute.

            Attr.set_node_attribute(ci_node, "deleted", "");

            end if;

            NM.copy_tree (lib_node,
                  ci_node,
                  "ci");
            Attr.set_node_attribute (ci_node,
                         "branches",
                         "0");
            Attr.set_node_attribute (ci_node,
                         "history",
                         SP.value(history));
            Attr.set_node_attribute (ci_node,
                         "creator",
                         UT.get_library_attribute (library,
                                       "OWNER")
                         );
            Attr.set_node_attribute (ci_node,
                         "submitter",
                         HL.get_item(HL.user_name));
            HL.get_time (time);
            Attr.set_node_attribute (ci_node,
                         "date",
                         HL.date(time)&" "&HL.time(time));
            add_properties (ci_id);
            UT.delete_library (library);
            NM.close_node_handle (ci_node);
         else
            UT.unlock_library (library, LD.write_lock);
        end if;
        else
            CL.remove_write;
        raise library_locked;
        end if;
        CL.remove_write;
    exception
        when ND.status_error | ND.use_error | ND.hif_internal_error |
         ND.IO_error | ND.lock_error | ND.access_violation =>
        raise internal_hif_failure;
        when ND.name_error =>
        -- you can try to unlock a library that has already been
        -- unlocked without any bad side effects.
        UT.unlock_library (library, LD.write_lock);
        CL.remove_write;
        raise internal_name_error;
        when constraint_error | LD.invalid_library_name =>
        CL.remove_write;
        raise invalid_library;
        when LD.library_does_not_exist =>
        CL.remove_write;
        raise library_nonexistent;
    end;
    else
        raise cant_lock;
    end if;
        return status;
    end create_ci;


function store (        --| store a CI in the catalog from an
                --| item library
    library : in SP.string_type;    --| itemlibrary name to get the CI from
    history : in SP.string_type        --| description of the CI
    ) return status_type is

--| Algorithm:  This is very similar to create_ci:
--|-
--| 1. upgrade the catalog lock.
--| 2. lock the library.
--| 3. check that the mode is trunk or branch (both imply update)
--| 4. Check the properties on the library for validity and required.
--| 5. Get the ci_id of what wsa checked out.
--| 6. Check that the current user is the one who checked it out.
--| 7. Massage the ci_id into the new one.
--| 8. purge the library.
--| 9. do a copytree.
--|10. change mode on library to no update.
--|11. add all the properties.
--|12. delete the library.
--|13. remove the catalog lock.
--|+
--| The rationale for store is pretty much the same as for create_ci.  The
--| only differences lying in the fact that whether it is a trunk or a
--| branch makes a difference to what nodes are created.

    status     : status_type := ok;
    ci_id      : ID.ci_id_type;
    ci_node     : ND.node_type;
    old_node    : ND.node_type;
    lib_node    : ND.node_type;
    old_ci_id   : ID.ci_id_type;
    trunk_node  : ND.node_type;
    branch_node : ND.node_type;
    branch_path : SP.string_type;
    branch      : natural;
    user         : SP.string_type;
    creator    : SP.string_type;
    last         : natural;
    time         : HL.time_value;
    mode        : LD.fetch_type;
    attrib      : string (1..80);
    remain    : LD.LL.list;
    priv        : LD.privilege_type := LD.WORLD;

    begin
    if CL.upgrade_lock (wait) then
    begin
        begin
            old_ci_id := ID.get_ci_id (UT.get_library_attribute(library,
                                    "CI"));
        exception when ID.invalid_ci_id =>
            status := error;
            errors(non_ci_id) := true;
        end;
        mode := LD.fetch_type'value(UT.get_library_attribute (library,
                                  "MODE"));
        if not errors(non_ci_id) then
        -- you can't check the name on the list if the ci id isn't
        -- right
        user := SP.create (HL.get_item(HL.user_name));
          creator := SP.create (
                UT.get_library_attribute (library, "OWNER"));
        if not check_list (old_ci_id, mode, SP.value(creator))
          then
            CL.remove_write;
            raise incorrect_person;
        end if;
        end if;
        begin
            NM.open_node_handle (old_node, ID.get_hif_path (old_ci_id));
        exception when ND.name_error =>
        status := error;
        errors(non_existent) := true;
        end;
        if (mode = LD.no_update) then
            status := error;
            errors(in_mode) := true;
        end if;

        if UT.is_item_checked_out (library) then
        status := error;
        errors(ready) := true;
        end if;

        -- we are starting to look at things the user could change so
        -- lock the library
        if UT.lock_library (library, LD.write_lock) then
        NM.open_node_handle (lib_node,
            SP.value (UT.node_name (library, SP.create("*"))));
        check_properties (lib_node, status);
        -- only continue with the store if there are no errors

            -- purge the library and rename all items to be version 1
        UT.purge (library, privilege=>priv, remainder=>remain);
        if not LD.LL.isempty (remain) then
            status := error;
            errors(purge) := true;
        else
            begin
                UT.rename_version (library,
                       SP.create("*"),
                       SP.create("0"),
                       SP.create("1"),
                       privilege=>priv,
                       remainder=>remain);
            exception when LD.item_not_found =>
            -- means its an empty library
            null;
            end;
        end if;

        if status = ok then

            if mode = LD.update then
            ci_id := ID.increment_ci_id (old_ci_id);
            Attr.set_node_attribute (old_node, "status", "UPDATE");
            begin
                NM.open_node_handle (ci_node,
                         ID.get_hif_path(ci_id));
                HU.get_node_attribute (ci_node,
                             "deleted",
                             attrib,
                             last);
                if attrib(1..last) = "" then
                    CL.remove_write;
                UT.unlock_library (library, LD.write_lock);
                raise update_already_exists;
                end if;
            exception when ND.name_error =>
                NM.create_node (node => ci_node,
                        name => ID.get_hif_path (ci_id),
                        form => "");
            end;
            else     -- mode = LD.branch
            NM.open_node_handle(trunk_node,
                        ID.get_hif_path(old_ci_id));
            HU.get_node_attribute (trunk_node,
                         "branches",
                         attrib,
                         last);
            branch := integer'value (attrib(1..last)) + 1;
            branch_path := ID.get_hif_path(old_ci_id) &
                    "'branch(v" & SU.image(branch) &")";
            ci_id := ID.get_ci_id(string'(ID.image(old_ci_id)) &
                          "." & SU.image(branch) & ".1");
            begin
                NM.open_node_handle (ci_node,
                         ID.get_hif_path (ci_id));
                HU.get_node_attribute (ci_node,
                             "deleted",
                             attrib,
                             last);
                if attrib(1..last) = "" then
                -- the branch is already here and it's not
                -- deleted.  The way to fix is to increment
                -- the branch number and call store again.
                Attr.set_node_attribute (trunk_node,
                             "branches",
                             integer'image(branch));
                CL.remove_write;
                status := store (library, history);
                return status;
                end if;
            exception when ND.name_error =>
                begin
                  NM.create_node (node => branch_node,
                          name => SP.value(branch_path),
                          form => "");
                  NM.create_node (node => ci_node,
                          name => ID.get_hif_path (ci_id),
                          form => "");
                  NM.close_node_handle (branch_node);
                exception when ND.name_error =>
                  NM.create_node (node => ci_node,
                          name => ID.get_hif_path (ci_id),
                          form => "");
                  NM.close_node_handle (branch_node);
                end;
            end;
            end if;
            Attr.set_node_attribute (ci_node,
                         "branches",
                         "0");
            NM.copy_tree (lib_node,
                  ci_node,
                  "ci");
            Attr.set_node_attribute (ci_node,
                         "history",
                         SP.value(history));
            Attr.set_node_attribute (ci_node,
                         "creator",
                         SP.value(creator));
            Attr.set_node_attribute (ci_node,
                         "submitter",
                         SP.value(user));
            HL.get_time (time);
            Attr.set_node_attribute (ci_node,
                         "date",
                         HL.date(time)&" "&HL.time(time));
            add_properties (ci_id);
            if mode = LD.branch then
            Attr.set_node_attribute (trunk_node,
                         "branches",
                         integer'image(branch));
            NM.close_node_handle (trunk_node);
            end if;
            remove_name (old_ci_id, mode, SP.value(user));
            -- set library to be no_update at this point otherwise
            -- delete_library will fail.  Besides we don't want it
            -- being added again.  You also have to unlock the
            -- library for delete to work.
            UT.set_library_attribute (library, "mode", "NO_UPDATE");
            UT.delete_library (library);
            NM.close_node_handle (ci_node);
            NM.close_node_handle (old_node);
         else
            UT.unlock_library (library, LD.write_lock);
        end if;
        else
            CL.remove_write;
        raise library_locked;
        end if;
        CL.remove_write;
    exception
        when constraint_error | LD.invalid_library_name =>
        CL.remove_write;
        raise invalid_library;
        when ND.name_error =>
        CL.remove_write;
        raise no_such_ci;

        when LD.library_does_not_exist =>
        CL.remove_write;
        raise library_nonexistent;
        when ND.status_error | ND.use_error | ND.hif_internal_error |
         ND.IO_error | ND.lock_error | ND.access_violation =>
        raise internal_hif_failure;
    end;
    else
        raise cant_lock;
    end if;
        return status;
    end store;

procedure cancel (        --| cancel a fetch for update
    library : in SP.string_type;--| name of the library where the CI is checked
                --| out
    user    : in SP.string_type --| user that checked out the CI
    ) is

--| Algorithm: Cancel is pretty simple.  The idea is to cancel a fetch that
--| was branch or trunk.  The library should be left alone however, so the
--| steps are to take the name from the checked out list and then to
--| change the mode on the library.  Of course the catalog will be locked
--| before the cancel and unlocked after.

    ci_id  : ID.ci_id_type;
    mode   : LD.fetch_type;

    begin
    if CL.upgrade_lock(wait) then
    begin
        ci_id := ID.get_ci_id (UT.get_library_attribute (library, "ci"));
        mode := LD.fetch_type'value (
            UT.get_library_attribute (library, "mode"));
        remove_name (ci_id, mode, SP.value (user));
        UT.set_library_attribute (library, "mode", "NO_UPDATE");
        CL.remove_write;
     exception
        when ID.invalid_ci_id | ND.name_error =>
        CL.remove_write;
        raise ci_not_fetched;
        when constraint_error =>
        CL.remove_write;
        raise invalid_mode;
        when LD.library_does_not_exist =>
        CL.remove_write;
        raise library_nonexistent;
        when LD.invalid_library_name =>
        CL.remove_write;
        raise invalid_library;
        when ND.status_error | ND.use_error | ND.hif_internal_error |
         ND.IO_error | ND.lock_error | ND.access_violation =>
        raise internal_hif_failure;
    end;
    else
        raise cant_lock;
    end if;
    end cancel;

procedure fetch (        --| Fetches the specified configuration item
                --| and places it in the given item_library
    CI_name : in SP.string_type;--| name of the CI to fetch
    library : in SP.string_type;--| name of the item_library to put the CI in
    dir        : in SP.string_type;--| where to put the item_library
    mode    : in LD.fetch_type    --| whether the fetch is for updating or not
    := LD.no_update
    ) is

--| Algorithm: The following is an outline of the fetch procedure.
--|-
--| 1. Upgrade the catalog lock.
--| 2. if the mode isn't no_update then check the checked out list to
--|     make sure the checkout can be done.
--| 3. create the library.
--| 4. lock the library.
--| 5. copy tree.
--| 6. put all the other info that a library needs on the library node
--| 7. add them to the checked out list.
--| 8. unlock both locks.
--|+
--| Note that the ci is not officially checked out until the name is on the
--| checked out list.

    cat_node : ND.node_type;
    ci_node  : ND.node_type;
    parent   : ND.node_type;
    ci_id    : ID.ci_id_type;
    attrib   : string (1..80);
    last     : natural;
    begin
    if CL.upgrade_lock (wait) then
    begin
        ci_id := ID.get_ci_id (ci_name);
        begin
        NM.open_node_handle (parent, ID.get_hif_path(ci_id));
        exception when ND.name_error =>
        CL.remove_write;
        raise no_such_ci;
        end;
        begin
             NM.open_node_handle (ci_node, ID.get_hif_path(ci_id) & ".ci");
        exception when ND.name_error =>
        HU.get_node_attribute (parent, "deleted", attrib, last);
        if attrib(1..last) /= "" then
            CL.remove_write;
            raise deleted_ci;
        else
            CL.remove_write;
            raise incomplete_store;
        end if;
        end;
        if not check_list (ci_id, mode) then
        CL.remove_write;
        raise already_fetched;
        end if;
        if mode = LD.update then
            HU.get_node_attribute (parent, "status", attrib, last);
            if attrib(1..last) = "UPDATE" then
            CL.remove_write;
            raise already_updated;
            end if;
        end if;
        NM.get_current_node (cat_node);
        UT.create_library (    library,
                dir,
                ci_name,
                mode,
                ci_node,
                locked=>TRUE);
        update_list (ci_id, mode);
        NM.close_node_handle (ci_node);
        NM.close_node_handle (cat_node);
        NM.close_node_handle (parent);
        UT.unlock_library (library, LD.write_lock);
        CL.remove_write;

      exception
        when ID.invalid_ci_id =>
        CL.remove_write;
        raise invalid_ci_id;
        when ND.name_error =>
        CL.remove_write;
        raise no_such_ci;
        when LD.invalid_library_name =>
        CL.remove_write;
        raise invalid_library;
        when LD.directory_already_exists | LD.library_already_exists |
         LD.invalid_directory_name  =>
        CL.remove_write;
        raise;
        when ND.status_error | ND.use_error | ND.hif_internal_error |
         ND.IO_error | ND.lock_error | ND.access_violation =>
        raise internal_hif_failure;
    end;
    else
        raise cant_lock;
    end if;
    end fetch;


procedure modify_property (    --| modify the value associated with a property
                --| for a given CI
    CI_name : in SP.string_type;--| the name of the CI to change
    keyword : in SP.string_type;--| the name of the keyword to modify
    value   : in SP.string_type    --| the new value to give the keyword
    ) is

    ci_id : ID.ci_id_type;
    node  : ND.node_type;
    list  : LU.list_type;
    attrib: string(1..80);
    last  : natural;

    begin

    if SP.is_empty(keyword) then    -- it causes a hif internal error if
                    -- you don't catch a null string here.
        raise IM.invalid_keyword;
    end if;
        if CL.upgrade_lock (wait) then
        begin
            -- Update the information in the index.
        -- delete doesn't do anything if the ci is not in this set
        -- already.
        ci_id := ID.get_ci_id (ci_name);
        begin
                NM.open_node_handle (node,
                     ID.get_hif_path (ci_id) & ".CI");
        exception when ND.name_error =>
            begin
            NM.open_node_handle (node,
                         ID.get_hif_path (ci_id));
            HU.get_node_attribute (node,
                         "deleted",
                         attrib,
                         last);
            if last /= 0 then
                CL.remove_write;
                raise deleted_ci;
            else
                    CL.remove_write;
                    raise no_such_ci;
            end if;
            NM.close_node_handle (node);
            exception
            when ND.name_error =>
                    CL.remove_write;
                    raise no_such_ci;
            end;
        end;
        if IM.is_required_keyword(keyword) and SP.is_empty(value) then
            CL.remove_write;
            raise required_keyword;
        end if;
        IM.delete_ci (keyword,
                  get_property (ci_name, keyword),
                  ci_id);

        if not SP.is_empty(value) then
            -- have to check the value here otherwise you get a list
            -- use error.
            LU.add_positional (list, LU.to_item(SP.value(value)));
            -- set node attribute clobbers the old value.
            Attr.set_node_attribute (node, SP.value(keyword), list);
            NM.close_node_handle (node);
            LU.free_list (list);
            IM.add_ci (keyword, value, ci_id);
        else
            LU.init_list(list);
            Attr.set_node_attribute (node, SP.value(keyword), list);
            NM.close_node_handle (node);
            LU.free_list (list);
        end if;

        CL.remove_write;
        exception
        when ND.name_error =>
            CL.remove_write;
            raise invalid_key_or_val;
        when ID.invalid_ci_id =>
            CL.remove_write;
            raise invalid_ci_id;
        when IM.invalid_keyword | IM.invalid_value =>
            CL.remove_write;
            raise;    -- these two are handled in command interpreter
            when ND.status_error | ND.use_error | ND.hif_internal_error |
             ND.IO_error | ND.lock_error | ND.access_violation =>
            raise internal_hif_failure;
        end;
    else
        raise cant_lock;
    end if;
    end modify_property;

function get_property (        --| get the value associated with a particular
                --| property for a given CI
    CI_name : in SP.string_type;--| name of the CI to give the info about
    keyword : in SP.string_type    --| name of the keyword for the property
    ) return SP.string_type is

    ci_id   : ID.ci_id_type;
    node    : ND.node_type;
    attrib  : string(1..80);
    last    : natural;

    begin
    ci_id := ID.get_ci_id (ci_name);
    NM.open_node_handle (node, ID.get_hif_path (ci_id) & ".CI");
    begin
        HU.get_node_attribute (node, SP.value(keyword), attrib, last);
        NM.close_node_handle (node);
    exception when ND.name_error =>
        raise IM.invalid_keyword;
    end;
    return SP.create(attrib(1..last));
    exception when ND.name_error =>
    raise incomplete_store;
    end get_property;

function history (        --| return the history of a particular CI
    CI_name : in SP.string_type --| name of the CI
    ) return CD.hist_list is

    ci_id  : ID.ci_id_type;
    curr_id  : ID.ci_id_type;
    node   : ND.node_type;
    ver_list : VL.list;
    name     : SP.string_type;
    iter     : VL.listiter;
    ci_ver   : SP.string_type;
    curr_ver : SP.string_type := SP.create ("1");
    history  : CD.hist_list;
    hist     : string(1..256);
    hist_len : natural;
    date     : string(1..20);
    date_len : natural;
    prog     : string(1..80);
    prog_len : natural;
    del         : string(1..80);
    del_len  : natural;
    sub      : string(1..80);
    sub_len  : natural;
    num      : positive;

    package HLS renames CD.hist_lists;

    begin
    begin
        ci_id := ID.get_ci_id (ci_name);
        NM.open_node_handle (node, ID.get_hif_path(ci_id));
        NM.close_node_handle(node);
    exception
        when ID.invalid_ci_id =>
            raise invalid_ci_id;
        when ND.name_error =>
        raise no_such_ci;
    end;
    ver_list := ID.get_version (ci_id);
    name := ID.get_name (ci_id);
    iter := VL.makelistiter (ver_list);
        VL.next (iter, num);
    ci_ver := SS.image (num);
    loop
        ci_id := ID.get_ci_id (name & " " & ci_ver);
        curr_id := ID.get_ci_id (name & " " & curr_ver);
        while ID."<=" (curr_id, ci_id) loop
        NM.open_node_handle (node, ID.get_hif_path (curr_id));
        HU.get_node_attribute (node, "history", hist, hist_len);
        HU.get_node_attribute (node, "date", date, date_len);
        HU.get_node_attribute (node, "creator", prog, prog_len);
        HU.get_node_attribute (node, "submitter", sub, sub_len);
        HU.get_node_attribute (node, "deleted", del, del_len);
        HLS.attach ((name    => ID.image(curr_id),
                 history => SP.create(hist(1..hist_len)),
                 creator => SP.create(prog(1..prog_len)),
                 submit  => SP.create( sub(1..sub_len)),
                 date    => SP.create(date(1..date_len)),
                 delete  => SP.create( del(1..del_len))),
                history);
        NM.close_node_handle (node);
        curr_id := ID.increment_ci_id (curr_id);
        end loop;
        if VL.more (iter) then
        VL.next (iter, num);
        ci_ver := ci_ver & "." & SU.image(num);
        curr_ver := ci_ver & ".1";
        VL.next (iter, num);
        ci_ver := ci_ver & "." & SU.image(num);
        else
        exit;
        end if;
    end loop;
    return history;
    exception
    when ID.invalid_ci_id =>
        raise no_such_ci;
    when  ND.name_error =>
        raise incomplete_store;
    end history;

function list_versions (    --| return a list of the different versions of
                --| a ci given a ci name (not a ci id)
    ci_name : in SP.string_type --| ada id part of ci id
    ) return SL.list is
    hif_path  : SP.string_type;
    name      : SP.string_type;
    root      : SP.string_type;
    hif_node  : ND.node_type;
    iter      : NM.node_iterator;
    list      : SL.list;
    next_node : ND.node_type;
    trunk     : boolean;
    attrib    : string(1..80);
    len       : natural;

    begin
    if not UT.is_ada_id (ci_name) then
        raise invalid_ci_name;
    end if;
    hif_path := "'current_node'ci_root(" & ci_name & ")";
    begin
        NM.open_node_handle (hif_node, SP.value(hif_path));
    exception when ND.name_error =>
        raise no_such_ci;
    end;
    find_versions (hif_node, ci_name & " ", list);
    return list;
    end list_versions;

--| Effects:  Returns a list of the versions of a CI given a name.
--| If the list is of trunk updates then the ci_id should be incomplete and
--| the program will show all trunk updates on that branch.  If a list
--| of branches is what is needed then the ci_id should be complete and
--| a list of the branches from that ci will be shown.

function list_components (    --| list the components of a given CI
    CI_name : in SP.string_type --| name of the CI
    ) return LD.LL.list is

    ci_id : ID.ci_id_type;
    node  : ND.node_type;
    attrib: string(1..80);
    last  : natural;

    begin
    ci_id := ID.get_ci_id (ci_name);
     NM.open_node_handle (node, ID.get_hif_path (ci_id) & ".CI");
    return UT.list_item (node);
    exception
    when ND.name_error=>
        begin
        NM.open_node_handle (node,
                     ID.get_hif_path (ci_id));
        HU.get_node_attribute (node,
                     "deleted",
                     attrib,
                     last);
        if last /= 0 then
            raise deleted_ci;
        else
                raise no_such_ci;
        end if;
        NM.close_node_handle (node);
        exception
        when ND.name_error =>
                raise no_such_ci;
        end;
    when LD.item_not_found =>
        return LD.LL.create;
    end list_components;

--| Effects: Returns a list that is all the components of the given CI.

function match_keys (        --| match keywords in a list to the
                --| keywords on a CI and return the list
    CI_name : in SP.string_type;--| name of the CI
    key_list : in SL.list    --| keywords list
    ) return PS.set is

--| Effects: Reads each of the elements of the list (which could have
--| wild cards) and matches them to all the properties on the given
--| CI.  Returns the set of matched properties which includes the value
--| as well as the keyword.

    ci_id : ID.ci_id_type;
    p_set : PS.set;
    iter  : SL.listiter;
    node  : ND.node_type;
    match : SP.string_type;
    key   : string(1..80);
    last  : natural;
    list  : LU.list_type;
    i     : Attr.attrib_iterator;
    attrib: string(1..80);

    begin
     ci_id := ID.get_ci_id (ci_name);
    iter := SL.makelistiter (key_list);
    begin
        NM.open_node_handle (node, ID.get_hif_path(ci_id) & ".CI");
    exception when ND.name_error=>
        begin
        NM.open_node_handle (node,
                     ID.get_hif_path (ci_id));
        HU.get_node_attribute (node,
                     "deleted",
                     attrib,
                     last);
        if last /= 0 then
            raise deleted_ci;
        else
                raise no_such_ci;
        end if;
        NM.close_node_handle (node);
        exception
        when ND.name_error =>
                raise no_such_ci;
        end;
    end;
    while SL.more (iter) loop
        SL.next (iter, match);
        Attr.node_attribute_iterate (i, node, SP.value(match));
        while Attr.more (i) loop
        Attr.get_next (i, key, last, list);
        PS.insert ((key => SP.create (key(1..last)),
                val => SP.create (LU.identifier(
                        LU.positional(list,1)))),
               p_set);
        LU.free_list (list);
        end loop;
    end loop;
    NM.close_node_handle (node);
    return p_set;
    end match_keys;

-- Operations for libuser's use
-- get_hif_file_name        returns a hif file name for the given CI
-- audit_trail            gives the audit trail for a CI item
-- check_obsolescence        checks to see if a file is included that
--                 is obsolete

function get_hif_file_name (     --| return the hif file name for a CI item
   catalog : in SP.string_type;    --| name of the catalog
   CI_name : in SP.string_type;    --| name of the CI
   item    : in SP.string_type  --| name of the item in the CI
   ) return SP.string_type is
    node : ND.node_type;
    ci_id   : ID.ci_id_type;
    path : SP.string_type;
    file : SP.string_type;
    begin
    SP.mark;
    ci_id := ID.get_ci_id (CI_name);
    begin
        NM.set_current_node ("'user(" & SP.value(catalog) & ")");
    exception when ND.name_error =>
        raise no_such_catalog;
    end;
    path := ID.get_hif_path(ci_id);
    begin
        NM.open_node_handle (node, SP.value(path));
        NM.close_node_handle (node);
    exception when ND.name_error =>
        raise no_such_ci;
    end;
    path := path & ".CI." & UT.internal_name (item) & ".V1";
    begin
        NM.open_node_handle (node, SP.value(path));
    exception when ND.name_error =>
        raise no_such_component;
    end;
    file := SP.make_persistent(NM.host_file_name (node));
    SP.release;
    NM.close_node_handle (node);
    return file;
    end get_hif_file_name;

--| Effects: Returns the internal hif name for a CI item.  The item  is
--| identified by first giving the CI_id and then the item name.

function ci_date_time (        --| return the date and time a CI was
                --| created.
   catalog : in SP.string_type;    --| name of the catalog
   name    : in SP.string_type;    --| name part of the CI id
   version : in SP.string_type    --| version part of the ci id
   ) return SP.string_type is

    begin
    return sp.create("");
    end;

--| Effects: Returns the date stored at the time of creation.


-- Operations to allow a privileged user to clean up the database:
-- remove_lock (*)        removes a temporary lock on a CI
-- delete (*)            delete a CI

procedure remove_lock (        --| remove a temporary lock that was left
                --| behind by an aborted process
    name : in SP.string_type;    --| name of the person owning the lock
    lock : in lock_type;    --| type of lock read or write
    node_name : in SP.string_type; --| Name of the node to be unlocked
    node : in node_type        --| type of node, CI or index
    ) is
    list : LU.list_type;
    hif_node : ND.node_type;
    begin
    -- At the moment the only thing that can be locked is the catalog
    -- itself.  The second two arguments are provided so that the
    -- interface won't have to change later.  However, since they are
    -- meaningless right now I won't even look at them.
    if lock = write then
        Attr.get_path_attribute (current_node & "'write_lock",
                     "userid",
                     list);
        -- the following depends upon the fact that lists always
        -- uppercase everything
        if LU.identifier(LU.positional(list, 1)) /=
        SP.value(SP.upper (name)) then
        -- if the userid on the lock doesn't match the user given there is
        -- no lock that can be removed
        LU.free_list (list);
            raise no_lock;
        end if;
        LU.free_list(list);
        NM.get_current_node (hif_node);
        NM.unlink (hif_node, relation => "write_lock");
    else -- it's a read lock
        NM.get_current_node (hif_node);
        NM.unlink (hif_node,
               key => SP.value (name),
               relation => "read_lock");
    end if;
    exception
    when ND.name_error =>
        raise no_lock;
    end remove_lock;
    --| Raises: no_lock

--| Effects: Removes a lock from a node.  The lock should be one that is
--| not for a current process, but there is no way for the catalog manager
--| to check this.  However, to try and protect this operation somewhat, it
--| is a privileged operation and therefore can only be performed by someone
--| who ought to know better than to remove the lock belonging to a current
--| process.  The lock can be on either a CI or an index.  In both cases the
--| lock may be a read lock or a write lock.  With a read lock it should be
--| safe to just remove the lock.  With a write lock it may be necessary to
--| find out what was being written so that the user can tell whether it
--| was actually written or not.  The information put in with a writing
--| operation that was aborted should probably be deleted, but that is up
--| to the discretion of the super user.

procedure delete (        --| delete a CI from the catalog
    CI_name : in SP.string_type;--| name of the CI to delete
    mode    : in delete_type    --| type of delete being done
    := clean_up
    ) is

    ci_id  : ID.ci_id_type;
    node   : ND.node_type;
    trunk  : string(1..80);
     len1   : natural;
    branch : string(1..80);
    len2   : natural;
    time   : HL.time_value;
    last   : natural;

    begin
    if CL.upgrade_lock (wait) then
    begin
        ci_id := ID.get_ci_id (ci_name);
        begin
            NM.open_node_handle (node, ID.get_hif_path (ci_id));
        exception when ND.name_error =>
        CL.remove_write;
        raise no_such_ci;
        end;
        if mode = clean_up then
            HU.get_node_attribute (node, "updating", trunk, len1);
            HU.get_node_attribute (node, "branching", branch, len2);
            if trunk(1..len1) /= "" or else branch(1..len2) /= "" then
            CL.remove_write;
            raise is_checked_out;
            end if;
        end if;
        HL.get_time(time);
        Attr.set_node_attribute (node, "deleted",
        HL.get_item(HL.user_name) & "   " & HL.date(time) & " " & HL.time(time));
        NM.close_node_handle (node);
        begin
            NM.open_node_handle (node, ID.get_hif_path (ci_id) & ".CI");
            NM.delete_tree (node);
        exception when ND.name_error =>
        -- this could be fix up and the .CI relation never created.
        -- so just continue since nothing is there anyway.
        null;
        end;
        CL.remove_write;

      exception
        when ID.invalid_ci_id =>
        CL.remove_write;
        raise invalid_ci_id;
        when ND.status_error | ND.use_error | ND.hif_internal_error |
         ND.IO_error | ND.lock_error | ND.access_violation =>
        raise internal_hif_failure;
    end;
    else
        raise cant_lock;
    end if;
    end delete;

 --| Effects: Delete a CI from the catalog.  Since CI's are supposed to be
--| almost permanent this is a privileged operation.  In this way only
--| someone cleaning up the database would be allowed to delete CI's.

-- the following procedure is for debugging purposes since the debugger
-- goes crazy on pointers and that's what a string_type is.

procedure print_string (
    s : in SP.string_type
    ) is
    begin
    Text_io.put_line (SP.value(s));
    end;
procedure print_ci_id (
    i : in ID.ci_id_type
    ) is
    begin
    Text_io.put (ID.get_name (i) & ", ");
    Text_io.put (ID.get_version (i) & ", ");
    Text_io.put_line (ID.get_hif_path (i));
    end;
procedure print_list_item (
    l : in LU.list_type;
    n : in LU.positive_count
    ) is
    begin
    text_io.put_line (LU.identifier (LU.positional (l, n)));
    exception when others =>
    begin
        text_io.put_line(LU.quoted_string(LU.positional (l, n)));
    exception when others =>
        null;
    end;
    end;

---- Bodies of local operations:

procedure check_properties (
    node : in ND.node_type;    -- node the properties are on
    stat : in out status_type    -- status of keywords
    ) is
    iter : Attr.attrib_iterator;
    attrib : string (1..80);
    last : natural;
    list : LU.list_type;
    keyword : SP.string_type;
    value : SP.string_type;
    keys : CD.string_set;
    begin
    Attr.node_attribute_iterate (iter, node, "*");
    while Attr.more (iter) loop
        Attr.get_next (iter, attrib, last, list);
        keyword := SP.create (attrib(1..last));
        if IM.is_valid_keyword (keyword) then
        value := SP.create(LU.identifier(LU.positional(list, 1)));
        pair_lists.attach (pairs, (key=>keyword, val=>value));
        CD.string_sets.insert(keys, keyword);
        else
        SL.attach(invalid, keyword);
        end if;
        LU.free_list (list);
    end loop;
    missing := IM.check_required(keys);
    if not SL.isempty (invalid) then
        errors(keywords) := true;
        stat := error;
    end if;
    if not CD.string_sets.is_empty(missing) then
        errors(required) := true;
        stat := error;
    end if;
    CD.string_sets.destroy (keys);
    end;

procedure add_properties (
    name : in ID.ci_id_type    -- ci id of the ci to add the properties under
    ) is
    i : pair_lists.listiter;
    p : pair;

-- pairs is the list of keyword-value pairs.  It is created by check_properties
-- since that is always called before adding any properties.  the actual
-- variable is global to the package.
    begin
    i := pair_lists.makelistiter (pairs);
     while pair_lists.more (i) loop
        pair_lists.next (i, p);
        IM.add_ci (p.key, p.val, name);
    end loop;
    pair_lists.destroy (pairs);
    end;

function check_list (        --| check the checked out list to make sure
                --| this fetch can be done.
    ci_id : in ID.ci_id_type;    --| name of the ci being fetched
    mode  : in LD.fetch_type    --| type of fetch being done
    ) return boolean is

    node : ND.node_type;
    attrib : string(1..80);
    last : natural;

    begin
    if mode = LD.no_update or    -- can always check out no update
       mode = LD.branch then    -- or branch
        return true;
    end if;
    NM.open_node_handle (node, ID.get_hif_path(ci_id));
    HU.get_node_attribute (node, "updating", attrib, last);
    NM.close_node_handle (node);
    return (attrib(1..last) = "");
    end;

function check_list (        --| check the checked out list to make sure
                --| this store can be done.
    ci_id : in ID.ci_id_type;    --| name of the ci being stored
    mode  : in LD.fetch_type;    --| type of fetch done originally
    user  : in STRING        --| name of the user to check for
    ) return boolean is

    node  : ND.node_type;
    attrib  : string(1..80);
    last  : natural;
    list  : LU.list_type;
    index : LU.count;

    begin
    if mode = LD.no_update then  -- if the mode is no_update then there
                     -- is no list to check.
        return true;
    end if;
    NM.open_node_handle (node, ID.get_hif_path(ci_id));
    if mode = LD.update then
        HU.get_node_attribute (node, "updating", attrib, last);
        NM.close_node_handle (node);
         return (attrib(1..last) = user);
    else
        Attr.get_node_attribute (node, "branching", list);
        LU.find_positional (list, LU.to_item(user), index);
        NM.close_node_handle (node);
        LU.free_list (list);
        return (index /= 0);
    end if;
    end;

procedure update_list (        --| Update the checked out list with this
                --| person's name and the type of update
    ci_id : in ID.ci_id_type;    --| name of the ci being fetched
    mode  : in LD.fetch_type    --| type of fetch being done
    ) is
    list  : LU.list_type;
    index : LU.count;
    last  : natural;
    node  : ND.node_type;

    begin
    if mode = LD.no_update then return; end if;
    NM.open_node_handle (node, ID.get_hif_path(ci_id));
    if mode = LD.update then
        Attr.set_node_attribute (node,
                     "updating",
                     HL.get_item(HL.user_name));
      else
        Attr.get_node_attribute (node, "branching", list);
        LU.add_positional (list, HL.get_item(HL.user_name));
        Attr.set_node_attribute (node, "branching", list);
        LU.free_list (list);
    end if;
        NM.close_node_handle (node);
    end;

procedure remove_name (        --| remove the user's name from the checked
                --| out list when a CI is stored (or cancelled)
    ci_id : in ID.ci_id_type;    --| name of the ci being stored
    mode  : in LD.fetch_type ;    --| type of fetch done originally
    user  : in STRING        --| name of the user to check for
    ) is

    node  : ND.node_type;
    list  : LU.list_type;
    pos   : LU.count;
    index : natural;
    new_list : LU.list_type;

    begin
    NM.open_node_handle (node, ID.get_hif_path(ci_id));
    if mode = LD.update then
        Attr.set_node_attribute (node, "updating", "");
    elsif mode = LD.branch then
        Attr.get_node_attribute (node, "branching", list);
        LU.find_positional (list, LU.to_item(user), pos);
        if pos /= 0 then
            for index in 1..(pos-1) loop
            LU.add_positional (new_list, LU.positional(list, index));
            end loop;
            for index in (pos+1)..LU.num_positional(list) loop
            LU.add_positional (new_list, LU.positional(list, index));
            end loop;
        Attr.set_node_attribute (node, "branching", new_list);
        LU.free_list (list);
        LU.free_list (new_list);
        end if;
       end if;
    NM.close_node_handle (node);
    end;

procedure find_versions (    --| recursively find all the versions of a
                --| ci starting at its root
    root : in ND.node_type;    --| node to start at
    name : in SP.string_type;    --| name of the ci to start with
    list : in out SL.list    --| list returned
    ) is

    node      : ND.node_type;
    next_node : ND.node_type;
    attrib    : string (1..50);
    iter      : NM.node_iterator;
    last      : natural;
    num       : natural;
    index     : natural;
    trunk     : natural := 0;
    temp      : SP.string_type;
    output    : SP.string_type;

    begin
    NM.iterate (iter, root, relation => "trunk");
    while NM.more (iter) loop
        trunk := trunk + 1;
        NM.get_next (iter, node);
        HU.get_node_attribute (node, "branches", attrib, last);
-- WORKAROUND
-- for some reason (i suspect a hif bug) last will at times come back as
-- 0 even if there is a number in attrib.  I was in the debugger and
-- attrib had a '0' as the first character (which it should have), but
-- last was 0 instead of 1!  So the workaround is to set num := 0 if
-- last = 0.  Other wise you get a constraint error.  I am also going to
-- try reseting last to 1 at the top of the loop to see if it just wasn't
-- getting the return value.  Setting last didn't help so I took it out.
        if last = 0 then
        num := 0;
        else
            num := integer'value (attrib(1..last));
        end if;
-- WORKAROUND

        HU.get_node_attribute (node, "deleted", attrib, last);
        temp := name & ss.image(trunk);
        output := temp;
        if last /= 0 then
            output := output & " (deleted by " & attrib(1..last) & ")";
        end if;
        SL.attach (list, output);
        if num /= 0 then  -- there are branches
        for index in 1..num loop
            NM.open_node_handle(node=>next_node,
                    base=>node,
                    name=>"'branch(v"&SU.image(num) & ")");
            find_versions (next_node,
                   temp & "." & SS.image(num) & ".",
                   list);
            NM.close_node_handle (next_node);
        end loop;
        end if;
        NM.close_node_handle (node);
    end loop;
    exception
    when ND.name_error =>
        -- I don't think this is a bad error.  It would generally mean
        -- that a branches attribute got out of order.  For the moment
        -- I am going to take the attitude that if it is something really
        -- bad it will show up as a major inconsistency in the listing.
        -- If it is not bad enough for someone to notice it in the list
        -- then it doens't matter that I don't do anything here.  --cg
        -- p.s. you could add a message to the list saying "missing node"
        null;
    end;

function strip_v (        --| given a string of the form "v11", strip the
                --| 'v' just leaving the number.
    ver : in string        --| input version string
    ) return string is
    last : integer;
    begin
    last := ver'last;
    return ver(2..last);
    end;

end catalog_manager;
::::::::::::::
catmgr.spc
::::::::::::::
with string_pkg;
with string_lists;
with catalog_decls;
with library_declarations;
with property_set;

package catalog_manager is

---- Package Renames:

package SP renames string_pkg;
package SL renames string_lists;
package CD renames catalog_decls;
package LD renames library_declarations;
package PS renames property_set;

---- Types:

type lock_type       is (read, write);
type node_type     is (catalog_node, CI_node, index_node);
type status_type   is (ok, error);
type delete_type   is (fix_up, clean_up);
type ci_type        is (update, branch);
type error_type    is (    dup_name,         -- the name is not unique
            non_ada,    -- the name is not and ada identifier
            non_ci_id,    -- the name is not a valid ci_id
            non_existent,    -- cannot store a ci that didn't exist
            create_mode,    -- the mode is not correct for creation
            in_mode,    -- the mode is not correct for check in
            required,     -- not all required keywords included
            person,     -- person isn't the same as checked out
            out_status,     -- cannot be checked out for update
            purge,        -- cannot purge all files in library
            keywords,    -- there are invalid keywords included
            ready
               );
type error_array   is array (error_type) of boolean;
type message_array is array (error_type) of SP.string_type;

---- Exceptions:

invalid_password : exception;    -- raised when set_password is given an invalid
                -- one
cant_lock     : exception;    -- raised when a lock cant be placed due to
                -- another person having a lock
no_lock         : exception;    -- raised when you try to remove a lock that
                -- doesn't exist
library_locked   : exception;    -- raised when the library to be copied is
                -- already locked
no_such_ci     : exception;    -- raised when the ci named doesn't exist
no_such_catalog  : exception;    -- raised when the catalog doesn't exist
no_such_component: exception;    -- raised when the component is not in the CI
already_fetched     : exception;    -- raised when trying to fetch for update a ci
                -- which has already been fetched for update
                -- by someone.  Doesn't apply to branches
                -- because there can be any number of branches
already_updated  : exception;    -- raised when a CI already has an update on
                -- the trunk.  At that point the only changes
                -- that can be made are on a branch
invalid_ci_id     : exception;    -- raised when a parameter to be used as a
                -- ci id is not in the correct format
invalid_ci_name     : exception;    -- raised when the name given to list_versions
                -- is not an ada id
incorrect_person : exception;    -- raised when the wrong person tries to check
                -- a ci back into the catalog (or tries to
                -- do a cancel)
is_checked_out   : exception;    -- raised when someone tries to delete a ci
                -- that is checked out
deleted_ci     : exception;    -- raised when someone tries to fetch a ci that
                -- has been deleted
incomplete_store : exception;    -- raised when the node for the ci exists but
                -- the nodes of the ci are not there during
                -- a fetch.  check_consistency should also
                -- find these cases.
invalid_key_or_val : exception;    -- raised when name error is raised and it
                -- could either be and invalid keyword or
                -- value
required_keyword : exception;    -- raised when a person tries to delete a
                -- required keyword in modify_property
ci_not_fetched   : exception;    -- raised when invalid ci id is raised
                -- in a cancel
invalid_mode     : exception;    -- raised when a cancel is done and the
                -- mode is not recognised
update_already_exists : exception;    -- raised when a store is being done
                    -- and a node exists with that
                    -- version number that is not deleted.
                    -- this should probably be a very fatal
                    -- error since as far as I know it is
                    -- not possible to do this
internal_hif_failure : exception;    -- raised if any unexpected hif errors
                    -- like use error are raised.
internal_name_error : exception;    -- raised when an unexpected name_error
                    -- is caught.
invalid_library : exception;        -- raised when you get invalid library
                    -- name or one of the required info
                    -- attributes are not on the library.
library_nonexistent : exception;    -- raised when the library is not found


---- Items global to the package catalog_manager:

empty_list   : SL.list := SL.create;
errors          : error_array := (others => false);
messages     : message_array := (
    SP.create ("The given name is already being used in the catalog"),
    SP.create ("The given name is not a valid id, give an ada identifier"),
    SP.create ("The id on the library is not a valid CI id, use create_ci"),
    SP.create ("You cannot store an update to a CI that doesn't exist"),
    SP.create ("Cannot use Create_CI to return a CI fetched for update"),
    SP.create ("Cannot store a library that was not created for update"),
    SP.create ("The following required keywords are missing: "),
    SP.create ("The owner of this library is not in the check out list"),
    SP.create ("This ci is already fetched for update by "),
    SP.create ("Cannot purge all files in the library -- Create_CI not " &
                            "complete"),
    SP.create ("The following keywords are invalid: "),
    SP.create ("Cannot create/store since a library item is still fetched"));

missing      : CD.string_set;        -- the set of missing required keywords
invalid      : SL.list := empty_list;    -- the list of invalid keywords
fetchee         : SP.string_type;        -- the person with a CI already fetched

---- Operations global to the package catalog_manager:

-- Operations on the catalog:
-- list_cis            list all the CI's in the cpcicat
-- verify_password         verify the password given is the correct one
-- set_password            set a new password

function list_cis (        --| list the contents of the catalog
    CIs : in SP.string_type      --| name to match
    := SP.create("*")
    ) return SL.list;

--| Effects: List the identifiers of CIs which match the pattern given.
--| The default is "*" which matches all identifiers in the catalog.
--| No versions are returned just identifiers.

function verify_password (    --| verify the privilege operations password
    p : in  SP.string_type    --| word to check
    ) return boolean;

--| Effects: Checks that the string given is the password for the catalog.
--| If it is the password true if returned, false otherwise.

procedure set_password (    --| set a new password
    next : in SP.string_type;    --| new password
    old  : in SP.string_type    --| old password for verification
    );
    --| raises: invalid_password

--| Effects: Sets the password to be the new one if the word given as the
--| old one is the correct password in actuality.  Raises invalid password
--| if not.  If this is really invoked by the catalog interface invalid
--| password should never be raised.

-- Operations on a configuration item:
-- create_CI            create a new configuration item from a library
-- store            update a configuration item from an itemlib
-- cancel            cancel a fetch for update
-- fetch            fetch an itemlib from the catalog
-- delete (*)            delete a CI
-- modify_property        change the value associated with a property
-- get_property            list all the keywords and values for a CI, and
--                 other information like creator as asked for.
-- history            history of a CI
-- list_versions        list the versions of a ci given a name
-- list_components        list the components of a CI
-- match_keys            match a list of keywords with the ones on a CI

function  create_CI (        --| create a new CI in the catalog
    name    : in SP.string_type;--| name of the new CI
    library : in SP.string_type;--| name of the library to find the CI in
    history : in SP.string_type --| description of the CI
    ) return status_type;
    --| Raises: name_in_use

--| Effects: Creates a new CI in the catalog under the given name.  The name
--| is checked to make sure it doesn't conflict with a name already in the
--| catalog.  Properties on the item library will be used as the properties for
--| this CI, and at this point they will be checked for vcalidity and that
--| all the required ones are included.  Errors will be reported as found and
--| if there are any errors are found the create will not take place although
--| it will continue to report as many errors as can be found at that point.
--| The history ought to be a description of the purposes of this CI.  It is
--| not necessarily a description of the creation history of this CI, but more
--| a description of its uses.  The library being checked in is checked that
--| it is not on another CI's list as being fetched as a branch or a trunk.
--| If it is, the user will get a message to  cancel the fetch before creating
--| the new CI.

function store (        --| store a CI in the catalog from an
                --| item library
    library : in SP.string_type;    --| itemlibrary name to get the CI from
    history : in SP.string_type        --| description of the CI
    ) return status_type;

--| Effects: Stores the contents of the item_library in the catalog under the
--| Ci named by the name given.  The Version number is given by the catalog
--| depending upon whether the CI was checked out to branch from the trunk
--| or update the trunk.  When storing a CI the catalog checks that the
--| person doing the store did indeed fetch it for modification, if they didn't
--| an error is raised and the store does not take place.  The keywords and
--| values applied to the new CI will be those that are on the item library
--| at the time of the store.  The predefined keywords person and date_in
--| will be given the appropriate values by the catalog, person being the
--| userid of the person doing the store and date_in being the current date
--| and time.
--| If the CI does not have all the required keywords on the itemlibrary
--| error messages will be reported and the store will not take place.
--| The history parameter is a field containing a description of the changes
--| made to the CI.  The description should be on a global scale rather than
--| a file by file description of the changes.  The file by file histories
--| will be handled by the item libraries.
--| In the case where there are any errors the errors will be reported and
--| the store will not take place.  However, the procedure will not stop at
--| the first error, but will continue and try to find as many errors as
--| possible.  It would have to stop in the case of a really fatal error.

procedure cancel (        --| cancel a fetch for update
    library : in SP.string_type;--| name of the library where the CI is checked
                --| out
    user    : in SP.string_type --| user that checked out the CI
    );

--| Effects: Takes the person's name from the checked out list leaving the
--| item library where it is.  The person cannot check that library in as
--| an update to anything.  Also if a person tries to create a new CI with
--| an item library that was fetched as a branch or trunk they will get an
--| error message that the should cancel the fetch first if they are still
--| on the list as having it checked out.  If they are not on any lists
--| there would not be any problem.

procedure fetch (        --| Fetches the specified configuration item
                --| and places it in the given item_library
    CI_name : in SP.string_type;--| name of the CI to fetch
    library : in SP.string_type;--| name of the item_library to put the CI in
    dir        : in SP.string_type;--| where to put the item_library
    mode    : in LD.fetch_type    --| whether the fetch is for updating or not
    := LD.no_update
    );

--| Effects: Makes a copy of the specified CI in the given item library.
--| If the mode is branch or trunk the user may modify the files in the
--| item library and store them back in the catalog as a new version of
--| the CI.  Trunk and branch indicate updating the CI along different
--| paths.  The trunk is the main path along which updates take place,
--| a branch is an update which begins another path.  Only one person
--| can update the trunk at any time, but there can be any number of
--| branches.  If the CI_name is just the identifier part with out a version
--| number, it is assumed that a trunk update would just be a fetch of the
--| most recent version along the main trunk.    A branch would be a branch
--| from the same CI.  Once a branch is started however, it begins another
--| minor trunk, from which the user can also update along the trunk or
--| branch.  To specify a fetch of one of these CIs the CI_name needs to
--| include a version number.  It is an error to try and fetch as a trunk
--| a CI which is not the most recent CI along the trunk.  If the mode
--| is not update, trying to store the CI in the catalog later will
--| result in an error.  The only user who can store a CI is the user who
--| fetched it from the catalog in the first place.


procedure modify_property (    --| modify the value associated with a property
                --| for a given CI
    CI_name : in SP.string_type;--| the name of the CI to change
    keyword : in SP.string_type;--| the name of the keyword to modify
    value   : in SP.string_type    --| the new value to give the keyword
    );

--| Effects: Modifies the value associated with a particular keyword on
--| the specified CI.  If the keyword is not already a keyword on that CI
--| it will be added with the given value.  If it does already exist on that
--| CI the value will be changed.  If, however, the value is the empty
--| string the keyword will be removed from that CI.

function get_property (        --| get the value associated with a particular
                --| property for a given CI
    CI_name : in SP.string_type;--| name of the CI to give the info about
    keyword : in SP.string_type    --| name of the keyword for the property
    ) return SP.string_type;

--| Effects: Returns the value associated with the keyword  for that CI.
--| The keyword may not contain any wild cards.  It recognises both
--| user defined keywords and the predefined ones, creator, date.

function history (        --| return the history of a particular CI
    CI_name : in SP.string_type --| name of the CI
    ) return CD.hist_list;

--| Effects: returns a list which is the history of the given CI.  Each
--| element of the list is the creator, date and description of the changes
--| given for a predecessor of the named CI.

function list_versions (    --| return a list of the different versions of
                --| a ci given an incomplete ci_id
   ci_name : in SP.string_type    --| incomplete ci_id
   ) return SL.list;

--| Effects:  Returns a list of the versions of a CI given a name.
--| If the list is of trunk updates then the ci_id should be incomplete and
--| the program will show all trunk updates on that branch.  If a list
--| of branches is what is needed then the ci_id should be complete and
--| a list of the branches from that ci will be shown.

function list_components (    --| list the components of a given CI
    CI_name : in SP.string_type --| name of the CI
    ) return LD.LL.list;

--| Effects: Returns a list that is all the components of the given CI.

function match_keys (        --| match keywords in a list to the
                --| keywords on a CI and return the list
    CI_name : in SP.string_type;--| name of the CI
    key_list : in SL.list    --| keywords list
    ) return PS.set;

--| Effects: Reads each of the elements of the list (which could have
--| wild cards) and matches them to all the properties on the given
--| CI.  Returns the set of matched properties which includes the value
--| as well as the keyword.

-- Operations for libuser's use
-- get_hif_file_name        returns a hif file name for the given CI

function get_hif_file_name (     --| return the hif file name for a CI item
   catalog : in SP.string_type;    --| name of the catalog
   CI_name : in SP.string_type;    --| name of the CI
   item    : in SP.string_type  --| name of the item in the CI
   ) return SP.string_type;

--| Effects: Returns the internal hif name for a CI item.  The item  is
--| identified by first giving the CI_id and then the item name.

function ci_date_time (        --| return the date and time a CI was
                --| created.
   catalog : in SP.string_type;    --| name of the catalog
   name    : in SP.string_type;    --| name part of the CI id
   version : in SP.string_type    --| version part of the ci id
   ) return SP.string_type;

--| Effects: Returns the date stored at the time of creation.

-- Operations to allow a privileged user to clean up the database:
-- remove_lock (*)        removes a temporary lock on a CI
-- delete (*)            delete a CI

procedure remove_lock (        --| remove a temporary lock that was left
                --| behind by an aborted process
    name : in SP.string_type;    --| name of the thing to be unlocked
    lock : in lock_type;    --| type of lock read or write
    node_name : in SP.string_type; --| Name of the node to be unlocked
    node : in node_type        --| type of node, CI or index
    );
    --| Raises: no_lock

--| Effects: Removes a lock from a node.  The lock should be one that is
--| not for a current process, but there is no way for the catalog manager
--| to check this.  However, to try and protect this operation somewhat, it
--| is a privileged operation and therefore can only be performed by someone
--| who ought to know better than to remove the lock belonging to a current
--| process.  The lock can be on either a CI or an index.  In both cases the
--| lock may be a read lock or a write lock.  With a read lock it should be
--| safe to just remove the lock.  With a write lock it may be necessary to
--| find out what was being written so that the user can tell whether it
--| was actually written or not.  The information put in with a writing
--| operation that was aborted should probably be deleted, but that is up
--| to the discretion of the super user.

procedure delete (        --| delete a CI from the catalog
    CI_name : in SP.string_type;--| name of the CI to delete
    mode    : in delete_type    --| type of delete being done
    := clean_up
    );

--| Effects: Delete a CI from the catalog.  Since CI's are supposed to be
--| almost permanent this is a privileged operation.  In this way only
--| someone cleaning up the database would be allowed to delete CI's.


end catalog_manager;
::::::::::::::
chconsist.ada
::::::::::::::

--------- SPEC ----------------------------------------------------------

function check_consistency return INTEGER;

--------- BODY ----------------------------------------------------------

with Standard_Interface;
with Tool_Identifier;
with String_Pkg;
with Host_Lib;
with paginated_output;
with catalog_interface;

function check_consistency return INTEGER is

    package SP renames String_Pkg;
    package CI renames catalog_interface;
    package SI renames Standard_Interface;

    package input is new SI.String_Argument(        -- instantiate with
    String_Type_Name => "string");            -- subtype string


    process      : SI.Process_Handle;    -- handle to process structure
    catalog     : SP.string_type;    -- name of the catalog
    output     : SP.string_type;    -- name of the output file

begin

    SI.set_tool_identifier (Tool_Identifier);
    SI.Define_Process(            -- define this process
    Name    => "check_consistency",    -- name of the process
    Help    => "Check the consistency of the information in a catalog",
    Proc    => process);        -- handle to be returned

    Input.Define_Argument(    -- define the first argument
    Proc => Process,        -- process
    Name => "catalog_name",        -- name of the argument
    Help => "Name of the catalog to be checked");

    Input.Define_Argument(    -- define the second argument
    Proc => Process,        -- process
    Name => "output_file",        -- name of the argument
    Help => "Name of the output file for the consistency report");

    SI.define_help (process,
    "Produces a report of the consistency of a given catalog");
    SI.append_help (process,
    "The checks include: ");
    SI.append_help (process,
    "Checking that the information on a CI matches the information in");
    SI.append_help (process,
    "        the index.");
    SI.append_help (process,
    "Checking that CIs are complete.");
    SI.append_help (process,
    "Checking that all the locks are current.");
    SI.append_help (process,
    "Checking that there is only one password");
    SI.append_help (process,
    "The user must be a document manager system user to use this tool");
    SI.append_help (process,
    "(see Add_User). ");

    SI.Parse_Line(Process);        -- parse the command line

    catalog := Input.Get_Argument(    -- get the first argument
            Proc => Process,
            Name => "catalog_name");

    output := Input.Get_Argument(    -- get the second argument
            Proc => Process,
            Name => "output_file");

    SI.Define_Output(                -- define paginated output
    Proc      => process,            -- process
    File_Name => SP.Value(Output));        -- file name

    CI.check_consistency (catalog, output);

    SI.Undefine_Process(Proc => Process);    -- destroy the process block

    return Host_Lib.Return_Code(Host_Lib.SUCCESS);-- return successful return code

exception

    when SI.Process_Help =>
    --
    -- Help message was printed
    --
    return Host_Lib.Return_Code(Host_Lib.INFORMATION);

    when SI.Abort_Process =>
    --
    -- Parse error
    --
    return Host_Lib.Return_Code(Host_Lib.ERROR);

    when Paginated_Output.File_Already_Open =>
    --
    -- Process output file error
    --
    return Host_Lib.Return_Code(Host_Lib.ERROR);

    when Paginated_Output.File_Error =>
    --
    -- Process output file error
    --
    return Host_Lib.Return_Code(Host_Lib.ERROR);

end check_consistency;
::::::::::::::
ciid.bdy
::::::::::::::
with string_utilities;

package body ci_ids is

--| Overview
--|
--| A ci_id is an idenitfier that uniquely identifies a configuration item (CI)
--| It has two parts: a name which is an Ada identifier and a version number.
--| The syntax for a ci_id follows:
--| -
--| ci_id     ::= name version
--| name      ::= letter [[underline] letter_or_digit]
--| letter_or_digit ::= letter | digit
--| version     ::= [number . number .] number
--| number     ::= digit [digit]
--| +
--| The name of a ci_id will identify all CIs which are versions derived from
--| a single parent.  The version uniquely identifies which version among
--| those is being referred to.

---- package renames and uses:

package SU renames string_utilities;
use SP;                    -- for "&" infix notation

---- Package instantiations:
package SS is new SU.generic_string_utilities(SP.string_type,
                          SP.make_persistent,
                          SP.value);

---- Local type declarations:

type compare_type is (less, same, more);

---- Local subprogram declarations:


function compare (        --| Compare two version lists
    v1 : in v_list;        --| first list
    v2 : in v_list        --| second version list
    ) return compare_type;

--| Effects: compares two version lists.  If the first is less than the
--| second it returns LESS, if they are equal it returns SAME,
--| and if it is greater compare returns MORE.

function parse_dotted_num (    --| parse the version number from an input
                --| string
    s : in SU.scanner        --| input string
    ) return v_list;

--| Effects: Parses the remainder of the string (after the identifier is
--| stripped off) for a valid version number.  It is a dotted number which
--| should have and odd number of components.

function make_hif_path (    --| create a hif path from the ci name and
                --| the ci version
    name    : in SP.string_type;
    version : in v_list
    ) return SP.string_type;

--| Effects: Creates a hif path for the node refered to by this ci_id.
--| The path is relative to the root node of the catalog.  So this
--| path will only work when the current node is set to be the current
--| catalog node.

---- Global Operations:

    function get_ci_id (    --| returns a ci_id from a string in the right
                --| format
    s : in string        --| string to parse for a ci_id
        ) return ci_id_type is
    --| Raises: invalid_ci_id

    --| Effects: Reads in a string and parses it into a ci_id_type.  All
    --| characters
    --| up to a space are considered the name.  Characters following the space
    --| will be interpreted as the version.  If the string
    --| cannot be interpreted in this way the exception invalid_ci_id is
    --| raised.  Numbers before the space will be a part of the name string.
    --| For this reason there must be a space between the name part and the
    --| version.
    scan  : SU.scanner;
    ci_id : ci_id_type;
    found : boolean;
    skip  : boolean := true;

    begin
        ci_id.quoted := SP.make_persistent (s);
        -- save a copy of the id as input for writing out

        scan := SS.make_scanner (ci_id.quoted);
        SS.scan_ada_id (scan, found, ci_id.name, skip);
        -- scan the string for an ada identifier which is the ci name
         -- if there isn't an identifier raise invalid_ci_id
        if not found then
        raise invalid_ci_id;
        end if;
        ci_id.name := SP.make_persistent (SP.upper (ci_id.name));
        -- the name has to be upper for testing of equality

        ci_id.version := parse_dotted_num (scan);
        -- parse_dotted_num raises invalid_ci_id if the version is not
        -- in the right format.

        ci_id.hif_path := make_hif_path (ci_id.name, ci_id.version);
        return ci_id;
    end get_ci_id;

    function get_ci_id (    --| returns a ci_id from a string in the right
                --| format
    s : in SP.string_type    --| string to parse for a ci_id
        ) return ci_id_type is
    --| Raises: invalid_ci_id

    scan  : SU.scanner;
    ci_id : ci_id_type;
    found : boolean;
    skip  : boolean := true;

    begin
        -- Every thing is basically the same as above, only I don't
        -- need to make the input a string type before starting because
        -- it already is one.
        ci_id.quoted := SP.make_persistent (s);
        scan := SS.make_scanner (ci_id.quoted);
        SS.scan_ada_id (scan, found, ci_id.name, skip);
        if not found then
        raise invalid_ci_id;
        end if;
        ci_id.name := SP.make_persistent (SP.upper (ci_id.name));
        ci_id.version := parse_dotted_num (scan);
        -- parse_dotted_num raises invalid_ci_id if the version is not
        -- in the right format.
        ci_id.hif_path := make_hif_path (ci_id.name, ci_id.version);
        return ci_id;
    end get_ci_id;

    function  image (        --| returns a string representation
                --| of a ci_id_type
    n : in ci_id_type    --| ci_id_type to translate
    ) return string is

    --| Effects: Takes a ci_id_type and translates it into a string
    --| in the ci_id format.
    begin
        return SP.value (n.quoted);
    end image;

    function  image (        --| returns a string representation
                --| of a ci_id_type
    n : in ci_id_type    --| ci_id_type to translate
    ) return SP.string_type is

    --| Effects: Takes a ci_id_type and translates it into a string
    --| in the ci_id format.
    begin
        return n.quoted;
    end image;

    function get_name (        --| returns the string which is the name
                --| part of a ci_id_type
      n : in ci_id_type
    ) return string is

    --| Effects: Takes a ci_id_type and returns the name part as a string.
    begin
        return SP.value (n.name);
    end get_name;

    function get_name (        --| returns the string which is the name
                --| part of a ci_id_type
      n : in ci_id_type
    ) return SP.string_type is

    --| Effects: Takes a ci_id_type and returns the name part as a string_type.
    begin
        return n.name;
    end get_name;

    function get_version(    --| returns the string which is the version
                --| part of a ci_id_type
      n : in ci_id_type
    ) return string is

    --| Effects: Takes a ci_id_type and returns the version number as a string.

    i : VL.listiter := VL.makelistiter (n.version);
    s : SP.string_type;
    num : integer;

    begin
        -- There always has to be at least one component in the
        -- version list, so start the string with that one and loop
        -- for the rest.
        -- don't worry about there being an odd number of components in
        -- the id because that would have been checked when it was made
        -- a ci id type
        SP.mark;
        VL.next (i, num);
        s := SS.image (num);
        loop
        exit when not VL.more (i);
        VL.next (i, num);
        s := s & "." & SS.image(num);
        end loop;
        declare
        new_s : string (1..SP.length(s));
        begin
        new_s := SP.value (s);
        SP.release;
        return new_s;
        end;
    end get_version;

    function get_version(    --| returns the string which is the version
                --| part of a ci_id_type
      n : in ci_id_type
    ) return SP.string_type is

    --| Effects: Takes a ci_id_type and returns the version number as a
    --| string_type.

    i : VL.listiter := VL.makelistiter (n.version);
    s : SP.string_type;
    s1 : SP.string_type;
    num : integer;

    begin
        -- There always has to be at least one component in the
        -- version list, so start the string with that one and loop
        -- for the rest.
        SP.mark;
        VL.next (i, num);
        s := SS.image (num);
        while VL.more (i) loop
        VL.next (i, num);
        s := s & "." & SS.image(num);
        end loop;
        s := SP.make_persistent(s);
        SP.release;
        -- I don't want to return a persistent string because it will
        -- probably never be flushed, so I create a new string (after the
        -- release for this procedure) that is the same as the other
        -- and explicitly flush the first string.  The second
        -- non-persistent string is returned.
        s1 := SP.create (SP.value (s));
        SP.flush (s);
        return s1;
    end get_version;

    function get_version(    --| returns the string which is the version
                --| part of a ci_id_type
      n : in ci_id_type
    ) return VL.list is

     begin
    return n.version;
     end get_version;

    --| Effects: Takes a ci_id_type and returns the version number as a list.

    function get_hif_path (    --| returns a string which is a valid hif
                --| path string for this ci.
        n : in ci_id_type
    ) return string is

    --| Effects: Takes a ci_id_type and returns the hif path for the node
    --| which corresponds to the hif node for this ci.
    begin
        return SP.value (n.hif_path);
    end get_hif_path;

    function get_hif_path (    --| returns a string which is a valid hif
                --| path string for this ci.
        n : in ci_id_type
    ) return SP.string_type is

    --| Effects: Takes a ci_id_type and returns the hif path for the node
    --| which corresponds to the hif node for this ci.
    begin
        return n.hif_path;
    end get_hif_path;

    function increment_ci_id (    --| returns a ci_id that is one more than
                --| the given ci_id assuming no branching.
    id : in ci_id_type    --| ci_id to increment
    ) return ci_id_type is

    --| Effects:  Increments the version of the ci_id.  So for example,
    --| if the ci_id was "abs 1.1.1" the new one would be "abs 1.1.2".
    --| It always just increments the last number in the tuple.
    ver   : SP.string_type;
    start : positive := 1;
    index : natural;
    len   : natural;
    last  : natural;
    begin
    ver := get_version (id);
    if SP.match_c (ver, '.', start) /= 0 then
        loop
        index := match_c (ver, '.', start);
        exit when index = 0;
        start := index + 1;
        end loop;
        -- start is now at the character past the last '.'
        len := SP.length(ver);
        last := SU.value (SP.value(SP.substr (ver,
                              start,
                              (len-start)+1))) + 1;
        return (get_ci_id(string'(get_name (id)) & " "
                        & SP.value (SP.substr(ver,
                              1,
                               len-(len-(start-1))))
                        & SU.image(last)));
    else
        return (get_ci_id (string'(get_name(id)) & " "
                       & SU.image((SU.value(SP.value(ver)))
                              + 1)));
    end if;
    end;

    function equal (        --| returns true if the two ci_id_types
                --| are equal
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean is

    --| Effects: compares the names and versions of each ci_id_type and
    --| returns true if both parts are the same.
    begin
        return (SP.equal (n1.name, n2.name) and
                (compare (n1.version, n2.version) = same));
    end equal;

    function similar (        --| returns true if the name part of
                --| the ci_id_types are the same.  The versions
                --| may be different
    n1 : in ci_id_type;
    n2 : in ci_id_type
         ) return boolean is

    --| Effects: Compares the names of each ci_id_type and returns true
    --| if they are the same.  In this way you can find out if two ci_id_types
    --| refer to different versions of the same CI.
    begin
        return SP.equal (n1.name, n2.name);
    end similar;

    function "<" (        --| returns true if name1 is less than name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean is

    --| Effects: compares the two ci_id_types given and returns true if name1
    --| is less than name2.  The name part is compared lexicographically,
    --| and the version number is compared in the following manner:
    --| compare each integer component of the versions in turn, the first
    --| version to have a number less than the other in the same component
    --| of the versions is the lower number.  A null component is less than
    --| anything. For example:
    --| 1 < 1.1.1 < 1.1.4 < 1.2.1 < 2.1.1 < 2.1.6 < 2.4.1
    begin
        if not SP.equal (n1.name, n2.name) then
        return SP."<"(n1.name, n2.name);
        else
        return (compare (n1.version, n2.version) = less);
        end if;
    end "<";

    function ">" (        --| returns true if name1 is greater than name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean is

    --| Effects: Compares two ci_id_types and returns true if the first one is
    --| greater than the second. The rules for comparison are discussed above.
    begin
        if not SP.equal (n1.name, n2.name) then
        return not SP."<="(n1.name, n2.name);
        else
        return (compare (n1.version, n2.version) = more);
        end if;
    end ">";

    function "<=" (        --| returns true if name1 is less than or
                --| equal to name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean is

    --| Effects: Compares two ci_id_types and returns true if the first one is
    --|  less than or equal to the second.  Rules for comparison are above.
    begin
        if not SP.equal (n1.name, n2.name) then
        return SP."<="(n1.name, n2.name);
        else
        return (compare (n1.version, n2.version) = less or
            compare (n1.version, n2.version) = same);
        end if;
    end "<=";

    function ">=" (        --| returns true if name1 is greater than or
                --| equal to name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean is

    --| Effects: Compares two ci_id_types and returns true if the first one is
    --| greater than or equal to the second.  Rules for comparison are above.
    begin
        if not SP.equal (n1.name, n2.name) then
        return not SP."<"(n1.name, n2.name);
        else
        return (compare (n1.version, n2.version) = more or
            compare (n1.version, n2.version) = same);
        end if;
    end ">=";

---- Local Subprogram bodies:

function compare (        --| Compare two version lists
    v1 : in v_list;        --| first list
    v2 : in v_list        --| second version list
    ) return compare_type is

    i1 : VL.listiter := VL.makelistiter (v1);
    i2 : VL.listiter := VL.makelistiter (v2);
    num1 : integer;
    num2 : integer;

    -- compare returns less if v1 < v2, same if v1 = v2 and more if v1 > v2
    begin
    -- first check for a simple case of comparing numbers to see if
    -- one is less than the other.  As long as they're equal go on to
    -- the next one in the version.
    while VL.more (i1) and VL.more (i2) loop
        VL.next (i1, num1);
        VL.next (i2, num2);
        if num1 < num2 then
        return less;
        elsif num1 > num2 then
        return more;
        end if;
    end loop;
    -- At this point either one of the lists has run out of numbers in
    -- the version list (in which case it is less), or both of them
    -- have run out of version numbers (in which case they're equal).
    if VL.more (i1) and not VL.more (i2) then
        --  i1 is greater
        return more;
    elsif not VL.more (i1) and VL.more (i2) then
        -- i2 is greater
        return less;
    else    -- they are equal
        return same;
    end if;
    end compare;

function parse_dotted_num (    --| parse the version number from an input
                --| string
    s : in SU.scanner        --| input string
    ) return v_list is

    found  : boolean;
    skip   : boolean := true;
    result : integer;
    char   : character;
    odd       : boolean := false;
    ver       : v_list := VL.create;

    --| Algorithm: The format of a dotted number is an odd number of
    --| integer components separated by periods.  It must begin and end
    --| with an integer.  So the plan is to scan the first number as there
    --| must always be at least one for it to be valid, and add that to
    --| the list.  If the first scan number fails raise invalid_ci_id.
    --| flip the odd indicator and then begin to loop. As long as the
    --| next character is a space continue to loop.  If it's a period
    --| recursively call parse_dotted_num to get the next number, and
    --| if it's anything else raise invalid ci id.
    begin
    loop
        SU.scan_number (s, found,  result, skip);
        if not found then
            raise invalid_ci_id;
        end if;
        odd := not odd;
            VL.attach (ver, result);
        exit when not SU.more (s);
        SU.next (s, char);
        if char /= '.' then
        raise invalid_ci_id;
        end if;
    end loop;
    if not odd then
        raise invalid_ci_id;
    end if;
    return ver;
    end parse_dotted_num;

function make_hif_path (    --| create a hif path from the ci name and
                --| the ci version
    name    : in SP.string_type;
    version : in v_list
    ) return SP.string_type is

    temp : SP.string_type;
    path : SP.string_type;
    iter : VL.listiter := VL.makelistiter (version);
    num  : integer;
    begin
    SP.mark;
    temp := SP.create ("'current_node'ci_root(");

    -- Note that for parse dotted num to have completed sucessfully there
    -- has to have been at least one number in the list so begin the hif
    -- path with that one and then do the rest in pairs.
    temp := temp & name & ")";
    VL.next (iter, num);
    temp := temp & "'trunk(v" & SS.image(num) & ")";
    while VL.more (iter) loop
        -- we can do both a trunk and a branch at the same time because
        -- there has to be an odd number of components to the version
        -- number.
        VL.next (iter, num);
        temp := temp & "'branch(v" & SS.image(num) & ")";
        VL.next (iter, num);
        temp := temp & "'trunk(v" & SS.image(num) & ")";
    end loop;
    path := SP.make_persistent (temp);
    SP.release;
    return path;
    end make_hif_path;

end ci_ids;
::::::::::::::
ciid.spc
::::::::::::::
with string_pkg;
with version_lists;

package ci_ids is

--| Overview
--|
--| A ci_id is an idenitfier that uniquely identifies a configuration item (CI)
--| It has two parts: a name which is an Ada identifier and a version number.
--| The syntax for a ci_id follows:
--| -
--| ci_id     ::= name version
--| name      ::= letter [[underline] letter_or_digit]
--| letter_or_digit ::= letter | digit
--| version     ::= [number . number .] number
--| number     ::= digit [digit]
--| +
--| The name of a ci_id will identify all CIs which are versions derived from
--| a single parent.  The version uniquely identifies which version among
--| those is being referred to.

    package SP renames string_pkg;
    package VL renames version_lists;
    subtype v_list is VL.list;

    type ci_id_type is private;

    invalid_ci_id : exception;        -- raised when a string has the wrong
                    -- format

    function get_ci_id (    --| returns a ci_id from a string in the right
                --| format
    s : in string        --| string to parse for a ci_id
        ) return ci_id_type;
    --| Raises: invalid_ci_id

    --| Effects: Reads in a string and parses it into a ci_id_type.  All
    --| characters
    --| up to a space are considered the name.  Characters following the space
    --| will be interpreted as the version.  If the string
    --| cannot be interpreted in this way the exception invalid_ci_id is
    --| raised.  Numbers before the space will be a part of the name string.
    --| For this reason there must be a space between the name part and the
    --| version.

    function get_ci_id (    --| returns a ci_id from a string in the right
                --| format
    s : in SP.string_type    --| string to parse for a ci_id
        ) return ci_id_type;
    --| Raises: invalid_ci_id

    --| Effects: Reads in a string_type and parses it into a ci_id_type.  All
    --| characters
    --| up to a space are considered the name.  Characters following the space
    --| will be interpreted as the version.  If the string
    --| cannot be interpreted in this way the exception invalid_ci_id is
    --| raised.  Numbers before the space will be a part of the name string.
    --| For this reason there must be a space between the name part and the
    --| version.

    function  image (        --| returns a string representation
                --| of a ci_id_type
    n : in ci_id_type    --| ci_id_type to translate
    ) return string;

    --| Effects: Takes a ci_id_type and translates it into a string
    --| in the ci_id format.

    function  image (        --| returns a string representation
                --| of a ci_id_type
    n : in ci_id_type    --| ci_id_type to translate
    ) return SP.string_type;

    --| Effects: Takes a ci_id_type and translates it into a string
    --| in the ci_id format.

    function get_name (        --| returns the string which is the name
                --| part of a ci_id_type
      n : in ci_id_type
    ) return string;

    --| Effects: Takes a ci_id_type and returns the name part as a string.

    function get_name (        --| returns the string which is the name
                --| part of a ci_id_type
      n : in ci_id_type
    ) return SP.string_type;

    --| Effects: Takes a ci_id_type and returns the name part as a string.

    function get_version(    --| returns the string which is the version
                --| part of a ci_id_type
      n : in ci_id_type
    ) return string;

    --| Effects: Takes a ci_id_type and returns the version number as a string.

    function get_version(    --| returns the string which is the version
                --| part of a ci_id_type
      n : in ci_id_type
    ) return SP.string_type;

    --| Effects: Takes a ci_id_type and returns the version number as a string.

    function get_version(    --| returns the string which is the version
                --| part of a ci_id_type
      n : in ci_id_type
    ) return VL.list;

    --| Effects: Takes a ci_id_type and returns the version number as a list.

    function get_hif_path (    --| returns a string which is a valid hif
                --| path string for this ci.
        n : in ci_id_type
    ) return string;

    --| Effects: Takes a ci_id_type and returns the hif path for the node
    --| which corresponds to the hif node for this ci.

    function get_hif_path (    --| returns a string which is a valid hif
                --| path string for this ci.
        n : in ci_id_type
    ) return SP.string_type;

    --| Effects: Takes a ci_id_type and returns the hif path for the node
    --| which corresponds to the hif node for this ci.

    function increment_ci_id (    --| returns a ci_id that is one more than
                --| the given ci_id assuming no branching.
    id : in ci_id_type    --| ci_id to increment
    ) return ci_id_type;

    --| Effects:  Increments the version of the ci_id.  So for example,
    --| if the ci_id was "abs 1.1.1" the new one would be "abs 1.1.2".
    --| It always just increments the last number in the tuple.

    function equal (        --| returns true if the two ci_id_types
                --| are equal
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean;

    --| Effects: compares the names and versions of each ci_id_type and
    --| returns true if both parts are the same.

    function similar (        --| returns true if the name part of
                --| the ci_id_types are the same.  The versions
                --| may be different
    n1 : in ci_id_type;
    n2 : in ci_id_type
         ) return boolean;

    --| Effects: Compares the names of each ci_id_type and returns true
    --| if they are the same.  In this way you can find out if two ci_id_types
    --| refer to different versions of the same CI.

    function "<" (        --| returns true if name1 is less than name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean;

    --| Effects: compares the two ci_id_types given and returns true if name1
    --| is less than name2.  The name part is compared lexicographically,
    --| and the version number is compared in the following manner:
    --| compare each integer component of the versions in turn, the first
    --| version to have a number less than the other in the same component
    --| of the versions is the lower number.  A null component is less than
    --| anything. For example:
    --| 1 < 1.1.1 < 1.1.4 < 1.2.1 < 2.1.1 < 2.1.6 < 2.4.1

    function ">" (        --| returns true if name1 is greater than name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean;

    --| Effects: Compares two ci_id_types and returns true if the first one is
    --| greater than the second. The rules for comparison are discussed above.

    function "<=" (        --| returns true if name1 is less than or
                --| equal to name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean;

    --| Effects: Compares two ci_id_types and returns true if the first one is
    --|  less than or equal to the second.  Rules for comparison are above.

    function ">=" (        --| returns true if name1 is greater than or
                --| equal to name2
    n1 : in ci_id_type;
    n2 : in ci_id_type
        ) return boolean;

    --| Effects: Compares two ci_id_types and returns true if the first one is
    --| greater than or equal to the second.  Rules for comparison are above.

  private


    -- the ci_id_type type is a record which keeps the different
    -- representations of the ci_id_type in its fields.
    -- The first two fields together make up the
    -- ci_id.  name is the name part of the ci_id and version is a list of
    -- the version numbers.  quoted is the ci_id as a plain old string.
    -- hif_path is a string representing the hif pathname for the node this
    -- ci_id refers to.

    type ci_id_type is
    record
    name       : SP.string_type;
    version   : v_list;
    quoted    : SP.string_type;
        hif_path  : SP.string_type;
    end record;

end ci_ids;
::::::::::::::
ciindex.bdy
::::::::::::::
with Hif_node_defs;    use Hif_node_defs;    -- for definitions of types
with hif_attributes;
with Hif_node_management;
with Hif_list_utils;
with hif_utils;
with catalog_locks;

package body ci_index_mgr is

--| Overview
--|
--| This package provides the interface to the keyword index of a catalog.
--| The index relies on the fact that there are a limited number of
--| keywords allowed.  For each keyword there are unlimited values, so a
--| configuration item in the catalog will be associated with a keyword and
--| a value for that keyword.  This interface handles putting this information
--| in the index and looking it up given the keyword and value to look
--| under.
--| The operations possible are:
--| -
--| define_keyword    adds a keyword to the set of keywords
--| list_keywords    list all the keywords and their statuses
--| add_ci        adds a CI to the index under it's keyword,value
--| delete_ci        deletes a CI from the list of CI's for a keyword,value
--| lookup_ci        returns a set of CI's which all have the same
--|            keyword,value.
--| is_keyword        checks that a string is a keyword
--| is_required_keyword checks that a string is a required keyword
--| is_valid_keyword    checks that a string is a valid keyword
--| check_required    checks that the given set of keywords includes all
--|             required ones
--| lock_index        lock a particular index for read or write
--| unlock_index    unlock an index
--| is_locked        checks whether an index is locked
--| +

  use string_pkg;    -- used only to allow infix notation of &
  use catalog_decls;    -- used so CI_sets operations aren't CD.CI_sets.op ();
  package Attr renames Hif_attributes;
  package ND renames Hif_node_defs;
  package NM renames Hif_node_management;
  package LU renames Hif_list_utils;
  package SS renames CD.string_sets;
  package HU renames hif_utils;
  package CL renames catalog_locks;

procedure define_keyword (    --| add a new keyword to the index set
    keyword : in SP.string_type;--| the keyword to add
    status  : in proper_status    --| the status the keyword has.
    := optional
    ) is

    path : SP.string_type;
    list : LU.list_type;
    wait : duration := 0.0;

    begin
    --| Algorithm
    --| Add the keyword to the root node with the given status.  If it is not
    --| already a keyword (ie this can be used to change the status of a
    --| keyword) then make a node for it off the database node.
    --| note that the current_node is the root node, so everything can be done
    --| relative to this.
    LU.init_list (list);
    SP.mark;
    if CL.upgrade_lock (wait) then
        --? lock index, with a write lock (or lock catalog)
        if not is_keyword (keyword) then
        begin
                NM.create_node (
               SP.value ("'current_node'index(" & keyword & ")"));
        exception when  ND.name_error =>
            CL.remove_write;
            raise invalid_keyword;
        end;
        end if;
            LU.add_positional (list, status_type'image(status));
         Attr.set_node_attribute(current_node,
                    SP.value(keyword),
                    list);
        CL.remove_write;
        --? unlock
    else
        raise unable_to_lock;
    end if;
    SP.release;
    end define_keyword;


function list_keywords        --| List the set of keywords indicating
                --| what the status of the keyword is.
    return SL.list is

    --| Algorithm:  Iterate over the attributes on the root node putting them
    --| in a list with their status.

    list : SL.list;
    iter : Attr.attrib_iterator;
    attrib : Attrib_name (1..256);
    attrib_last : natural;
    value  : LU.list_type;
    keyword : SP.string_type;

    begin
    -- make an iterator with the pattern to match being the default '*'
    --? read lock on the catalog
    Attr.node_attribute_iterate(iter, current_node);
    while Attr.more (iter) loop
        Attr.get_next (iter, attrib, attrib_last, value);
        keyword := SP.create (attrib(1..attrib_last) & " "
                 & LU.list_image(value));
        SL.attach (list, keyword);
    end loop;
    --? unlock
    return list;

    end list_keywords;


procedure add_ci (        --| add a CI under it's appropriate
                --| keyword,value
    keyword : in SP.string_type;--| the keyword to put it under
    value   : in SP.string_type;--| the value to put it under
    CI_name : in ID.ci_id_type  --| the CI's name
    ) is

    keywd_path : SP.string_type;
    list : LU.list_type;
    begin
    --| Algorithm
    --| The way to store the data (considering that the values of attribs
    --| are Hif lists and very inconvenient) is to first get the value of
    --| the attrib as a hif list and then to add the new CI to the list
    --| and finally put it back as the value for the list.
    --| A ci id cannot be added with a keyword that isn't valid.  And if
    --| the value isn't an ada identifier it also fails.

    -- Note that since hif lists are completely useless there is no way
    -- to raise any kind of error if you are adding a ci id which is
    -- already on the list.  Luckily this has no effect on lookup_ci


    SP.mark;
    if is_valid_keyword (keyword) then
    --? lock index with write
    keywd_path := current_node & "'index(" & keyword & ")";
    begin
        attr.get_node_attribute (SP.value(keywd_path),
                     SP.value(value),
                     list);
        exception when ND.name_error =>
        SP.release;
        raise invalid_value;
    end;
    LU.add_positional (list,
               LU.to_item (HU.enquote (ID.image(CI_name))));
    attr.set_node_attribute (SP.value(keywd_path),
                 SP.value(value),
                 list);
    --? unlock
    else
    SP.release;
    raise invalid_keyword;
    end if;
    SP.release;

    exception
    when ND.name_error =>
        SP.release;
        raise invalid_keyword;
    end add_ci;

procedure delete_ci (        --| delete the given CI under the given
                --| keyword and value
    keyword : in SP.string_type;--| keyword to find the CI under
    value   : in SP.string_type;--| value to fine the CI under
    CI_name : in ID.ci_id_type  --| CI to delete from the list
    ) is

    keywd_path : SP.string_type;
    list : LU.list_type;
    new_list : LU.list_type;
    item : LU.item_type;
    index : LU.count;
    i : LU.count;
    begin
    --| Algorithm
    --| This is not as easy as it looks because hif lists do not have
    --| a way to delete an item.  So what we have to do is iterate over
    --| the list associated with a property.  Compare each element of the
    --| list with the ci id, and if it is not the same put it in a new list.
    --| This takes care of the case in add_ci where the same ci is added
    --| twice. There is one problem, when the ci to delete isn't in the
    --| list no error is raised.

    SP.mark;
    if is_keyword (keyword) and then not SP.equal (value, "") then
    --? lock for write
    keywd_path := current_node & "'index(" & keyword & ")";
    begin
        attr.get_node_attribute (SP.value(keywd_path),
                      SP.value(value),
                      list);
    exception when ND.name_error =>
        SP.release;
        raise invalid_value;
    end;
        LU.init_list (new_list);
    index := LU.num_positional (list);
    -- Since hif lists don't have delete item loop through the list
     -- putting the values in a new list.  If the value is the one
    -- we want to delete don't add it to the new list.
    for i in 1..index loop
        LU.get_positional (list, item, i);
        if not LU."=" (item, LU.to_item (HU.enquote(ID.image(CI_name))))
          then
        LU.add_positional (new_list, item);
        end if;
    end loop;
    attr.set_node_attribute (SP.value(keywd_path),
                 SP.value(value),
                 new_list);
    --? unlock
    else
    if not SP.equal (value, "") then
        SP.release;
        raise invalid_keyword;
    end if;
    end if;
    SP.release;

    exception when ND.name_error =>
    SP.release;
    raise invalid_keyword;
    end delete_ci;

function lookup_CI (        --| lookup the CI's associated with a
                --| particular keyword and value
    keyword : in SP.string_type;--| keyword to lookup under
    value   : in SP.string_type --| value  to lookup under
    ) return CD.CI_set is

    keywd_path : SP.string_type;
    list : LU.list_type;
    list_item : LU.item_type;
    index : LU.count;
    item : SP.string_type;
    CIs : CD.CI_set := CI_sets.create;
    begin
    SP.mark;
    --| Algorithm
    --| Get the list associated with the attribute and read it into a CI_set
    --| to return it.
    if is_keyword (keyword) then
    --? lock index for read
    keywd_path := current_node & "'index(" & keyword & ")";
    begin
        attr.get_node_attribute (SP.value(keywd_path),
                     SP.value(value),
                     list);
    exception when ND.name_error =>
        SP.release;
        raise invalid_value;
    end;
    index := LU.num_positional (list);
    for i in 1..index loop
            LU.get_positional (list, list_item, i);
          if LU.quoted_string (list_item) /= "" then
           CI_sets.insert(CIs,
                    ID.get_ci_id (
                    LU.quoted_string(list_item)));
        end if;
    end loop;
    else
    SP.release;
    raise invalid_keyword;
    end if;
    SP.release;
    --? unlock
    return CIs;

    exception when ND.name_error =>
    SP.release;
    raise invalid_keyword;

    end lookup_ci;

function is_keyword (        --| is the given string a keyword at all
    keyword : in SP.string_type --| string to look up
    ) return boolean is

    --| Algorithm: Get the value for that keyword and return true if the
    --| list returned isn't empty.
    list : LU.list_type;
    item : LU.item_type;
    begin
    SP.mark;
     Attr.get_node_attribute (current_node, SP.value(keyword), list);
    SP.release;
    return not LU.empty(list);
    exception when ND.name_error =>
    return false;
    end is_keyword;


function is_required_keyword (    --| is the given keyword a required one
    keyword : in SP.string_type --| string to look up
    ) return boolean is

    --| Algorithm: Get the value for the given key word and check its status
    list : LU.list_type;
    begin
    SP.mark;
     Attr.get_node_attribute (current_node, SP.value(keyword), list);
    SP.release;
    return (not LU.empty (list) and then
           (status_type'value(LU.identifier(LU.positional(list,1)))=required));
    exception
        when ND.name_error =>
        -- keyword probably doesn't exist and the list was null;
        SP.release;
        return false;
    end is_required_keyword;


function is_valid_keyword (    --| is the given keyword a valid one
    keyword : in SP.string_type --| string to look up
    ) return boolean is

    --| Algorithm: Get the value for the given key word and check its status
    list : LU.list_type;
    begin
    SP.mark;
     Attr.get_node_attribute (current_node, SP.value(keyword), list);
    SP.release;
    return (not LU.empty (list) and then
      ((status_type'value(LU.identifier(LU.positional(list,1))) = required)
      or else
      (status_type'value(LU.identifier(LU.positional(list,1)))=optional)));
    exception
        when ND.name_error =>
        -- keyword probably doesn't exist and the list was null;
        SP.release;
        return false;
    end is_valid_keyword;

function check_required (    --| check that the given set of keywords
                --| contains all the required ones
    set : in CD.string_set    --| set to check
    ) return CD.string_set is

    --| Algorithm: Iterate over the keywords at this time putting required
    --| ones in a set.  When the set is complete make sure that the
    --| intersection of the required set and the input set is equal to the
    --| required set.  Otherwise the input set didn't contain all the
    --| required keywords and so check_required returns false.

    iter : Attr.attrib_iterator;
    attrib : attrib_name (1..256);
    attrib_last : natural;
    list : LU.list_type;
    req_set : CD.string_set;
    union : CD.string_set;
    key : SP.string_type;
    i : SS.members_iter;

    begin
    --? lock index for read
    -- SP.mark;    -- the mark is commented because the release is after
            -- the return and so is not executed.
    Attr.Node_Attribute_Iterate (iter, current_node);
    -- let the pattern default to "*"
    while Attr.more (iter) loop
        Attr.get_next (iter, attrib, attrib_last, list);
        if status_type'value(LU.identifier(LU.positional(list,1)))
           = required then
        SS.insert (req_set, SP.create (attrib (1..attrib_last)));
        end if;
    end loop;
    union := SS.union (req_set, set);
    i := SS.make_members_iter (set);
    while SS.more (i) loop
        SS.next (i, key);
        SS.delete (union, key);
    end loop;
    return union;
        -- SP.release;    -- commented out because after the return it is no use
    --? unlock
    end check_required;

function lock_index (        --| lock the given index for read or write
    keyword : in SP.string_type;--| key for the index to lock
    lock    : in lock_type    --| kind of lock
    ) return boolean is

    --| Algorithm: This is a null program until we actually implement locking
    --| on a more complex level than just locking the whole catalog.
    begin
    return true;
    end lock_index;

function unlock_index (        --| unlock the given index
    keyword : in SP.string_type --| key for the index to unlock
    ) return boolean is

    --| Algorithm: This is a null program until we actually implement locking
    --| on a more complex level than just locking the whole catalog.

    begin
    return true;
    end unlock_index;

function is_locked (        --| returns true if the index is locked
    keyword : in SP.string_type --| key for the index to check
    ) return boolean is

    --| Algorithm: This is a null program until we actually implement locking
    --| on a more complex level than just locking the whole catalog.

    begin
    return true;
    end is_locked;

end ci_index_mgr;
::::::::::::::
ciindex.spc
::::::::::::::
with catalog_decls;
with string_pkg;
with string_lists;
with ci_ids;

package ci_index_mgr is

--| Overview
--|
--| This package provides the interface to the keyword index of a catalog.
--| The index relies on the fact that there are a limited number of
--| keywords allowed.  For each keyword there are unlimited values, so a
--| configuration item in the catalog will be associated with a keyword and
--| a value for that keyword.  This interface handles putting this information
--| in the index and looking it up given the keyword and value to look
--| under.
--| The operations possible are:
--| -
--| define_keyword    adds a keyword to the set of keywords
--| list_keywords    list all the keywords and their statuses
--| add_ci        adds a CI to the index under it's keyword,value
--| delete_ci        deletes a CI from the list of CI's for a keyword,value
--| lookup_ci        returns a set of CI's which all have the same
--|            keyword,value.
--| is_keyword        checks that a string is a keyword
--| is_required_keyword checks that a string is a required keyword
--| is_valid_keyword    checks that a string is a valid keyword
--| check_required    checks that the given set of keywords includes all
--|             required ones
--| lock_index        lock a particular index for read or write
--| unlock_index    unlock an index
--| is_locked        checks whether an index is locked
--| +

  package SP renames string_pkg;
  package CD renames catalog_decls;
  package SL renames string_lists;
  package ID renames ci_ids;

  type status_type         is (optional, required, invalid, undefined);
  subtype proper_status         is status_type range optional .. invalid;
  type lock_type          is (read, write);

  invalid_keyword : exception;    -- raised when the keyword is not valid
  invalid_value : exception;    -- raised when the value is not valid
  unable_to_lock : exception;    -- raised when the catalog cannot be locked

procedure define_keyword (    --| add a new keyword to the index set
    keyword : in SP.string_type;--| the keyword to add
    status  : in proper_status    --| the mode the keyword has.
    := optional
    );

--| Effects: defines a keyword and its status.  If the keyword already exists
--| it changes its status to the given status.  If it does not exist in the
--| catalog the keyword is added with the given status.  The possibilities for
--| status are: optional, required, and invalid.  Invalid indicates that it is
--| no longer valid to give new CI's this property when they are stored, but it
--| is still possible to select CI's with this property.  Required indicates
--| that every CI being stored must have this property.  The default is
--| optional which means the property is valid, but it is not requred
--| on every CI stored. To change an invalid keyword back to valid one
--| would just define it with the status => optional and the keyword would
--| be changed from invalid to optional.

function list_keywords         --| List the set of keywords indicating
                --| what the status of the keyword is.
    return SL.list;

--| Effects: Each of the keywords in the catalog is listed with its
--| current status.  The output is a string_list


procedure add_ci (        --| add a CI under it's appropriate
                --| keyword,value
    keyword : in SP.string_type;--| the keyword to put it under
    value   : in SP.string_type;--| the value to put it under
    CI_name : in ID.ci_id_type --| the CI's name
    );

--| Effects: Adds CI_name to the list of values for the attribute off the
--| keyword node with the name value.  If no attribute with that name
--| exists a new one is created with value as its name.

procedure delete_ci (        --| delete the given CI under the given
                --| keyword and value
    keyword : in SP.string_type;--| keyword to find the CI under
    value   : in SP.string_type;--| value to fine the CI under
    CI_name : in ID.ci_id_type  --| CI to delete from the list
    );

--| Effects: Delete the CI given from the list of names associated with the
--| value parameter under the keyword given.  Other keywords and values that
--| this CI is classified under remain the same unless changed by another
--| call to this routine explicitly naming them.

function lookup_CI (        --| lookup the CI's associated with a
                --| particular keyword and value
    keyword : in SP.string_type;--| keyword to lookup under
    value   : in SP.string_type --| value  to lookup under
    ) return CD.CI_set;

--| Effects: Returns the set of CI's which have that keyword associated
--| with that value.

function is_keyword (        --| is the given string a keyword at all
    keyword : in SP.string_type --| string to look up
    ) return boolean;

function is_required_keyword (    --| is the given keyword a required one
    keyword : in SP.string_type --| string to look up
    ) return boolean;

function is_valid_keyword (    --| is the given keyword a valid one
    keyword : in SP.string_type --| string to look up
    ) return boolean;

function check_required (    --| check that the given set of keywords
                --| contains all the required ones
    set : in CD.string_set    --| set to check
    ) return CD.string_set;

--| Effects: Returns true if all the required keywords are included in the
--| given set.

function lock_index (        --| lock the given index for read or write
    keyword : in SP.string_type;--| key for the index to lock
    lock    : in lock_type    --| kind of lock
    ) return boolean;

--| Effects: Tries to lock the given index with the type of lock specified.
--| Normal completion will return true.  If the lock cannot be set the
--| function will return false.

function unlock_index (        --| unlock the given index
    keyword : in SP.string_type --| key for the index to unlock
    ) return boolean;

--| Effects: Unlocks the index indicated and returns true if it completes
--| successfully.  If the person does not own the lock or if the index is
--| not locked false will be returned.

function is_locked (        --| returns true if the index is locked
    keyword : in SP.string_type --| key for the index to check
    ) return boolean;

--| Effects: Returns true if the index is locked false other wise.

end ci_index_mgr;
::::::::::::::
command.bdy
::::::::::::::
with rd_parser;
with string_pkg;
with string_lists;
with standard_interface;
with tool_identifier;
with catalog_manager;    use catalog_manager;    -- for visible "="
with catalog_decls;
with ci_index_mgr;
with ci_ids;
with library_declarations;
with text_io;
with property_set;
with host_lib;
with string_utilities;
with catalog_locks;
with properties;
with Library_Manager_Interface;

package body interpret is

---- Package renames:

package SP renames string_pkg;
package SL renames string_lists;
package SI renames standard_interface;
package CM renames catalog_manager;
package CD renames catalog_decls;
package IM renames ci_index_mgr;
package ID renames ci_ids;
package LD renames library_declarations;
package PS renames property_set;
package HL renames host_lib;
package SU renames string_utilities;
package CL renames catalog_locks;

package TIO renames text_io;

---- Package instantiations:

package string_arg is new SI.string_argument("string");
package lib_name is new SI.string_argument("library_name");
package ci_arg is new SI.string_argument("ci_id");
package fetch_arg  is new SI.enumerated_argument (LD.fetch_type, "fetch_type");
package lock_arg   is new SI.enumerated_argument (CM.lock_type, "lock_type");
package node_arg   is new SI.enumerated_argument (CM.node_type, "node_type");
package update_arg is new SI.enumerated_argument (CM.ci_type, "ci_type");
package status_arg is new SI.enumerated_argument (IM.proper_status,
                          "proper_status");
package delete_arg is new SI.enumerated_argument (CM.delete_type,
                          "delete_type");
package s_list_arg is new SI.string_list_argument ("string",
                           "string_list");

package SS is new SU.generic_string_utilities(SP.string_type,
                          SP.create,
                          SP.value);


---- Type definitions:

type command is (select_cis, clear_selected_set, print_set,
    list_cis, change_password, define_keyword, list_keywords,
    create_ci, store, fetch, cancel, delete,
    modify_property, describe, history, list_versions, list_components,
    remove_lock, library_manager);

package SC is new SI.command_line (command);

procedure init_processes (processes : in out SC.process_handle_array);

procedure print_list (
    list : in  SL.list
    );

procedure print_sel_set (
    set : in CD.ci_set
    );

procedure print_string_set (
    set : in CD.string_set
    );

procedure print_property_set (
    set : in PS.set
    );

procedure print_item_list (
    set : in LD.LL.list
    );

procedure print_hist_list (
    list : in  CD.hist_list
    );

procedure print_errors ;

procedure command_interpreter is

cmd   : command;
rest  : SP.string_type;
input : string (1..256);    -- 256 is an arbitrary limit
last  : natural;

-- all the list types returned by query procedures.
s_list  : SL.list;
p_set   : PS.set;
i_list  : LD.LL.list;
h_list  : CD.hist_list;

abbreviation : SC.Command_Abbreviation_Array :=
    (select_cis         => 3,
     clear_selected_set => 2,
     print_set          => 2,
     list_cis           => 6,
     change_password    => 2,
     define_keyword     => 3,
     list_keywords      => 6,
     create_ci          => 2,
     store              => 1,
     fetch              => 1,
     cancel             => 3,
     delete             => 3,
     modify_property    => 3,
     describe           => 4,
     history            => 4,
     list_versions      => 6,
     list_components    => 7,
     remove_lock        => 3,
     library_manager    => 3);

processes  : SC.process_handle_array;
name       : SP.string_type;
key        : SP.string_type;
val        : SP.string_type;
lib        : SP.string_type;
prompt     : SP.string_type;
hist       : SP.string_type;
arg1       : SP.string_type;
arg2       : SP.string_type;
arg3       : SP.string_type;
wait       : duration := 0.0;
user1      : SP.string_type;
user2      : SP.string_type;
old_pass   : SP.string_type;
new_pass1  : SP.string_type;
new_pass2  : SP.string_type;
key_list   : SL.list;
iter       : SL.listiter;
status     : CM.status_type;
s_code     : HL.severity_code;
privileged : boolean := false;    -- flag which indicates whether the current
                -- user is privileged.  Set upon entry.

begin
    SI.set_tool_identifier (tool_identifier);
    init_processes (processes);
    SP.set_comparison_option (SP.case_insensitive);
--    SI.action_switches (SI.echo_command) := SI.off;
    SI.parsing_switches (SI.argument_enclosure) := SI.on;
    SC.define_command_abbreviation (abbreviation, Check_Conflict => TRUE);
    TIO.put ("Enter password for privileges or return for none: ");
    if CM.verify_password (SS.strip (HL.read_no_echo(""))) then
    privileged := true;
    TIO.put_line ("You are entering as a privileged user");
    else
    TIO.put_line ("You are entering as a regular user");
    end if;
    loop
    -- the loop is exited when the user enters exit to the command line.
    -- Standard_Interface raises an exception which is handled at the
    -- end of the loop and it contains the statement to exit the loop.
    begin
        TIO.new_line (1);
        TIO.put ("Catalog> ");
        TIO.get_line (input, last);
        cmd := SC.parse_command_line (processes, input(1..last));
        case cmd is
        -- for each command parse the command line even if it doesn't
        -- have any parameters just to make sure it does the syntax
        -- checking.  Of course if it does a parse_line it must do a
        -- redefine_process immediately afterwards for the next time
        -- the procedure is called.
        when select_cis =>
            SP.mark;
            arg1 := string_arg.get_argument (
                    processes(select_cis),
                    "criteria");
            begin
                rd_parser.parse (arg1);
                if CD.ci_sets.is_empty (rd_parser.current_set) then
                TIO.put_line ("Selected set is empty");
                else
                    TIO.put_line ("Selected Set:");
                    print_sel_set (rd_parser.current_set);
                end if;
            exception when rd_parser.parse_error =>
            TIO.put_line ("The syntax of the selection criteria " &
                    "is incorrect.  Try again.");
            end;
            SI.redefine_process (processes(select_cis));
            SP.flush (arg1);
            SP.release;
        when clear_selected_set =>
            SP.mark;
            SI.redefine_process (processes(clear_selected_set));
            rd_parser.clear_set;
            TIO.put_line ("Selected set cleared");
            SP.release;
        when print_set =>
            SP.mark;
            SI.redefine_process (processes(print_set));
            if CD.ci_sets.is_empty (rd_parser.current_set) then
            TIO.put_line ("Current selected set is empty");
            else
                TIO.put_line ("Current Selected Set:");
                print_sel_set (rd_parser.current_set);
            end if;
            SP.release;
        when list_cis =>
            SP.mark;
            arg1 := string_arg.get_argument (processes(list_cis),
                             "cis");
            s_list := CM.list_cis (arg1);
            if SL.isempty(s_list) then
            TIO.put_line ("Catalog is empty");
            else
                TIO.put_line ("Catalog List:");
                print_list (s_list);
            SL.destroy (s_list);
            end if;
            SI.redefine_process (processes(list_cis));
            SP.flush (arg1);
            SP.release;
        when change_password =>
            SP.mark;
            SI.redefine_process (processes(change_password));
            TIO.put ("Enter old password: ");
            old_pass := SS.strip (HL.read_no_echo(""));
            TIO.put ("Enter new password: ");
            new_pass1 := SS.strip (HL.read_no_echo(""));
            TIO.put ("Retype new password: ");
            new_pass2 := SS.strip (HL.read_no_echo(""));
            if SP.equal (new_pass1, new_pass2) then
            CM.set_password (new_pass1, old_pass);
            else
            TIO.put_line ("New password not verified, try again");
            end if;
            SP.release;
        when define_keyword =>
            SP.mark;
            if privileged then
            begin
                key := string_arg.get_argument
                        (processes(define_keyword),
                          "keyword");
                    IM.define_keyword (key,
                                   status_arg.get_argument
                        (processes(define_keyword),
                          "status"));
                TIO.put_line ("Defined keyword " & SP.value(key));
                SP.flush (key);
            exception when IM.unable_to_lock =>
                TIO.put_line ("Catalog cannot be locked for " &
                        "this operation");
                SP.flush (key);
            end;
            else
                raise CM.invalid_password;
            end if;
            SI.redefine_process (processes(define_keyword));
            SP.release;
        when list_keywords =>
            SP.mark;
            SI.redefine_process (processes(list_keywords));
            s_list := IM.list_keywords;
            if SL.isempty (s_list) then
            TIO.put_line ("No keywords are defined");
            else
                TIO.put_line ("Catalog Keywords:");
                print_list (s_list);
            SL.destroy (s_list);
            end if;
            SP.release;
        when create_ci =>
            SP.mark;
            if privileged then
                begin
                name := ci_arg.get_argument (processes(create_ci),
                             "name");
                lib  := string_arg.get_argument (processes(create_ci),
                             "library");
                hist := string_arg.get_argument (processes(create_ci),
                             "history");
                status := CM.create_ci (name,
                            lib,
                                hist);
                if status = CM.error then
               TIO.put_line ("creation not completed due to errors");
               print_errors;
                else
                TIO.put_line ("Created CI " & SP.value(name) & " 1");
                end if;
                exception
            when CM.library_locked =>
                TIO.put_line ("Unable to complete operation due "
                & "to the library being locked");
                TIO.put_line ("Incomplete error checking done");
                print_errors;
            when CM.library_nonexistent =>
                TIO.put_line ("Unable to complete operation due "
                & "to the library not existing");
                print_errors;
            when CM.invalid_library =>
                TIO.put_line ("Unable to complete operation due "
                & "to an invalid library");
                print_errors;
                end;
                SP.flush (lib);
                SP.flush (hist);
                SP.flush (name);
            else
            raise CM.invalid_password;
            end if;
            SI.redefine_process (processes(create_ci));
            SP.release;
        when store =>
            SP.mark;
            if privileged then
                begin
                lib  := string_arg.get_argument (processes(store),
                             "library");
                hist := string_arg.get_argument (processes(store),
                             "history");
                status := CM.store (lib,
                              hist);
                if status = CM.error then
                TIO.put_line ("Store not performed due to errors");
                print_errors;
                else
                TIO.put_line ("Stored library " & SP.value(lib) );
                end if;
                exception
            when CM.library_locked =>
                TIO.put_line ("Unable to complete operation due "
                & "to the library being locked");
                TIO.put_line ("Incomplete error checking done");
                print_errors;
            when CM.library_nonexistent =>
                TIO.put_line ("Unable to complete operation due "
                & "to the library not existing");
                print_errors;
            when CM.invalid_library =>
                TIO.put_line ("Unable to complete operation due "
                & "to an invalid library");
                print_errors;
                end;
                SP.flush (lib);
                SP.flush (hist);
            else
            raise CM.invalid_password;
            end if;
            SI.redefine_process (processes(store));
            SP.release;
        when fetch =>
            SP.mark;
            begin
            name := ci_arg.get_argument (processes(fetch),
                                    "name");
            lib  := string_arg.get_argument (processes(fetch),
                                 "library");
            arg3 := string_arg.get_argument (processes(fetch),
                                 "directory");
                CM.fetch (name,
                             lib,
                             arg3,
                            fetch_arg.get_argument (processes(fetch),
                                  "mode"));
            TIO.put_line ("Fetched CI " & SP.value(name) &
                " into library " & SP.value(lib));
            exception when CM.invalid_library =>
            TIO.put_line ("Unable to complete the fetch since "
                & "the library name given is invalid");
            end;
            SI.redefine_process (processes(fetch));
            SP.flush (name);
            SP.flush (lib);
            SP.flush (arg3);
            SP.release;
        when cancel  =>
            SP.mark;
            user1 := SP.create (HL.get_item(HL.user_name));
            user2 := string_arg.get_argument (processes(cancel),
                              "user");
            if not SP.equal (user1, user2) then
            if not privileged then
                raise CM.invalid_password;
            end if;
            end if;
            CM.cancel (string_arg.get_argument (processes(cancel),
                                "library"),
                   user2);
            TIO.put_line ("Fetch is cancelled");
            SI.redefine_process (processes(cancel));
            SP.flush (user2);
            SP.release;
        when delete =>
            SP.mark;
            if privileged then
            name := ci_arg.get_argument (processes(delete),
                                 "name");
                CM.delete (name,
                   delete_arg.get_argument (processes(delete),
                                "mode"));
            TIO.put_line ("CI " & SP.value(name) & " is deleted");
            SP.flush (name);
            else
                raise CM.invalid_password;
            end if;
            SI.redefine_process (processes(delete));
            SP.release;
          when modify_property =>
            SP.mark;
            name := ci_arg.get_argument (processes(modify_property),
                             "name");
            key := string_arg.get_argument (processes(modify_property),
                            "keyword");
            val := string_arg.get_argument (processes(modify_property),
                            "value");
            begin
                CM.modify_property (name, key, val);
                TIO.put_line ("Property modified");
            exception when CM.deleted_ci =>
            TIO.put_line ("You can't modify the proerties of a " &
                    "deleted CI");
            end;
            SI.redefine_process (processes(modify_property));
            SP.flush (name);
            SP.flush (key);
            SP.flush (val);
            SP.release;
        when describe =>
            SP.mark;
            name := ci_arg.get_argument (processes(describe),
                             "name");
            key_list := s_list_arg.get_argument (processes(describe),
                                  "keywords");
            -- iterate over the node expanding the keys given in
            -- key_list
            begin
                p_set := CM.match_keys (name, key_list);
                if (PS.cardinality (p_set) = 0) then
                TIO.put_line (SP.value(name) & " has no properties"
                & " that match the list");
                else
                TIO.put_line ("Properties of " & SP.value (name));
                    print_property_set (p_set);
                end if;
            exception when CM.deleted_ci =>
            TIO.put_line ("You cannot describe a deleted CI.");
            end;
            SI.redefine_process (processes(describe));
            SP.flush (name);
            SP.release;
        when history =>
            SP.mark;
            name := ci_arg.get_argument(processes(history),
                            "name");
            h_list := CM.history (name);
            TIO.put_line ("History of " & SP.value(name));
            print_hist_list (h_list);
            CD.hist_lists.destroy (h_list);
            SI.redefine_process (processes(history));
            SP.flush (name);
            SP.release;
            when list_versions =>
            SP.mark;
            name := ci_arg.get_argument(processes(list_versions),
                            "name");
        -- the temp s_list is used so that the header isn't printed
        -- and then an error message.  If there is an exception the
        -- put line is not executed.
            s_list := CM.list_versions (name);
            TIO.put_line ("Versions of " & SP.value(name));
            print_list (s_list);
            SL.destroy (s_list);
            SI.redefine_process (processes(list_versions));
            SP.flush (name);
            SP.release;
        when list_components =>
            SP.mark;
            name := ci_arg.get_argument(processes(list_components),
                            "name");
            begin
                i_list := CM.list_components(name);
                if LD.LL.isempty (i_list) then
              TIO.put_line (SP.value(name) & " has no components");
                else
                  TIO.put_line ("Components of " & SP.value(name));
                  print_item_list (i_list);
              LD.LL.destroy (i_list);
                end if;
            exception when CM.deleted_ci =>
            TIO.put_line ("CI has been deleted - no components.");
            end;
            SI.redefine_process (processes(list_components));
            SP.flush (name);
            SP.release;
        when remove_lock =>
            SP.mark;
            if privileged then
            name := string_arg.get_argument
                               (processes(remove_lock),
                        "name");
            arg3 := string_arg.get_argument
                               (processes(remove_lock),
                        "node_name");
                CM.remove_lock (name,
                        lock_arg.get_argument
                            (processes(remove_lock),
                        "lock"),
                        arg3,
                        node_arg.get_argument
                               (processes(remove_lock),
                        "node"));
            TIO.put_line ("Lock removed");
                SP.flush (name);
                SP.flush (arg3);
            else
                raise CM.invalid_password;
            end if;
            SI.redefine_process (processes(remove_lock));
            SP.release;
        when library_manager =>
            lib := lib_name.get_argument
                (processes(library_manager),
                "library");
            prompt := string_arg.get_argument
                (processes(library_manager),
                "prompt");
            s_code := Library_Manager_Interface(lib, prompt);
            SI.redefine_process (processes(library_manager));
        end case;
    exception
        when constraint_error =>
        TIO.put_line ("Constraint error");
        SI.redefine_process(processes(cmd));
            SP.release;
        when SI.process_help =>
        null;
         when SI.abort_process =>
        null;
        when SI.abort_command =>
        TIO.new_line(1);
        TIO.put ("Errors in command.  Enter command name with no");
        TIO.put_line ("parameters for help");
        when SI.command_help =>
        null;
        when SI.command_exit =>
        Exit;
        when SI.no_command =>
        TIO.put_line ("Enter 'help' for information about the commands");
        when CM.invalid_password =>
        TIO.put_line ("Sorry, you are not a privileged user.");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.cant_lock =>
        TIO.put_line ("The catalog cannot be locked for that " &
            "operation, try again later");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.no_lock =>
        TIO.put_line ("That lock doesn't exist");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.library_locked =>
        TIO.put_line ("The library is locked against this operation");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.no_such_ci =>
        TIO.put_line ("The named CI does not exist in this Catalog");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.already_fetched =>
        TIO.put_line ("The CI named has already been fetched for update");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.already_updated =>
        TIO.put_line ("An update already exists for the given CI");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.invalid_ci_id =>
        TIO.put_line ("The format of the CI id is incorrect");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.invalid_ci_name =>
        TIO.put_line ("The name of the CI is not an ada identifier");
        SI.redefine_process(processes(cmd));
        SP.release;
        when CM.incorrect_person =>
        TIO.put_line ("You are not authorized to store or cancel this"
            & " fetch");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.is_checked_out =>
        TIO.put_line ("The CI named is fetched and cannot be deleted");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.deleted_ci =>
        TIO.put_line ("You cannot fetch a CI that has been deleted");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.incomplete_store =>
        TIO.put_line ("The store for this CI was not completed.");
        TIO.put_line ("Before fetching the store must be fixed up by"
            & " deleting and retrying the store");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.invalid_key_or_val =>
        TIO.put_line ("One of the keyword or value is invalid");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.required_keyword =>
        TIO.put_line ("You cannot modify a required property to " &
                "have no value");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.ci_not_fetched =>
        TIO.put_line ("No CI with this name was fetched from the"
            & " catalog");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.invalid_mode =>
        TIO.put_line ("This is an invalid or corrupted library"
            & " because its mode is unknown");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.update_already_exists =>
        TIO.put_line ("The update to this CI already exists.  If you" &
            " validly fetched it from this catalog,");
        TIO.put_line ("you will have to fetch the new update to " &
            "compare with yours, and store the appropriate");
        TIO.put_line ("contents.  Don't forget to cancel the old " &
            "library so you can delete it");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CM.library_nonexistent =>
        TIO.put_line ("The given library does not exist.");
        SI.redefine_process(processes(cmd));
        SP.release;
        when CM.invalid_library =>
        TIO.put_line ("The given library name is invalid.");
        SI.redefine_process(processes(cmd));
        SP.release;
        when ID.invalid_ci_id =>
        TIO.put_line ("The format of the CI id is incorrect");
        SI.redefine_process(processes(cmd));
            SP.release;
        when IM.invalid_keyword =>
        TIO.put_line ("The keyword given is either not a valid one " &
            "or it is not an ada identifier");
        SI.redefine_process(processes(cmd));
            SP.release;
        when IM.invalid_value =>
        TIO.put_line ("The value given is either not a valid one " &
            "or it is not an ada identifier");
        SI.redefine_process(processes(cmd));
            SP.release;
        when CL.unauthorized | CL.lock_doesnt_exist =>
        TIO.put_line ("Your locks have been lost. ");
        TIO.put_line ("Please exit the catalog and restart your " &
            "session.");
        SI.redefine_process(processes(cmd));
            SP.release;
        when LD.directory_already_exists =>
        TIO.put_line ("The given directory already exists. The " &
            " catalog cannot");
        TIO.put_line ("create a library there.");
        SI.redefine_process(processes(cmd));
            SP.release;
        when LD.library_already_exists =>
        TIO.put_line ("A library with that name already exists.  " &
            "Please try with another name");
        SI.redefine_process(processes(cmd));
            SP.release;
        when LD.invalid_directory_name =>
        TIO.put_line ("The specification of the directory is " &
            "incorrect");
        SI.redefine_process(processes(cmd));
            SP.release;
    end;
    end loop;
    TIO.put_line ("Exiting the catalog manager");
end command_interpreter;

procedure init_processes (processes : in out SC.process_handle_array) is


begin
-- do not define process help since the standard interface will do what you
-- want.
--    SI.define_process ("help",
--               "General help about the catalog",
--               processes(help));
--    -- help has no parameters
--    SI.append_process_help (processes(help),
--    "The catalog is an interactive tool that allows a user to select");
--    SI.append_process_help (processes(help),
--    "configuration items (CIs) according certain properties, and then to");
--    SI.append_process_help (processes(help),
--    "get more information about each CI.  The user can then having");
--    SI.append_process_help (processes(help),
--    "picked a certain CI fetch it for study or modification.  The ");
--    SI.append_process_help (processes(help),
--    "commands recognised are: help, done, clear_selected_set, print_set");
--    SI.append_process_help (processes(help),
--    "list_cis, change_password *, define_keyword *, list_keywords,");
--    SI.append_process_help (processes(help),
--    "create_ci, store, fetch, cancel, delete *, modify_property, ");
--    SI.append_process_help (processes(help),
--    "describe, history, list_versions, list_components, remove_lock *. ");
--    SI.append_process_help (processes(help),
--     "The words followed by '*' are privileged operation for which you");
--    SI.append_process_help (processes(help),
--    "need to know the catalog password.  Operations not described here");
--    SI.append_process_help (processes(help),
--    "will give more help if entered with no parameters.  ");
--    SI.append_process_help (processes(help),
--    "Help puts out this message, done exits the user from the catalog,");
--    SI.append_process_help (processes(help),
--    "clear_selected_set empties the current set, print_set will print ");
--    SI.append_process_help (processes(help),
--    "the current_set, change_password prompts for a new password,");
--    SI.append_process_help (processes(help),
--    "and list_keywords lists the keywords and their current status.");


    SI.define_process ("select_cis",
               "Selects a set of CIs according to"
            & " the selection criteria given",
               processes(select_cis));
    -- define select_cis parameters
    string_arg.define_argument (processes(select_cis),
                "criteria",
                "A string in selection syntax giving the " &
    "criteria to");
    string_arg.append_argument_help (processes(select_cis),
                     "criteria",
    "select by.  The operators recognized are & and |.  Parentheses");
    string_arg.append_argument_help (processes(select_cis),
                     "criteria",
    "can be used to indicate precedence.  & does intersections,");
    string_arg.append_argument_help (processes(select_cis),
                     "criteria",
    "and | does unions. The expressions are evaluated from left");
    string_arg.append_argument_help (processes(select_cis),
                     "criteria",
                     "to right");

    SI.define_process ("clear_selected_set",
               "Make the current selected set be the empty set.",
               processes(clear_selected_set));
    -- clear_selected_set has no parameters

    SI.define_process ("print_set",
               "Print the contents of the currently selected set.",
               processes(print_set));
    -- print_set has no parameters

    SI.define_process ("list_cis",
               "Lists the contents of the catalog by name.",
               processes(list_cis));
    -- define list catalog argument
    string_arg.define_argument (processes(list_cis),
                "cis",
                "*",
                "Name string to match, * matches all strings");
    SI.define_help (processes(list_cis),
    "This will only list the name part of a configuration item id. To");
    SI.append_help (processes(list_cis),
    "see the different versions of a CI use LIST_VERSIONS.");

    SI.define_process ("change_password",
               "Changes the privileged user password.",
               processes(change_password));
    SI.append_process_help (processes(change_password),
                "This is a privileged operation");
    -- change_password could have parameters, but it would be a security hole.
    SI.define_help (processes(change_password),
    "To change the password the user must know the old password.");
    SI.append_help (processes(change_password),
    "The user will prompted for the old password and then the new");
    SI.append_help (processes(change_password),
    "password twice to verify that it was typed correctly.");

    SI.define_process ("define_keyword",
               "Define a new keyword, or change the status of an",
               processes(define_keyword));
    SI.append_process_help (processes(define_keyword),
                "existing one.");
    SI.append_process_help (processes(define_keyword),
                "This is a privileged operation");
    string_arg.define_argument (processes(define_keyword),
                "keyword",
                "name of the keyword to define");
    status_arg.define_argument (processes(define_keyword),
                "status",
                IM.optional,
                 "status of the keyword");
    SI.define_help (processes(define_keyword),
    "Keywords are defined so that information about CIs can be stored");
    SI.append_help (processes(define_keyword),
    "in the database.  A required keyword must always be included on");
    SI.append_help (processes(define_keyword),
    "any CI stored.  Optional keywords are just that, optional.");
    SI.append_help (processes(define_keyword),
    "Invalid keywords are ones that may at one time have been valid,");
    SI.append_help (processes(define_keyword),
    "but can no longer be used to store CIs.  They can still be used");
    SI.append_help (processes(define_keyword),
    "for lookup since CIs added with a keyword before it was made ");
    SI.append_help (processes(define_keyword),
    "invalid are not changed.");

    SI.define_process ("list_keywords",
               "List all the keywords and their status.",
               processes(list_keywords));
    SI.define_help (processes(list_keywords),
    "The possible values for the status of a keyword are REQUIRED,");
    SI.append_help (processes(list_keywords),
    "OPTIONAL and INVALID.  REQUIRED keywords mean that a property");
    SI.append_help (processes(list_keywords),
    "with that keyword must be on all libraries being stored in the");
    SI.append_help (processes(list_keywords),
    "catalog as CIs.  OPTIONAL keywords mean a library with that");
    SI.append_help (processes(list_keywords),
    "property may be stored in the catalog.  A library can not be");
    SI.append_help (processes(list_keywords),
    "stored with an INVALID property keyword.  CIs may be selected");
    SI.append_help (processes(list_keywords),
    "by any keyword (see SELECT_CIS).");
    -- list keywords has no parameters

    SI.define_process ("create_ci",
               "create a new configuration item (CI) in the catalog",
               processes(create_ci));
    ci_arg.define_argument (processes(create_ci),
                "name",
                "Name of the new ci to create");
    string_arg.define_argument (processes(create_ci),
                "library",
                "Name of the item library to"
                 & " create the CI from");
    string_arg.define_argument (processes(create_ci),
                "history",
                "Brief description of the new CI");
    SI.define_help (processes(create_ci),
    "Any errors encountered will be reported to the user and the");
    SI.append_help (processes(create_ci),
    "creation will not take place.  In addition to having the correct");
    SI.append_help (processes(create_ci),
    "status, the keywords on the library must be both valid, and");
    SI.append_help (processes(create_ci),
    "include all the required ones.  The history parameter will be");
    SI.append_help (processes(create_ci),
    "stored on the new CI along with the creator and date.  This");
    SI.append_help (processes(create_ci),
    "information can be seen with the HISTORY command.");

    SI.define_process ("store",
               "Store a new version of an already existing CI",
               processes(store));
    string_arg.define_argument (processes(store),
                "library",
                "Name of the item library to get the CI from");
    string_arg.define_argument (processes(store),
                "history",
                "Description of the changes made"
                  & " to the new CI");
    SI.define_help (processes(store),
    "Any errors encountered will be reported to the user and the");
    SI.append_help (processes(store),
    "store will not take place.  In addition to being fetched");
    SI.append_help (processes(store),
    "correctly, the keywords on the library must be both valid,");
    SI.append_help (processes(store),
    "and include all the required ones.  The history parameter will");
    SI.append_help (processes(store),
    "be stored along with the creator and date and can be accessed");
    SI.append_help (processes(store),
    "with the history command.");

    SI.define_process ("fetch",
               "Fetch a specified CI and put it in an item library.",
               processes(fetch));
    ci_arg.define_argument (processes(fetch),
                "name",
                "Name of the ci to fetch");
    string_arg.define_argument (processes(fetch),
                "library",
                "Name of the item library to put the CI in");
    string_arg.define_argument (processes(fetch),
                "directory",
                "Name of the directory to create the item" &
                "library in");
    fetch_arg.define_argument (processes(fetch),
                   "mode",
                   LD.no_update,
                   "Indicates what type of update the fetch"
                  & " is allowing");
    SI.define_help (processes(fetch),
    "Fetch will put a specified CI in an item library for the user.");
    SI.append_help (processes(fetch),
    "If the mode is UPDATE or BRANCH the user can modify the CI and");
    SI.append_help (processes(fetch),
    "STORE it as a new version.  If the mode is NO_UPDATE (default)");
    SI.append_help (processes(fetch),
    "the user is still free to modify the library, but it may NOT be");
    SI.append_help (processes(fetch),
    "returned to the catalog as a new version.  When a CI is fetched");
    SI.append_help (processes(fetch),
    "for UPDATE checks are made to make sure that no one else is");
    SI.append_help (processes(fetch),
    "updating the same CI");

    SI.define_process ("cancel",
               "Cancel a fetch that was made with the mode update",
               processes(cancel));
    string_arg.define_argument (processes(cancel),
                "library",
                "Name of the item library the fetched"
                  & " CI is in");
    string_arg.define_argument (processes(cancel),
                "user",
                HL.get_item(HL.user_name),
                "Name of the person who did the fetch");
    string_arg.append_argument_help (processes(cancel),
                "user",
                "Default is the current user");
    SI.define_help (processes(cancel),
    "Any user can cancel a fetch that he or she made, but only a");
    SI.append_help (processes(cancel),
    "privileged user may cancel someone else's.  So if the name given");
    SI.append_help (processes(cancel),
    "does not match the current user the catalog password will be ");
    SI.append_help (processes(cancel),
    "asked for.");

    SI.define_process ("delete",
               "Delete a configuration item that is in the catalog.",
                processes(delete));
    SI.append_process_help (processes(delete),
                "This is a privileged operation.");
    ci_arg.define_argument (processes(delete),
                "name",
                "Name of the configuration item to delete");
    delete_arg.define_argument (processes(delete),
                "mode",
                CM.clean_up,
                "What type of delete is to be done");
    SI.define_help (processes(delete),
    "There are two types of deletion that may take place.  Deletion of a");
    SI.append_help (processes(delete),
    "CI that is out of date and not needed, and deletion of a CI where");
    SI.append_help (processes(delete),
    "the store only partially completed for some reason.  The former is");
    SI.append_help (processes(delete),
    "clean_up and the latter is fix_up.  When cleaning up, the catalog ");
    SI.append_help (processes(delete),
    "manager checks that the CI is not currently fetched.  In fix up the");
    SI.append_help (processes(delete),
    "store was incomplete and so by definition the CI will still appear");
    SI.append_help (processes(delete),
    "to be fetched.");

    SI.define_process ("modify_property",
                      "Modify the value associated with the given keyword",
               processes(modify_property));
    SI.append_process_help (processes(modify_property),
            "on the specified CI");
    ci_arg.define_argument (processes(modify_property),
                   "name",
                "Name of the CI with the property to be"
                  & " changed");
    string_arg.define_argument (processes(modify_property),
                "keyword",
                "name of the keyword to change the value of");
    string_arg.define_argument (processes(modify_property),
                "value",
                "New value for the keyword");
    SI.define_help (processes(modify_property),
    "Modify_property will change the value associated with a keyword");
    SI.append_help (processes(modify_property),
    "on a CI.  The property can not be added if the keyword is");
    SI.append_help (processes(modify_property),
    "invalid and a property can not be removed if it is required.");
    SI.append_help (processes(modify_property),
    "To remove a property simply give it a null string for a new");
    SI.append_help (processes(modify_property),
    "value.  This change has no effect on other CIs with the same");
    SI.append_help (processes(modify_property),
    "name.");

    SI.define_process ("describe",
               "Show the values of the given keywords",
               processes(describe));
    ci_arg.define_argument (processes(describe),
                "name",
                "Name of the CI to describe");
    s_list_arg.define_argument (processes(describe),
                "keywords",
                SL.makelist (SP.create ("*")),
                "List of keywords to lookup the values of");
    s_list_arg.append_argument_help (processes(describe),
                     "keywords",
     "The default (*) matches all properties on a CI");
    SI.define_help (processes(describe),
    "Describe does not list the creator or creation date see HISTORY");
    SI.append_help (processes(describe),
    "for that information.");

    SI.define_process ("history",
               "Give the history of the named CI",
               processes(history));
    ci_arg.define_argument (processes(history),
                "name",
                "Name of the CI of which to give the history");
    SI.define_help (processes(history),
    "The history of a CI is the history comments stored when each of its");
    SI.append_help (processes(history),
    "predecessors was stored.  The comments will be printed out in ");
    SI.append_help (processes(history),
    "reverse order, that is, from the most recent version to the first");
    SI.append_help (processes(history),
    "version of the CI with that name.");

    SI.define_process ("list_versions",
               "List the versions of a named CI",
               processes(list_versions));
    string_arg.define_argument (processes(list_versions),
                   "name",
                "Name of the CI to list");
    SI.define_help (processes(list_versions),
    "LIST_VERSIONS lists the versions of a CI with the same name.  The");
    SI.append_help (processes(list_versions),
    "name given should be an ada identifier.  The list will be from");
    SI.append_help (processes(list_versions),
    "oldest to newest.");

    SI.define_process ("list_components",
               "List the components of the given CI",
               processes(list_components));
    ci_arg.define_argument (processes(list_components),
                   "name",
                "Name of the CI to list");
    SI.define_help (processes(list_components),
    "The listing will consist of the file items that make up the");
    SI.append_help (processes(list_components),
    "CI.  It will be in the same format as a component list from");
    SI.append_help (processes(list_components),
    "the Item Library Manager");

    SI.define_process ("remove_lock",
               "Remove a lock that was left by a user aborting"
            & " a session",
               processes(remove_lock));
    SI.append_process_help (processes(remove_lock),
                "This is a privileged operation");
    string_arg.define_argument (processes(remove_lock),
                "name",
                "Name of the person owning the lock");
    lock_arg.define_argument (processes(remove_lock),
                  "lock",
                  "Type of lock that is to be removed");
    -- Note: the following two arguments default because for the time being
    -- they are completely useless.  If and when locking on a node by node
    -- basis is done both of these parameters will have to be specified.
    -- It may be that "current_catalog" and catalog are reasonable defaults
    -- (this is what I hope) in which case this interface won't have to be
    -- changed.  But it is important to realize that in the code I will
    -- write these two variables will not even be looked at  and they can
    -- be nonsense as far as I'm concerned.  The reason for putting in these
    -- parameters now is so that the interfaces do not need to be changed
    -- (or changed minimally) if the node by node looking is done.
    string_arg.define_argument (processes(remove_lock),
                "node_name",
                "current_catalog",
                "Name of the node to be unlocked");
    node_arg.define_argument (processes(remove_lock),
                  "node",
                  CM.catalog_node,
                  "Type of node to be unlocked");

    SI.define_process ("library_manager",
               "Interactive Library Manager",
               processes(library_manager));
    lib_name.define_argument (processes(library_manager),
                  "library",
                  "Name of the item library");
    string_arg.define_argument (processes(library_manager),
                "prompt",
                "",
                "Prompt (null string implies library name)");

    end init_processes;

procedure print_list (list : in SL.list) is
  i : SL.listiter;
  s : SP.string_type;
  begin
    i := SL.makelistiter (list);
    while SL.more (i) loop
      SL.next (i, s);
      text_io.put_line (SP.value (s));
    end loop;
  end print_list;

procedure print_sel_set (set : in CD.ci_set) is

package ci_sets renames catalog_decls.ci_sets;

  i : ci_sets.members_iter;
  c : ID.ci_id_type;
  begin
    i := ci_sets.make_members_iter (set);
    while ci_sets.more (i) loop
      ci_sets.next (i, c);
      text_io.put_line (ID.image(c));
    end loop;
  end print_sel_set;

procedure print_string_set (
    set : in CD.string_set
    ) is

package SS renames catalog_decls.string_sets;

  i : SS.members_iter;
  s : SP.string_type;
  begin
    i := SS.make_members_iter (set);
    while SS.more (i) loop
      SS.next (i, s);
      text_io.put_line (SP.value(s));
    end loop;
  end print_string_set;

procedure print_property_set (
    set : in PS.set
    ) is

  i : PS.setiter;
  p : properties.property;
  begin
    i := PS.makesetiter (set);
    while PS.more (i) loop
      PS.next (i, p);
      text_io.put_line (properties.image(p));
    end loop;
  end print_property_set;

procedure print_item_list (
    set : in LD.LL.list
    ) is
  i : LD.LL.listiter;
  l : SL.list;
  begin
    i := LD.LL.makelistiter (set);
    while LD.LL.more (i) loop
      LD.LL.next (i, l);
      text_io.put_line (SP.value (SL.firstvalue (l)));
    end loop;
  end print_item_list;

procedure print_hist_list (
    list : in  CD.hist_list
    ) is
  package CHL renames CD.hist_lists;
  i : CHL.listiter;
  h : CD.hist_record;
  begin
  i := CHL.makelistiter(list);
  while CHL.more (i) loop
    CHL.next (i, h);
    text_io.put_line ("Name      : " & SP.value (h.name));
    text_io.put_line ("Creator   : " & SP.value (h.creator));
    text_io.put_line ("Date      : " & SP.value (h.date));
    text_io.put_line ("History   : " & SP.value (h.history));
    text_io.put_line ("Submitter : " & SP.value (h.submit));
    if not SP.is_empty (h.delete) then
      text_io.put_line ("Deleted by " & SP.value (h.delete));
    end if;
  end loop;
  end print_hist_list;

procedure print_errors is

error : CM.error_type;

    begin
        for error in CM.error_type'first .. CM.error_type'last loop
        if CM.errors(error) = true then
        case error is
        when CM.required =>
            TIO.put_line(SP.value(CM.messages(error)));
            -- loop putting out the contents of required
            print_string_set (CM.missing);
        when CM.person =>
            TIO.put_line (SP.value(CM.messages(error))
            & SP.value(CM.fetchee));
        when CM.keywords =>
            TIO.put_line(SP.value(CM.messages(error)));
            print_list (CM.invalid);
        when others =>
            TIO.put_line(SP.value(CM.messages(error)));
        end case;
        end if;
    end loop;
    CM.errors := (others => false);
    CD.string_sets.destroy (CM.missing);
    CM.invalid := CM.empty_list;
    end;

end interpret;

::::::::::::::
command.spc
::::::::::::::
package interpret is

--| Overview: This package contains the procedure to interpret the commands
--| entered by the user.

procedure command_interpreter;

--| Effects: prompts for and interprets the commands entered by the user.
--| When a command has been interpreted it calls the appropriate catalog
--| subprogram to make the changes, or provide the information asked for.

end interpret;
::::::::::::::
copyl.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with Library_Declarations;
with Copy_Library_Interface;

function Copy_Library return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LD  renames Library_Declarations;
    package LIB is new SI.String_Argument(String_Type_Name => "library_name");
    package DIR is new SI.String_Argument(String_Type_Name => "directory_spec");
    package CLM is new SI.Enumerated_Argument(Enum_Type      => LD.Copy_Mode,
                          Enum_Type_Name => "copy_mode");

    Copy_Library_Process   : SI.Process_Handle;
    To_Library             : SP.String_Type;
    Directory              : SP.String_Type;
    From_Library           : SP.String_Type;
    Copy_Library_Mode      : LD.Copy_Mode;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => Copy_Library_Process,
    Name    => "Copy_Library",
    Help    => "Copy an Item Library to Another Item Library");

    LIB.Define_Argument(
    Proc => Copy_Library_Process,
    Name => "From_Library",
    Help => "Name of the item library to be copied");

    LIB.Define_Argument(
    Proc => Copy_Library_Process,
    Name => "To_Library",
    Help => "Name of the new item library");

    DIR.Define_Argument(
    Proc => Copy_Library_Process,
    Name => "to_directory",
    Help => "Name of directory to be used by the new library");

    CLM.Define_Argument(
    Proc    => Copy_Library_Process,
    Name    => "mode",
    Default => LD.CURRENT,
    Help    => "Copy option:");

    CLM.Append_Argument_Help(
    Proc    => Copy_Library_Process,
    Name    => "mode",
    Help    => "   CURRENT : copy only the current version of items");

    CLM.Append_Argument_Help(
    Proc    => Copy_Library_Process,
    Name    => "mode",
    Help    => "   FULL    : copy all versions of items");

    SI.Parse_Line(Copy_Library_Process);

    From_Library := LIB.Get_Argument(
            Proc => Copy_Library_Process,
            Name => "From_Library");

    To_Library := LIB.Get_Argument(
            Proc => Copy_Library_Process,
            Name => "To_Library");

    Directory := DIR.Get_Argument(
            Proc => Copy_Library_Process,
            Name => "to_directory");

    Copy_Library_Mode := CLM.Get_Argument(
            Proc => Copy_Library_Process,
            Name => "mode");

    return HL.Return_Code(
    Copy_Library_Interface(From_Library, To_Library, Directory, Copy_Library_Mode));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end Copy_Library;
                                                                    pragma page;
::::::::::::::
copyl.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;
with HIF_List_Utils;

function Copy_Library_Interface(
    From_Library : in String_Pkg.String_Type;
    To_Library   : in String_Pkg.String_Type;
    To_Directory : in String_Pkg.String_Type;
    Mode         : in Copy_Mode := CURRENT
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;
    package HLU renames HIF_List_Utils;

    Library_Node     : HND.Node_Type;
    IL_Node          : HND.Node_Type;
    Iterator         : HA.Attrib_Iterator;
    Property_List    : HLU.List_Type;
    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;
    List_of_Lists    : LL.List;
    Trap             : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    begin
    if not LU.Lock_Library(From_Library, READ_LOCK) then
        LE.Report_Error(LE.Library_Read_Locked, From_Library);
        HL.Set_Interrupt_State(Trap);
        return HL.ERROR;
    end if;
    exception
    when Invalid_Library_Name =>
        LE.Report_Error(LE.Invalid_Library_Name, From_Library);
        HL.Set_Interrupt_State(Trap);
        return HL.ERROR;
    when Library_Does_Not_Exist =>
        LE.Report_Error(LE.Library_Does_Not_Exist, From_Library);
        HL.Set_Interrupt_State(Trap);
        return HL.ERROR;
    when Library_Master_Locked =>
        LE.Report_Error(LE.Library_Master_Locked, From_Library);
        HL.Set_Interrupt_State(Trap);
        return HL.ERROR;
    end;
    if LU.Is_Item_Checked_Out(From_Library) then
    LU.Unlock_Library(From_Library, READ_LOCK);
    LE.Report_Error(LE.Library_Incomplete, From_Library);
        HL.Set_Interrupt_State(Trap);
    return HL.ERROR;
    end if;

    HNM.Open_Node_Handle(Library_Node,
             SP.Value(LU.Node_Name(From_Library, SP.Create("*"))));
    LU.Create_Library(Library   => To_Library,
              Directory => To_Directory,
              Mode      => NO_UPDATE,
              Node      => Library_Node,
              Locked    => TRUE);
    HNM.Close_Node_Handle(Library_Node);
    LU.Unlock_Library(From_Library, READ_LOCK);
    if Mode = CURRENT then
    LU.Purge(Library   => To_Library,
         Privilege => WORLD,
         Remainder => List_of_Lists);
    end if;

    begin
    LU.Open_Property_Node(To_Library, SP.Create(""), SP.Create(""), LIST, IL_Node);
    HA.Node_Attribute_Iterate(Iterator, IL_Node, "*");
    while HA.More(Iterator) loop
        HA.Get_Next(Iterator, Attribute_Value, Attribute_Length, Property_List);
        HA.Set_Node_Attribute(Node   => IL_Node,
                  Attrib => Attribute_Value(1 .. Attribute_Length),
                  Value  => "");
    end loop;
    HNM.Close_Node_Handle(IL_Node);
    exception
    when others =>
        HNM.Close_Node_Handle(IL_Node);
    end;

    LU.Unlock_Library(To_Library, WRITE_LOCK);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Library " & SP.Value(SP.Upper(From_Library)) &
        " copied to " & SP.Value(SP.Upper(To_Library)) & '.');
    end if;
    if not LL.IsEmpty(List_of_Lists) and then Message_on_Error then
    LU.Display_List(List_of_Lists, "Item/Version not purged");
    end if;
    Destroy_List_of_Lists(List_of_Lists);
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name | Invalid_External_Name =>
    LU.Unlock_Library(From_Library, READ_LOCK);
    LE.Report_Error(LE.Invalid_Library_Name, To_Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Already_Exists =>
    LU.Unlock_Library(From_Library, READ_LOCK);
    LE.Report_Error(LE.Library_Already_Exists, To_Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Directory_Name =>
    LU.Unlock_Library(From_Library, READ_LOCK);
    LE.Report_Error(LE.Invalid_Directory_Name, To_Directory);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Directory_Already_Exists =>
    LU.Unlock_Library(From_Library, READ_LOCK);
    LE.Report_Error(LE.Directory_Already_Exists, To_Directory);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Set_Protection_Error =>
    LU.Unlock_Library(From_Library, READ_LOCK);
    LE.Report_Error(LE.Set_Protection_Error, SP.Create("directory file"));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(From_Library, READ_LOCK);
    exception
        when others =>
        null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Copy_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(From_Library, READ_LOCK);
    exception
        when others =>
        null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Copy_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Copy_Library_Interface;
                                                                    pragma page;
::::::::::::::
copyl.spc
::::::::::::::
with String_Pkg;
with Host_Lib;
with Library_Declarations;

function Copy_Library_Interface(        --| Copy an Item Library
   From_Library : in String_Pkg.String_Type;    --| Item library to be copied
   To_Library   : in String_Pkg.String_Type;    --| New item library
   To_Directory : in String_Pkg.String_Type;    --| Directory for new library
   Mode         : in Library_Declarations.Copy_Mode := Library_Declarations.CURRENT
                        --| Copy option (CURRENT/FULL)
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library to copy from and the name and the directory of the
--| new library

--| Effects:
--| Copies all the contents (but not the properties) of a item library to
--| another.  The copy option specifies current version or all versions copy

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
createcat.ada
::::::::::::::

--------- SPEC ----------------------------------------------------------

function create_catalog return INTEGER;

--------- BODY ----------------------------------------------------------

with Standard_Interface;
with Tool_Identifier;
with String_Pkg;
with Host_Lib;
with catalog_interface;

function create_catalog return INTEGER is

    package SP renames String_Pkg;
    package CI renames catalog_interface;
    package SI renames Standard_Interface;

    package input is new SI.String_Argument(        -- instantiate with
    String_Type_Name => "string");        -- subtype output_file


    process      : SI.Process_Handle;    -- handle to process structure
    catalog     : SP.string_type;    -- name of the catalog
    directory     : SP.string_type;    -- name of the directory to put
                    -- partition in

begin

    SI.set_tool_identifier (Tool_Identifier);
    SI.Define_Process(            -- define this process
    Name    => "create_catalog",    -- name of the process
    Help    => "Create a new configuration item catalog",
    Proc    => process);        -- handle to be returned

    Input.Define_Argument(    -- define the first argument
    Proc => Process,        -- process
    Name => "catalog_name",        -- name of the argument
    Help => "Name of the catalog to be created");

    Input.Define_Argument(        -- define the second argument
    Proc    => Process,        -- process
    Name    => "directory_spec",    -- name of the argument
    Help    => "Name of the directory to create the catalog in");

    SI.define_help (process,
    "Creates a new configuration item catalog.  The name of the catalog");
    SI.append_help (process,
    "must be and ada identifier and the directory should not already");
    SI.append_help (process,
    "exist.  The user will be prompted for a privileged user password");
    SI.append_help (process,
    "when the catalog is created.  The user must be a document manager");
    SI.append_help (process,
    "system user to be able to run this tool (see Add_User).");

    SI.Parse_Line(Process);        -- parse the command line

    catalog := Input.Get_Argument(    -- get the first argument
            Proc => Process,
            Name => "catalog_name");

    directory := Input.Get_Argument(    -- get the second argument
            Proc => Process,
            Name => "directory_spec");

    SI.Undefine_Process(Proc => Process);    -- destroy the process block

    CI.create_catalog (catalog, directory);

    return Host_Lib.Return_Code(Host_Lib.SUCCESS);-- return successful return code

exception

    when SI.Process_Help =>
    --
    -- Help message was printed
    --
    return Host_Lib.Return_Code(Host_Lib.INFORMATION);

    when SI.Abort_Process =>
    --
    -- Parse error
    --
    return Host_Lib.Return_Code(Host_Lib.ERROR);

end create_catalog;
::::::::::::::
createi.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with Create_Item_Interface;

function Create_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package FN  is new SI.String_Argument(
                String_Type_Name => "file_name");
    package STR is new SI.String_Argument(
                String_Type_Name => "string");

    Create_Item_Process : SI.Process_Handle;
    Library             : SP.String_Type;
    File_Name           : SP.String_Type;
    History             : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => Create_Item_Process,
    Name    => "Create_Item",
    Help    => "Create an Item in the Item Library");

    LIB.Define_Argument(
    Proc => Create_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    FN.Define_Argument(
    Proc => Create_Item_Process,
    Name => "file",
    Help => "Name of the file to be checked into the item library");

    STR.Define_Argument(
    Proc => Create_Item_Process,
    Name => "history",
    Help => "Description/reason for this item");

    SP.Release;

    SI.Parse_Line(Create_Item_Process);

    Library := LIB.Get_Argument(
            Proc => Create_Item_Process,
            Name => "library");

    File_Name := FN.Get_Argument(
            Proc => Create_Item_Process,
            Name => "file");

    History := STR.Get_Argument(
            Proc => Create_Item_Process,
            Name => "history");

    return HL.Return_Code(Create_Item_Interface(Library, File_Name, History));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end Create_Item;
                                                                    pragma page;
::::::::::::::
createi.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with File_Manager;

function Create_Item_Interface(
    Library : in String_Pkg.String_Type;
    File    : in String_Pkg.String_Type;
    History : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package FM  renames File_Manager;

    Item_Value         : SP.String_Type;
    Checked_In_Version : SP.String_Type;
    Trap               : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    Item_Value := SP.Create(FM.Parse_Filename(SP.Value(File), FM.FILE_ONLY));
    LU.Check_In_Item(Library, File, History, CREATE_ITEM, Checked_In_Version);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Item " & SP.Value(SP.Upper(Item_Value)) & '/' & SP.Value(Checked_In_Version) &
        " created in library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when FM.Parse_Error | Invalid_External_Name =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_External_Name, File);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when File_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.File_Not_Found, File);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Already_Exists =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Already_Exists, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Created =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Created, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Set_Protection_Error =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Set_Protection_Error, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Create_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Create_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Create_Item_Interface;
                                                                    pragma page;
::::::::::::::
createi.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function Create_Item_Interface(            --| Create an Item
   Library : in String_Pkg.String_Type;        --| Item library
   File    : in String_Pkg.String_Type;        --| File to be checked in
   History : in String_Pkg.String_Type        --| Description/reason
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library, name file to be created as an item in the library,
--| and a description of the item to be created

--| Effects:
--| Creates an item from a given file in the named library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
createl.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with Create_Library_Interface;

function Create_Library return INTEGER is

    package SI   renames Standard_Interface;
    package SP   renames String_Pkg;
    package HL   renames Host_Lib;
    package LE   renames Library_Errors;
    package LIB  is new SI.String_Argument(String_Type_Name => "library_name");
    package DIR  is new SI.String_Argument(String_Type_Name => "directory_spec");

    Create_Library_Process : SI.Process_Handle;
    Library                : SP.String_Type;
    Directory              : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => Create_Library_Process,
    Name    => "Create_Library",
    Help    => "Create an Item Library");

    LIB.Define_Argument(
    Proc => Create_Library_Process,
    Name => "library",
    Help => "Name of the item library to be created");

    DIR.Define_Argument(
    Proc => Create_Library_Process,
    Name => "directory",
    Help => "Name of directory to be used by this library");

    SP.Release;

    SI.Parse_Line(Create_Library_Process);

    Library   := LIB.Get_Argument(
            Proc => Create_Library_Process,
            Name => "library");

    Directory := DIR.Get_Argument(
            Proc => Create_Library_Process,
            Name => "directory");

    return HL.Return_Code(Create_Library_Interface(Library, Directory));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end Create_Library;
                                                                    pragma page;
::::::::::::::
createl.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;

function Create_Library_Interface(
    Library   : in String_Pkg.String_Type;
    Directory : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;

    Library_Node : HND.Node_Type;
    DOCMGR_Node  : HND.Node_Type;
    Lock         : BOOLEAN;
    Trap         : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    HNM.Close_Node_Handle(Node => Library_Node);
    LU.Create_Library(Library   => Library,
              Directory => Directory,
              CI        => SP.Create(""),
              Mode      => NO_UPDATE,
              Node      => Library_Node,
              Locked    => FALSE);
    if Message_on_Completion then
    HL.Put_Message_Line("Library " & SP.Value(SP.Upper(Library)) & " created.");
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name | Invalid_External_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Already_Exists =>
    LE.Report_Error(LE.Library_Already_Exists, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Directory_Name =>
    LE.Report_Error(LE.Invalid_Directory_Name, Directory);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Directory_Already_Exists =>
    LE.Report_Error(LE.Directory_Already_Exists, Directory);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Set_Protection_Error =>
    LE.Report_Error(LE.Set_Protection_Error, SP.Create("directory file"));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Create_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Create_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Create_Library_Interface;
                                                                    pragma page;
::::::::::::::
createl.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function Create_Library_Interface(        --| Create an Item Library
   Library   : in String_Pkg.String_Type;    --| Item library to be created
   Directory : in String_Pkg.String_Type    --| Directory for the library
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library to be created and the directory for the library

--| Effects:
--| Creates a new library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
createrm.ada
::::::::::::::
With Hif_System_Management ;

Procedure Cre_RM is
      Package SYS renames Hif_System_Management;
begin
    SYS.Create_RootMap ;
end ;
::::::::::::::
createrp.ada
::::::::::::::
-- $Source: /usr8/pif/hif/newer/RCS/cre_rp.ada,v $
-- $Revision: 1.1 $ -- $Date: 85/04/18 13:26:59 $ -- $Author: fitch $

with Hif_Keyed_IO; use Hif_Keyed_IO;
with Hif_Keyed_IO_Defs;
with Hif_Debug;
with Hif_Partition_Elements;
with Hif_Partition_Mapping;
with Hif_Defs;

procedure cre_rp is

    package PELT renames Hif_Partition_Elements;
    package DEFS renames Hif_Defs;
    package KIODEFS renames Hif_Keyed_IO_Defs;

    File:   File_Type;
    Key:    PELT.Key_Type;
    Data:   PELT.Data_Type;

    s: KIODEFS.Status_Type;
    Hif_Directory : constant string := "HIF_DIRECTORY:";
    -- logical name of the directory that contains the root partition
begin
    Create(s,File, Hif_Partition_Mapping.Host_Partition_Mapping.
      Make_Repository_Name(Hif_Directory));
    if kiodefs."/="(s,kiodefs.success) then
        hif_debug.unexpected_status(s);
    end if;
    Write(s,File, PELT.Null_Item_Id,
                PELT.First_Item_Id);
    --
    if kiodefs."/="(s,kiodefs.success) then
        hif_debug.unexpected_status(s);
    end if;
    pelt.make_key(key,PELT.First_Item_Id);
    pelt.make_data(Data, DEFS.Structural);
    Write(s,File, PELT.Image(Key), PELT.Image(Data));
    if kiodefs."/="(s,kiodefs.success) then
        hif_debug.unexpected_status(s);
    end if;
    Close(File);
end cre_rp;
::::::::::::::
deletei.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Utilities;
with Item_Library_Manager_Declarations;

function Delete_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILU renames Item_Library_Manager_Utilities;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(
                String_Type_Name => "item_name");
    package VER is new SI.String_Argument(
                String_Type_Name => "version");

    Delete_Item_Process : SI.Process_Handle;
    Library             : SP.String_Type;
    Item                : SP.String_Type;
    Version             : SP.String_Type;
    List                : ILD.LL.List;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Delete_Item_Process,
    Name    => "Delete_Item",
    Help    => "Delete Item(s) in an Item Library");

    LIB.Define_Argument(
    Proc => Delete_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc => Delete_Item_Process,
    Name => "item",
    Help => "Name of the item(s) to be deleted in the item library");

    VER.Define_Argument(
    Proc    => Delete_Item_Process,
    Name    => "version",
    Default => "",
    Help    => "Version specification");

    SP.Release;

    SI.Parse_Line(Delete_Item_Process);

    Library := LIB.Get_Argument(
            Proc => Delete_Item_Process,
            Name => "library");

    Item := ITM.Get_Argument(
            Proc => Delete_Item_Process,
            Name => "item");

    Version := VER.Get_Argument(
            Proc => Delete_Item_Process,
            Name => "version");

    ILM.Delete_Item(Library   => Library,
            Item      => Item,
            Version   => Version,
            Privilege => ILD.OWNER,
            Remainder => List);

    if not ILD.LL.IsEmpty(List) then
    ILU.Display_List(List, "Item/Version not deleted");
    ILD.Destroy_List_of_Lists(List);
    else
        HL.Put_Message("Item """ & SP.Value(SP.Upper(Item)));
    if not SP.Is_Empty(Version) then
        HL.Put_Message('/' & SP.Value(Version));
    end if;
    HL.Put_Message_Line(""" deleted.");
    end if;
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Not_Found =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Checked_Out =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ checked out.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Version =>
    HL.Put_Error("Invalid version specification.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Version_Not_Found =>
    HL.Put_Error("Version not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Delete Item internal error.");
    return HL.Return_Code(HL.SEVERE);

end Delete_Item;

::::::::::::::
deletei.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;

function Delete_Item_Interface(
    Library   : in String_Pkg.String_Type;
    Item      : in String_Pkg.String_Type;
    Version   : in String_Pkg.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;

    List_of_Lists    : LL.List;
    Item_Node        : HND.Node_Type;
    Item_Iterator    : HNM.Node_Iterator;
    Version_Iterator : SL.ListIter;
    Versions         : SL.List;
    Undeleted        : SL.List;
    Trap             : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    LU.Iterate_Item(Library, Item, Item_Iterator);
    while HNM.More(Item_Iterator) loop
    HNM.Get_Next(Item_Iterator, Item_Node);
    Versions := LU.Get_Version(Item_Node, Version);
    LU.Delete(Item_Node, Versions, Privilege, List_of_Lists);
    Destroy_String_List(Versions);
    HNM.Close_Node_Handle(Item_Node);
    end loop;
    LU.Unlock_Library(Library, WRITE_LOCK);
    if not LL.IsEmpty(List_of_Lists) then
    if Message_on_Error then
        LU.Display_List(List_of_Lists, "Item/Version not deleted");
    end if;
    elsif Message_on_Completion then
        HL.Put_Message("Item " & SP.Value(SP.Upper(Item)));
    if not SP.Is_Empty(Version) then
        HL.Put_Message('/' & SP.Value(Version));
    end if;
    HL.Put_Message_Line(" deleted from library " &
                SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Found, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Version =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Version, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Version_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Version_Not_Found, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Delete_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Delete_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Delete_Item_Interface;
                                                                    pragma page;
::::::::::::::
deletei.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Delete_Item_Interface(                --| Delete Item(s)
    Library   : in String_Pkg.String_Type;        --| Item library
    Item      : in String_Pkg.String_Type;        --| Item(s) to be deleted
    Version   : in String_Pkg.String_Type;        --| Version specification
    Privilege : in Privilege_Type := WORLD        --| Delete privilege
    ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the libray, name of the item, and the version specification

--| Effects:
--| Deletes the specified version(s) of item(s) in the library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
deletel.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Declarations;
with Library_Errors;
with Delete_Library_Interface;

function Delete_Library return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LD  renames Library_Declarations;
    package LIB is new SI.String_Argument(String_Type_Name => "library_name");

    Delete_Library_Process : SI.Process_Handle;
    Library                : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => Delete_Library_Process,
    Name    => "Delete_Library",
    Help    => "Delete an Item Library");

    LIB.Define_Argument(
    Proc    => Delete_Library_Process,
    Name => "library",
    Help => "Name of the item library to be deleted");

    SP.Release;

    SI.Parse_Line(Delete_Library_Process);

    Library := LIB.Get_Argument(
            Proc => Delete_Library_Process,
            Name => "library");

    return HL.Return_Code(Delete_Library_Interface(Library, LD.Delete_Library_Privilege));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end Delete_Library;
                                                                    pragma page;
::::::::::::::
deletel.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;
with Hif_Node_Defs;

function Delete_Library_Interface(
    Library   : in String_Pkg.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HND renames Hif_Node_Defs;

    Trap : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    HL.Ignore_Interrupts;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    LU.Delete_Library(Library, Privilege);
    if HL.Interrupts_Ignored then
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    else
        raise Process_Interrupted;
    end if;
    end if;
    if Message_on_Completion then
    HL.Put_Message_Line("Library " & SP.Value(SP.Upper(Library)) & " deleted.");
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name | Invalid_External_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Pending_Return =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Library_Pending_Return, Library, SP.Create(LU.Get_Library_Attribute(Library, "CI")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Process_Interrupted =>
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Delete_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when HL.Interrupt_Encountered =>
    raise HL.Interrupt_Encountered;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Delete_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Delete_Library_Interface;
                                                                    pragma page;
::::::::::::::
deletel.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Delete_Library_Interface(        --| Delete an Item Library
    Library   : in String_Pkg.String_Type;    --| Item library to be deleted
    Privilege : in Privilege_Type := WORLD    --| Delete privilege
    ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library to be deleted

--| Effects:
--| Delete a library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
deletep.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Declarations;

function Delete_Property return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package STR is new SI.String_Argument(
                String_Type_Name => "string");

    Delete_Property_Process : SI.Process_Handle;
    Library                 : SP.String_Type;
    Keyword                 : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Delete_Property_Process,
    Name    => "Delete_Property",
    Help    => "Delete a Property Keyword from the Item Library");

    LIB.Define_Argument(
    Proc => Delete_Property_Process,
    Name => "library",
    Help => "Name of the item library");

    STR.Define_Argument(
    Proc    => Delete_Property_Process,
    Name    => "keyword",
    Help    => "Property keyword");

    SP.Release;

    SI.Parse_Line(Delete_Property_Process);

    Library := LIB.Get_Argument(
            Proc => Delete_Property_Process,
            Name => "library");

    Keyword := STR.Get_Argument(
            Proc => Delete_Property_Process,
            Name => "keyword");

    ILM.Delete_Property(Library   => Library,
            Keyword   => Keyword,
            Privilege => ILD.OWNER);
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Keyword =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) & """ invalid.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Keyword_Not_Found =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) &
             """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Delete Property internal error.");
    return HL.Return_Code(HL.SEVERE);

end Delete_Property;

::::::::::::::
deletep.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;

function Delete_Property_Interface(
    Library   : in String_Pkg.String_Type;
    Keyword   : in String_Pkg.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;

    Node : HND.Node_Type;
    Trap : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    if not LU.Privileged(Privilege, Library) then
    raise No_Privilege;
    end if;
    LU.Open_Property_Node(Library, Keyword, SP.Create(""), DELETE, Node);
    HA.Set_Node_Attribute(Node   => Node,
              Attrib => SP.Value(Keyword),
              Value  => "");
    HNM.Close_Node_Handle(Node);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Property " & SP.Value(SP.Upper(Keyword)) &
        " deleted from for library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Keyword =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Keyword, Keyword);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Keyword_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Keyword_Not_Found, Keyword);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Delete_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Delete_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Delete_Property_Interface;
                                                                    pragma page;
::::::::::::::
deletep.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Delete_Property_Interface(        --| Delete Property Keyword
    Library   : in String_Pkg.String_Type;    --| Item library
    Keyword   : in String_Pkg.String_Type;    --| Property keyword
    Privilege : in Privilege_Type := WORLD    --| Delete privilege
    ) return Host_Lib.Severity_Code;

--| Requires:
--| The names of the library and the keyword.

--| Effects:
--| Keyword associated with the library is deleted.

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
delhuser.bdy
::::::::::::::
with HIF_System_Management;
with HIF_Node_management;
with HIF_Node_Defs;
with Document_Manager_Declarations;

function Delete_HIF_User_Interface(
    User : String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package HNM renames HIF_Node_Management;
    package HND renames HIF_Node_Defs;
    package HSM renames HIF_System_Management;
    package DMD renames Document_Manager_Declarations;

    DOCMGR_Node : HND.Node_Type;

begin

    begin
    HNM.Open_Node_Handle(DOCMGR_Node, DMD.Document_Manager_List_Path);

    -- In case this user is a catalog or library try and unlink it from
    -- the docmgr list node before deleting the user.  Notice that if the link
    -- doesn't exist and name error is raised nothing happens.

    begin
        HNM.Unlink(Base     => DOCMGR_Node,
               Key      => SP.Value(User),
               Relation => "CATALOG");
    exception
        when HND.Name_Error => null;
    end;
    begin
        HNM.Unlink(Base     => DOCMGR_Node,
               Key      => SP.Value(User),
               Relation => "LIBRARY");
    exception
        when HND.Name_Error => null;
    end;
    exception
    when HND.Name_Error => null;
    end;
    begin
    HSM.Delete_User(User_Name =>SP.Value(User));
    exception
    when HND.Name_Error => null;
    end;
    HNM.Close_Node_Handle(DOCMGR_Node);

    return HL.SUCCESS;

exception
    when others =>
    HL.Put_Error("Fatal error in delete");
    return HL.SEVERE;

end Delete_HIF_User_Interface;
                                                                    pragma page;
::::::::::::::
delhuser.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function Delete_HIF_User_Interface(        --| Delete a HIF user
    User : String_Pkg.String_Type        --| User to be deleted
    ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the user to be deleted

--| Effects:
--| Delete a HIF user

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
deluser.ada
::::::::::::::
with Host_Lib;
with String_pkg;
with Standard_Interface;
with Tool_Identifier;
with Delete_HIF_User_Interface;

function Delete_User return INTEGER is

    package HL  renames Host_Lib;
    package SP  renames String_pkg;
    package SI  renames Standard_Interface;

    Process  : SI.Process_Handle;

begin
    SI.Set_Tool_Identifier(Tool_Identifier);
    SI.Define_Process("delete_user",
               "Delete yourself as a documentation system user",
               Process);
    SI.Parse_Line(Process);
    return HL.Return_Code(Delete_HIF_User_Interface(SP.Create(HL.Get_Item(HL.USER_NAME))));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);
    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);
    when others =>
    HL.Put_Error("Fatal error in Delete_User");
    return HL.Return_Code(HL.SEVERE);

end Delete_User;
                                                                    pragma page;
::::::::::::::
docmgr.dat
::::::::::::::

package Document_Manager_Declarations is

--------------------------------------------------------------------------------
--    Change Document_Manager_List to alter the document manager's          --
--    list root node name  (No need to alter Document_Manager_List_Path).   --
--------------------------------------------------------------------------------

Document_Manager_List      : constant STRING := "DOCMGR";
Document_Manager_List_Path : constant STRING := "'USER(" & Document_Manager_List & ')';

end Document_Manager_Declarations;

::::::::::::::
fetchi.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with Library_Declarations;
with Fetch_Item_Interface;

function Fetch_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package ILD renames Library_Declarations;
    package LIB is new SI.String_Argument(String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(String_Type_Name => "item_name");
    package VER is new SI.String_Argument(String_Type_Name => "version");
    package FIM is new SI.Enumerated_Argument(Enum_Type      => ILD.State_Type,
                          Enum_Type_Name => "fetch_mode");

    Fetch_Item_Process  : SI.Process_Handle;
    Library             : SP.String_Type;
    Item                : SP.String_Type;
    Version             : SP.String_Type;
    Fetch_Item_Mode     : ILD.State_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Fetch_Item_Process,
    Name    => "Fetch_Item",
    Help    => "Fetch an Item from an Item Library");

    LIB.Define_Argument(
    Proc => Fetch_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc => Fetch_Item_Process,
    Name => "item",
    Help => "Name of the item to be fetched from the item library");

    VER.Define_Argument(
    Proc    => Fetch_Item_Process,
    Name    => "version",
    Default => "",
    Help    => "Version specification");

    FIM.Define_Argument(
    Proc    => Fetch_Item_Process,
    Name    => "mode",
    Default => ILD.NO_UPDATE,
    Help    => "Fetch mode:");

    FIM.Append_Argument_Help(
    Proc    => Fetch_Item_Process,
    Name    => "mode",
    Help    => "   NO_UPDATE : check out an item for read only");

    FIM.Append_Argument_Help(
    Proc    => Fetch_Item_Process,
    Name    => "mode",
    Help    => "   UPDATE    : check out an item for update");

    SP.Release;

    SI.Parse_Line(Fetch_Item_Process);

    Library := LIB.Get_Argument(
            Proc => Fetch_Item_Process,
            Name => "library");

    Item := ITM.Get_Argument(
            Proc => Fetch_Item_Process,
            Name => "item");

    Version := VER.Get_Argument(
            Proc => Fetch_Item_Process,
            Name => "version");

    Fetch_Item_Mode := FIM.Get_Argument(
            Proc => Fetch_Item_Process,
            Name => "mode");

    return HL.Return_Code(Fetch_Item_Interface(Library, Item, Version, Fetch_Item_Mode));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end Fetch_Item;
                                                                    pragma page;
::::::::::::::
fetchi.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with TEXT_IO;
with HIF_Utils;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;
with File_Manager;

function Fetch_Item_Interface(
    Library : in String_Pkg.String_Type;
    Item    : in String_Pkg.String_Type;
    Version : in String_Pkg.String_Type;
    Mode    : in State_Type := NO_UPDATE
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package TIO renames TEXT_IO;
    package HU  renames HIF_Utils;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;
    package FM  renames File_Manager;

    Library_Node        : HND.Node_Type;
    Item_Node           : HND.Node_Type;
    Full_Item_Name      : SP.String_Type;
    Full_Item_Node      : HND.Node_Type;
    Versions            : SL.List;
    Version_Number      : SP.String_Type;
    File_Handle         : TIO.File_Type;
    Attribute_Value     : STRING(1 .. 16);
    Attribute_Length    : INTEGER;
    Check_Out_Count     : NATURAL;
    Checked_Out_Version : SP.String_Type;
    Trap                : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if Mode = UPDATE then
    if not LU.Lock_Library(Library, WRITE_LOCK) then
        raise Library_Write_Locked;
    end if;
    else
    if not LU.Lock_Library(Library, READ_LOCK) then
        raise Library_Read_Locked;
    end if;
    end if;
    LU.Is_Item(Item_Node, Library, Item);
    if not HNM.Is_Open(Item_Node) then
    raise Item_Not_Found;
    end if;
    if Mode = UPDATE then
    Checked_Out_Version := SP.Make_Persistent(LU.Checked_Out_By(Item_Node));
    if not SP.Is_Empty(Checked_Out_Version) then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Checked_Out;
    end if;
    end if;
    Versions := LU.Get_Version(Item_Node, Version);
    Version_Number := SL.FirstValue(Versions);
    HU.Get_Node_Attribute(Node       => Item_Node,
              Attrib     => "V",
              Value      => Attribute_Value,
              Value_Last => Attribute_Length);
    if Mode = UPDATE and
       Attribute_Value(1 .. Attribute_Length) /= SP.Value(Version_Number) then
    Destroy_String_List(Versions);
    HNM.Close_Node_Handle(Item_Node);
    raise Invalid_Operation;
    end if;
    Full_Item_Name := LU.Node_Name(Library, Item, SP.Value(Version_Number));
    Checked_Out_Version := SP.Make_Persistent(SP.Value(Version_Number));
    Destroy_String_List(Versions);
    LU.Is_Node(Full_Item_Node, Full_Item_Name);
    if not HNM.Is_Open(Full_Item_Node) then
    HNM.Close_Node_Handle(Item_Node);
    raise Internal_Error;
    end if;
    begin
    FM.Copy(HNM.Host_File_Name(Full_Item_Node),
        SP.Value(Item));
    exception
    when others =>
        HNM.Close_Node_Handle(Full_Item_Node);
        HNM.Close_Node_Handle(Item_Node);
        raise File_Not_Created;
    end;
    HNM.Close_Node_Handle(Full_Item_Node);
    if Mode = UPDATE then
    HA.Set_Node_Attribute(Node   => Item_Node,
                  Attrib => "CHECKED_OUT",
                  Value  => HL.Get_Item(HL.USER_NAME));
    LU.Change_Checked_Out_Count(Library, +1);
    LU.Unlock_Library(Library, WRITE_LOCK);
    else
    LU.Unlock_Library(Library, READ_LOCK);
    end if;
    HNM.Close_Node_Handle(Item_Node);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Item " & SP.Value(SP.Upper(Item)) & '/' & SP.Value(Checked_Out_Version) &
        " fetched from library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Read_Locked =>
    LE.Report_Error(LE.Library_Read_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Found, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when File_Not_Created =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.File_Not_Created, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Set_Protection_Error =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Set_Protection_Error, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Checked_Out =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Checked_Out, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Operation =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Operation, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Version =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Version, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Version_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Version_Not_Found, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Fetch_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Fetch_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Fetch_Item_Interface;
                                                                    pragma page;
::::::::::::::
fetchi.spc
::::::::::::::
with String_Pkg;
with Host_Lib;
with Library_Declarations;

function Fetch_Item_Interface(            --| Fetch an Item
   Library : in String_Pkg.String_Type;        --| Item library
   Item    : in String_Pkg.String_Type;        --| Item to be fetched
   Version : in String_Pkg.String_Type;        --| Version specification
   Mode    : in Library_Declarations.State_Type := Library_Declarations.NO_UPDATE
                        --| Fetch mode: (NO_UPDATE/UPDATE)
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library, item name to be fetched from the library, and version
--| specification of the item to be fetched

--| Effects:
--| Creates a file (in the external file system) from the named version of
--| the named item in the named library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
fgen.bdy
::::::::::::::

with String_Pkg;
with String_Utilities; use String_Utilities;
with Text_IO;
with Catalog_Manager;
with CI_Ids;
with Item_Library_Manager_Utilities;
with Host_Dependencies;
with Stack_Pkg;
with Labeled_Binary_Trees_Pkg;
with Case_Insensitive_String_Comparison;
with File_Manager;
with Item_Library_Manager_Declarations;

package body Process_File is

---------------------------------------------------

-- package SP renames String_Pkg;
package CISC renames Case_Insensitive_String_Comparison;
package FM renames File_Manager;
package ILMD renames Item_Library_Manager_Declarations;
package CM renames Catalog_Manager;

---------------------------------------------------

    Line_Mark: constant character:= '#';

    Curr_Catalog: SP.String_Type; -- Catalog containing source file.

    function Compare(x,y: SP.String_Type) return INTEGER;

    package VL is new Labeled_Binary_Trees_Pkg(
                Label_Type => SP.String_Type,
                Value_Type => SP.String_Type,
                Difference => Compare);

    -- handling a number of files:
    type File_Kind_Type is (Cat_File, Lib_File, Arbitrary_File);

    type File_Info_Type(File_Kind : File_Kind_Type) is record
    Full_File_Name    : SP.String_Type;
    My_Variables    : VL.tree;
    Line_Number    : INTEGER;
    case File_Kind is
        when Cat_File =>
        CI_Name        : SP.String_Type;
        Comp_Name    : SP.String_Type;
        CI_Version    : SP.String_Type;
        when Lib_File =>
        Lib_Name    : SP.String_Type;
        Item_Name    : SP.String_Type;
        Item_Version    : SP.String_Type;
        when Arbitrary_File =>
        NULL;

      end case;

    end record;

    type File_Info_Ptr is access File_Info_Type;
    Curr_File_Info    : File_Info_Ptr := Null;

    package ST is new Stack_Pkg(File_Info_Ptr);

    File_Stack        : ST.Stack := ST.Create;

    -- to prosess a directive line
    package SU is new String_Utilities.Generic_String_Utilities(
                Generic_String_Type => SP.String_Type,
                To_Generic => SP.Create,
                From_Generic => SP.Value);
    use SU;


-- local procedures
----------------------------------------------------------------

procedure Scan_File_And_Copy(
        Full_File_Name    : in out SP.String_Type;
        File_Kind    : File_Kind_Type;
        CI_Or_Lib_Name    : SP.String_Type;
        Comp_Or_Item_Name : SP.String_Type;
        Version        : SP.String_Type);

-----------------------------------------------------------------

procedure Process_Directive(
        S    : Scanner);

----------------------------------------------------------------

procedure Process_Variable_Def(
        S    : Scanner);

--------------------------------------------------------------

procedure Process_Include(
        S    : Scanner);

-------------------------------------------------------------

procedure Process_Substitution(
        S    : Scanner);
-----------------------------------------------------------------

function Process_Primary(
        S    : Scanner) return SP.String_Type;

-----------------------------------------------------------------

procedure Init_Variables;

-----------------------------------------------------------------

procedure Put_Location;

-----------------------------------------------------------------

function Check_Cycle(
        Full_File_Name    : SP.String_Type;
        File_Kind    : File_Kind_Type;
        CI_Or_Lib_Name    : SP.String_Type;
        Comp_Or_Item_Name : SP.String_Type;
        Version        : SP.String_Type) return boolean;

-----------------------------------------------------------------

procedure Check_Nothing_Or_Comment_Left(
        S    : Scanner);

-----------------------------------------------------------------

function Compare(
    X,Y    : SP.String_Type) return INTEGER is

    Result    : INTEGER;
begin

    return CISC.Compare(SP.Value(X), SP.Value(Y));

end Compare;

--------------------------------------------------------------

procedure File_Gen(
    Source_File    : SP.String_Type;
    Result_File    : SP.String_Type;
    Catalog    : SP.String_Type;
    CI_Name_Ver    : SP.String_Type) is

    Full_File_Name : SP.String_Type;
    File_From_Cat : boolean;
    Id        : CI_Ids.CI_Id_Type;
    Output_File    : Text_IO.File_Type;

begin
    Curr_Catalog := Catalog;

    -- open the input and output files; set them to the standard
    -- input and output files
    File_From_Cat := not SP.Is_Empty(CI_Name_Ver);
    if not File_From_Cat then
    Full_File_Name := SP.Create(FM.Parse_Filename(SP.Value(Source_File)));
                    --now the name is a full path name

    else
    Full_File_Name := CM.Get_Hif_File_Name
                (Catalog, CI_Name_Ver, Source_File);

    end if;

    if not SP.Is_Empty(Result_File) then
      begin
        Text_IO.Create(Output_File, Text_IO.Out_File, SP.Value(Result_File));
    Text_IO.Set_Output(Output_File);
      exception
    when Text_IO.Status_Error | Text_IO.Name_Error | Text_IO.Use_Error =>
      text_IO.put_Line("?? Unable to open " & SP.Value(Result_File)
            & " for output");
      raise abort_filegen;
      end;
    end if;

    -- do the work
    if not File_From_Cat then
    Scan_File_And_Copy(Full_File_Name, Arbitrary_File, SP.Create(""),
               SP.Create(""), SP.Create(""));

    else
    Id := CI_Ids.Get_CI_Id(CI_Name_Ver);
    Scan_File_And_Copy(Full_File_Name, Cat_File, CI_Ids.Get_Name(Id),
               Source_File, CI_Ids.Get_Version(Id));

    end if;

    if not SP.Is_Empty(Result_File) then
        Text_IO.Close(Output_File);

    end if;

exception
    when FM.Parse_Error =>
    Text_IO.Put_Line(SP.Value(Source_File) & " is illegal file name");
    raise abort_filegen;

    when CM.No_Such_Catalog =>
    Text_IO.Put_Line("No such catalog " & SP.Value(Catalog));
    raise abort_filegen;

    when CM.No_Such_Ci | CM.invalid_ci_id | CM.deleted_ci =>
    Text_IO.Put_Line("No such ci item " & SP.Value(CI_Name_Ver));
    raise abort_filegen;

    when CM.No_Such_Component | CM.invalid_ci_name =>
    Text_IO.Put_Line("No such ci component " & SP.Value(Source_File));
    raise abort_filegen;

end file_gen;

-----------------------------------------------------------------

procedure Scan_File_And_Copy(
        Full_File_Name    : in out SP.String_Type;
        File_Kind    : File_Kind_Type;
        CI_Or_Lib_Name    : SP.String_Type;
        Comp_Or_Item_Name : SP.String_Type;
        Version        : SP.String_Type) is

    Input_File    : Text_IO.File_Type;
    Line    : string(1..256);    -- This can be changed
    Length    : INTEGER;
    called_1st_time: boolean := False;

begin
    -- all SP strings created in the processing of a file will
    -- be released at the end of this procedure
--xx    SP.mark;

    -- handle the existence of the new file
    if Curr_File_Info = Null then
        called_1st_time := TRUE;

    else
    if Check_Cycle(Full_File_Name, File_Kind, CI_Or_Lib_Name,
               Comp_Or_Item_Name, Version) then
--xx        SP.Release;
        return;

    else
            -- everything went fine
        ST.Push(File_Stack, Curr_File_Info);

    end if;

    end if;

    Text_IO.Open(Input_File, Text_IO.In_File, SP.Value(Full_File_Name));

    case File_Kind is
    when Cat_File =>
            Curr_File_Info := new File_Info_Type(Cat_File);
        Curr_File_Info.CI_Name := CI_Or_Lib_Name;
        Curr_File_Info.Comp_Name := Comp_Or_Item_Name;
        Curr_File_Info.CI_Version := Version;

    when Lib_File =>
            Curr_File_Info := new File_Info_Type(Lib_File);
        Curr_File_Info.Lib_Name := CI_Or_Lib_Name;
        Curr_File_Info.Item_Name := Comp_Or_Item_Name;
        Curr_File_Info.Item_Version := Version;

    when Arbitrary_File =>
            Curr_File_Info := new File_Info_Type(Arbitrary_File);
        Full_File_Name := SP.Create(FM.Parse_Filename(SP.Value(Full_File_Name)));
                --now the name is a full path name

    end case;

    Curr_File_Info.Full_File_Name := Full_File_Name;
    Curr_File_Info.My_Variables := VL.Create;
    Curr_File_Info.Line_Number := 0;

    -- put values of the predefined variables (i.e. date, CI
    -- ITEM, Version) into the tree
    Init_Variables;


    -- read lines and process them
    while not Text_IO.End_Of_File(Input_File) loop
    Text_IO.Get_Line(Input_File, Line(1..Line'Last), Length);
    Curr_File_Info.Line_Number := Curr_File_Info.Line_Number + 1;

    if Length > 0 and then Line(1) = Line_Mark then
        -- if the 2nd is also Line_Mark just copy the line
        -- stripping the 1st Line_mark
        if Line(2) = Line_Mark then
        Text_IO.Put_Line(Line(2..Length));

        else
        Process_Directive(SU.Make_Scanner(SP.Create(Line(2..Length))));

        end if;

    else
        Text_IO.Put_Line(Line(1..Length));

    end if;

    end loop;

--xx    SP.Release;

    if not called_1st_time then
    ST.Pop(File_Stack, Curr_File_Info);

    end if;

    Text_IO.Close(Input_File);

    return;

exception
    when Text_IO.Status_Error | Text_IO.Name_Error | Text_IO.Use_Error =>
        if not called_1st_time then
        ST.Pop(File_Stack, Curr_File_Info);

        Put_Location;
            -- this exception can happen only when opening
            -- an arbitrary file;
            -- location is of a file which
            -- includes a file
        end if;
    Text_IO.Put_Line("    Error opening file " & SP.Value(Full_File_Name));
    return;

end Scan_File_And_Copy;

-------------------------------------------------------------------------

procedure Process_Directive(
    S    : Scanner) is

    C    : Character;
    Found    : boolean;
    Word    : SP.String_Type;

begin
    if not More(S) then
    return;

    end if;

    Mark(S);

    Skip_Space(S);

    Scan_Ada_Id(S, Found, Word, True);

    SP.Set_Comparison_Option(SP.Case_Insensitive);

    If Found and then SP.Equal(Word, "set") then
    Process_Variable_Def(S);

    elsif Found and then SP.Equal(Word, "include") then
    Process_Include(S);

    else
    --it must be a substitution or a comment; go back one word.
    Restore(S);
    Process_Substitution(S);

    end if;


    return;

end Process_Directive;

---------------------------------------------------------------

procedure Process_Variable_Def(
        S    : Scanner) is

        Var    : SP.String_Type;
        Found    : boolean;
         C    : character;
        Val    : SP.String_Type;
                -- value of a primary expr
        Dupl    : SP.String_Type;

begin
    -- Var := Primary expr
    Scan_ADA_Id(S, Found, Var, True);
    if not Found then
    --illegal directive
    Put_Location;
    Text_IO.Put_Line("    In ""Set Variable"" Variable must be an ADA id.");
    Return;

    end if;

    Skip_Space(S);
    Next(S,C);
    if  C /= ':' then
    --illegal directive
    Put_Location;
    Text_IO.Put_Line("    To define a variable: Set Variable := Primary Expr.");
    Return;

    end if;

    Skip_Space(S);
    Next(S,C);
    if C /= '=' then
    --illegal directive
    Put_Location;
    Text_IO.Put_Line("    To define a variable: Set Variable := Primary Expr.");
    Return;

    end if;

    Skip_Space(S);
    Val := Process_Primary(S);
    VL.Insert_If_Not_Found(Var, Val, Curr_File_Info.My_Variables,
               Found, Dupl);

    if Found then
    -- multiple definition of a variable
    Put_Location;
    Text_IO.Put_Line("    Multiple definitions of the variable " &
             SP.Value(Var));
    Return;

    end if;

    Check_Nothing_Or_Comment_Left(S);

    return;

end Process_Variable_Def;

--------------------------------------------------------------

procedure Process_Include(
        S    : Scanner) is

        Found    : boolean;
        Word    : SP.String_Type;
        C    : Character;
        CI_Or_IL: SP.String_Type;
        Item    : SP.String_Type;
        Version    : SP.String_Type;
        Full_File_Name : SP.String_Type;
        CI_Name_Ver : SP.String_Type;
                -- CI version
        File_Name : SP.String_Type;

begin

    -- Syntax to scan:
    -- "File" Primary expr
    -- "CI_comp" Primary expr "," Primary expr "," Primary expr
    -- "IL_item" Primary expr "," Primary expr "," Primary expr
    Scan_ADA_Id(S, Found, Word, True);
    if not Found then
    --illegal directive
    Put_Location;
    Text_IO.Put_Line("    To include a file: Include File Primary expr or");
    Text_IO.Put_Line("    Include CI_Comp | IL_Item Primary expr, Primary expr, Primary exp");
    Return;

    end if;

    -- the following comparisons are case insensitive
    if SP.Equal(Word,"file") then
    File_Name := Process_Primary(S);
    Full_File_Name := SP.Create(FM.Parse_Filename(SP.Value(File_Name)));
                --now the name is a full path name
        Scan_File_And_Copy(Full_File_Name, Arbitrary_File, SP.Create(""),
               SP.Create(""), SP.Create(""));

    elsif SP.Equal(Word, "ci_comp") or SP.Equal(Word, "il_item") then
    CI_Or_IL := Process_Primary(S);
    Skip_Space(S);
    Next(S,C);
    if C /=',' then
        -- illegal directive
          Put_Location;
         Text_IO.Put_Line("    To include a file: Include File Primary expr or");
        Text_IO.Put_Line("    Include CI_Comp | IL_Item Primary expr, Primary expr, Primary exp");
        Return;

    end if;

    Item := Process_Primary(S);
    Skip_Space(S);
    Next(S,C);
    if C /=',' then
        -- illegal directive
          Put_Location;
         Text_IO.Put_Line("    To include a file: Include File Primary expr or");
        Text_IO.Put_Line("    Include CI_Comp | IL_Item Primary expr, Primary expr, Primary exp");
        Return;

    end if;

    Version := Process_Primary(S);

    if SP.Equal(Word, "ci_comp") then
        CI_Name_Ver := SP.Create(SP.Value(CI_Or_IL) & " " & SP.Value(Version));
        Full_File_Name := CM.Get_Hif_File_Name
                    (Curr_Catalog, CI_Name_Ver, Item);
        Scan_File_And_Copy(Full_File_Name, Cat_File, CI_Or_IL, Item,
                   Version);

    else
        Full_File_Name := Item_Library_Manager_Utilities.Get_Hif_File_Name
                (CI_Or_IL, Item, Version);
        Scan_File_And_Copy(Full_File_Name, Lib_File, CI_Or_IL, Item,
                   Version);

    end if;

    else
    -- illegal directive
      Put_Location;
    Text_IO.Put_Line("    To include a file: Include File Primary expr or");
    Text_IO.Put_Line("    Include CI_Comp | IL_Item Primary expr, Primary expr, Primary exp");
    Return;

    end if;

    Check_Nothing_Or_Comment_Left(S);

    return;

exception
    when FM.Parse_Error =>
    Put_Location;
    Text_IO.Put_Line("    " & SP.Value(File_Name) & " is illegal file name");
    return;

-- the following two exceptions do not exist at this time but will be added
--    when CM.No_Such_Catalog =>
--    Put_Location;
--    Text_IO.Put_Line("    No such catalog " & SP.Value(Curr_Catalog));
--    return;

    when CM.No_Such_Ci =>
    Put_location;
    Text_IO.Put_Line("    No such ci item " & SP.Value(CI_Name_Ver));
    return;

--    when CM.No_Such_Component =>
--    Put_location;
--    Text_IO.Put_Line("    No such ci component " & SP.Value(Item));
--    return;

    when ILMD.Invalid_Library_Name | ILMD.Library_Does_Not_Exist =>
    Put_location;
    Text_IO.Put_Line("    No such ci library " & SP.Value(CI_Or_IL));
    return;

    when ILMD.Item_Not_Found =>
    Put_location;
    Text_IO.Put_Line("    No such library item " & SP.Value(Item));
    return;

    when ILMD.Invalid_Version | ILMD.Version_Not_Found =>
    Put_location;
    Text_IO.Put_Line("    No such item version " & SP.Value(Version));
    return;

end Process_Include;

-------------------------------------------------------------

procedure Process_Substitution(
        S    : Scanner) is

        C    : Character;
        Found    : boolean;
        Result    : SP.String_Type := SP.Create("");
        Spaces    : SP.String_Type;
        Just_Comment : boolean := TRUE;

begin

    while More(S) loop

    --get the leading spaces
    Scan_Space(S, Found, Spaces);
    if Found then
        Result := SP."&"(Result, Spaces);

    end if;

        --recognise "--"
        if Get(S) = '-' then
        --throw away the first "-"
        Next(S,C);
        if More(S) and then Get(S) /= '-' then
        --illegal directive
            Put_Location;
            Text_IO.Put_Line("    Illegal directive.");

        end if;
        if Just_Comment then
                return;

        else
        exit;

        end if;

        end if;

    Just_Comment := False;

    Result := SP."&"(Result, Process_Primary(S));
    if More(S) then
        Scan_Space(S, Found, Spaces);
        if not Found then
        --illegal directive
        Put_Location;
        Text_IO.Put_Line("    Illegal syntax for substitution.");
        return;

        end if;
        Result := SP."&"(Result, Spaces);

    end if;

    end loop;

    if not SP.Is_Empty(Result) then
        Text_IO.Put_Line(SP.Value(Result));

    end if;

    return;

end Process_Substitution;

-------------------------------------------------------------

function Process_Primary(
        S    : Scanner) return SP.String_Type is

        Found    : boolean;
        String_Val : SP.String_Type;
        Var    : SP.String_Type;
        Var_Val    : SP.String_Type;

begin

    Skip_Space(S);

    if Get(S) = '"' then
    --this must be a string
    Scan_Quoted(S, Found, String_Val, True);
    if not Found then
        -- illegal directive
        Put_Location;
        Text_IO.Put_Line("    Illegal string in a Primary expr.");
        return SP.Create("");

    end if;
    return String_Val;

    else
    Scan_ADA_Id(S, Found, Var, True);
    if not Found then
        --illegal directive
        Put_Location;
        Text_IO.Put_Line("    Illegal Primary expr.");
        return SP.Create("");

        end if;

    -- find a value of the variable
    VL.Find(Var, Curr_File_Info.My_Variables, Found, Var_Val);
    if not Found then
        -- variable is not defined
        Put_Location;
        Text_IO.Put_Line("    Variable " & SP.Value(Var) &
                 " is not defined.");
        return SP.Create("");

    end if;

    Return Var_Val;

    end if;

end Process_Primary;

--------------------------------------------------------------

procedure Init_Variables is

        CI    : SP.String_Type;
        Version    : SP.String_Type;
        Comp_Name : SP.String_Type;
        Date    : SP.String_Type;
begin


    if Curr_File_Info.File_Kind = Cat_File then
    CI := Curr_File_Info.CI_Name;
    Comp_Name := Curr_File_Info.Comp_Name;
    Version := Curr_File_Info.CI_Version;
    Date := CM.Ci_Date_Time(Curr_Catalog, CI, Version);

    else
    CI := SP.Create("CI?");
    Version := SP.Create("Version?");
    Comp_Name := SP.Create("COMP?");
    if Curr_File_Info.File_Kind = Lib_File then
        Date := SP.Create(Item_Library_Manager_Utilities.Get_Item_Date_Time
                   (Curr_File_Info.Lib_Name, Curr_File_Info.Item_Name,
                Curr_File_Info.Item_Version));

       else
        Date := SP.Create(FM.Modification_Date(
                  SP.Value(Curr_File_Info.Full_File_Name)));

         end if;

    end if;

    VL.Insert(SP.Create("ci"), CI, Curr_File_Info.My_Variables);
    VL.Insert(SP.Create("comp"), Comp_Name, Curr_File_Info.My_Variables);
    VL.Insert(SP.Create("version"), Version, Curr_File_Info.My_Variables);
    VL.Insert(SP.Create("date"), Date, Curr_File_Info.My_Variables);

    return;

end Init_Variables;

---------------------------------------------------------------

procedure Put_Location is

begin

    case Curr_File_Info.File_Kind is
    when Cat_File =>
        Text_IO.Put("ERROR: CI " & SP.Value(Curr_File_Info.CI_Name) &
                 ", Comp " & SP.Value(Curr_File_Info.Comp_Name) &
                 ", Version " & SP.Value(Curr_File_Info.CI_Version) &
                 ":");

    when Lib_File =>
        Text_IO.Put("ERROR: Lib " & SP.Value(Curr_File_Info.Lib_Name) &
                 ", Item " & SP.Value(Curr_File_Info.Item_Name) &
                 ", Version " & SP.Value(Curr_File_Info.Item_Version) &
                 ":");

    when Arbitrary_File =>
        Text_IO.Put("ERROR: File " & SP.Value(Curr_File_Info.Full_File_Name) & ":");

    end case;

    Text_IO.Put_Line(" line " & INTEGER'Image(Curr_File_Info.Line_Number) & ":");

    return;

end Put_Location;

----------------------------------------------------------------

function Check_Cycle(
        Full_File_Name    : SP.String_Type;
        File_Kind    : File_Kind_Type;
        CI_Or_Lib_Name    : SP.String_Type;
        Comp_Or_Item_Name : SP.String_Type;
        Version        : SP.String_Type) return boolean is

        Temp_Stack    : ST.Stack;
        Ptr        : File_Info_Ptr;

begin

    -- check whether the file (passed as the set of arguments
    -- to this function) is already in the list of files currently
    -- being included
    Temp_Stack := ST.Copy(File_Stack);
    --all files are in the stack except for the last one;
    -- so to make all cases similar put the last file which
    -- is still in curr_file_info into the stack
    ST.Push(Temp_Stack, Curr_File_Info);

    SP.Set_Comparison_Option(SP.Case_Insensitive);

    while not ST.Is_Empty(Temp_Stack) loop
    ST.Pop(Temp_Stack, Ptr);
    if File_Kind = Ptr.File_Kind then
        if SP.Equal(Full_File_Name, Ptr.Full_File_Name) then
            case File_Kind is
            when Cat_File =>
                Text_IO.Put_Line(
                 "ERROR: CI " & SP.Value(CI_Or_Lib_Name) &
                 ", Comp " & SP.Value(Comp_Or_Item_Name) &
                 ", Version " & SP.Value(Version) &
                 ":");

                when Lib_File =>
                Text_IO.Put_Line(
                "ERROR: Lib " & SP.Value(CI_Or_Lib_Name) &
                 ", Item " & SP.Value(Comp_Or_Item_Name) &
                 ", Version " & SP.Value(Version) &
                 ":");

            when Arbitrary_File =>
                Text_IO.Put_Line(
                "ERROR: File " & SP.Value(Full_File_Name) & ":");

            end case;
                Text_IO.Put_Line("    Includes itself either directly or indirectly");
        SP.Set_Comparison_Option(SP.Case_Sensitive);
        return TRUE;

        end if;

    end if;

    end loop;

    ST.Destroy(Temp_Stack);

    SP.Set_Comparison_Option(SP.Case_Sensitive);

    return FALSE;

end Check_Cycle;

-----------------------------------------------------------

procedure Check_Nothing_Or_Comment_Left(
        S    : Scanner) is

        C    : character;

begin
    --check that there is nothing or only a comment left
    if More(S) then
    Skip_Space(S);
    if More(S) then
        Next(S,C);
        if C = '-' and then More(S) then
        Next(S,C);
        if C /= '-' then
            -- illegal directive
            Put_Location;
            Text_IO.Put_Line("    Illegal directive");

        end if;
        else
        -- illegal directive
        Put_Location;
        Text_IO.Put_Line("    Illegal directive");

        end if;

       end if;

    end if;

end Check_Nothing_Or_Comment_Left;

end Process_File;
::::::::::::::
fgen.spc
::::::::::::::
with String_Pkg;

package Process_File is

package SP renames String_Pkg;

abort_filegen: exception;

procedure File_Gen(
    Source_File    : SP.String_Type;
    Result_File    : SP.String_Type;
    Catalog        : SP.String_Type;
    CI_Name_Ver    : SP.String_Type);

end Process_File;
::::::::::::::
filegen.ada
::::::::::::::
function fileGen return INTEGER;


with Standard_Interface; use Standard_Interface;
with String_pkg;
with Host_Lib;
with Process_File;
with Text_IO;

function fileGen return INTEGER is

    package SP renames String_pkg;

    package Str_Arg is new String_Argument(
    String_Type_Name => "STRING");

    fgen    : Process_Handle;
    Source_File    : SP.String_Type;
    Output_File    : SP.String_Type;
    Catalog    : SP.String_Type;
    CI_Name    : SP.String_Type;

begin

    Host_Lib.Set_Error;
    Set_Tool_Identifier("1.0");

    Define_Process(
    Name => "fileGen",
    Help => "Includes files; simple substitutions.",
    Proc => fgen);

    Str_Arg.Define_Argument(
        Proc => fgen,
    Name => "Source",
    Help => "Source file (or a CI component) to process");

    Str_Arg.Define_Argument(
        Proc => fgen,
    Name => "Output",
    Default => "",
    Help => "Output file (default is standard output)");

    Str_Arg.Define_Argument(
        Proc => fgen,
    Name => "Catalog",
    Default => "",
    Help => "Catalog name (default is no catalog)");

    Str_Arg.Define_Argument(
        Proc => fgen,
    Name => "CI_Name",
    Default => "",
    Help => "CI name (default is no CI)");

    --get arguments
    Parse_Line(fgen);

    Source_File := Str_Arg.Get_Argument(
            Proc => fgen,
            Name => "Source");

    Output_File := Str_Arg.Get_Argument(
            Proc => fgen,
            Name => "Output");

    Catalog := Str_Arg.Get_Argument(
            Proc => fgen,
            Name => "Catalog");

    CI_Name := Str_Arg.Get_Argument(
            Proc => fgen,
            Name => "CI_name");

    Process_File.File_gen(Source_File, Output_File, Catalog, CI_Name);

    return Host_Lib.Return_Code(Host_Lib.Success);

exception
    when Process_File.abort_FileGen =>
    -- Error message was already printed when exception was raised
    return Host_Lib.Return_Code(Host_Lib.Error);

    when Process_Help =>
    return Host_Lib.Return_Code(Host_Lib.Information);

    when Abort_Process =>
    return Host_Lib.Return_Code(Host_Lib.Error);

--x    when others =>
--x    Text_IO.Put_Line("File Generator internal Error");
--x    return Host_Lib.Return_Code(Host_Lib.Error);

end fileGen;
::::::::::::::
hifutil.bdy
::::::::::::::
with hif_attributes;

package body hif_utils is

--| Overview: This package contains subprograms which will aid in the
--| interface to the HIF.

package HA renames hif_attributes;

function enquote (    --| Puts a string in the right format  to be a
            --| hif list quoted string
    s : in string_type     --| string to enquote
    ) return string is
    begin
    return value ( """" & s & """");
    end;

function enquote (    --| Puts a string in the right format  to be a
            --| hif list quoted string
    s : in string_type     --| string to enquote
    ) return string_type is
    begin
    return """" & s & """";
    end;


procedure get_node_attribute (    --| Strips off the parens returned on an
                --| attribute.
    node : in ND.node_type;
    attrib : in ND.attrib_name;
    value : in out ND.value_string;
    value_last : out ND.value_string_range
    ) is
    length : ND.value_string_range;
    begin
    HA.get_node_attribute (node, attrib, value, length);
    if value(1..length) = "()" then
        value_last := 0;
    else
        value_last := length;
    end if;
    end get_node_attribute;

procedure get_path_attribute (    --| Strips off the parens returned on an
                --| attribute.
    node : in ND.node_type;
    attrib : in ND.attrib_name;
    value : in out ND.value_string;
    value_last : out ND.value_string_range
    ) is
    length : ND.value_string_range;
    begin
    HA.get_path_attribute (node, attrib, value, length);
    if value(1..length) = "()" then
        value_last := 0;
    else
        value_last := length;
    end if;
    end get_path_attribute;

end hif_utils;
::::::::::::::
hifutil.spc
::::::::::::::
with string_pkg;  use string_pkg;
with hif_node_defs;

package hif_utils is

--| Overview: This package contains subprograms which will aid in the
--| interface to the HIF.

package ND renames hif_node_defs;

function enquote (    --| Puts a string in the right format  to be a
            --| hif list quoted string
    s : in string_type     --| string to enquote
    ) return string;

function enquote (    --| Puts a string in the right format  to be a
            --| hif list quoted string
    s : in string_type     --| string to enquote
    ) return string_type;

procedure get_node_attribute (    --| Strips off the parens returned on an
                --| attribute.
    node : in ND.node_type;
    attrib : in ND.attrib_name;
    value : in out ND.value_string;
    value_last : out ND.value_string_range
    );

procedure get_path_attribute (    --| Strips off the parens returned on an
                --| attribute.
    node : in ND.node_type;
    attrib : in ND.attrib_name;
    value : in out ND.value_string;
    value_last : out ND.value_string_range
    );

end hif_utils;
::::::::::::::
interface.bdy
::::::::::::::
with hif_node_management;
with hif_node_defs; use hif_node_defs;
with hif_list_utils;
with hif_attributes;
with catalog_locks;
with text_io;
with hif_system_management;
with catalog_manager;
with interpret;
with file_manager;
with string_utilities;
with lists;
with host_lib;
with document_manager_declarations;
with catalog_decls;
with ci_index_mgr;
with ci_ids;
with paginated_output;
with hif_utils;

package body catalog_interface is

--| Overview
--|
--| This package contains the procedures which  control input to the
--| catalog.  The two main procedures are those  that are the interactive
--| interface to the catalog routines.  Any other catalog functions that
--| are invoked from the command line will also be in this package.
--| There are two of these, namely, check_consistency and list_catalogs.

package NM renames hif_node_management;
package ND renames hif_node_defs;
package LU renames hif_list_utils;
package ATT renames hif_attributes;
package CL renames catalog_locks;
package TIO renames text_io;
package SM renames hif_system_management;
package CM renames catalog_manager;
package FM renames file_manager;
package SU renames string_utilities;
package HL renames host_lib;
package DMD renames document_manager_declarations;
package CD renames catalog_decls;
package IM renames ci_index_mgr;
package ID renames ci_ids;
package PG renames paginated_output;
package HU renames hif_utils;

package SS is new SU.generic_string_utilities(SP.string_type,
                          SP.create,
                          SP.value);
use string_pkg;        -- for visiblity of "&"

---- Local operations:

function name_of (            --| figure out the ci id of a node
    node : ND.node_type
    ) return string;

procedure report (            --| write a diagnostic to the report
    line : string
    );

procedure check_root (            --| check the information on the
                    --| trunk node.
    node : ND.node_type;
    name : string
    );

procedure check_trunk_node (        --| do all the checks required for a
                    --| trunk node.
    node : ND.node_type
    );

procedure check_ci_node (        --| check the properties on a CI node
    node : ND.node_type;
    name : string
    );

procedure check_branch_node (        --| the branch attributes
    node : ND.node_type
    );

---- Local variables:
max_wait : duration    -- how long to wait for locks.  Not yet implemented
    := 0.0;
version         : SP.string_type;        -- all these are for check consistency
output_file  : PG.paginated_file_handle;

---- Global operations:

procedure open_catalog (    --| Open a catalog with the given name
    catalog_name : SP.string_type    --| Name of the catalog
    ) is

    user : SP.string_type;

    --| Algorithm: The first thing to do is set the current node as every
    --| other package will depend on this being set correctly (including the
    --| locking package).
    --| Before getting the read lock it has to check that the password
    --| relation exists for the catalog node.  Otherwise the odd situation
    --| can occur during write where the catalog has just been created, but
    --| not locked and another user getting a read lock in the middle of
    --| this would cause the create to fail.
    --| The default upon opening a catalog is a read lock.  Many users can
    --| have read locks on a catalog at the same time as they will not be
    --| doing anything that will interfere with anyone.  If a user wants to
    --| perform an operation that takes a write lock the read lock can be
    --| upgraded, but the rules for write locks apply.
    --| If the read lock is obtained (i.e. read_lock returns true) then invoke
    --| command interpreter and continue until they exit.  When they exit
    --| remove the read lock.
    --| If the read lock returns false it is because some one has locked the
    --| catalog to write.  The user gets a message with the other user's id
    --| indicating who has the lock.  This is in order that should someone
    --| accidentally abort out of the catalog leaving a lock behind other
    --| users can tell if a write lock for a single person has been on an
    --| especially long time.

    ans  : string (1..1);    -- answer to a yes/no prompt
    word : SP.string_type;    -- word is answer to a password prompt
    last : natural;
    node : node_type;
    iter : NM.node_iterator;

    begin
    NM.set_current_node ("'user(" & SP.value(catalog_name) & ")");
    NM.get_current_node (node);
    begin
        -- the only way to see if the password path exists is to
        -- iterate over the relations emanting from the current node.
        NM.iterate (iter, node, relation=>"password", primary_only=>false);
        if not NM.more (iter) then
        Text_io.put_line ("Catalog not yet created");
            return;
        end if;
    end;
    if CL.read_lock (max_wait) then
        interpret.command_interpreter;
        CL.remove_read;
    else
        CL.get_write_user (user);
        TIO.put_line
         ("The user " & SP.value(user) & " has the catalog write locked");
        -- The following code is for the special case where a user has
        -- aborted out of a catalog session and left a write lock behind.
        -- There has to be a way for a super user to get into the catalog
        -- to run remove_lock, but they can't if this open won't let them
        -- into the catalog, so ther is this override code.
        TIO.put ("Do you wish to override? [y/n]: ");
        TIO.get_line (ans, last);
        if ans = "y" or ans = "Y" then
        TIO.put ("Enter password to override: ");
        word := SS.strip(HL.read_no_echo(""));
        if CM.verify_password (word) then
            TIO.put_line
           ("Remember that you have no locks, but you can fix up the catalog");
            interpret.command_interpreter;
           else
            TIO.put_line ("Incorrect password");
        end if;
        end if;
    end if;
    exception
    when name_error =>
        TIO.put_line ("Catalog doesn't exist, use Create_catalog " &
        "to create it");
    when CL.lock_already_exists =>
        TIO.put_line ("You are already using the catalog as a read lock " &
        "already exists");
    end open_catalog;

procedure create_catalog (    --| Create a catalog with the given name
    catalog_name : in SP.string_type;    --| Name of the catalog to create
    directory    : in SP.string_type    --| Name of the directory where the
                    --| catalog will be stored
    ) is

    dir         : SP.string_type;
    node     : node_type;
    list_node: node_type;

    --| Algorithm:  First check that the name is not alredy in the database.
    --| To do this try to open the node with that name.  If it is successful
    --| it already exists, so close it and print the error.  If it doesn't
    --| exist the exception name_error will be raised.  In this case the
    --| exception handler for name_error is the code to create the catalog,
    --| as follows:
    --| Add the user node and set the current node to be that one.
    --| If the write lock is obtained prompt for the password and store it
    --| in the appropriate place.  When this is done creation is complete
    --| so give a messge this effect and exit.
    --| In the event that the write lock cannot be obtained delete the
    --| user node and print out an error message.

begin
    if SU.is_ada_id (SU.make_scanner(SP.value(catalog_name))) then
        NM.open_node_handle (node, "'user(" & SP.value(catalog_name) & ")");
        NM.close_node_handle (node);
        TIO.put_line ("Error: That name has already been used");
    else
    TIO.put_line ("Error: Name must be an ada id");
    end if;
exception
    when name_error =>         -- that name is not yet used
    -- first check  that the directory where the repository will be does
    -- not exist.  This is to prevent the case where someone creates a
    -- catalog with a diferent name but in the same directory which would
    -- result in the first catalog being wiped out.
    if FM.is_directory (SP.value(directory)) then
        TIO.put_line ("Error: Catalog directory already exists");
        return;
       end if;
        dir := SP.create(FM.path_name (directory => SP.value (directory),
                       file      => "",
                       absolute  => true));
    SM.add_user (SP.value(catalog_name), SP.value(dir));
    NM.set_current_node ("'user(" & SP.value(catalog_name) & ")");
    if CL.write_lock (max_wait) then
            NM.get_current_node (node);
        NM.open_node_handle(node => list_node,
                 name => DMD.document_manager_list_path);
        NM.link(to_node  => node,
             new_base => list_node,
             relation => "CATALOG",
             key      => SP.value(catalog_name));
        NM.close_node_handle(list_node);
        loop
         begin
                TIO.put ("Enter password: ");
                NM.link (node,
                 node,
                 HL.read_no_echo(""),
                      "password",
                      must_not_exist);
            exit;
        exception
            when ND.name_error =>
            TIO.put_line ("Not a valid password, password must be"
                & " an ada id");
        end;
        end loop;
        NM.close_node_handle(node);
        CL.remove_write;
        TIO.put_line ("Creation complete");
    else
    -- the open catalog command checks that the password relation exists
    -- for the catalog before placing a read lock.  Since the password
    -- relation is only created after the write lock is in place this
    -- should work to exclude people reading the catalog before it is
    -- fully created.
    -- In the highly unlikely event that the write lock does fail for
    -- some reason we stil have to decide what to do.  Since this is
    -- very unlikely to happen I think an unfriendly solution is
    -- sufficient.

        SM.delete_user (SP.value(catalog_name));
        TIO.put_line
         ("Unable to create catalog: Another user has locked the catalog");
    end if;
end create_catalog;


procedure check_consistency (    --| check the consistency of a catalog
                --| producing a written report
    name   : in SP.string_type;        --| catalog name
    output : in SP.string_type        --| the name of the output file
    ) is

    root     : ND.node_type;
    node     : ND.node_type;
    trunk    : ND.node_type;
    i1        : NM.node_iterator;
    i2        : NM.node_iterator;
    num_trunks    : natural;

    begin
    -- set the local variable with the catalog name
    -- set up the output file first:
    PG.create_paginated_file (SP.value(output), output_file);
    PG.set_header (output_file, 2,
    "Consistency check for Catalog " & SP.value(name) &
            " page ~p(R4)");
    PG.set_header (output_file, 3, "~c ~t");
    -- Use set_current node so that the rest of the catalog functions
    -- that are userd for checking don't bomb out.
    NM.set_current_node ("'user(" & SP.value(name) & ")");
    NM.get_current_node (root);
    check_root (root, SP.value(name));
    NM.iterate (i1, root, relation=>"ci_root");
    while NM.more(i1) loop
        NM.get_next (i1, node);
        num_trunks := 0;
        NM.iterate (i2, node, relation=>"trunk");
        while NM.more(i2) loop
        NM.get_next (i2, trunk);
        num_trunks := num_trunks + 1;
        check_trunk_node (trunk);
        end loop;
        if num_trunks < 1 then
        report ("CI " & name_of(node) & " has no versions at all.");
        end if;
    end loop;

    -- report that the check is done so that at least there is some output
    -- to the output file even if there are no problems.
        report ("Check consistency of " & SP.value(name) & " is complete.");

    end check_consistency;

procedure list_catalogs (    --| List the names of all catalogs on the
                --| system
    catalogs : in SP.string_type
    := SP.create("*")    --| String to match for catalog names
    ) is

list_node    : node_type;
ci_node        : node_type;
iterator    : NM.node_iterator;

begin

    SP.mark;
    NM.open_node_handle(node => list_node,
             name => DMD.document_manager_list_path);
    SP.release;
    NM.iterate(iterator     => iterator,
        node         => list_node,
        key          => SP.value(catalogs),
        relation     => "CATALOG",
        primary_only => false);
    while NM.more(iterator) loop
    NM.get_next(iterator, ci_node);
    TIO.put_line (NM.path_key(ci_node));
    end loop;
end list_catalogs;

-- Local Operation Bodies:
function name_of (            --| figure out the ci id of a node
    node : ND.node_type
    ) return string is

    name : SP.string_type;
    temp : SP.string_type;
    scan : SU.scanner;
    found: boolean;

    begin
    scan := SU.make_scanner (NM.primary_name(node));
    SS.scan_not_literal ("(", scan, found, temp);    -- scan through
                            -- 'user(
    if not found then
        SU.destroy_scanner (scan);
        return "";
    end if;
     SU.forward (scan);
    SS.scan_not_literal ("(", scan, found, temp);    -- scan through
                            -- xxx)'ci_root(
    if not found then
        SU.destroy_scanner (scan);
        return "";
    end if;
    SS.scan_enclosed ('(', ')', scan, found, temp); -- get ci name
    if not found then
        SU.destroy_scanner (scan);
        return "";
    end if;
    name := temp & " ";
    SS.scan_not_literal ("(", scan, found, temp);    -- scan 'trunk(
    if not found then
        SU.destroy_scanner (scan);
        return SP.value(name);
    end if;
    SS.scan_enclosed ('(', ')', scan, found, temp);    -- get version
    if not found then
        SU.destroy_scanner (scan);
        return SP.value(name);
    end if;
    -- temp = "Vnumber" so strip off the V
    name := name & SP.substr(temp, 2, SP.length(temp)-1);
    while SU.more(scan) loop
        SS.scan_not_literal ("(", scan, found, temp); --scan 'branch( or
        if not found then                  -- 'trunk( or 'DOT(
            SU.destroy_scanner (scan);
            return SP.value(name);
        elsif SP.equal (temp, "'DOT") then
        -- we are at a ".CI" part and therefore done.
        return SP.value(name);
        end if;
        SS.scan_enclosed ('(', ')', scan, found, temp); --get version
        if not found then
            SU.destroy_scanner (scan);
            return SP.value(name);
        end if;
        -- temp = "Vnumber" so strip off the V
        name := name & "." & SP.substr(temp, 2, SP.length(temp)-1);
    end loop;
    return SP.value(name);
    end name_of;

procedure report (            --| write a diagnostic to the report
    line : string
    ) is

    begin
        PG.put_line (output_file, line);
    end;

procedure check_root (            --| check the information on the
                    --| trunk node.
    node : ND.node_type;
    name : string
    ) is

    i1         : NM.node_iterator;
    i2        : NM.node_iterator;
    temp    : ND.node_type;
    index_node    : ND.node_type;
    ai        : ATT.attrib_iterator;
    num_pass    : natural := 0;
    last    : natural;
    attrib    : string(1..80);
    list    : LU.list_type;

    begin
    NM.iterate (i1, node, relation=>"password", primary_only=>false);
    while NM.more(i1) loop
        NM.get_next (i1, temp);
        num_pass := num_pass + 1;
    end loop;
    if num_pass > 1 then
        report ("Catalog has too many passwords: " &
                integer'image(num_pass));
    end if;
    begin
        ATT.get_path_attribute ("'user(" & name & ")"
                        & "'write_lock",
                    "userid",
                    list);
        if not LU.empty(list) then
                report (LU.identifier (LU.positional (list, 1)) & " has the " &
                "catalog write locked.");
        end if;
        LU.free_list(list);
    exception when ND.name_error =>
        -- it's ok if there's no write lock
        null;
    end;
    NM.iterate (i2, node, relation=>"read_lock", primary_only=>false);
    while NM.more(i2) loop
        NM.get_next (i2, temp);
        report (NM.path_relation(temp) & " has the catalog read locked.");
    end loop;
    ATT.node_attribute_iterate (ai, node, "*");
    while ATT.more(ai) loop
        ATT.get_next (ai, attrib, last, list);
        begin
        NM.open_node_handle (    index_node,
                    base=>node,
                    relation=>"index",
                    key=>attrib(1..last));
        NM.close_node_handle (index_node);
        exception when ND.name_error =>
        report ("The catalog is missing the information node for " &
            "keyword " & attrib(1..last) & ".");
        end;
        LU.free_list (list);
    end loop;

    end check_root;

procedure check_trunk_node (        --| do all the checks required for a
                    --| trunk node.
    node : ND.node_type
    ) is


    attrib    : string (1..80);
    last    : natural;
    ci_node    : ND.node_type;
    branch    : ND.node_type;
    iter    : NM.node_iterator;
    branches    : natural := 0;
    num_branch    : natural := 0;
    list    : LU.list_type;
    count    : LU.count := 0;
    index    : LU.positive_count;
    name    : SP.string_type;

    begin
    name := SP.create (name_of(node));
    HU.get_node_attribute (node, "deleted", attrib, last);
    if last = 0 then
        begin
        NM.open_node_handle (    ci_node,
                         base=>node,
                    relation=>"DOT",
                    key=>"CI");
        check_ci_node (ci_node, SP.value(name));
        NM.close_node_handle (ci_node);
        exception when ND.name_error =>
        report ("CI " & SP.value(name) & " has no contents.");
        end;
    else
        begin
        NM.open_node_handle (    ci_node,
                    base=>node,
                    relation=>"DOT",
                    key=>"CI");
        NM.close_node_handle (ci_node);
        report ("CI " & SP.value(name) & " that was deleted by " &
            attrib(1..last) & " still has contents when it should"
            & " be empty.");
        exception when ND.name_error =>
        -- this is what is supposed to happen
        null;
        end;
    end if;
    -- report who has a CI fetched.
    HU.get_node_attribute (node, "updating", attrib, last);
    if last /= 0 then
        report (attrib(1..last) & " has " & SP.value(name) &
            " fetched for update.");
    end if;
    ATT.get_node_attribute (node, "branching", list);
    count := LU.num_positional(list);
    for index in 1..count loop
        report (LU.identifier(LU.positional(list,index)) & " has " &
            SP.value(name) & " fetched for branching.");
    end loop;
    LU.free_list (list);
    NM.iterate (iter, node, relation=>"branch", key=>"*");
    while NM.more(iter) loop
        num_branch := num_branch + 1;
        NM.get_next (iter, branch);
        check_branch_node (branch);
    end loop;
    HU.get_node_attribute (node, "branches", attrib, last);
    branches := integer'value (attrib(1..last));
    if num_branch > branches then
       report("There are more branches than recorded for " &
            SP.value(name) & ":");
       report("This will get fixed next time there is a store.");
    elsif num_branch < branches then
       report("There are fewer branches than recorded for " &
            SP.value(name) & ":");
       report("There must be an internal error in the catalog_manager to "
            & "cause this.");
    end if;

    end check_trunk_node;

procedure check_ci_node (        --| check the properties on a CI node
    node : ND.node_type;
    name : string
    ) is

    ai        : ATT.attrib_iterator;
    attrib    : string(1..80);
    last    : natural;
    list    : LU.list_type;
    set        : CD.CI_set;
    ci_id     : ID.ci_id_type;

    begin
    ATT.node_attribute_iterate (ai, node, "*");
    ci_id := ID.get_ci_id (name);
    while ATT.more(ai) loop
        ATT.get_next(ai, attrib, last, list);
        begin
            set := IM.lookup_ci (SP.create(attrib(1..last)),
             SP.create(LU.identifier(LU.positional(list,1))));
        exception when IM.invalid_value =>
        report ("Unable to check keyword" & attrib(1..last) &
            " for " & name & "because the index is missing.");
        end;
        if not CD.CI_sets.is_member (set, ci_id) then

        report ("Property " & attrib(1..last) & "-" &
                LU.identifier(LU.positional(list,1)) &
            " is missing from the index for " & name);
        end if;
    end loop;
    end check_ci_node;

procedure check_branch_node (        --| the branch attributes
    node : ND.node_type
    ) is

    iter    : NM.node_iterator;
    trunk    : ND.node_type;
    num_trunks  : natural := 0;

    begin
    NM.iterate (iter, node, relation=>"trunk", key=>"*");
    while NM.more(iter) loop
        num_trunks := num_trunks + 1;
        NM.get_next (iter, trunk);
        check_trunk_node (trunk);
    end loop;
    if num_trunks = 0 then
        report ("Branch " & name_of (node) & " does not have at least " &
            "one trunk CI");
    end if;
    end check_branch_node;

end catalog_interface;

::::::::::::::
interface.spc
::::::::::::::
with string_pkg;

package catalog_interface is

--| Overview
--|
--| This package contains the procedures which  control input to the
--| catalog.  The two main procedures are those  that are the interactive
--| interface to the catalog routines.  Any other catalog functions that
--| are invoked from the command line will also be in this package.
--| There is one of these, namely, check_consistency.

package SP renames string_pkg;

procedure open_catalog (    --| Open a catalog with the given name
    catalog_name : SP.string_type    --| Name of the catalog
    );

--| Effects: Opens a catalog with the given name.  If the catalog does
--| not exist an error message is printed out to the user to use the
--| operation create_catalog which creates a new catalog.
--| If the catalog does exist it places the user in interactive mode
--| with the catalog in order to query the contents.

procedure create_catalog (    --| Create a catalog with the given name
    catalog_name : in SP.string_type;    --| Name of the catalog to create
    directory    : in SP.string_type    --| Name of the directory where the
                    --| catalog will be stored
    );

--| Effects: Creates a catalog with the given name.  The catalog is empty, but
--| the user is left in interactive mode.  The person will be prompted for a
--| password for the catalog to use with privileged operations.  Before
--| leaving the catalog manger the person should also define a set of
--| valid keywords for the database.

--| Notes: The above procedures open_catalog, and create_catalog put the
--| user in interactive mode with the catalog manager.
--| The operations which the catalog
--| manager provides in interactive mode are summarized below.
--|-
--| Catalog Manager operations:
--| help            gives help about the interactive commands
--| exit            exit the catalog manager

--| Operations on the catalog:
--| select_CIs            select CI's matching keyword values given
--| clear_selected_set        make the current selected set of CIs empty
--| print_set            prints out the current selected set
--| list_catalog        list all the CI's in the cpcicat
--| change_password (*)        change the privileged user password

--| Operations on the list of keywords:
--| define_keyword (*)        define a keyword and its status.
--| list_keywords        list all valid keywords

--| Operations on a configuration item:
--| store            add a new configuration item from an itemlib
--| fetch            fetch an itemlib from the catalog
--| archive (*)            archive a CI
--| retrieve (*)        retrieve an archived CI
--| modify_property         change the value associated with a property
--| describe            list all the properties for a CI, (or the
--|                selected_set) and other information
--|                like history as asked for.
--| list_components        list the components of a CI

--| Operations to allow a privileged user to clean up the database:
--| remove_lock (*)        removes a temporary lock on a CI
--| delete (*)            delete a CI
--|
--|+
--| (*) indicates a privileged operation.

procedure check_consistency (    --| check the consistency of a catalog
                --| producing a written report
    name   : in SP.string_type;        --| catalog name
    output : in SP.string_type        --| the name of the output file
    );

--| Effects: Runs over the whole catalog noting whether the properties on
--| CIs match what the database contains and reporting locks that have been
--| left on a CI, or property more than a day.  The report is put in the
--| output file given by the user.  A privileged user can then fix up the
--| inconsistencies (if there are any) using remove_lock and delete.
--| In general a read lock can just be removed, but the privileged user
--| probably ought to tell the user the lock belonged to that the copy
--| they have if any is not considered checked out.  With a write lock
--| the half written CI probably needs to be deleted too.  Again, probably
--| a check with the user to see if the itemlibrary is still around is
--| a good idea.  Also, it is expected that running this procedure will
--| be quite time consuming and probably ought to be run in batch
--| overnight, or over a weekend (depending on the size of the catalog).

procedure list_catalogs (    --| List the names of all catalogs on the
                --| system
    catalogs : in SP.string_type
    := SP.create("*")    --| String to match for catalog names
    );

--| Effects: Lists the names of catalogs in the hif.  It can only find
--| catalogs in the one hif that is defined since only one hif can be
--| defined at a time.  In the cases where someone has forgotten the
--| name of a catalog they created they can do a listing of all catalogs
--| and try to figure it out that way.

end catalog_interface;

-- Note:  There will be drivers for each of these subprograms that use the
-- standard interface and read the parameters off the command line.  It
-- seems unnecessary to make specs for them since they will have very
-- boring specs.

-- The following subprograms will be taken care of entirely with in the
-- body of the interface:
-- clear_selected_set      since this is just one set operation
-- print_set        since this is just an output operation
--
-- The syntax of the select_CIs operation will also be taken care of within
-- the body of the interface.  The operation in the catalog manager which
-- selects CIs will take just one keyword and value and return a set.  The
-- interface will have to take care of the merging and intersection as
-- needed.
::::::::::::::
liberr.bdy
::::::::::::::
with Host_Lib;
with Library_Declarations;

package body Library_Errors is

--------------------------------------------------------------------------------

    package HL renames Host_Lib;
    package LD renames Library_Declarations;

--------------------------------------------------------------------------------

    Errors : constant array (Error_Type) of SP.String_Type :=
       (Directory_Already_Exists =>
        SP.Make_Persistent("Directory ~S already exists."),
    File_Not_Created =>
        SP.Make_Persistent("File ~S not created."),
    File_Not_Found =>
        SP.Make_Persistent("File ~S not found."),
    Internal_Error =>
        SP.Make_Persistent("<<< ~S Internal Error >>>"),
    Interrupt_Encountered =>
        SP.Make_Persistent("Command ~S aborted by user interrupt."),
    Invalid_Directory_Name =>
        SP.Make_Persistent("Invalid directory specificaton ~S."),
    Invalid_Downgrade =>
        SP.Make_Persistent("Invalid lock downgrade for library ~S."),
    Invalid_External_Name =>
        SP.Make_Persistent("Invalid file name ~S."),
    Invalid_Keyword =>
        SP.Make_Persistent("Property keyword ~S invalid."),
    Invalid_Library_Name =>
        SP.Make_Persistent("Invalid library name ~S."),
    Invalid_Operation =>
        SP.Make_Persistent("Fetch mode UPDATE not allowed for version ~S."),
    Invalid_Upgrade =>
        SP.Make_Persistent("Invalid lock upgrade for library ~S."),
    Invalid_Value =>
        SP.Make_Persistent("Property value ~S invalid."),
    Invalid_Version =>
        SP.Make_Persistent("Invalid version specification ~S."),
    Item_Already_Exists =>
        SP.Make_Persistent("Item ~S already exists."),
    Item_Checked_Out =>
        SP.Make_Persistent("Item ~S checked out by ~T."),
    Item_Not_Checked_Out =>
        SP.Make_Persistent("Item ~S not checked out."),
    Item_Not_Created =>
        SP.Make_Persistent("Item ~S not created."),
    Item_Not_Found =>
        SP.Make_Persistent("Item ~S not found."),
    Keyword_Already_Exists =>
        SP.Make_Persistent("Property keyword ~S already exists."),
    Keyword_Not_Found =>
        SP.Make_Persistent("Property keyword ~S not found."),
    Library_Already_Exists =>
        SP.Make_Persistent("Library ~S already exists"),
    Library_Does_Not_Exist =>
        SP.Make_Persistent("Library ~S does not exist."),
    Library_Incomplete =>
        SP.Make_Persistent("Item(s) currently checked out from library ~S."),
    Library_Master_Locked =>
        SP.Make_Persistent("Library ~S is master locked."),
    Library_Pending_Return =>
        SP.Make_Persistent("Library ~S pending return to CI ~T."),
    Library_Read_Locked =>
        SP.Make_Persistent("Unable to open library ~S for read."),
    Library_Write_Locked =>
        SP.Make_Persistent("Unable to open library ~S for write."),
    No_Privilege =>
        SP.Make_Persistent("No privilege for operation on ~S owned by ~T."),
    Not_Authorized =>
        SP.Make_Persistent("Unauthorized unlocking attempt on library ~S."),
    Process_Interrupted =>
        SP.Make_Persistent("Process ~S interrupted."),
    Set_Protection_Error =>
        SP.Make_Persistent("Proper protection not set for ~S."),
    Version_Not_Found =>
        SP.Make_Persistent("Version ~S not found."));

--------------------------------------------------------------------------------

    procedure Report_Error(
    Kind : in Error_Type;
    Sub1 : in SP.String_Type := SP.Create("");
    Sub2 : in SP.String_Type := SP.Create("")
    ) is

    S_Str : SP.String_Type;
    Num   : NATURAL;

    begin

    if not LD.Message_on_Error then
        return;
    end if;
    SP.Mark;
    S_Str := SP.Create(SP.Value(Errors(Kind)));
    loop
        Num := SP.Match_S(S_Str, "~S");
        exit when Num = 0;
        if SP.Is_Empty(Sub1) then
        if Num = 1 then
            S_Str := SP.Splice(S_Str, Num, 3);
        else
            S_Str := SP.Splice(S_Str, Num-1, 3);
        end if;
        else
        S_Str := SP.Splice(S_Str, Num, 2);
        S_Str := SP.Insert(S_Str, SP.Upper(Sub1), Num);
        end if;
    end loop;

    loop
        Num := SP.Match_S(S_Str, "~T");
        exit when Num = 0;
        if SP.Is_Empty(Sub2) then
        if Num = 1 then
            S_Str := SP.Splice(S_Str, Num, 3);
        else
            S_Str := SP.Splice(S_Str, Num-1, 3);
        end if;
        else
        S_Str := SP.Splice(S_Str, Num, 2);
        S_Str := SP.Insert(S_Str, SP.Upper(Sub2), Num);
        end if;
    end loop;

    HL.Put_Error(SP.Value(S_Str));
    SP.Release;

    end Report_Error;

end Library_Errors;
                                                                    pragma page;
::::::::::::::
liberr.spc
::::::::::::::
with String_Pkg;

package Library_Errors is

--------------------------------------------------------------------------------

    package SP renames String_Pkg;

--------------------------------------------------------------------------------

    type Error_Type is (Directory_Already_Exists,
            File_Not_Created,
            File_Not_Found,
            Internal_Error,
            Interrupt_Encountered,
            Invalid_Directory_Name,
            Invalid_Downgrade,
            Invalid_External_Name,
            Invalid_Keyword,
            Invalid_Library_Name,
            Invalid_Operation,
            Invalid_Upgrade,
            Invalid_Value,
            Invalid_Version,
            Item_Already_Exists,
            Item_Checked_Out,
            Item_Not_Checked_Out,
            Item_Not_Created,
            Item_Not_Found,
            Keyword_Already_Exists,
            Keyword_Not_Found,
            Library_Already_Exists,
            Library_Does_Not_Exist,
            Library_Incomplete,
            Library_Master_Locked,
            Library_Pending_Return,
            Library_Read_Locked,
            Library_Write_Locked,
            No_Privilege,
            Not_Authorized,
            Process_Interrupted,
            Set_Protection_Error,
            Version_Not_Found);

--------------------------------------------------------------------------------

procedure Report_Error(
    Kind : in Error_Type;
    Sub1 : in SP.String_Type := SP.Create("");
    Sub2 : in SP.String_Type := SP.Create("")
    );

--------------------------------------------------------------------------------

end Library_Errors;
                                                                    pragma page;
::::::::::::::
libmgr.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with Library_Manager_Interface;

function Library_Manager return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LIB is new SI.String_Argument(String_Type_Name => "library_name");
    package STR is new SI.String_Argument(String_Type_Name => "string");

    Library_Manager_Process : SI.Process_Handle;
    Library                 : SP.String_Type;
    Prompt                  : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => Library_Manager_Process,
    Name    => "Library_Manager",
    Help    => "Interactive Library Manager");

    LIB.Define_Argument(
    Proc    => Library_Manager_Process,
    Name    => "library",
    Default => "",
    Help    => "Name of the item library");

    STR.Define_Argument(
    Proc    => Library_Manager_Process,
    Name    => "prompt",
    Default => "",
    Help    => "Prompt (null string implies library name)");

    SP.Release;

    SI.Parse_Line(Library_Manager_Process);

    Library := LIB.Get_Argument(Proc => Library_Manager_Process,
                Name => "library");

    Prompt := STR.Get_Argument(Proc => Library_Manager_Process,
                   Name => "prompt");

    return HL.Return_Code(Library_Manager_Interface(Library, Prompt));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end Library_Manager;
                                                                    pragma page;
::::::::::::::
libmgr.bdy
::::::::::::::
with TEXT_IO;
with Standard_Interface;
with Tool_Identifier;
with Library_Errors;
with Library_Declarations;
with Add_Property_Interface;
with Cancel_Item_Interface;
with Copy_Library_Interface;
with Create_Item_Interface;
with Create_Library_Interface;
with Delete_Item_Interface;
with Delete_Library_Interface;
with Delete_Property_Interface;
with Fetch_Item_Interface;
with Library_Manager_Interface;
with List_Item_Interface;
with List_Library_Interface;
with List_Property_Interface;
with Modify_Property_Interface;
with Purge_Item_Interface;
with Rename_Item_Interface;
with Rename_Version_Interface;
with Return_Item_Interface;
with Show_History_Interface;

function Library_Manager_Interface(
    Library : in String_Pkg.String_Type;
    Prompt  : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP   renames String_Pkg;
    package HL   renames Host_Lib;
    package TIO  renames TEXT_IO;
    package SI   renames Standard_Interface;
    package LE   renames Library_Errors;
    package LD   renames Library_Declarations;
    package LIB  is new SI.String_Argument(String_Type_Name => "library_name");
    package DIR  is new SI.String_Argument(String_Type_Name => "directory_spec");
    package USER is new SI.String_Argument(String_Type_Name => "user_name");
    package FN   is new SI.String_Argument(String_Type_Name => "file_name");
    package ITM  is new SI.String_Argument(String_Type_Name => "item_name");
    package STR  is new SI.String_Argument(String_Type_Name => "string");
    package VER  is new SI.String_Argument(String_Type_Name => "version");
    package LIM  is new SI.Enumerated_Argument(Enum_Type      => LD.List_Mode,
                           Enum_Type_Name => "list_mode");
    package FIM  is new SI.Enumerated_Argument(Enum_Type      => LD.State_Type,
                           Enum_Type_Name => "fetch_mode");
    package CLM  is new SI.Enumerated_Argument(Enum_Type      => LD.Copy_Mode,
                           Enum_Type_Name => "copy_mode");

    type Commands is (
    Create_Library,
    Delete_Library,
    Copy_Library,
    List_Library,
    Create_Item,
    Fetch_Item,
    Return_Item,
    Cancel_Item,
    List_Item,
    Delete_Item,
    Purge_Item,
    Rename_Item,
    Rename_Version,
    Show_History,
    Add_Property,
    Delete_Property,
    Modify_Property,
    List_Property,
--    Escape,
    Enter_Library);

    package CMD is new SI.Command_Line(Command_Enumeration => Commands);

    Abbreviation : CMD.Command_Abbreviation_Array :=
    (Create_Library  => 8,
     Delete_Library  => 8,
     Copy_Library    => 6,
     List_Library    => 6,
     Create_Item     => 2,
     Fetch_Item      => 3,
     Return_Item     => 3,
     Cancel_Item     => 3,
     List_Item       => 4,
     Delete_Item     => 3,
     Purge_Item      => 3,
     Rename_Item     => 3,
     Rename_Version  => 8,
     Show_History    => 4,
     Add_Property    => 5,
     Delete_Property => 8,
     Modify_Property => 8,
     List_Property   => 6,
--     Escape          => 3,
     Enter_Library   => 5);

    Command_Array     : CMD.Process_Handle_Array;
    Command           : Commands;
    Default_Library   : SP.String_Type;
    Current_Library   : SP.String_Type;
    Default_Prompt    : SP.String_Type;
    Current_Prompt    : SP.String_Type;
    Library_Name      : SP.String_Type;
    To_Library_Name   : SP.String_Type;
    Directory         : SP.String_Type;
    Owner_Name        : SP.String_Type;
    Item_Name         : SP.String_Type;
    To_Item_Name      : SP.String_Type;
    Version_Name      : SP.String_Type;
    To_Version_Name   : SP.String_Type;
    File_Name         : SP.String_Type;
    Keyword           : SP.String_Type;
    Value             : SP.String_Type;
    System_Command    : SP.String_Type;
    History           : SP.String_Type;
    Fetch_Item_Mode   : LD.State_Type;
    List_Item_Mode    : LD.List_Mode;
    Copy_Library_Mode : LD.Copy_Mode;
    Input_Line        : STRING(1..256);
    Input_Line_Length : INTEGER;
    Return_Code       : HL.Severity_Code := HL.SUCCESS;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc => Command_Array(Create_Library),
    Name => "Create_Library",
    Help => "Create an Item Library");

    LIB.Define_Argument(
    Proc => Command_Array(Create_Library),
    Name => "library",
    Help => "Name of the item library to be created");

    DIR.Define_Argument(
    Proc => Command_Array(Create_Library),
    Name => "directory",
    Help => "Name of directory to be used by this library");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc => Command_Array(Delete_Library),
    Name => "Delete_Library",
    Help => "Delete an Item Library");

    LIB.Define_Argument(
    Proc => Command_Array(Delete_Library),
    Name => "library",
    Help => "Name of the item library to be deleted");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc => Command_Array(Copy_Library),
    Name => "Copy_Library",
    Help => "Copy an Item Library to Another Item Library");

    LIB.Define_Argument(
    Proc => Command_Array(Copy_Library),
    Name => "from_library",
    Help => "Name of the item library to be copied");

    LIB.Define_Argument(
    Proc => Command_Array(Copy_Library),
    Name => "to_library",
    Help => "Name of the new item library");

    DIR.Define_Argument(
    Proc => Command_Array(Copy_Library),
    Name => "to_directory",
    Help => "Name of directory to be used by the new library");

    CLM.Define_Argument(
    Proc   => Command_Array(Copy_Library),
    Name    => "mode",
    Default => LD.CURRENT,
    Help    => "Copy option:");

    CLM.Append_Argument_Help(
    Proc => Command_Array(Copy_Library),
    Name => "mode",
    Help => "   CURRENT : copy only the current version of items");

    CLM.Append_Argument_Help(
    Proc => Command_Array(Copy_Library),
    Name => "mode",
    Help => "   FULL    : copy all versions of items");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc => Command_Array(List_Library),
    Name => "List_Library",
    Help => "List Libraries Owned by User");

    USER.Define_Argument(
    Proc    => Command_Array(List_Library),
    Name    => "owner",
    Default => HL.Get_Item(HL.USER_NAME),
    Help    => "Name of the library owner");

    LIB.Define_Argument(
    Proc    => Command_Array(List_Library),
    Name    => "library",
    Default => "*",
    Help    => "Name of the library");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Create_Item),
    Name    => "Create_Item",
    Help    => "Create an Item in the Item Library");

    FN.Define_Argument(
    Proc => Command_Array(Create_Item),
    Name => "file",
    Help => "Name of the file to be checked into the item library");

    STR.Define_Argument(
    Proc => Command_Array(Create_Item),
    Name => "history",
    Help => "Description/reason for this item");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Fetch_Item),
    Name    => "Fetch_Item",
    Help    => "Fetch an Item from an Item Library");

    ITM.Define_Argument(
    Proc => Command_Array(Fetch_Item),
    Name => "item",
    Help => "Name of the item to be fetched from the item library");

    VER.Define_Argument(
    Proc    => Command_Array(Fetch_Item),
    Name    => "version",
    Default => "",
    Help    => "Version specification");

    FIM.Define_Argument(
    Proc    => Command_Array(Fetch_Item),
    Name    => "mode",
    Default => LD.NO_UPDATE,
    Help    => "Fetch mode:");

    FIM.Append_Argument_Help(
    Proc    => Command_Array(Fetch_Item),
    Name    => "mode",
    Help    => "   NO_UPDATE : check out an item for read only");

    FIM.Append_Argument_Help(
    Proc    => Command_Array(Fetch_Item),
    Name    => "mode",
    Help    => "   UPDATE    : check out an item for update");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Cancel_Item),
    Name    => "Cancel_Item",
    Help    => "Cancel a Pending Return for an Item in the Item Library");

    ITM.Define_Argument(
    Proc => Command_Array(Cancel_Item),
    Name => "item",
    Help => "Name of the item to cancel the pending return");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Return_Item),
    Name    => "Return_Item",
    Help    => "Return a File to an Item Library");

    FN.Define_Argument(
    Proc => Command_Array(Return_Item),
    Name => "file",
    Help => "Name of the file to be returned to the item library");

    STR.Define_Argument(
    Proc => Command_Array(Return_Item),
    Name => "history",
    Help => "Description/reason for the change(s) in this item");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Delete_Item),
    Name    => "Delete_Item",
    Help    => "Delete Item(s) in an Item Library");

    ITM.Define_Argument(
    Proc => Command_Array(Delete_Item),
    Name => "item",
    Help => "Name of the item(s) to be deleted in the item library");

    VER.Define_Argument(
    Proc    => Command_Array(Delete_Item),
    Name    => "version",
    Default => "",
    Help    => "Version specification");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Purge_Item),
    Name    => "Purge_Item",
    Help    => "Purge Item(s) in an Item Library");

    ITM.Define_Argument(
    Proc => Command_Array(Purge_Item),
    Name => "item",
    Help => "Name of the item(s) to be purged in the item library");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Rename_Item),
    Name    => "Rename_Item",
    Help    => "Rename an Item in an Item Library");

    ITM.Define_Argument(
    Proc => Command_Array(Rename_Item),
    Name => "from_item",
    Help => "Name of the item to be renamed in the item library");

    ITM.Define_Argument(
    Proc => Command_Array(Rename_Item),
    Name => "to_item",
    Help => "New item name");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Rename_Version),
    Name    => "Rename_Version",
    Help    => "Rename Version of Item(s) in an Item Library");

    ITM.Define_Argument(
    Proc => Command_Array(Rename_Version),
    Name => "item",
    Help => "Name of the item(s) to be renamed in the item library");

    VER.Define_Argument(
    Proc => Command_Array(Rename_Version),
    Name => "from_version",
    Help => "Version of item(s) to be renamed");

    VER.Define_Argument(
    Proc => Command_Array(Rename_Version),
    Name => "to_version",
    Help => "New version of item(s)");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(List_Item),
    Name    => "List_Item",
    Help    => "List Item(s) in the Item Library");

    ITM.Define_Argument(
    Proc    => Command_Array(List_Item),
    Name    => "item",
    Default => "*",
    Help    => "Name of the item to list");

    VER.Define_Argument(
    Proc    => Command_Array(List_Item),
    Name    => "version",
    Default => "",
    Help    => "Version specification");

    LIM.Define_Argument(
    Proc    => Command_Array(List_Item),
    Name    => "mode",
    Default => LD.SHORT,
    Help    => "List mode:");

    LIM.Append_Argument_Help(
    Proc    => Command_Array(List_Item),
    Name    => "mode",
    Help    => "   SHORT : list item/version name(s) only");

    LIM.Append_Argument_Help(
    Proc    => Command_Array(List_Item),
    Name    => "mode",
    Help    => "   LONG  : list attributes as well as item/version name(s)");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Show_History),
    Name    => "Show_History",
    Help    => "Show History of Item(s) in an Item Library");

    ITM.Define_Argument(
    Proc    => Command_Array(Show_History),
    Name    => "item",
    Default => "*",
    Help    => "Name of the item to list");

    VER.Define_Argument(
    Proc    => Command_Array(Show_History),
    Name    => "version",
    Default => "",
    Help    => "Version specification");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Add_Property),
    Name    => "Add_Property",
    Help    => "Add a Property Keyword/Value to the Item Library");

    STR.Define_Argument(
    Proc    => Command_Array(Add_Property),
    Name    => "keyword",
    Help    => "Property keyword");

    STR.Define_Argument(
    Proc    => Command_Array(Add_Property),
    Name    => "value",
    Help    => "Property value");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Delete_Property),
    Name    => "Delete_Property",
    Help    => "Delete a Property Keyword from the Item Library");

    STR.Define_Argument(
    Proc    => Command_Array(Delete_Property),
    Name    => "keyword",
    Help    => "Property keyword");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Modify_Property),
    Name    => "Modify_Property",
    Help    => "Change a Property Keyword/Value in the Item Library");

    STR.Define_Argument(
    Proc    => Command_Array(Modify_Property),
    Name    => "keyword",
    Help    => "Property keyword");

    STR.Define_Argument(
    Proc    => Command_Array(Modify_Property),
    Name    => "value",
    Help    => "Property value");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(List_Property),
    Name    => "List_Property",
    Help    => "List Property Keyword/Value in the Item Library");

    STR.Define_Argument(
    Proc    => Command_Array(List_Property),
    Name    => "keyword",
    Default => "*",
    Help    => "Property keyword");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --
--
--    SI.Define_Process(
--    Proc    => Command_Array(Escape),
--    Name    => "Escape",
--    Help    => "Execute System Command");
--
--    STR.Define_Argument(
--    Proc    => Command_Array(Escape),
--    Name    => "command",
--    Help    => "System Command");
--
--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SI.Define_Process(
    Proc    => Command_Array(Enter_Library),
    Name    => "Enter_Library",
    Help    => "Enter a Given Item Library");

    LIB.Define_Argument(
    Proc    => Command_Array(Enter_Library),
    Name    => "library",
    Help    => "Name of the library");

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    CMD.Define_Command_Abbreviation(
    Abbreviation   => Abbreviation,
    Check_Conflict => TRUE);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    SP.Release;

    Default_Library := SP.Make_Persistent(Library);
    if SP.Is_Empty(Prompt) then
    Default_Prompt := SP.Make_Persistent(SP."&"(SP.Upper(Default_Library), ">"));
    else
    Default_Prompt := SP.Make_Persistent(Prompt);
    end if;

    Current_Library := SP.Make_Persistent(Default_Library);
    Current_Prompt  := SP.Make_Persistent(Default_Prompt);

    loop

    begin
    TIO.NEW_LINE(1);
    TIO.PUT(SP.Value(Current_Prompt) & ' ');
    TIO.GET_LINE(Input_Line, Input_Line_Length);

    Command := CMD.Parse_Command_Line(Handles => Command_Array,
                      Line    => Input_Line(1..Input_Line_Length));

    case Command is

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Create_Library =>

        Library_Name := LIB.Get_Argument(
        Proc => Command_Array(Create_Library),
        Name => "library");

        Directory := DIR.Get_Argument(
        Proc => Command_Array(Create_Library),
        Name => "directory");

        Return_Code := Create_Library_Interface(
                Library   => Library_Name,
                Directory => Directory);

        SP.Flush(Library_Name);
        SP.Flush(Directory);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Delete_Library =>

        Library_Name := LIB.Get_Argument(
        Proc => Command_Array(Delete_Library),
        Name => "library");

        Return_Code := Delete_Library_Interface(
                Library   => Library_Name,
                Privilege => LD.Delete_Library_Privilege);

        SP.Flush(Library_Name);
        SP.Flush(Directory);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Copy_Library =>

        Library_Name := LIB.Get_Argument(
        Proc => Command_Array(Copy_Library),
        Name => "from_library");

        To_Library_Name := LIB.Get_Argument(
        Proc => Command_Array(Copy_Library),
        Name => "to_library");

        Directory := DIR.Get_Argument(
        Proc => Command_Array(Copy_Library),
        Name => "to_directory");

        Copy_Library_Mode := CLM.Get_Argument(
        Proc => Command_Array(Copy_Library),
        Name => "mode");

        Return_Code := Copy_Library_Interface(
                From_Library => Library_Name,
                To_Library   => To_Library_Name,
                To_Directory => Directory,
                Mode         => Copy_Library_Mode);

        SP.Flush(Library_Name);
        SP.Flush(To_Library_Name);
        SP.Flush(Directory);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when List_Library =>

        Owner_Name := USER.Get_Argument(
        Proc => Command_Array(List_Library),
        Name => "owner");

        Library_Name := LIB.Get_Argument(
        Proc => Command_Array(List_Library),
        Name => "library");

        Return_Code := List_Library_Interface(
                User    => Owner_Name,
                Library => Library_Name);

        SP.Flush(Owner_Name);
        SP.Flush(Library_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Create_Item =>

        File_Name := FN.Get_Argument(
        Proc => Command_Array(Create_Item),
        Name => "file");

        History := STR.Get_Argument(
        Proc => Command_Array(Create_Item),
        Name => "history");

        Return_Code := Create_Item_Interface(
                Library => Current_Library,
                File    => File_Name,
                History => History);

        SP.Flush(File_Name);
        SP.Flush(History);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Fetch_Item =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Fetch_Item),
        Name => "item");

        Version_Name := VER.Get_Argument(
        Proc => Command_Array(Fetch_Item),
        Name => "version");

        Fetch_Item_Mode := FIM.Get_Argument(
        Proc => Command_Array(Fetch_Item),
        Name => "mode");

        Return_Code := Fetch_Item_Interface(
                Library => Current_Library,
                Item    => Item_Name,
                Version => Version_Name,
                Mode    => Fetch_Item_Mode);

        SP.Flush(Item_Name);
        SP.Flush(Version_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Cancel_Item =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Cancel_Item),
        Name => "item");

        Return_Code := Cancel_Item_Interface(
                Library => Current_Library,
                Item    => Item_Name);

        SP.Flush(Item_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Return_Item =>

        File_Name := FN.Get_Argument(
        Proc => Command_Array(Return_Item),
        Name => "file");

        History := STR.Get_Argument(
        Proc => Command_Array(Return_Item),
        Name => "history");

        Return_Code := Return_Item_Interface(
                Library => Current_Library,
                File    => File_Name,
                History => History);

        SP.Flush(File_Name);
        SP.Flush(History);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Delete_Item =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Delete_Item),
        Name => "item");

        Version_Name := VER.Get_Argument(
        Proc => Command_Array(Delete_Item),
        Name => "version");

        Return_Code := Delete_Item_Interface(
                Library   => Current_Library,
                Item      => Item_Name,
                Version   => Version_Name,
                Privilege => LD.Delete_Item_Privilege);

        SP.Flush(Item_Name);
        SP.Flush(Version_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Purge_Item =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Purge_Item),
        Name => "item");

        Return_Code := Purge_Item_Interface(
                Library   => Current_Library,
                Item      => Item_Name,
                Privilege => LD.Purge_Item_Privilege);

        SP.Flush(Item_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Rename_Item =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Rename_Item),
        Name => "from_item");

        To_Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Rename_Item),
        Name => "to_item");

        Return_Code := Rename_Item_Interface(
                Library   => Current_Library,
                From_Item => Item_Name,
                To_Item   => To_Item_Name,
                Privilege => LD.Rename_Item_Privilege);

        SP.Flush(Item_Name);
        SP.Flush(To_Item_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Rename_Version =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Rename_Version),
        Name => "item");

        Version_Name := VER.Get_Argument(
        Proc => Command_Array(Rename_Version),
        Name => "from_version");

        To_Version_Name := VER.Get_Argument(
        Proc => Command_Array(Rename_Version),
        Name => "to_version");

        Return_Code := Rename_Version_Interface(
                Library      => Current_Library,
                Item         => Item_Name,
                From_Version => Version_Name,
                To_Version   => To_Version_Name,
                Privilege    => LD.Rename_Version_Privilege);

        SP.Flush(Item_Name);
        SP.Flush(Version_Name);
        SP.Flush(To_Version_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when List_Item =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(List_Item),
        Name => "item");

        Version_Name := VER.Get_Argument(
        Proc => Command_Array(List_Item),
        Name => "version");

        List_Item_Mode := LIM.Get_Argument(
        Proc => Command_Array(List_Item),
        Name => "mode");

        Return_Code := List_Item_Interface(
                Library => Current_Library,
                Item    => Item_Name,
                Version => Version_Name,
                Mode    => List_Item_Mode);

        SP.Flush(Item_Name);
        SP.Flush(Version_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Show_History =>

        Item_Name := ITM.Get_Argument(
        Proc => Command_Array(Show_History),
        Name => "item");

        Version_Name := VER.Get_Argument(
        Proc => Command_Array(Show_History),
        Name => "version");

        Return_Code := Show_History_Interface(
                Library => Current_Library,
                Item    => Item_Name,
                Version => Version_Name);

        SP.Flush(Item_Name);
        SP.Flush(Version_Name);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Add_Property =>

        Keyword := STR.Get_Argument(
        Proc => Command_Array(Add_Property),
        Name => "keyword");

        Value := STR.Get_Argument(
        Proc => Command_Array(Add_Property),
        Name => "value");

        Return_Code := Add_Property_Interface(
                Library   => Current_Library,
                Keyword   => Keyword,
                Value     => Value,
                Privilege => LD.Add_Property_Privilege);

        SP.Flush(Keyword);
        SP.Flush(Value);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Delete_Property =>

        Keyword := STR.Get_Argument(
        Proc => Command_Array(Delete_Property),
        Name => "keyword");

        Return_Code := Delete_Property_Interface(
                Library   => Current_Library,
                Keyword   => Keyword,
                Privilege => LD.Delete_Property_Privilege);

        SP.Flush(Keyword);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Modify_Property =>

        Keyword := STR.Get_Argument(
        Proc => Command_Array(Modify_Property),
        Name => "keyword");

        Value := STR.Get_Argument(
        Proc => Command_Array(Modify_Property),
        Name => "value");

        Return_Code := Modify_Property_Interface(
                Library   => Current_Library,
                Keyword   => Keyword,
                Value     => Value,
                Privilege => LD.Modify_Property_Privilege);

        SP.Flush(Keyword);
        SP.Flush(Value);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when List_Property =>

        Keyword := STR.Get_Argument(
        Proc => Command_Array(List_Property),
        Name => "keyword");

        Return_Code := List_Property_Interface(
                Library   => Current_Library,
                Keyword   => Keyword);

        SP.Flush(Keyword);

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --
--
--    when Escape =>
--
--        System_Command := STR.Get_Argument(
--        Proc => Command_Array(Escape),
--        Name => "command");
--
--        HL.Invoke(SP.Value(System_Command), Return_Code);
--
--        SP.Flush(System_Command);
--
--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    when Enter_Library =>

        SP.Flush(Current_Library);
        SP.Flush(Current_Prompt);

        Current_Library := LIB.Get_Argument(
        Proc => Command_Array(Enter_Library),
        Name => "library");

        if SP.Is_Empty(Current_Library) then
        Current_Library := SP.Make_Persistent(Default_Library);
        Current_Prompt  := SP.Make_Persistent(Default_Prompt);
        else
        Current_Prompt := SP.Make_Persistent(SP."&"(SP.Upper(Current_Library), ">"));
        end if;

--  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --  --

    end case;

    if HL."="(Return_Code, HL.SEVERE) then
        return HL.SEVERE;
    end if;

    SI.Redefine_Process(Command_Array(Command));

    exception
    when SI.Process_Help =>
        null;
    when SI.Abort_Process =>
        null;
    when SI.No_Command =>
        null;
    when SI.Abort_Command =>
        null;
    when SI.Command_Help =>
        null;
    when SI.Command_Exit =>
        return HL.SUCCESS;
    when others =>
        LE.Report_Error(LE.Internal_Error, SP.Create("Library_Manager"));
        return HL.SEVERE;
    end;

    end loop;

end Library_Manager_Interface;
                                                                    pragma page;
::::::::::::::
libmgr.dat
::::::::::::::
with Lists;
with String_Pkg;
with String_Lists;

package Library_Declarations is


--------------------------------------------------------------------------------
--                              Exceptions                                    --
--------------------------------------------------------------------------------

Invalid_Library_Name     : exception;    --| Library name not an Ada identifier
Library_Does_Not_Exist   : exception;    --| Library specified does not exist
Library_Already_Exists   : exception;    --| Library specified already exist
Library_Pending_Return   : exception;    --| Library pending return to catalog
Library_Master_Locked    : exception;    --| Library is locked by a master lock
Library_Write_Locked     : exception;    --| Library is locked for update
Library_Read_Locked      : exception;    --| Library is locked for read
Not_Authorized           : exception;    --| Non authorized unlocking attempt
Invalid_Upgrade          : exception;    --| Lock upgrade invalid
Invalid_Downgrade        : exception;    --| Lock downgrade invalid

Item_Not_Found           : exception;    --| Item does not exist
Item_Already_Exists      : exception;    --| Item is already in the library
Item_Checked_Out         : exception;    --| Item is currently checked out
Item_Not_Checked_Out     : exception;    --| Item is not checked out
Item_Not_Created         : exception;    --| Item is not created on return

Invalid_Version          : exception;    --| Invalid version specification
Version_Not_Found        : exception;    --| Version of item does not exist

Invalid_Keyword          : exception;    --| Invalid property keyword specified
Invalid_Value            : exception;    --| Invalid value for keyword specified
Keyword_Already_Exists   : exception;    --| Keyword-value pair already exists
Keyword_Not_Found        : exception;    --| Keyword not associated with item

Invalid_Directory_Name   : exception;    --| Directory name not valid for system
Directory_Already_Exists : exception;    --| Directory specified already exist

File_Not_Found           : exception;    --| File is not found
File_Not_Created         : exception;    --| File is not created on fetch
Set_Protection_Error     : exception;    --| Error while setting file protection

Invalid_External_Name    : exception;    --| Specified external name invalid
Invalid_Operation        : exception;    --| Specified operation cannot be performed
No_Privilege             : exception;    --| No privilege for attempted operation
Process_Interrupted      : exception;    --| Process is terminated by interrupt

Internal_Error           : exception;    --| Library manager internal error


--------------------------------------------------------------------------------
--                        Packages and Procedures                             --
--------------------------------------------------------------------------------

package SP renames String_Pkg;

package SL renames String_Lists;

package LL is new Lists(SL.List, SL.Equal);

procedure Destroy_String_List is new
            SL.DestroyDeep(Dispose => SP.Flush);

procedure Destroy_List_Of_Lists is new
            LL.DestroyDeep(Dispose => Destroy_String_List);


--------------------------------------------------------------------------------
--                               Types                                        --
--------------------------------------------------------------------------------

type    Copy_Mode      is (CURRENT, FULL);
                    --| Library copy mode
type    Fetch_Type     is (NO_UPDATE, UPDATE, BRANCH);
                    --| Check out/Return mode
subtype State_Type is Fetch_Type range NO_UPDATE .. UPDATE;
                    --| Item state type
type    List_Mode      is (LONG, SHORT);
                    --| List items in full/terse form
type    Lock_Type      is (READ_LOCK, WRITE_LOCK, MASTER_LOCK);
                    --| Types of lock
type    Edit_Mode      is (ADD, DELETE, MODIFY, LIST);
                    --| Edit mode
type    Operation_Type is (CREATE_ITEM, RETURN_ITEM, CANCEL_ITEM);
                    --| Check-in operation type
type    Privilege_Type is (OWNER, GROUP, WORLD);


--------------------------------------------------------------------------------
--                               Values                                       --
--------------------------------------------------------------------------------

Message_on_Completion : BOOLEAN := TRUE;

Message_on_Error      : BOOLEAN := TRUE;


--------------------------------------------------------------------------------
--                             Constants                                      --
--------------------------------------------------------------------------------

Separator                 : constant STRING (1 .. 80) := (others => '-');

Maximum_Library_Name      : constant INTEGER          := 20;

Maximum_Owner_Name        : constant INTEGER          := 12;

Maximum_Group_Name        : constant INTEGER          := 12;

Maximum_CI_Name           : constant INTEGER          := 20;

Maximum_Item_Name         : constant INTEGER          := 28;

Maximum_Line_Size         : constant INTEGER          := 80;

Maximum_Keyword           : constant INTEGER          := 36;

Retry_Count               : constant INTEGER          :=  1;

Delay_Interval            : constant DURATION         := 10.00;

Delete_Library_Privilege  : constant Privilege_Type   := OWNER;

Delete_Item_Privilege     : constant Privilege_Type   := OWNER;

Purge_Item_Privilege      : constant Privilege_Type   := OWNER;

Rename_Item_Privilege     : constant Privilege_Type   := OWNER;

Rename_Version_Privilege  : constant Privilege_Type   := OWNER;

Add_Property_Privilege    : constant Privilege_Type   := OWNER;

Delete_Property_Privilege : constant Privilege_Type   := OWNER;

Modify_Property_Privilege : constant Privilege_Type   := OWNER;

end Library_Declarations;
                                                                    pragma page;
::::::::::::::
libmgr.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function Library_Manager_Interface(        --| Interactive library manager
    Library : in String_Pkg.String_Type;    --| Item library to be created
    Prompt  : in String_Pkg.String_Type        --| Prompt
    ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library

--| Effects:
--| Enter an interactive library manager for a given library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
libutl.bdy
::::::::::::::
with String_Utilities;
with HIF_Attributes;
with HIF_List_Utils;
with Host_Lib;
with File_Manager;
with Document_Manager_Declarations;
with HIF_Utils;
with HIF_System_Management;

package body Library_Utilities is

    package SU  renames String_Utilities;
    package SS  is new SU.Generic_String_Utilities(
            SP.String_Type,
            SP.Make_Persistent,
            SP.Value);
    package FM  renames File_Manager;
    package DMD renames Document_Manager_Declarations;
    package HA  renames HIF_Attributes;
    package HLU renames HIF_List_Utils;
    package HL  renames Host_Lib;
    package HU  renames HIF_Utils;
    package HSM renames HIF_System_Management;

    subtype Valid_Character      is CHARACTER range ' ' .. '~';
    subtype Digit                is CHARACTER range '0' .. '9';
    subtype Lower_Alphabet       is CHARACTER range 'a' .. 'z';
    subtype Upper_Alphabet       is CHARACTER range 'A' .. 'Z';

    Substitute_Character    : constant CHARACTER := 'Z';

    Privilege_Reason        : constant STRING    := "PRIVILEGE";
    Version_Exists_Reason   : constant STRING    := "NAME_CONFLICT";
    Item_Checked_Out_Reason : constant STRING    := "CHECKED_OUT";
    Regression_Reason       : constant STRING    := "REGRESSION";

--------------------------------------------------------------------------------

    function Internal_Name(
    External_Name : in SP.String_Type;
    Exclude       : in STRING := ""
    ) return STRING is

    Translate           : BOOLEAN;
    Internal_Name       : STRING(1 .. 256) := (others => ' ');
    Internal_Name_Index : INTEGER := 1;
    External_Character  : Valid_Character;

    begin

    for i in 1 .. SP.Length(External_Name) loop
        begin
        External_Character := SP.Fetch(External_Name, i);
        exception
        when CONSTRAINT_ERROR =>
            raise Invalid_External_Name;
        end;

        Translate := TRUE;

        begin
        External_Character := Digit'(External_Character);
        Translate := FALSE;
        if i = 1 then
            Internal_Name(1 .. 3) := Substitute_Character & "00";
            Internal_Name_Index := 4;
        end if;
        exception
        when CONSTRAINT_ERROR => null;
        end;

        if Translate then
        begin
            External_Character := Lower_Alphabet'(External_Character);
            Translate := FALSE;
        exception
            when CONSTRAINT_ERROR => null;
        end;
        end if;

        if Translate then
        begin
            External_Character := Upper_Alphabet'(External_Character);
            Translate := FALSE;
        exception
            when CONSTRAINT_ERROR => null;
        end;
        end if;

        if Translate then
        for k in Exclude'range loop
            if External_Character = Exclude(k) then
            Translate := FALSE;
            exit;
            end if;
        end loop;
        end if;

        if Translate then
        Internal_Name(Internal_Name_Index .. Internal_Name_Index+2) :=
            Substitute_Character &
            SU.Image(
            CHARACTER'pos(External_Character) - CHARACTER'pos(Valid_Character'first) + 1,
            2,
            '0');
        Internal_Name_Index := Internal_Name_Index + 3;
        else
        Internal_Name(Internal_Name_Index) := External_Character;
        Internal_Name_Index := Internal_Name_Index + 1;
        end if;
    end loop;
    return Internal_Name(1 .. Internal_Name_Index-1);

    end Internal_Name;

--------------------------------------------------------------------------------

    function External_Name(
    Internal_Name : in STRING
    ) return STRING is

    External_Name       : STRING(1 .. 256) := (others => ' ');
    External_Name_Index : INTEGER := 1;
    Internal_Name_Index : INTEGER := Internal_Name'first;

    begin

    while Internal_Name_Index <= Internal_Name'last loop
        if Internal_Name(Internal_Name_Index) = Substitute_Character then
        begin
            if NATURAL'value(Internal_Name(Internal_Name_Index+1 .. Internal_Name_Index+2)) /= 0 then
            External_Name(External_Name_Index) :=
                Valid_Character'val(
                NATURAL'value(
                    Internal_Name(Internal_Name_Index+1 .. Internal_Name_Index+2)) +
                    CHARACTER'pos(Valid_Character'first) -
                    1);
            External_Name_Index := External_Name_Index + 1;
            end if;
            Internal_Name_Index := Internal_Name_Index + 2;
        exception
            when CONSTRAINT_ERROR =>
            External_Name(External_Name_Index) := Substitute_Character;
            External_Name_Index := External_Name_Index + 1;
        end;
        else
        External_Name(External_Name_Index) :=
            Internal_Name(Internal_Name_Index);
        External_Name_Index := External_Name_Index + 1;
        end if;
        Internal_Name_Index := Internal_Name_Index + 1;
    end loop;
    return External_Name(1 .. External_Name_Index-1);

    end External_Name;

--------------------------------------------------------------------------------

    procedure Is_Node(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    ) is


    begin

    if HNM.Is_Open(Node) then
        HNM.Close_Node_Handle(Node);
    end if;
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Name));

    exception
    when others =>
        HNM.Close_Node_Handle(Node);

    end Is_Node;

--------------------------------------------------------------------------------

    function Node_Name(
    Library : in SP.String_Type;
    Item    : in SP.String_Type := SP.Create("");
    Version : in STRING := ""
    ) return SP.String_Type is

    begin

    if SP.Equal(Item, "") then
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ')');
    elsif SP.Equal(Item, "*") then
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ").IL");
    elsif Version = "" then
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ").IL." &
                 Internal_Name(Item));
    else
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ").IL." &
                 Internal_Name(Item) &
                 ".V" & Version);
    end if;

    end Node_Name;

--------------------------------------------------------------------------------

    procedure Parse_Node(
    Node    : in     HND.Node_Type;
    Library :    out SP.String_Type;
    Item    :    out SP.String_Type;
    Version :    out SP.String_Type
    ) is

    Scanner : SU.Scanner;
    Temp    : SP.String_Type;
    Found   : BOOLEAN;

    begin

    Scanner := SS.Make_Scanner(SP.Upper(HNM.Primary_Name(Node)));

    SS.Scan_Literal("'USER", Scanner, Found);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    SS.Scan_Enclosed('(', ')', Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    Library := SP.Make_Persistent(External_Name(SP.Value(Temp)));
    SP.Flush(Temp);

    SU.Backward(Scanner);
    SS.Scan_Not_Literal("'DOT(IL)", Scanner, Found, Temp);
    if not Found then
        SS.Scan_Not_Literal("'DOT(CI)", Scanner, Found, Temp);
        if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
        else
        SS.Scan_Literal("'DOT(CI)", Scanner, Found);
        end if;
    else
        SS.Scan_Literal("'DOT(IL)", Scanner, Found);
    end if;
    SP.Flush(Temp);

    SS.Scan_Not_Literal("(", Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    SP.Flush(Temp);
    SS.Scan_Enclosed('(', ')', Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    Item := SP.Make_Persistent(External_Name(SP.Value(Temp)));
    SP.Flush(Temp);

    SS.Scan_Not_Literal("(", Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    SP.Flush(Temp);
    SS.Scan_Enclosed('(', ')', Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    Version := SP.Make_Persistent(SP.Substr(Temp, 2, SP.Length(Temp)-1));
    SP.Flush(Temp);
    SU.Destroy_Scanner(Scanner);

    end Parse_Node;

--------------------------------------------------------------------------------

    function Is_Ada_Id(
    Value : in SP.String_Type
    ) return BOOLEAN is

    Scanner : SU.Scanner;
    Ada_Id  : SP.String_Type;
    Found   : BOOLEAN;

    begin

    Scanner := SS.Make_Scanner(Value);
    SS.Scan_Ada_Id(Scanner, Found, Ada_Id, Skip => FALSE);
    SP.Flush(Ada_Id);
    Found := Found and not SU.More(Scanner);
    SU.Destroy_Scanner(Scanner);
    return Found;

    end Is_Ada_Id;

--------------------------------------------------------------------------------

    procedure Is_Library(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type
    ) is

    Owner_Value  : STRING(1 .. Maximum_Owner_Name);
    Owner_Length : INTEGER;


    begin

    if not Is_Ada_Id(Library) then
        raise Invalid_Library_Name;
    end if;
    Is_Node(Node, Node_Name(Library));
    if not HNM.Is_Open(Node) then
        return;
    end if;
    HU.Get_Node_Attribute(Node       => Node,
                  Attrib     => "OWNER",
                  Value      => Owner_Value,
                  Value_Last => Owner_Length);
    if Owner_Length = 0 then
        HNM.Close_Node_Handle(Node);
    end if;

    end Is_Library;

--------------------------------------------------------------------------------

    procedure Is_Item(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type
    ) is

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    Is_Node(Node, Node_Name(Library, Item));

    end Is_Item;

--------------------------------------------------------------------------------

    procedure Is_Version(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type;
    Version : in     SP.String_Type
    ) is

    Found     : BOOLEAN;
    Versions  : SL.List := SL.Create;

    begin

    Is_Node(Node, Node_Name(Library, Item));
    if not HNM.Is_Open(Node) then
        raise Item_Not_Found;
    end if;
    Versions := Get_Version(Node, Version);
    if SL.Length(Versions) = 1 then
        Is_Node(Node,
            Node_Name(Library,
                  Item,
                  SP.Value(SL.FirstValue(Versions))));
    else
        HNM.Close_Node_Handle(Node);
    end if;
    Destroy_String_List(Versions);

    end Is_Version;

--------------------------------------------------------------------------------

    function Is_Checked_Out(
    Item_Node : in HND.Node_Type
    ) return BOOLEAN is

    begin

    return Checked_Out_By(Item_Node) /= "";

    end Is_Checked_Out;

--------------------------------------------------------------------------------

    function Checked_Out_By(
    Item_Node : in HND.Node_Type
    ) return STRING is

    Attribute_Value  : STRING(1 .. 16);
    Attribute_Length : INTEGER;

    begin

    HU.Get_Node_Attribute(Node       => Item_Node,
                  Attrib     => "CHECKED_OUT",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    return Attribute_Value(1 .. Attribute_Length);

    end Checked_Out_By;

--------------------------------------------------------------------------------

    procedure Wait is

    begin
                -- Place waiting algorithm here
    null;            -- (use constant Delay_Interval in
                --  Library_Declarations)
    end Wait;

--------------------------------------------------------------------------------

    procedure Check_Master_Lock(
    Node : in HND.Node_Type
    ) is

    begin

    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(MASTER_LOCK));
    exception
        when others =>
        raise Library_Master_Locked;
    end;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(MASTER_LOCK));
    exception
        when others =>
        null;
    end;

    end Check_Master_Lock;

--------------------------------------------------------------------------------

    function Lock_Library(
    Node : in HND.Node_Type;
    Lock : in Lock_Type
    ) return BOOLEAN is

    Was_Locked : BOOLEAN;
    Iterator   : HNM.Node_Iterator;

    begin

    if Lock = MASTER_LOCK then
        begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(Lock));
        exception
        when others =>
            raise Library_Master_Locked;
        end;
        Set_Lock_Attributes(Node, Lock, "");
        return TRUE;
    end if;

    Check_Master_Lock(Node);

    Was_Locked := TRUE;
    for i in 1 .. Retry_Count loop
        begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(WRITE_LOCK));
        Was_Locked := FALSE;
        exit;
        exception
        when others =>
            Wait;
        end;
    end loop;

    if Was_Locked then
        return FALSE;
    end if;

    if Lock = WRITE_LOCK then
        HNM.Iterate(Iterator     => Iterator,
            Node         => Node,
            Relation     => Lock_Type'image(READ_LOCK),
            Primary_Only => FALSE);
        if HNM.More(Iterator) then
        begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(Lock));
        exception
            when others =>
            null;
        end;
        return FALSE;
        end if;
        Set_Lock_Attributes(Node, Lock, "");
        return TRUE;
    end if;

    Was_Locked := TRUE;
    for i in 1 .. Retry_Count loop
        begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(Lock),
             Key      => HL.Get_Item(HL.USER_NAME));
        Was_Locked := FALSE;
        exit;
        exception
        when others =>
            Wait;
        end;
    end loop;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(WRITE_LOCK));
    exception
        when others =>
        null;
    end;

    if Was_Locked then
        return FALSE;
    end if;
    Set_Lock_Attributes(Node, Lock, HL.Get_Item(HL.USER_NAME));

    return TRUE;

    end Lock_Library;

--------------------------------------------------------------------------------

    function Lock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    ) return BOOLEAN is

    Node   : HND.Node_Type;
    Locked : BOOLEAN;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    Locked := Lock_Library(Node, Lock);
    HNM.Close_Node_Handle(Node);
    return Locked;

    end Lock_Library;

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type
    ) is

    Owner : SP.String_Type;
    Group : SP.String_Type;
    Date  : SP.String_Type;
    Time  : SP.String_Type;

    begin

    if Lock = MASTER_LOCK then
        begin
        Get_Lock_Attributes(Node, Lock, "", Owner, Group, Date, Time);
        if SP.Value(Owner) /= HL.Get_Item(HL.USER_NAME) then
            raise Not_Authorized;
        else
            begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(Lock));
            exception
            when others =>
                null;
            end;
            return;
        end if;
        exception
        when others =>
            return;
        end;
    end if;

    if Lock = WRITE_LOCK then
        begin
        Get_Lock_Attributes(Node, Lock, "", Owner, Group, Date, Time);
        if SP.Value(Owner) /= HL.Get_Item(HL.USER_NAME) then
            raise Not_Authorized;
        else
            begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(Lock));
            exception
            when others =>
                null;
            end;
            return;
        end if;
        exception
        when others =>
            return;
        end;
    end if;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(Lock),
               Key      => HL.Get_Item(HL.USER_NAME));
    exception
        when others =>
        null;
    end;

    end Unlock_Library;

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    ) is

    Node  : HND.Node_Type;
    Owner : SP.String_Type;
    Date  : SP.String_Type;
    Time  : SP.String_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    Unlock_Library(Node, Lock);
    HNM.Close_Node_Handle(Node);

    end Unlock_Library;

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Node  : in HND.Node_Type
    ) return BOOLEAN is

    Was_Locked : BOOLEAN;
    Iterator   : HNM.Node_Iterator;
    Temp_Node  : HND.Node_Type;

    begin

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(READ_LOCK),
             Key      => HL.Get_Item(HL.USER_NAME));
        Was_Locked := FALSE;
    exception
        when others =>
        Was_Locked := TRUE;
    end;

    if not Was_Locked then
        begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(READ_LOCK),
               Key      => HL.Get_Item(HL.USER_NAME));
        exception
        when others =>
            null;
        end;
        raise Invalid_Upgrade;
    end if;

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(WRITE_LOCK));
    exception
        when others =>
        raise Internal_Error;
    end;

    HNM.Iterate(Iterator     => Iterator,
            Node         => Node,
            Relation     => Lock_Type'image(READ_LOCK),
            Primary_Only => FALSE);
    while HNM.More(Iterator) loop
        HNM.Get_Next(Iterator, Temp_Node);
        if HNM.Path_Key(Temp_Node) /= HL.Get_Item(HL.USER_NAME) then
        begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(WRITE_LOCK));
        exception
            when others =>
            null;
        end;
        return FALSE;
        end if;
        HNM.Close_Node_Handle(Temp_Node);
    end loop;

    Set_Lock_Attributes(Node, WRITE_LOCK, "");

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(READ_LOCK),
               Key      => HL.Get_Item(HL.USER_NAME));
    exception
        when others =>
        null;
    end;
    return TRUE;

    end Upgrade_Lock;

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Library : in SP.String_Type
    ) return BOOLEAN is

    Node   : HND.Node_Type;
    Locked : BOOLEAN;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Invalid_Library_Name;
    end if;
    Locked := Upgrade_Lock(Node);
    HNM.Close_Node_Handle(Node);
    return Locked;

    end Upgrade_Lock;

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Node  : in HND.Node_Type
    ) is

    Was_Locked : BOOLEAN;
    Owner      : SP.String_Type;
    Group      : SP.String_Type;
    Date       : SP.String_Type;
    Time       : SP.String_Type;

    begin

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(WRITE_LOCK));
        Was_Locked := FALSE;
    exception
        when others =>
        Was_Locked := TRUE;
    end;

    if Was_Locked then
        Get_Lock_Attributes(Node, WRITE_LOCK, "", Owner, Group, Date, Time);
        if SP.Value(Owner) /= HL.Get_Item(HL.USER_NAME) then
        raise Invalid_Downgrade;
        end if;
    end if;

    if not Was_Locked then
        begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(WRITE_LOCK));
        exception
        when others =>
            null;
        end;
        raise Invalid_Downgrade;
    end if;

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(READ_LOCK),
             Key      => HL.Get_Item(HL.USER_NAME));
        Set_Lock_Attributes(Node, READ_LOCK, "");
    exception
        when others =>
        raise Internal_Error;
    end;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(WRITE_LOCK));
    exception
        when others =>
        null;
    end;

    end Downgrade_Lock;

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Library : in SP.String_Type
    ) is

    Node : HND.Node_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Invalid_Library_Name;
    end if;
    Downgrade_Lock(Node);
    HNM.Close_Node_Handle(Node);

    end Downgrade_Lock;

--------------------------------------------------------------------------------

    function Get_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING
    ) return STRING is

    Library_Node     : HND.Node_Type;
    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;

    begin

    Is_Library(Library_Node, Library);
    if not HNM.Is_Open(Library_Node) then
        raise Library_Does_Not_Exist;
    end if;
    HU.Get_Node_Attribute(Node       => Library_Node,
                  Attrib     => Attribute,
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    HNM.Close_Node_Handle(Library_Node);
    return Attribute_Value(1 .. Attribute_Length);

    end Get_Library_Attribute;

--------------------------------------------------------------------------------

    procedure Set_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING;
    Value     : in STRING
    ) is

    Library_Node : HND.Node_Type;

    begin

    Is_Library(Library_Node, Library);
    if not HNM.Is_Open(Library_Node) then
        raise Library_Does_Not_Exist;
    end if;
    HA.Set_Node_Attribute(Node   => Library_Node,
                  Attrib => Attribute,
                  Value  => Value);
    HNM.Close_Node_Handle(Library_Node);

    end Set_Library_Attribute;

--------------------------------------------------------------------------------

    procedure Open_Standard_Node_Handle(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    ) is

    begin

    if HNM.Is_Open(Node) then
        HNM.Close_Node_Handle(Node);
    end if;
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Name));
    Set_Standard_Attributes(Node);

    end Open_Standard_Node_Handle;

--------------------------------------------------------------------------------

    procedure Set_Standard_Attributes(
    Node : in HND.Node_Type
    ) is

    Time : HL.Time_Value;

    begin

    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "OWNER",
                  Value  => HL.Get_Item(HL.USER_NAME));
    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "GROUP",
                  Value  => HL.Get_Item(HL.ACCOUNT));
    HL.Get_Time(Time);
    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "DATE",
                  Value  => HL.Date(Time));
    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "TIME",
                  Value  => HL.Time(Time));

    end Set_Standard_Attributes;

--------------------------------------------------------------------------------

    procedure Set_Lock_Attributes(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type;
    Key   : in STRING
    ) is

    Time      : HL.Time_Value;
    Lock_Node : HND.Node_Type;

    begin

    HNM.Open_Node_Handle(Node => Lock_Node,
                 Base => Node,
                 Name => ''' & Lock_Type'image(Lock) & '(' & Key & ')');
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "OWNER",
                  Value  => HL.Get_Item(HL.USER_NAME));
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "GROUP",
                  Value  => HL.Get_Item(HL.ACCOUNT));
    HL.Get_Time(Time);
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "DATE",
                  Value  => HL.Date(Time));
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "TIME",
                  Value  => HL.Time(Time));
    HNM.Close_Node_Handle(Lock_Node);

    end Set_Lock_Attributes;

--------------------------------------------------------------------------------

    procedure Get_Lock_Attributes(
    Node       : in     HND.Node_Type;
    Lock       : in     Lock_Type;
    Key        : in     STRING;
    Owner      : in out SP.String_Type;
    Group      : in out SP.String_Type;
    Date       : in out SP.String_Type;
    Time       : in out SP.String_Type
    ) is

    Lock_Node        : HND.Node_Type;
    Attribute_Value  : STRING(1 .. Maximum_Owner_Name);
    Attribute_Length : INTEGER;

    begin

    HNM.Open_Node_Handle(Node => Lock_Node,
                 Base => Node,
                 Name => ''' & Lock_Type'image(Lock) & '(' & Key & ')');
    HU.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "OWNER",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Owner := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HU.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "GROUP",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Group := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HU.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "DATE",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Date := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HU.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "TIME",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Time := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HNM.Close_Node_Handle(Lock_Node);

    end Get_Lock_Attributes;

--------------------------------------------------------------------------------

    function Get_Item_Date_Time(
    Library : in SP.String_Type;
    Item    : in SP.String_Type;
    Version : in SP.String_Type
    ) return STRING is

    Node      : HND.Node_Type;
    Date_Attr : STRING(1 .. 8);
    Date_Len  : INTEGER;
    Time_Attr : STRING(1 .. 8);
    Time_Len  : INTEGER;

    begin

    Is_Version(Node, Library, Item, Version);
    if not HNM.Is_Open(Node) then
        raise Version_Not_Found;
    end if;
    HU.Get_Node_Attribute(Node       => Node,
                  Attrib     => "DATE",
                  Value      => Date_Attr,
                  Value_Last => Date_Len);
    HU.Get_Node_Attribute(Node       => Node,
                  Attrib     => "TIME",
                  Value      => Time_Attr,
                  Value_Last => Time_Len);
    HNM.Close_Node_Handle(Node);
    return Date_Attr(1 .. Date_Len) & ' ' & Time_Attr(1 .. Time_Len);

    end Get_Item_Date_Time;

--------------------------------------------------------------------------------

    function Get_Current_Version(
    Node : in HND.Node_Type
    ) return STRING is

    Iterator     : HNM.Node_Iterator;
    Version_Node : HND.Node_Type;
    Library      : SP.String_Type;
    Item         : SP.String_Type;
    Version      : SP.String_Type;

    begin

    HNM.Iterate(Iterator     => Iterator,
            Node         => Node,
            Relation     => "DOT",
            Key          => "V*",
            Primary_Only => TRUE);
    if not HNM.More(Iterator) then
        raise Version_Not_Found;
    end if;
    while HNM.More(Iterator) loop
        HNM.Close_Node_Handle(Version_Node);
        HNM.Get_Next(Iterator, Version_Node);
    end loop;
    Parse_Node(Version_Node, Library, Item, Version);
    SP.Flush(Library);
    SP.Flush(Item);
    declare
        Version_Number : STRING (1 .. SP.Length(Version)) := SP.Value(Version);
    begin
        SP.Flush(Item);
        return Version_Number;
    end;

    end Get_Current_Version;

--------------------------------------------------------------------------------

    function Get_Version(
    Node    : in HND.Node_Type;
    Version : in SP.String_Type
    ) return SL.List is

    Version_Number  : INTEGER := 0;
    Current_Version : INTEGER;
    List            : SL.List;
    Version_Value   : STRING(1 .. 16);
    Version_Length  : INTEGER;
    Temp_Node       : HND.Node_Type;
    Temp_Str        : SP.String_Type;

    begin

    if not SP.Equal(Version, "") and then SP.Match_C(Version, '*') = 0 then
        begin
        Version_Number := INTEGER'value(SP.Value(Version));
        exception
        when others =>
            raise Invalid_Version;
        end;
        if Version_Number > 0 then
            begin
            HNM.Open_Node_Handle(Node => Temp_Node,
                     Base => Node,
                     Name => ".V" & SU.Image(Version_Number));
            HNM.Close_Node_Handle(Temp_Node);
        exception
            when others =>
            raise Version_Not_Found;
        end;
        return SL.MakeList(SS.Image(Version_Number));
        end if;
    end if;

    HU.Get_Node_Attribute(Node       => Node,
                  Attrib     => "V",
                  Value      => Version_Value,
                  Value_Last => Version_Length);
    if Version_Value(1 .. Version_Length) = "0" then
        Current_Version := INTEGER'value(Get_Current_Version(Node));
        HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "V",
                  Value  => SU.Image(Current_Version));
    else
        Current_Version := INTEGER'value(Version_Value(1 .. Version_Length));
    end if;
    if SP.Match_C(Version, '*') = 0 then
        Version_Number := Current_Version + Version_Number;
        if Version_Number <= 0 then
        raise Version_Not_Found;
        end if;
        return SL.MakeList(SS.Image(Version_Number));
    else
        List := SL.Create;
        for i in reverse 1 .. Current_Version loop
        begin
            HNM.Open_Node_Handle(Node => Temp_Node,
                     Base => Node,
                     Name => ".V" & SU.Image(i));
            Temp_Str := SS.Image(i);
            if SS.Match(Version, Temp_Str) then
            SL.Attach(List, Temp_Str);
            else
            SP.Flush(Temp_Str);
            end if;
            HNM.Close_Node_Handle(Temp_Node);
        exception
            when others =>
            null;
        end;
        end loop;
        return List;
    end if;

    end Get_Version;

--------------------------------------------------------------------------------

    procedure Iterate_Item(
    Library  : in     SP.String_Type;
    Item     : in     SP.String_Type;
    Iterator : in out HNM.Node_Iterator
    ) is

    Node : HND.Node_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    HNM.Close_Node_Handle(Node);
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Node_Name(Library, SP.Create("*"))));
    begin
        HNM.Iterate(Iterator     => Iterator,
            Node         => Node,
            Relation     => "DOT",
            Key          => Internal_Name(Item, "*"),
            Primary_Only => TRUE);
        HNM.Close_Node_Handle(Node);
    exception
        when others =>
        HNM.Close_Node_Handle(Node);
        raise Item_Not_Found;
    end;

    end Iterate_Item;

--------------------------------------------------------------------------------

    procedure Open_Property_Node(
    Library : in     SP.String_Type;
    Keyword : in     SP.String_Type;
    Value   : in     SP.String_Type;
    Mode    : in     Edit_Mode;
    Node    : in out HND.Node_Type
    ) is

    Property_List    : HLU.List_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    HNM.Close_Node_Handle(Node);
    if Mode /= LIST then
        if SP.Equal(Keyword, "") or else not Is_Ada_Id(Keyword) then
        raise Invalid_Keyword;
        end if;
    end if;
    if Mode = ADD or Mode = MODIFY then
        if SP.Equal(Value, "") or else not Is_Ada_Id(Value) then
        raise Invalid_Value;
        end if;
    end if;
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Node_Name(Library, SP.Create("*"))));
    if Mode /= LIST then
        HA.Get_Node_Attribute(Node       => Node,
                  Attrib     => SP.Value(Keyword),
                  Value      => Property_List);
        if (Mode = DELETE or Mode = MODIFY) and HLU.Empty(Property_List) then
        HLU.Free_List(Property_List);
        raise Keyword_Not_Found;
        end if;
        if Mode = ADD and not HLU.Empty(Property_List) then
        HLU.Free_List(Property_List);
        raise Keyword_Already_Exists;
        end if;
        HLU.Free_List(Property_List);
    end if;

    end Open_Property_Node;

--------------------------------------------------------------------------------

    procedure Delete(
    Item_Node : in out HND.Node_Type;
    Versions  : in     SL.List;
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    ) is

    Version_Iterator : SL.ListIter;
    Version_Number   : SP.String_Type;
    Version_Node     : HND.Node_Type;
    All_Version      : SL.List;
    Library          : SP.String_Type;
    Item             : SP.String_Type;
    Version          : SP.String_Type;
    Remainder_List   : SL.List;
    Delete           : BOOLEAN := FALSE;
    Current_Version  : INTEGER;
    Interrupt        : HL.Interrupt_State;

    begin

    if SL.IsEmpty(Versions) then
        return;
    end if;
    Parse_Node(Node    => Item_Node,
           Library => Library,
           Item    => Item,
           Version => Version);
    if Privileged(Privilege, Library, Item) then
        All_Version := Get_Version(Item_Node, SP.Create("*"));
        if SL.Equal(All_Version, Versions) then
        Interrupt := HL.Get_Interrupt_State;
        HL.Ignore_Interrupts;
        Destroy_String_List(All_Version);
        if Is_Checked_Out(Item_Node) then
            Change_Checked_Out_Count(Library, -1);
        end if;
        HNM.Delete_Tree(Item_Node);
        HL.Set_Interrupt_State(Interrupt);
        return;
        else
        Destroy_String_List(All_Version);
        Delete := TRUE;
        end if;
    end if;
    SP.Flush(Library);
    SP.Flush(Item);
    SP.Flush(Version);
    Current_Version := INTEGER'value(Get_Current_Version(Item_Node));
    HA.Set_Node_Attribute(Node   => Item_Node,
                  Attrib => "V",
                  Value  => "0");
    Version_Iterator := SL.MakeListIter(Versions);
    while SL.More(Version_Iterator) loop
        SL.Next(Version_Iterator, Version_Number);
        HNM.Open_Node_Handle(Node         => Version_Node,
                 Base         => Item_Node,
                 Relation     => "DOT",
                 Key          => 'V' & SP.Value(Version_Number));
        Parse_Node(Node    => Version_Node,
               Library => Library,
               Item    => Item,
               Version => Version);
        if Delete then
        Interrupt := HL.Get_Interrupt_State;
        HL.Ignore_Interrupts;
        HNM.Delete_Tree(Version_Node);
        if INTEGER'value(SP.Value(Version_Number)) = Current_Version and then
           Is_Checked_Out(Item_Node) then
            Change_Checked_Out_Count(Library, -1);
        end if;
        HL.Set_Interrupt_State(Interrupt);
        SP.Flush(Library);
        SP.Flush(Item);
        SP.Flush(Version);
        else
        if Privileged(Privilege, Library, Item, SP.Value(Version)) then
            Interrupt := HL.Get_Interrupt_State;
            HL.Ignore_Interrupts;
            HNM.Delete_Tree(Version_Node);
            if INTEGER'value(SP.Value(Version_Number)) = Current_Version and then
               Is_Checked_Out(Item_Node) then
            Change_Checked_Out_Count(Library, -1);
            end if;
            HL.Set_Interrupt_State(Interrupt);
            SP.Flush(Library);
            SP.Flush(Item);
            SP.Flush(Version);
        else
            Remainder_List := SL.MakeList(Library);
            SL.Attach(Remainder_List, Item);
            SL.Attach(Remainder_List, Version);
            SL.Attach(Remainder_List, SP.Make_Persistent(Privilege_Reason));
            LL.Attach(Remainder, Remainder_List);
        end if;
        end if;
        HNM.Close_Node_Handle(Version_Node);
    end loop;
    begin
        HA.Set_Node_Attribute(Node   => Item_Node,
                  Attrib => "V",
                  Value  => Get_Current_Version(Item_Node));
    exception
        when Version_Not_Found =>
        HNM.Delete_Tree(Item_Node);
    end;

    exception
    when others =>
        HNM.Close_Node_Handle(Version_Node);
        raise;

    end Delete;

--------------------------------------------------------------------------------

    procedure Purge(
    Library   : in     SP.String_Type;
    Item      : in     SP.String_Type := SP.Create("*");
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    ) is

    Item_Node        : HND.Node_Type;
    Item_Iterator    : HNM.Node_Iterator;
    Versions         : SL.List;

    begin

    Iterate_Item(Library, Item, Item_Iterator);
    while HNM.More(Item_Iterator) loop
        HNM.Get_Next(Item_Iterator, Item_Node);
        Versions := Get_Version(Item_Node, SP.Create("*"));
        SL.DeleteHead(Versions);
        Delete(Item_Node, Versions, Privilege, Remainder);
        Destroy_String_List(Versions);
        HNM.Close_Node_Handle(Item_Node);
    end loop;

    exception
    when others =>
        HNM.Close_Node_Handle(Item_Node);
        raise;

    end Purge;

--------------------------------------------------------------------------------

    procedure Rename_Item(
    Library   : in SP.String_Type;
    From_Item : in SP.String_Type;
    To_Item   : in SP.String_Type;
    Privilege : in Privilege_Type;
    Remainder : in out LL.List
    ) is

    Item_Node      : HND.Node_Type;
    Remainder_List : SL.List;

    begin

    Is_Item(Item_Node, Library, To_Item);
    if HNM.Is_Open(Item_Node) then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Already_Exists;
    end if;
    Is_Item(Item_Node, Library, From_Item);
    if not HNM.Is_Open(Item_Node) then
        raise Item_Not_Found;
    end if;
    if Is_Checked_Out(Item_Node) then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Checked_Out;
    end if;
    if not Privileged(Privilege, Library, From_Item) then
        Remainder_List := SL.MakeList(SP.Make_Persistent(Library));
        SL.Attach(Remainder_List, SP.Make_Persistent(From_Item));
        SL.Attach(Remainder_List, SP.Make_Persistent(""));
        SL.Attach(Remainder_List, SP.Make_Persistent(Privilege_Reason));
        LL.Attach(Remainder, Remainder_List);
        return;
    end if;
    HNM.Rename(Node     => Item_Node,
           New_Name => SP.Value(Node_Name(Library, To_Item)));
    HNM.Close_Node_Handle(Item_Node);

    exception
    when others =>
        HNM.Close_Node_Handle(Item_Node);
        raise;

    end Rename_Item;

--------------------------------------------------------------------------------

    procedure Rename_Version(
    Library      : in     SP.String_Type;
    Item         : in     SP.String_Type;
    From_Version : in     SP.String_Type;
    To_Version   : in     SP.String_Type;
    Privilege    : in     Privilege_Type;
    Remainder    : in out LL.List
    ) is

    Library_Name        : SP.String_Type;
    Item_Name           : SP.String_Type;
    Version_Name        : SP.String_Type;
    Reason              : SP.String_Type;
    Version_Node        : HND.Node_Type;
    Item_Node           : HND.Node_Type;
    Item_Iterator       : HNM.Node_Iterator;
    Full_Version_List   : SL.List;
    List_Iterator       : SL.ListIter;
    Version             : SP.String_Type;
    From_Version_List   : SL.List;
    To_Version_List     : SL.List;
    Remainder_List      : SL.List;
    Add_To_List         : BOOLEAN;
    From_Version_Num    : INTEGER;
    To_Version_Num      : INTEGER;

    begin

    begin
        From_Version_Num := INTEGER'value(SP.Value(From_Version));
    exception
        when others =>
        if not SP.Is_Empty(From_Version) then
            raise Invalid_Version;
        end if;
    end;
    begin
        To_Version_Num := INTEGER'value(SP.Value(To_Version));
    exception
        when others =>
        if not SP.Is_Empty(To_Version) then
            raise Invalid_Version;
        end if;
    end;
    Iterate_Item(Library, Item, Item_Iterator);
    while HNM.More(Item_Iterator) loop
        HNM.Get_Next(Item_Iterator, Item_Node);
        if not Is_Checked_Out(Item_Node) then
        Parse_Node(Item_Node, Library_Name, Item_Name, Version_Name);
        SP.Flush(Version_Name);
        From_Version_List := Get_Version(Item_Node, From_Version);
        From_Version_Num := INTEGER'value(SP.Value(SL.FirstValue(From_Version_List)));
        Destroy_String_List(From_Version_List);
        Is_Version(Version_Node,
               Library_Name,
               Item_Name,
               SS.Image(From_Version_Num));
        Add_To_List := FALSE;
        begin
            To_Version_List := Get_Version(Item_Node, To_Version);
            To_Version_Num := INTEGER'value(SP.Value(SL.FirstValue(To_Version_List)));
            Destroy_String_List(To_Version_List);
            if From_Version_Num /= To_Version_Num then
            Add_To_List := TRUE;
            Reason := SP.Make_Persistent(Version_Exists_Reason);
            end if;
        exception
            when Version_Not_Found =>
            if To_Version_Num <= 0 then
                SP.Mark;
                To_Version_List := Get_Version(Item_Node, SP.Create("0"));
                To_Version_Num := INTEGER'value(SP.Value(SL.FirstValue(To_Version_List))) + To_Version_Num;
                Destroy_String_List(To_Version_List);
                SP.Release;
            end if;
            Full_Version_List := Get_Version(Item_Node, SP.Create("*"));
            List_Iterator := SL.MakeListIter(Full_Version_List);
            if From_Version_Num > To_Version_Num then
                while SL.More(List_Iterator) loop
                SL.Next(List_Iterator, Version);
                if From_Version_Num = INTEGER'value(SP.Value(Version)) then
                    if SL.More(List_Iterator) and then
                       To_Version_Num <= INTEGER'value(SP.Value(SL.CellValue(List_Iterator))) then
                    Add_To_List := TRUE;
                    Reason := SP.Make_Persistent(Regression_Reason);
                    end if;
                    exit;
                end if;
                end loop;
            else
                while SL.More(List_Iterator) loop
                SL.Next(List_Iterator, Version);
                if To_Version_Num > INTEGER'value(SP.Value(Version)) then
                    if From_Version_Num /= INTEGER'value(SP.Value(Version)) then
                    Add_To_List := TRUE;
                    Reason := SP.Make_Persistent(Regression_Reason);
                    end if;
                    exit;
                end if;
                end loop;
            end if;
            Destroy_String_List(Full_Version_List);
            if not Add_To_List then
                if Privileged(Privilege,
                      Library_Name,
                      Item_Name,
                      SU.Image(From_Version_Num)) then
                HA.Set_Node_Attribute(Node   => Item_Node,
                              Attrib => "V",
                              Value  => "0");
                HNM.Rename(Node     => Version_Node,
                       New_Name => SP.Value(Node_Name(Library_Name, Item_Name, SU.Image(To_Version_Num))));
                HA.Set_Node_Attribute(Node   => Item_Node,
                              Attrib => "V",
                              Value  => Get_Current_Version(Item_Node));
                else
                Add_To_List := TRUE;
                Reason := SP.Make_Persistent(Privilege_Reason);
                end if;
            end if;
        end;
        HNM.Close_Node_Handle(Version_Node);
        HNM.Close_Node_Handle(Item_Node);
        else
        Add_To_List :=TRUE;
        Reason := SP.Make_Persistent(Item_Checked_Out_Reason);
        end if;
        if Add_To_List then
        Remainder_List := SL.MakeList(SP.Make_Persistent(Library));
        SL.Attach(Remainder_List, SP.Make_Persistent(Item_Name));
        SL.Attach(Remainder_List, SS.Image(From_Version_Num));
        SL.Attach(Remainder_List, Reason);
        LL.Attach(Remainder, Remainder_List);
        end if;
    end loop;

    exception
    when others =>
        HNM.Close_Node_Handle(Version_Node);
        HNM.Close_Node_Handle(Item_Node);
        raise;

    end Rename_Version;

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Node      : in HND.Node_Type
    ) return BOOLEAN is

    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;

    begin

    case Privilege is
        when WORLD =>
        return TRUE;
        when GROUP =>
        HU.Get_Node_Attribute(Node       => Node,
                      Attrib     => "GROUP",
                      Value      => Attribute_Value,
                      Value_Last => Attribute_Length);
        if Attribute_Value(1 .. Attribute_Length) = "" then
            return TRUE;
        else
            return Attribute_Value(1 .. Attribute_Length) = HL.Get_Item(HL.ACCOUNT);
        end if;
        when OWNER =>
        HU.Get_Node_Attribute(Node       => Node,
                      Attrib     => "OWNER",
                      Value      => Attribute_Value,
                      Value_Last => Attribute_Length);
        if Attribute_Value(1 .. Attribute_Length) = "" then
            return TRUE;
        else
            return Attribute_Value(1 .. Attribute_Length) = HL.Get_Item(HL.USER_NAME);
        end if;
    end case;

    exception
    when HND.Name_Error =>
        raise Internal_Error;

    end Privileged;

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Library   : in SP.String_Type;
    Item      : in SP.String_Type := SP.Create("");
    Version   : in STRING := ""
    ) return BOOLEAN is

    Node  : HND.Node_Type;
    Owned : BOOLEAN := FALSE;

    begin

    if Version /= "" then
        Is_Node(Node, Node_Name(Library, Item, Version));
        if not HNM.Is_Open(Node) then
        raise Internal_Error;
        end if;
        Owned := Privileged(Privilege, Node);
        HNM.Close_Node_Handle(Node);
    end if;
    if Owned then
        return TRUE;
    end if;

    if not SP.Is_Empty(Item) then
        Is_Node(Node, Node_Name(Library, Item));
        if not HNM.Is_Open(Node) then
        raise Internal_Error;
        end if;
        Owned := Privileged(Privilege, Node);
        HNM.Close_Node_Handle(Node);
    end if;
    if Owned then
        return TRUE;
    end if;

    Is_Node(Node, Node_Name(Library));
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    Owned := Privileged(Privilege, Node);
    HNM.Close_Node_Handle(Node);
    return Owned;

    end Privileged;

--------------------------------------------------------------------------------

    function Get_Hif_File_Name(
    Lib_Name : in SP.String_Type;
    Item     : in SP.String_Type;
    Version  : in SP.String_Type
    ) return SP.String_Type is

    Node : HND.Node_Type;
    Path : SP.String_Type;
    File : SP.String_Type;

    begin

    SP.Mark;
    HNM.Open_Node_Handle(Node, SP.Value(Node_Name(Lib_Name, Item, SP.Value(Version))));
    File := SP.Make_Persistent(HNM.Host_File_Name(Node));
    SP.Release;
    HNM.Close_Node_Handle(Node);
    return File;

    end Get_Hif_File_Name;

--------------------------------------------------------------------------------

    function Is_Item_Checked_Out(
    Library : in SP.String_Type
    ) return BOOLEAN is

    Node             : HND.Node_Type;
    Attribute_Value  : STRING(1 .. 16);
    Attribute_Length : INTEGER;
    Check_Out_Count  : NATURAL;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    HU.Get_Node_Attribute(Node       => Node,
                  Attrib     => "CHECKED_OUT",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    HNM.Close_Node_Handle(Node);
    begin
        Check_Out_Count := NATURAL'value(Attribute_Value(1 .. Attribute_Length));
    exception
        when CONSTRAINT_ERROR =>
        Check_Out_Count := 0;
    end;
    return Check_Out_Count /= 0;

    end Is_Item_Checked_Out;

--------------------------------------------------------------------------------

    procedure Display_List(
    List   : in out LL.List;
    Header : in     STRING
    ) is

    List_Iter   : LL.ListIter;
    Value_List  : SL.List;
    Value_Iter  : SL.ListIter;
    Value       : SP.String_Type;
    Work_String : SP.String_Type;

    begin

    List_Iter := LL.MakeListIter(List);
    HL.Put_Message_Line(SU.Left_Justify(Header, Maximum_Item_Name) & " Reason");
    HL.Put_Message_Line(Separator);
    while LL.More(List_Iter) loop
        LL.Next(List_Iter, Value_List);
        Value_Iter := SL.MakeListIter(Value_List);
        SP.Mark;
        SL.Forward(Value_Iter);
        SL.Next(Value_Iter, Value);
        Work_String := Value;
        Work_String := SP."&"(Work_String, "/");
        SL.Next(Value_Iter, Value);
        Work_String := SP."&"(Work_String, Value);
        SL.Next(Value_Iter, Value);
        HL.Put_Message_Line(SS.Left_Justify(Work_String, Maximum_Item_Name) & ' ' & SP.Value(Value));
        SP.Release;
    end loop;

    end Display_List;

--------------------------------------------------------------------------------

    procedure Change_Checked_Out_Count(
    Library : SP.String_Type;
    Count   : INTEGER
    ) is

    Node              : HND.Node_Type;
    Attribute_Value   : STRING(1 .. Maximum_Owner_Name);
    Attribute_Length  : INTEGER;
    Checked_Out_Count : NATURAL;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    HU.Get_Node_Attribute(Node       => Node,
                  Attrib     => "CHECKED_OUT",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    begin
        Checked_Out_Count :=
        NATURAL'value(Attribute_Value(1 .. Attribute_Length)) + Count;
    exception
        when CONSTRAINT_ERROR =>
        Checked_Out_Count := 0;
    end;
    HA.Set_Node_Attribute(Node       => Node,
                  Attrib     => "CHECKED_OUT",
                  Value      => SU.Image(Checked_Out_Count));
    HNM.Close_Node_Handle(Node);

    end Change_Checked_Out_Count;

--------------------------------------------------------------------------------

    procedure Check_In_Item(
    Library   : in     SP.String_Type;
    File      : in     SP.String_Type;
    History   : in     SP.String_Type;
    Operation : in     Operation_Type;
    Returned  : in out SP.String_Type
    ) is

    Item_Name        : SP.String_Type;
    Item_Node        : HND.Node_Type;
    Full_Item_Name   : SP.String_Type;
    Full_Item_Node   : HND.Node_Type;
    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;
    Version          : POSITIVE;
    History_Index    : POSITIVE;
    History_List     : HLU.List_Type;
    Check_Out_Count  : NATURAL;

    begin

    if Operation = CREATE_ITEM or Operation = RETURN_ITEM then
        begin
        if not FM.Is_File(SP.Value(File)) then
            raise File_Not_Found;
        end if;
        exception
        when FM.Parse_Error =>
            raise Invalid_External_Name;
        when others =>
            raise;
        end;
    end if;
    Item_Name := Node_Name(Library, SP.Create(FM.Parse_Filename(SP.Value(File), FM.FILE_ONLY)));
    Is_Node(Item_Node, Item_Name);
    if not HNM.Is_Open(Item_Node) then
        if Operation = CREATE_ITEM then
        HNM.Create_Node(Name => SP.Value(Item_Name));
        History_Index := 1;
        Version := 1;
        HLU.Init_List(History_List);
        else
        raise Item_Not_Found;
        end if;
    else
        if Operation = CREATE_ITEM then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Already_Exists;
        elsif Operation = RETURN_ITEM then
        Version := NATURAL'value(Get_Current_Version(Item_Node)) + 1;
        end if;
    end if;

    if Operation = CREATE_ITEM or Operation = RETURN_ITEM then
        if HNM.Is_Open(Item_Node) then
        Returned := SP.Make_Persistent(Checked_Out_By(Item_Node));
        if SP.Is_Empty(Returned) then
            HNM.Close_Node_Handle(Item_Node);
            raise Item_Not_Checked_Out;
        end if;
        if SP.Value(Returned) /= HL.Get_Item(HL.USER_NAME) then
            HNM.Close_Node_Handle(Item_Node);
            raise Item_Checked_Out;
        end if;
        SP.Flush(Returned);
        HU.Get_Node_Attribute(Node       => Item_Node,
                      Attrib     => "HISTORY_INDEX",
                      Value      => Attribute_Value,
                      Value_Last => Attribute_Length);
        History_Index := NATURAL'value(Attribute_Value(1 .. Attribute_Length)) + 1;
        HA.Get_Node_Attribute(Node   => Item_Node,
                      Attrib => "HISTORY",
                      Value  => History_List);
        else
        Open_Standard_Node_Handle(Item_Node, Item_Name);
        end if;
        Full_Item_Name := SP."&"(Item_Name, ".V" & SU.Image(Version));
        HNM.Create_Node(Node         => Full_Item_Node,
                Name         => SP.Value(Full_Item_Name),
                Kind_Of_Node => HND.File);
        begin
        FM.Copy(SP.Value(File),
            HNM.Host_File_Name(Full_Item_Node));
        exception
        when others =>
            if Version = 1 then
            HNM.Delete_Tree(Item_Node);
            else
            HNM.Delete_Tree(Full_Item_Node);
            end if;
            raise Item_Not_Created;
        end;
        begin
        FM.Set_File_Protection(
            HNM.Host_File_Name(Full_Item_Node));
        exception
        when others =>
            if Version = 1 then
            HNM.Delete_Tree(Item_Node);
            else
            HNM.Delete_Tree(Full_Item_Node);
            end if;
            raise Set_Protection_Error;
        end;
        HA.Set_Node_Attribute(Node   => Item_Node,
                  Attrib => "V",
                  Value  => SU.Image(Version));
        HA.Set_Node_Attribute(Node   => Item_Node,
              Attrib => "HISTORY_INDEX",
              Value  => SU.Image(History_Index));
        HLU.Add_Positional(History_List, '"' & SP.Value(History) & '"');
        HA.Set_Node_Attribute(Node   => Item_Node,
                  Attrib => "HISTORY",
                  Value  => History_List);
        HLU.Free_List(History_List);
        Set_Standard_Attributes(Full_Item_Node);
        HA.Set_Node_Attribute(Node   => Full_Item_Node,
                  Attrib => "HISTORY_INDEX",
                  Value  => SU.Image(History_Index));
        HNM.Close_Node_Handle(Full_Item_Node);
    else
        Returned := SP.Make_Persistent(Checked_Out_By(Item_Node));
        if SP.Is_Empty(Returned) then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Not_Checked_Out;
        end if;
        if SP.Value(Returned) /= HL.Get_Item(HL.USER_NAME) then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Checked_Out;
        end if;
        SP.Flush(Returned);
    end if;

    HA.Set_Node_Attribute(Node   => Item_Node,
                  Attrib => "CHECKED_OUT",
                  Value  => "");
    Change_Checked_Out_Count(Library, -1);
    Returned := SP.Make_Persistent(Get_Current_Version(Item_Node));
    HNM.Close_Node_Handle(Item_Node);

    end Check_In_Item;

--------------------------------------------------------------------------------

    procedure Create_Library(
    Library   : in SP.String_Type;
    Directory : in SP.String_Type;
    CI        : in SP.String_Type := SP.Create("");
    Mode      : in Fetch_Type;
    Node      : in HND.Node_Type;
    Locked    : in BOOLEAN := FALSE
    ) is

    Library_Node : HND.Node_Type;
    DOCMGR_Node  : HND.Node_Type;
    Lock         : BOOLEAN;

    begin

    if FM.Is_Directory(SP.Value(Directory)) then
        raise Directory_Already_Exists;
    end if;
    Is_Node(Library_Node, Node_Name(Library));
    if HNM.Is_Open(Library_Node) then
        HNM.Close_Node_Handle(Library_Node);
        raise Library_Already_Exists;
    end if;
    HSM.Add_User(User_Name      => Internal_Name(Library),
             Partition_Name => FM.Path_Name(SP.Value(Directory),
                            "",
                            Absolute => TRUE));
    Is_Node(Library_Node, Node_Name(Library));
    if not HNM.Is_Open(Library_Node) then
        raise Internal_Error;
    end if;
    Lock := Lock_Library(Library_Node, WRITE_LOCK);
    Set_Standard_Attributes(Library_Node);
    HA.Set_Node_Attribute(Node   => Library_Node,
                  Attrib => "CI",
                  Value  => SP.Value(CI));
    HA.Set_Node_Attribute(Node   => Library_Node,
                  Attrib => "MODE",
                  Value  => Fetch_Type'image(Mode));
    HA.Set_Node_Attribute(Node   => Library_Node,
                  Attrib => "CHECKED_OUT",
                  Value  => "0");
    if HNM.Is_Open(Node) then
        HNM.Copy_Tree(From    => Node,
              To_Base => Library_Node,
              To_Key  => "IL");
    else
        HNM.Create_Node (Base => Library_Node,
                 Key  => "IL",
                 Form => "");
    end if;
    begin
        FM.Set_File_Protection(FM.Directory_Name(SP.Value(Directory)));
    exception
        when others =>
        raise Set_Protection_Error;
    end;
    HNM.Open_Node_Handle(Node => DOCMGR_Node,
                 Name => DMD.Document_Manager_List_Path);
    HNM.Link(To_Node  => Library_Node,
         New_Base => DOCMGR_Node,
         Relation => "LIBRARY",
         Key      => Internal_Name(Library));
    HNM.Close_Node_Handle(DOCMGR_Node);
    if not Locked then
        Unlock_Library(Library_Node, WRITE_LOCK);
    end if;
    HNM.Close_Node_Handle(Library_Node);

    exception

    when FM.Parse_Error =>
        raise Invalid_Directory_Name;
    when Directory_Already_Exists | Library_Already_Exists =>
        raise;
    when others =>
        begin
        if not HNM.Is_Open(DOCMGR_Node) then
            HNM.Open_Node_Handle(Node => DOCMGR_Node,
                     Name => DMD.Document_Manager_List_Path);
        end if;
        HNM.Unlink(Base     => DOCMGR_Node,
               Relation => "LIBRARY",
               Key      => Internal_Name(Library));
        exception
        when others =>
            null;
        end;
        HNM.Close_Node_Handle(DOCMGR_Node);
        begin
        HSM.Delete_User(Internal_Name(Library));
        exception
        when others =>
            null;
        end;
        raise;

    end Create_Library;

--------------------------------------------------------------------------------

    procedure Delete_Library(
    Library   : in SP.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) is

    DOCMGR_Node  : HND.Node_Type;

    begin

    if not Privileged(Privilege, Library) then
        raise No_Privilege;
    end if;
    if Get_Library_Attribute(Library, "MODE") = Fetch_Type'image(UPDATE) or
       Get_Library_Attribute(Library, "MODE") = Fetch_Type'image(BRANCH) then
        raise Library_Pending_Return;
    end if;
    HNM.Open_Node_Handle(Node => DOCMGR_Node,
                 Name => DMD.Document_Manager_List_Path);
    begin
        HNM.Unlink(Base     => DOCMGR_Node,
               Relation => "LIBRARY",
               Key      => Internal_Name(Library));
    exception
        when others =>
        null;
    end;
    HNM.Close_Node_Handle(DOCMGR_Node);
    HSM.Delete_User(Internal_Name(Library));

    end Delete_Library;

--------------------------------------------------------------------------------

    function List_Item(
    Node    : in HND.Node_Type;
    Item    : in SP.String_Type := SP.Create("*");
    Version : in SP.String_Type := SP.Create("*");
    Mode    : in List_Mode := SHORT
    ) return LL.List is

    Item_Node        : HND.Node_Type;
    Item_Attributes  : SL.List;
    Versions         : SL.List;
    Version_Node     : HND.Node_Type;
    Version_Iterator : SL.ListIter;
    Current_Version  : SP.String_Type;
    List_of_Lists    : LL.List := LL.Create;
    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;
    Item_Iterator    : HNM.Node_Iterator;
    Library_Name     : SP.String_Type;
    Item_Name        : SP.String_Type;
    Version_Name     : SP.String_Type;

    begin

    HNM.Iterate(Iterator     => Item_Iterator,
            Node         => Node,
            Relation     => "DOT",
            Key          => Internal_Name(Item, "*"),
            Primary_Only => TRUE);
    while HNM.More(Item_Iterator) loop
        HNM.Get_Next(Item_Iterator, Item_Node);
        Current_Version := SP.Create(Get_Current_Version(Item_Node));
        Versions := Get_Version(Item_Node, Version);
        Version_Iterator := SL.MakeListIter(Versions);
        while SL.More(Version_Iterator) loop
        HNM.Open_Node_Handle(Node         => Version_Node,
                     Base         => Item_Node,
                     Relation     => "DOT",
                     Key          => 'V' & SP.Value(SL.CellValue(Version_Iterator)));
        Parse_Node(Item_Node, Library_Name, Item_Name, Version_Name);
        Item_Attributes := SL.MakeList(
                     SP.Make_Persistent(
                       External_Name(
                         SP.Value(Item_Name))));
        SL.Attach(Item_Attributes, SP.Make_Persistent(SL.CellValue(Version_Iterator)));
        if Mode = LONG then
            HU.Get_Node_Attribute(Version_Node, "OWNER", Attribute_Value, Attribute_Length);
            SL.Attach(Item_Attributes, SP.Make_Persistent(Attribute_Value(1 .. Attribute_Length)));
            HU.Get_Node_Attribute(Version_Node, "GROUP", Attribute_Value, Attribute_Length);
            SL.Attach(Item_Attributes, SP.Make_Persistent(Attribute_Value(1 .. Attribute_Length)));
            HU.Get_Node_Attribute(Version_Node, "DATE", Attribute_Value, Attribute_Length);
            SL.Attach(Item_Attributes, SP.Make_Persistent(Attribute_Value(1 .. Attribute_Length)));
            HU.Get_Node_Attribute(Version_Node, "TIME", Attribute_Value, Attribute_Length);
            SL.Attach(Item_Attributes, SP.Make_Persistent(Attribute_Value(1 .. Attribute_Length)));
            if SP.Equal(Current_Version, SL.CellValue(Version_Iterator)) then
            SL.Attach(Item_Attributes, SP.Make_Persistent(Checked_Out_By(Item_Node)));
            else
            SL.Attach(Item_Attributes, SP.Make_Persistent(""));
            end if;
        end if;
        HNM.Close_Node_Handle(Version_Node);
        LL.Attach(List_of_Lists, Item_Attributes);
        SL.Forward(Version_Iterator);
        end loop;
        Destroy_String_List(Versions);
        HNM.Close_Node_Handle(Item_Node);
    end loop;
    if LL.IsEmpty(List_of_Lists) then
        raise Item_Not_Found;
    end if;
    return List_of_Lists;

    exception

    when others =>
        begin
        Destroy_List_Of_Lists(List_Of_Lists);
        HNM.Close_Node_Handle(Item_Node);
        exception
        when others =>
            HNM.Close_Node_Handle(Item_Node);
        end;
        raise;

    end List_Item;

--------------------------------------------------------------------------------


end Library_Utilities;
                                                                    pragma page;
::::::::::::::
libutl.spc
::::::::::::::
with Library_Declarations;        use Library_Declarations;
with String_Pkg;
with HIF_Node_Defs;
with HIF_Node_Management;
with String_Lists;

package Library_Utilities is

    package SP  renames String_Pkg;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package SL  renames String_Lists;

--------------------------------------------------------------------------------

    function Internal_Name(
    External_Name : in SP.String_Type;
    Exclude       : in STRING := ""
    ) return STRING;

--| Raises:
--| Invalid_External_Name

--| Effects:
--| Translate representation internal to the Library Manager to its
--| external representation.  (Needed to satisfy the condition that
--| node names be Ada identifiers)

--------------------------------------------------------------------------------

    function External_Name(
    Internal_Name : in STRING
    ) return STRING;

--| Effects:
--| Translate external representation to the Library Manager
--| external representation.

--------------------------------------------------------------------------------

    procedure Is_Node(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    );

--| Effects:
--| Verifies that the given node name is indeed a node and if so opens
--| the node for processing.  Otherwise the node is closed.

--------------------------------------------------------------------------------

    function Node_Name(
    Library : in SP.String_Type;
    Item    : in SP.String_Type := SP.Create("");
    Version : in STRING := ""
    ) return SP.String_Type;

--| Effects:
--| Creates a node name representation of a library, item in a library, or
--| a version of an item in a library

--------------------------------------------------------------------------------

    procedure Parse_Node(
    Node    : in     HND.Node_Type;
    Library :    out SP.String_Type;
    Item    :    out SP.String_Type;
    Version :    out SP.String_Type
    );

--| Effects:
--| Given a node handle, parses the node name into library name, item name,
--| and version number

--------------------------------------------------------------------------------

    function Is_Ada_Id(
    Value : in SP.String_Type
    ) return BOOLEAN;

--| Effects:
--| Verifies that th e given value is an Ada identifier

--------------------------------------------------------------------------------

    procedure Is_Library(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type
    );

--| Raises:
--| Invalid_Library_Name

--| Effects:
--| Verifies that the given library exists and opens the node handle to
--| the library.  Otherwise the node is not opened.

--------------------------------------------------------------------------------

    procedure Is_Item(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist

--| Effects:
--| Verifies that the given item exists and opens the node handle to
--| the item. Otherwise the node is not opened.

--------------------------------------------------------------------------------

    procedure Is_Version(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type;
    Version : in     SP.String_Type
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Item_Not_Found,
--| Invalid_Version, Version_Not_Found

--| Effects:
--| Verifies that the version of an item exists and opens the node handle to
--| the version of the item.  Otherwise the node is not opened.

--------------------------------------------------------------------------------

    function Is_Checked_Out(
    Item_Node : in HND.Node_Type
    ) return BOOLEAN;

--| Effects:
--| Verifies that the item (given as a node handle) is checked out for
--| update.

--------------------------------------------------------------------------------

    function Checked_Out_By(
    Item_Node : in HND.Node_Type
    ) return STRING;

--| Effects:
--| Returns the name who has the item checked out (null string if item is
--| not checked out.

--------------------------------------------------------------------------------

    procedure Wait;

--| Effects:
--| Delays execution by a predefined interval

--------------------------------------------------------------------------------

    function Lock_Library(
    Node : in HND.Node_Type;
    Lock : in Lock_Type
    ) return BOOLEAN;

--| Raises:
--| Library_Master_Locked

--| Effects:
--| Locks the library (given as a node handle) with the appropriate Lock_Type.
--| Returns TRUE iff the locking was successful.

--------------------------------------------------------------------------------

    function Lock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    ) return BOOLEAN;

--| Raises:
--| Invalid_Library_Name. Library_Does_Not_Exist. Library_Master_Locked

--| Effects:
--| Locks the library (given as a library name) with the appropriate
--| Lock_Type.  Returns TRUE iff the locking was successful.

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type
    );

--| Raises:
--| Not_Authorized

--| Effects:
--| Unlocks the library (given as a node handle).

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Not_Authorized

--| Effects:
--| Unlocks the library (given as a library name).

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Node  : in HND.Node_Type
    ) return BOOLEAN;

--| Raises:
--| Library_Master_Locked, Invalid_Upgrade

--| Effects:
--| Upgrades the library lock to a write lock.

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Library : in SP.String_Type
    ) return BOOLEAN;

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Library_Master_Locked,
--| Invalid_Upgrade

--| Effects:
--| Upgrades the library lock to a write lock.

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Node  : in HND.Node_Type
    );

--| Raises:
--| Library_Master_Locked, Invalid_Downgrade

--| Effects:
--| Downgrades the library lock to a read lock.

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Library : in SP.String_Type
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Library_Master_Locked,
--| Invalid_Downgrade

--| Effects:
--| Downgrades the library lock to a read lock.

--------------------------------------------------------------------------------

    function Get_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING
    ) return STRING;

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist

--| Effects:
--| Returns the value of a given attribute associated with the library

--------------------------------------------------------------------------------

    procedure Set_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING;
    Value     : in STRING
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist

--| Effects:
--| Sets the value of a given attribute associated with the library

--------------------------------------------------------------------------------

    procedure Open_Standard_Node_Handle(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    );

--| Effects:
--| Open the node handle associated with a given node name and set the
--| standard attributes for this node.

--------------------------------------------------------------------------------

    procedure Set_Standard_Attributes(
    Node : in HND.Node_Type
    );

--| Effects:
--| Set the common attributes (eg. OWNER, DATE) of a given node.

--------------------------------------------------------------------------------

    procedure Set_Lock_Attributes(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type;
    Key   : in STRING
    );

--| Effects:
--| Set the common lock attributes (eg. DATE).

--------------------------------------------------------------------------------

    procedure Get_Lock_Attributes(
    Node       : in     HND.Node_Type;
    Lock       : in     Lock_Type;
    Key        : in     STRING;
    Owner      : in out SP.String_Type;
    Group      : in out SP.String_Type;
    Date       : in out SP.String_Type;
    Time       : in out SP.String_Type
    );

--| Effects:
--| Get the values of common lock attributes.

--------------------------------------------------------------------------------

    function Get_Item_Date_Time(
    Library : in SP.String_Type;
    Item    : in SP.String_Type;
    Version : in SP.String_Type
    ) return STRING;

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Item_Not_Found,
--| Invalid_Version, Version_Not_Found

--| Effects:
--| Return the create date and time (MM/DD/YY HH:MM:SS format) associated
--| with a version of an item in a library.

--------------------------------------------------------------------------------

    function Get_Current_Version(
    Node : in HND.Node_Type
    ) return STRING;

--| Raises:
--| Version_Not_Found

--| Effects:
--| Return a string of the current version number.

--------------------------------------------------------------------------------

    function Get_Version(
    Node    : in HND.Node_Type;
    Version : in SP.String_Type
    ) return SL.List;

--| Raises:
--| Invalid_Version, Version_Not_Found

--| Effects:
--| Return a list of version numbers of an item satifying the given condition.

--------------------------------------------------------------------------------

    procedure Iterate_Item(
    Library  : in     SP.String_Type;
    Item     : in     SP.String_Type;
    Iterator : in out HNM.Node_Iterator
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Item_Not_Found

--| Effects:
--| Creates an iterator over all items satisfying the given codition.

--------------------------------------------------------------------------------

    procedure Open_Property_Node(
    Library : in     SP.String_Type;
    Keyword : in     SP.String_Type;
    Value   : in     SP.String_Type;
    Mode    : in     Edit_Mode;
    Node    : in out HND.Node_Type
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Invalid_Keyword,
--| Invalid_Value, Keyword_Not_Found, Keyword_Already_Exists

--| Effects:
--| Open the node handle for a node which has properties associated with it
--| for the given library

--------------------------------------------------------------------------------

    procedure Delete(
    Item_Node : in out HND.Node_Type;
    Versions  : in     SL.List;
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    );

--| Raises:
--| Invalid_Version, Version_Not_Found


--| Effects:
--| Delete the given version(s) of an item (given as a node handle).  Return
--| a list of list(s) containing item and version number that were not deleted.

--------------------------------------------------------------------------------

    procedure Purge(
    Library   : in     SP.String_Type;
    Item      : in     SP.String_Type := SP.Create("*");
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Item_Not_Found,
--| Invalid_Version, Version_Not_Found

--| Effects:
--| Purge the given item. Return a list of list(s) containing item and version
--| number that were not purged.

--------------------------------------------------------------------------------

    procedure Rename_Item(
    Library   : in SP.String_Type;
    From_Item : in SP.String_Type;
    To_Item   : in SP.String_Type;
    Privilege : in Privilege_Type;
    Remainder : in out LL.List
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Item_Already_Exists,
--| Item_Not_Found, Item_Checked_Out

--| Effects:
--| Renames a given item in the item library.  Remainder is a list of lists
--| containing item/version of entities not renamed together with the reason.

--------------------------------------------------------------------------------

    procedure Rename_Version(
    Library      : in     SP.String_Type;
    Item         : in     SP.String_Type;
    From_Version : in     SP.String_Type;
    To_Version   : in     SP.String_Type;
    Privilege    : in     Privilege_Type;
    Remainder    : in out LL.List
    );

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist, Item_Not_Found,
--| Invalid_Version, Version_Not_Found

--| Effects:
--| Renames a given version of item(s) in the item library.  Remainder is a
--| list of lists containing item/version of entities not renamed together
--| with the reason.

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Node      : in HND.Node_Type
    ) return BOOLEAN;

--| Effects:
--| Verify that the given node may be deleted (purged) in terms of
--| ownership privileges.

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Library   : in SP.String_Type;
    Item      : in SP.String_Type := SP.Create("");
    Version   : in STRING := ""
    ) return BOOLEAN;

--| Effects:
--| Verify that the given library, item in a library or a version of an item
--| in a library may be deleted (purged) in terms of ownership privileges.

--------------------------------------------------------------------------------

    function Get_Hif_File_Name(        --| return the hif file name for a Lib item
    Lib_Name : in SP.String_Type;    --| name of the Lib
    Item     : in SP.String_Type;    --| name of the item in the Lib
    Version  : in SP.String_Type    --| version number
    ) return SP.String_Type;

--| Effects:
--| Return the Hif file name for a particular version of a given item
--| in an item library.

--------------------------------------------------------------------------------

    function Is_Item_Checked_Out(    --| check if any items are checked out
    Library : in SP.String_Type    --| name of the library
    ) return BOOLEAN;

--| Raises:
--| Invalid_Library_Name, Library_Does_Not_Exist

--| Effects:
--| Return TRUE if any item is checked out for update in the specified library.

--------------------------------------------------------------------------------

    procedure Display_List(        --| display a list of lists
    List   : in out LL.List;    --| list of lists
    Header : in     STRING        --| display header
    );

--| Effects:
--| Write Header and contents of a list of lists

--------------------------------------------------------------------------------

    procedure Change_Checked_Out_Count(
    Library : SP.String_Type;
    Count   : INTEGER
    );

--| Effects:
--| Changes the checked out count

--------------------------------------------------------------------------------

    procedure Check_In_Item(
    Library   : in     SP.String_Type;
    File      : in     SP.String_Type;
    History   : in     SP.String_Type;
    Operation : in     Operation_Type;
    Returned  : in out SP.String_Type
    );

--| Effects:
--| Create/return/cancel an item checked out of the library

--------------------------------------------------------------------------------

    procedure Create_Library(
    Library   : in SP.String_Type;
    Directory : in SP.String_Type;
    CI        : in SP.String_Type := SP.Create("");
    Mode      : in Fetch_Type;
    Node      : in HND.Node_Type;
    Locked    : in BOOLEAN := FALSE
    );

--| Effects:
--| Create an item library

--------------------------------------------------------------------------------

    procedure Delete_Library(
    Library   : in SP.String_Type;
    Privilege : in Privilege_Type := WORLD
    );

--| Effects:
--| Delete an item library

--------------------------------------------------------------------------------

    function List_Item(
    Node    : in HND.Node_Type;
    Item    : in SP.String_Type := SP.Create("*");
    Version : in SP.String_Type := SP.Create("*");
    Mode    : in List_Mode := SHORT
    ) return LL.List;

--| Effects:
--| List item(s) of an item library

--------------------------------------------------------------------------------

end Library_Utilities;
                                                                    pragma page;
::::::::::::::
listcat.ada
::::::::::::::

--------- SPEC ----------------------------------------------------------

function list_catalogs return INTEGER;

--------- BODY ----------------------------------------------------------

with Standard_Interface;
with Tool_Identifier;
with String_Pkg;
with Host_Lib;
with catalog_interface;

function list_catalogs return INTEGER is

    package SP renames String_Pkg;
    package CI renames catalog_interface;
    package SI renames Standard_Interface;

    package input is new SI.String_Argument(
    String_Type_Name => "string");


    process      : SI.Process_Handle;    -- handle to process structure
    catalogs     : SP.string_type;    -- name of the catalog

begin

    SI.set_tool_identifier (Tool_Identifier);
    SI.Define_Process(            -- define this process
    Name    => "list_catalogs",    -- name of the process
    Help    => "List the names of all the catalogs in the document system",
    Proc    => process);        -- handle to be returned

    Input.Define_Argument(    -- define the first argument
    Proc     => Process,        -- process
    Name     => "catalogs",        -- name of the argument
    Default => "*",
    Help     => "Search string for the name to match");

    SI.define_help (process,
    "A list of all the catalogs in the current document manager system");
    SI.append_help (process,
    "is produced.  The default is to list all catalogs, but a subset may");
    SI.append_help (process,
    "be selected by giving a pattern to match for catalogs.  The user");
    SI.append_help (process,
    "must be a document manager system user to run this tool (see Add_User)");

    SI.Parse_Line(Process);        -- parse the command line

    catalogs := Input.Get_Argument(    -- get the first argument
            Proc => Process,
            Name => "catalogs");

    SI.Undefine_Process(Proc => Process);    -- destroy the process block

    CI.list_catalogs (catalogs);

    return Host_Lib.Return_Code(Host_Lib.SUCCESS);-- return successful return code

exception

    when SI.Process_Help =>
    -- Help message was printed
    return Host_Lib.Return_Code(Host_Lib.INFORMATION);
    when SI.Abort_Process =>
    -- Parse error
    return Host_Lib.Return_Code(Host_Lib.ERROR);

end list_catalogs;
::::::::::::::
listi.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with Library_Declarations;
with List_Item_Interface;

function List_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LD  renames Library_Declarations;
    package LIB is new SI.String_Argument(String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(String_Type_Name => "item_name");
    package VER is new SI.String_Argument(String_Type_Name => "version");
    package LIM is new SI.Enumerated_Argument(Enum_Type      => LD.List_Mode,
                          Enum_Type_Name => "list_mode");

    List_Item_Process : SI.Process_Handle;
    Library           : SP.String_Type;
    Item              : SP.String_Type;
    Version           : SP.String_Type;
    List_Item_Mode    : LD.List_Mode;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => List_Item_Process,
    Name    => "List_Item",
    Help    => "List Item(s) in the Item Library");

    LIB.Define_Argument(
    Proc => List_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc    => List_Item_Process,
    Name    => "item",
    Default => "*",
    Help    => "Name of the item to list");

    VER.Define_Argument(
    Proc    => List_Item_Process,
    Name    => "version",
    Default => "",
    Help    => "Version specification");

    LIM.Define_Argument(
    Proc    => List_Item_Process,
    Name    => "mode",
    Default => LD.SHORT,
    Help    => "List mode:");

    LIM.Append_Argument_Help(
    Proc    => List_Item_Process,
    Name    => "mode",
    Help    => "   SHORT : list item/version name(s) only");

    LIM.Append_Argument_Help(
    Proc    => List_Item_Process,
    Name    => "mode",
    Help    => "   LONG  : list attributes as well as item/version name(s)");

    SP.Release;

    SI.Parse_Line(List_Item_Process);

    Library := LIB.Get_Argument(
            Proc => List_Item_Process,
            Name => "library");

    Item := ITM.Get_Argument(
            Proc => List_Item_Process,
            Name => "item");

    Version := VER.Get_Argument(
            Proc => List_Item_Process,
            Name => "version");

    List_Item_Mode := LIM.Get_Argument(
            Proc => List_Item_Process,
            Name => "mode");

    return HL.Return_Code(List_Item_Interface(Library, Item, Version, List_Item_Mode));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end List_Item;
                                                                    pragma page;
::::::::::::::
listi.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with String_Lists;
with String_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;

function List_Item_Interface(
    Library : in String_Pkg.String_Type;
    Item    : in String_Pkg.String_Type;
    Version : in String_Pkg.String_Type;
    Mode    : in List_Mode := SHORT
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package SL  renames String_Lists;
    package SU  renames String_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;

    IL_Node        : HND.Node_Type;
    List_of_Lists  : LL.List;
    List_Iter      : LL.ListIter;
    Value_List     : SL.List;
    Value_Iter     : SL.ListIter;
    Item_Value     : SP.String_Type;
    Version_Value  : SP.String_Type;
    Owner_Value    : SP.String_Type;
    Date_Value     : SP.String_Type;
    Time_Value     : SP.String_Type;
    Group_Value    : SP.String_Type;
    Status_Value   : SP.String_Type;
    Work_String    : SP.String_Type;
    Trap           : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, READ_LOCK) then
    raise Library_Read_Locked;
    end if;
    HNM.Open_Node_Handle(Node => IL_Node,
             Name => SP.Value(LU.Node_Name(Library, SP.Create("*"))));
    begin
    List_of_Lists := LU.List_Item(IL_Node, Item, Version, Mode);
    exception
    when Item_Not_Found | Version_Not_Found =>
        null;
    end;
    LU.Unlock_Library(Library, READ_LOCK);
    HNM.Close_Node_Handle(IL_Node);
    if LL.IsEmpty(List_of_Lists) then
    if Message_on_Error then
        HL.Put_Message_Line("No item(s) found.");
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;
    end if;
    if List_Mode'image(Mode) = "LONG" then
    HL.Put_Message_Line(
        SU.Left_Justify("Item Name/Version", Maximum_Item_Name) & ' ' &
        SU.Left_Justify("Owner", Maximum_Owner_Name) & ' ' &
        SU.Left_Justify("Group", Maximum_Group_Name) & ' ' &
        "Date    " & ' ' &
        "Time    " & ' ' &
        "Out");
    HL.Put_Message_Line(Separator);
    end if;
    List_Iter := LL.MakeListIter(List_of_Lists);
    while LL.More(List_Iter) loop
    LL.Next(List_Iter, Value_List);
    Value_Iter := SL.MakeListIter(Value_List);
    SP.Mark;
    SL.Next(Value_Iter, Item_Value);
    SL.Next(Value_Iter, Version_Value);
    Work_String := SP."&"(SP.Upper(Item_Value), "/");
    Work_String := SP."&"(Work_String, Version_Value);
    if List_Mode'image(Mode) = "LONG" then
        SL.Next(Value_Iter, Owner_Value);
        SL.Next(Value_Iter, Group_Value);
        SL.Next(Value_Iter, Date_Value);
        SL.Next(Value_Iter, Time_Value);
        SL.Next(Value_Iter, Status_Value);
        HL.Put_Message_Line(
        SU.Left_Justify(SP.Value(Work_String), Maximum_Item_Name) & ' ' &
        SU.Left_Justify(SP.Value(Owner_Value), Maximum_Owner_Name) & ' ' &
        SU.Left_Justify(SP.Value(Group_Value), Maximum_Group_Name) & ' ' &
        SP.Value(Date_Value) & ' ' &
        SP.Value(Time_Value) & ' ' &
        SP.Value(Status_Value));
    else
        HL.Put_Message_Line(SP.Value(Work_String));
    end if;
    SP.Release;
    end loop;
    Destroy_List_of_Lists(List_of_Lists);
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Read_Locked =>
    LE.Report_Error(LE.Library_Read_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, READ_LOCK);
    HNM.Close_Node_Handle(IL_Node);
    LE.Report_Error(LE.Item_Not_Found, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Version =>
    LU.Unlock_Library(Library, READ_LOCK);
    HNM.Close_Node_Handle(IL_Node);
    LE.Report_Error(LE.Invalid_Version, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Version_Not_Found =>
    LU.Unlock_Library(Library, READ_LOCK);
    HNM.Close_Node_Handle(IL_Node);
    LE.Report_Error(LE.Version_Not_Found, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("List_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    HNM.Close_Node_Handle(IL_Node);
    begin
        LU.Unlock_Library(Library, READ_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("List_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end List_Item_Interface;
                                                                    pragma page;
::::::::::::::
listi.spc
::::::::::::::
with String_Pkg;
with Host_Lib;
with Library_Declarations;

function List_Item_Interface(            --| List Item(s)
   Library : in String_Pkg.String_Type;        --| Item library
   Item    : in String_Pkg.String_Type;        --| Item(s) to list
   Version : in String_Pkg.String_Type;        --| Version specification
   Mode    : in Library_Declarations.List_Mode := Library_Declarations.SHORT
                        --| List mode: (SHORT/LONG)
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library, name of the item, and version specification

--| Effects:
--| List all items that satisfy the item and version specification in the
--| library.  List mode specifies a terse or a full listing

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
listl.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with List_Library_Interface;

function List_Library return INTEGER is

    package SI   renames Standard_Interface;
    package SP   renames String_Pkg;
    package HL   renames Host_Lib;
    package LE  renames Library_Errors;
    package LIB  is new SI.String_Argument(String_Type_Name => "library_name");
    package USER is new SI.String_Argument(String_Type_Name => "user_name");

    List_Library_Process   : SI.Process_Handle;
    Owner_Name             : SP.String_Type;
    Library                : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => List_Library_Process,
    Name    => "List_Library",
    Help    => "List Libraries Owned by User");

    USER.Define_Argument(
    Proc    => List_Library_Process,
    Name    => "owner",
    Default => HL.Get_Item(HL.USER_NAME),
    Help    => "Name of the library owner");

    LIB.Define_Argument(
    Proc    => List_Library_Process,
    Name    => "library",
    Default => "*",
    Help    => "Name of the library");

    SI.Parse_Line(List_Library_Process);

    Owner_Name := USER.Get_Argument(
            Proc => List_Library_Process,
            Name => "owner");

    Library := LIB.Get_Argument(
            Proc => List_Library_Process,
            Name => "library");

    return HL.Return_Code(List_Library_Interface(Owner_Name, Library));

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end List_Library;
                                                                    pragma page;
::::::::::::::
listl.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with String_Utilities;
with HIF_Utils;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;
with Document_Manager_Declarations;

function List_Library_Interface(
    User    : in String_Pkg.String_Type;
    Library : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package SU  renames String_Utilities;
    package HU  renames HIF_Utils;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;
    package DMD renames Document_Manager_Declarations;

    DOCMGR_Iterator     : HNM.Node_Iterator;
    DOCMGR_Node         : HND.Node_Type;
    Library_Node        : HND.Node_Type;
    Attribute_Value     : STRING(1 .. 64);
    Attribute_Length    : INTEGER;
    Mode_Value          : STRING(1 .. 64);
    Mode_Length         : INTEGER;
    Library_Name        : SP.String_Type;
    Item_Name           : SP.String_Type;
    Version_Name        : SP.String_Type;
    First               : BOOLEAN := TRUE;
    Trap                : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    HNM.Open_Node_Handle(Node => DOCMGR_Node,
             Name => DMD.Document_Manager_List_Path);
    HNM.Iterate(Iterator     => DOCMGR_Iterator,
        Node         => DOCMGR_Node,
        Relation     => "LIBRARY",
        Primary_Only => FALSE);
    while HNM.More(DOCMGR_Iterator) loop
    HNM.Get_Next(DOCMGR_Iterator, Library_Node);
    HU.Get_Node_Attribute(Library_Node, "OWNER", Attribute_Value, Attribute_Length);
    if SU.Match(SP.Value(User), Attribute_Value(1 .. Attribute_Length), Comparison => SP.CASE_INSENSITIVE) then
        LU.Parse_Node(Library_Node, Library_Name, Item_Name, Version_Name);
        if SU.Match(SP.Value(Library),
            LU.External_Name(SP.Value(Library_Name)),
            Comparison => SP.CASE_INSENSITIVE) then
        if First then
            HL.Put_Message_Line(
            SU.Left_Justify("Library Name", Maximum_Library_Name) & ' ' &
            SU.Left_Justify("Owner", Maximum_Owner_Name) & ' ' &
            "Date    " & ' ' &
            "Time    " & ' ' &
            SU.Left_Justify("CI Name", Maximum_CI_Name) & ' ' &
            "Mode");
            HL.Put_Message_Line(Separator);
            First := FALSE;
        end if;
        HL.Put_Message(SU.Left_Justify(LU.External_Name(SP.Value(Library_Name)), Maximum_Library_Name) & ' ');
        HL.Put_Message(SU.Left_Justify(Attribute_Value(1 .. Attribute_Length), Maximum_Owner_Name) & ' ');
        HU.Get_Node_Attribute(Library_Node, "DATE", Attribute_Value, Attribute_Length);
        HL.Put_Message(Attribute_Value(1 .. Attribute_Length) & ' ');
        HU.Get_Node_Attribute(Library_Node, "TIME", Attribute_Value, Attribute_Length);
        HL.Put_Message(Attribute_Value(1 .. Attribute_Length) & ' ');
        HU.Get_Node_Attribute(Library_Node, "CI", Attribute_Value, Attribute_Length);
        HU.Get_Node_Attribute(Library_Node, "MODE", Mode_Value, Mode_Length);
        if Fetch_Type'value(Mode_Value(1 .. Mode_Length)) = NO_UPDATE then
            HL.Put_Message_Line("");
        else
            HL.Put_Message(SU.Left_Justify(Attribute_Value(1 .. Attribute_Length), Maximum_CI_Name) & ' ');
            if Fetch_Type'value(Mode_Value(1 .. Mode_Length)) = UPDATE then
            HL.Put_Message_Line("TRUNK");
            else
            HL.Put_Message_Line("BRANCH");
            end if;
        end if;
        end if;
    end if;
    HNM.Close_Node_Handle(Library_Node);
    end loop;
    HNM.Close_Node_Handle(DOCMGR_Node);
    if First and then Message_on_Error then
    HL.Put_Message_Line(
        "No libraries " & SP.Value(SP.Upper(Library)) &
        " found for user " & SP.Value(SP.Upper(User)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when HL.Interrupt_Encountered =>
    HNM.Close_Node_Handle(Library_Node);
    HNM.Close_Node_Handle(DOCMGR_Node);
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("List_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    HNM.Close_Node_Handle(Library_Node);
    HNM.Close_Node_Handle(DOCMGR_Node);
    LE.Report_Error(LE.Internal_Error, SP.Create("List_Library"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end List_Library_Interface;
                                                                    pragma page;
::::::::::::::
listl.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function List_Library_Interface(        --| List Libraries Owned by User
   User    : in String_Pkg.String_Type;        --| Name of the library owner
   Library : in String_Pkg.String_Type        --| Name of the library
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library and the owner

--| Effects:
--| List all libraries that satisfies the owner and library name specification

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
listp.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Declarations;
with String_Utilities;
with String_Lists;

function List_Property return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package SL  renames String_Lists;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILD renames Item_Library_Manager_Declarations;
    package SU  renames String_Utilities;
    package GSU is new SU.Generic_String_Utilities(SP.String_Type,
                           SP.Create,
                           SP.Value);

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package STR is new SI.String_Argument(
                String_Type_Name => "string");

    List_Property_Process : SI.Process_Handle;
    Library                : SP.String_Type;
    Keyword                : SP.String_Type;
    List                   : ILD.LL.List;
    List_Iter              : ILD.LL.ListIter;
    Value_List             : SL.List;
    Value_Iter             : SL.ListIter;
    Work_String            : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => List_Property_Process,
    Name    => "List_Property",
    Help    => "List Property Keyword/Value in the Item Library");

    LIB.Define_Argument(
    Proc => List_Property_Process,
    Name => "library",
    Help => "Name of the item library");

    STR.Define_Argument(
    Proc    => List_Property_Process,
    Name    => "keyword",
    Default => "*",
    Help    => "Property keyword");

    SP.Release;

    SI.Parse_Line(List_Property_Process);

    Library := LIB.Get_Argument(
            Proc => List_Property_Process,
            Name => "library");

    Keyword := STR.Get_Argument(
            Proc => List_Property_Process,
            Name => "keyword");

    List := ILM.List_Property(Library, Keyword);

    List_Iter := ILD.LL.MakeListIter(List);
    while ILD.LL.More(List_Iter) loop
    ILD.LL.Next(List_Iter, Value_List);
    Value_Iter := SL.MakeListIter(Value_List);
    SP.Mark;
    SL.Next(Value_Iter, Work_String);
    HL.Put_Message(GSU.Left_Justify(Work_String, ILD.Maximum_Keyword));
    HL.Put_Message(" : ");
    SL.Next(Value_Iter, Work_String);
    HL.Put_Message_Line(SP.Value(Work_String));
    SP.Release;
    end loop;
    ILD.Destroy_List_of_Lists(List);
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Keyword =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) & """ invalid.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Keyword_Not_Found =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) &
             """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("List Property internal error.");
    return HL.Return_Code(HL.SEVERE);

end List_Property;

::::::::::::::
listp.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with String_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;
with HIF_List_Utils;

function List_Property_Interface(
    Library : in String_Pkg.String_Type;
    Keyword : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package SU  renames String_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;
    package HLU renames HIF_List_Utils;

    Node             : HND.Node_Type;
    Iterator         : HA.Attrib_Iterator;
    Property_List    : HLU.List_Type;
    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;
    Trap             : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, READ_LOCK) then
    raise Library_Read_Locked;
    end if;
    LU.Open_Property_Node(Library, SP.Create(""), SP.Create(""), LIST, Node);

    begin
    HA.Node_Attribute_Iterate(Iterator, Node, SP.Value(Keyword));
    exception
    when HND.Name_Error =>
        raise Invalid_Keyword;
    end;

    HNM.Close_Node_Handle(Node);

    if HA.More(Iterator) then
    HL.Put_Message(SU.Left_Justify("Keyword", Maximum_Keyword));
    HL.Put_Message_Line("   Value");
    HL.Put_Message_Line(Separator);
    elsif Message_on_Error then
    HL.Put_Message_Line("Propery " &
                SU.Left_Justify("Keyword", Maximum_Keyword) &
                " not found.");
    LU.Unlock_Library(Library, READ_LOCK);
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;
    end if;

    while HA.More(Iterator) loop
    HA.Get_Next(Iterator, Attribute_Value, Attribute_Length, Property_List);
    HL.Put_Message(SU.Left_Justify(
        Attribute_Value(1 .. Attribute_Length), Maximum_Keyword));
    HL.Put_Message(" : ");
    HL.Put_Message_Line(HLU.Item_Image(
        HLU.Positional(Property_List, HLU.Positive_Count(1))));
    end loop;
    LU.Unlock_Library(Library, READ_LOCK);
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Read_Locked =>
    LE.Report_Error(LE.Library_Read_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Keyword =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Keyword, Keyword);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("List_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("List_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end List_Property_Interface;
                                                                    pragma page;
::::::::::::::
listp.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function List_Property_Interface(        --| List Property Keyword/Value in the Item Library
    Library : in String_Pkg.String_Type;    --| Item library
    Keyword : in String_Pkg.String_Type        --| Property keyword
    ) return Host_Lib.Severity_Code;

--| Requires:
--| The names of the library, and the keyword.

--| Effects:
--| Returns the value associated with the keyword.
--| If any wildcard characters are specified in the keyword, all keyword
--| value pairs satisfying the specification are returned.

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
lmutils.bdy
::::::::::::::
with String_Utilities;
with HIF_Attributes;
with HIF_List_Utils;
with Host_Lib;
with Hif_Host_File_Management;

package body Item_Library_Manager_Utilities is

    package SU  renames String_Utilities;
    package SS  is new SU.Generic_String_Utilities(
            SP.String_Type,
            SP.Make_Persistent,
            SP.Value);
    package HA  renames HIF_Attributes;
    package HLU renames HIF_List_Utils;
    package HL  renames Host_Lib;
    package HFM renames Hif_Host_File_Management;

    subtype Valid_Character      is CHARACTER range ' ' .. '~';
    subtype Digit                is CHARACTER range '0' .. '9';
    subtype Lower_Alphabet       is CHARACTER range 'a' .. 'z';
    subtype Upper_Alphabet       is CHARACTER range 'A' .. 'Z';

    Substitute_Character    : constant CHARACTER := 'Z';
    Privilege_Reason        : constant STRING    := "PRIVILEGE";
    Version_Exists_Reason   : constant STRING    := "NAME_CONFLICT";
    Item_Checked_Out_Reason : constant STRING    := "CHECKED_OUT";

--------------------------------------------------------------------------------

    function Internal_Name(
    External_Name : in SP.String_Type;
    Exclude       : in STRING := ""
    ) return STRING is

    Translate           : BOOLEAN;
    Internal_Name       : STRING(1 .. 256) := (others => ' ');
    Internal_Name_Index : INTEGER := 1;
    External_Character  : Valid_Character;

    begin

    for i in 1 .. SP.Length(External_Name) loop
        begin
        External_Character := SP.Fetch(External_Name, i);
        exception
        when CONSTRAINT_ERROR =>
            raise Invalid_External_Name;
        end;

        Translate := TRUE;

        begin
        External_Character := Digit'(External_Character);
        Translate := FALSE;
        if i = 1 then
            Internal_Name(1 .. 3) := Substitute_Character & "00";
            Internal_Name_Index := 4;
        end if;
        exception
        when CONSTRAINT_ERROR => null;
        end;

        if Translate then
        begin
            External_Character := Lower_Alphabet'(External_Character);
            Translate := FALSE;
        exception
            when CONSTRAINT_ERROR => null;
        end;
        end if;

        if Translate then
        begin
            External_Character := Upper_Alphabet'(External_Character);
            Translate := FALSE;
        exception
            when CONSTRAINT_ERROR => null;
        end;
        end if;

        if Translate then
        for k in Exclude'range loop
            if External_Character = Exclude(k) then
            Translate := FALSE;
            exit;
            end if;
        end loop;
        end if;

        if Translate then
        Internal_Name(Internal_Name_Index .. Internal_Name_Index+2) :=
            Substitute_Character &
            SU.Image(
            CHARACTER'pos(External_Character) - CHARACTER'pos(Valid_Character'first) + 1,
            2,
            '0');
        Internal_Name_Index := Internal_Name_Index + 3;
        else
        Internal_Name(Internal_Name_Index) := External_Character;
        Internal_Name_Index := Internal_Name_Index + 1;
        end if;
    end loop;
    return Internal_Name(1 .. Internal_Name_Index-1);

    end Internal_Name;

--------------------------------------------------------------------------------

    function External_Name(
    Internal_Name : in STRING
    ) return STRING is

    External_Name       : STRING(1 .. 256) := (others => ' ');
    External_Name_Index : INTEGER := 1;
    Internal_Name_Index : INTEGER := Internal_Name'first;

    begin

    while Internal_Name_Index <= Internal_Name'last loop
        if Internal_Name(Internal_Name_Index) = Substitute_Character then
        begin
            if NATURAL'value(Internal_Name(Internal_Name_Index+1 .. Internal_Name_Index+2)) /= 0 then
            External_Name(External_Name_Index) :=
                Valid_Character'val(
                NATURAL'value(
                    Internal_Name(Internal_Name_Index+1 .. Internal_Name_Index+2)) +
                    CHARACTER'pos(Valid_Character'first) -
                    1);
            External_Name_Index := External_Name_Index + 1;
            end if;
            Internal_Name_Index := Internal_Name_Index + 2;
        exception
            when CONSTRAINT_ERROR =>
            External_Name(External_Name_Index) := Substitute_Character;
            External_Name_Index := External_Name_Index + 1;
        end;
        else
        External_Name(External_Name_Index) :=
            Internal_Name(Internal_Name_Index);
        External_Name_Index := External_Name_Index + 1;
        end if;
        Internal_Name_Index := Internal_Name_Index + 1;
    end loop;
    return External_Name(1 .. External_Name_Index-1);

    end External_Name;

--------------------------------------------------------------------------------

    procedure Is_Node(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    ) is


    begin

    if HNM.Is_Open(Node) then
        HNM.Close_Node_Handle(Node => Node);
    end if;
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Name));

    exception
    when others =>
        HNM.Close_Node_Handle(Node => Node);

    end Is_Node;

--------------------------------------------------------------------------------

    function Node_Name(
    Library : in SP.String_Type;
    Item    : in SP.String_Type := SP.Create("");
    Version : in STRING := ""
    ) return SP.String_Type is

    begin

    if SP.Equal(Item, "") then
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ')');
    elsif SP.Equal(Item, "*") then
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ").IL");
    elsif Version = "" then
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ").IL." &
                 Internal_Name(Item));
    else
        return SP.Create("'USER(" &
                 Internal_Name(Library) &
                 ").IL." &
                 Internal_Name(Item) &
                 ".V" & Version);
    end if;

    end Node_Name;

--------------------------------------------------------------------------------

    procedure Parse_Node(
    Node    : in     HND.Node_Type;
    Library :    out SP.String_Type;
    Item    :    out SP.String_Type;
    Version :    out SP.String_Type
    ) is

    Scanner : SU.Scanner;
    Temp    : SP.String_Type;
    Found   : BOOLEAN;

    begin

    Scanner := SS.Make_Scanner(SP.Upper(HNM.Primary_Name(Node)));

    SS.Scan_Literal("'USER", Scanner, Found);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    SS.Scan_Enclosed('(', ')', Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    Library := SP.Make_Persistent(External_Name(SP.Value(Temp)));
    SP.Flush(Temp);

    SU.Backward(Scanner);
    SS.Scan_Not_Literal("'DOT(IL)", Scanner, Found, Temp);
    if not Found then
        SS.Scan_Not_Literal("'DOT(CI)", Scanner, Found, Temp);
        if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
        else
        SS.Scan_Literal("'DOT(CI)", Scanner, Found);
        end if;
    else
        SS.Scan_Literal("'DOT(IL)", Scanner, Found);
    end if;
    SP.Flush(Temp);

    SS.Scan_Not_Literal("(", Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    SP.Flush(Temp);
    SS.Scan_Enclosed('(', ')', Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    Item := SP.Make_Persistent(External_Name(SP.Value(Temp)));
    SP.Flush(Temp);

    SS.Scan_Not_Literal("(", Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    SP.Flush(Temp);
    SS.Scan_Enclosed('(', ')', Scanner, Found, Temp);
    if not Found then
        SU.Destroy_Scanner(Scanner);
        return;
    end if;
    Version := SP.Make_Persistent(SP.Substr(Temp, 2, SP.Length(Temp)-1));
    SP.Flush(Temp);
    SU.Destroy_Scanner(Scanner);

    end Parse_Node;

--------------------------------------------------------------------------------

    function Is_Ada_Id(
    Value : in SP.String_Type
    ) return BOOLEAN is

    Scanner : SU.Scanner;
    Ada_Id  : SP.String_Type;
    Found   : BOOLEAN;

    begin

    Scanner := SS.Make_Scanner(Value);
    SS.Scan_Ada_Id(Scanner, Found, Ada_Id, Skip => FALSE);
    SP.Flush(Ada_Id);
    Found := Found and not SU.More(Scanner);
    SU.Destroy_Scanner(Scanner);
    return Found;

    end Is_Ada_Id;

--------------------------------------------------------------------------------

    procedure Is_Library(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type
    ) is

    Owner_Value  : STRING(1 .. Maximum_Owner_Name);
    Owner_Length : INTEGER;


    begin

    if not Is_Ada_Id(Library) then
        raise Invalid_Library_Name;
    end if;
    Is_Node(Node, Node_Name(Library));
    if not HNM.Is_Open(Node) then
        return;
    end if;
    HA.Get_Node_Attribute(Node       => Node,
                  Attrib     => "OWNER",
                  Value      => Owner_Value,
                  Value_Last => Owner_Length);
    if Owner_Length = 0 then
        HNM.Close_Node_Handle(Node);
    end if;

    end Is_Library;

--------------------------------------------------------------------------------

    procedure Is_Item(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type
    ) is

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    Is_Node(Node, Node_Name(Library, Item));

    end Is_Item;

--------------------------------------------------------------------------------

    procedure Is_Version(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type;
    Version : in     SP.String_Type
    ) is

    Found     : BOOLEAN;
    Versions  : SL.List := SL.Create;

    begin

    Is_Node(Node, Node_Name(Library, Item));
    if not HNM.Is_Open(Node) then
        raise Item_Not_Found;
    end if;
    Versions := Get_Version(Node, Version);
    if SL.Length(Versions) = 1 then
        Is_Node(Node,
            Node_Name(Library,
                  Item,
                  SP.Value(SL.FirstValue(Versions))));
    else
        HNM.Close_Node_Handle(Node => Node);
    end if;
    Destroy_String_List(Versions);

    end Is_Version;

--------------------------------------------------------------------------------

    function Is_Checked_Out(
    Item_Node : in HND.Node_Type
    ) return BOOLEAN is

    Attribute_Value  : STRING(1 .. 16);
    Attribute_Length : INTEGER;

    begin

    HA.Get_Node_Attribute(Node       => Item_Node,
                  Attrib     => "MODE",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    return Attribute_Value(1 .. Attribute_Length) = State_Type'image(UPDATE);

    end;

--------------------------------------------------------------------------------

    function Lock_Library(
    Node : in HND.Node_Type;
    Lock : in Lock_Type
    ) return BOOLEAN is

    Was_Locked : BOOLEAN;
    Iterator   : HNM.Node_Iterator;

    begin

    if Lock = MASTER_LOCK then
        begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(Lock));
        exception
        when others =>
            raise Library_Master_Locked;
        end;
        Set_Lock_Attributes(Node, Lock, "");
        return TRUE;
    end if;

    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(MASTER_LOCK));
    exception
        when others =>
        raise Library_Master_Locked;
    end;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(MASTER_LOCK));
    exception
        when others =>
        null;
    end;

    Was_Locked := TRUE;
    for i in 1 .. Retry_Count loop
        begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(WRITE_LOCK));
        Was_Locked := FALSE;
        exit;
        exception
        when others =>
            null;
        end;
    end loop;

    if Was_Locked then
        return FALSE;
    end if;

    if Lock = WRITE_LOCK then
        HNM.Iterate(Iterator     => Iterator,
            Node         => Node,
            Relation     => Lock_Type'image(READ_LOCK),
            Primary_Only => FALSE);
        if HNM.More(Iterator) then
        begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(Lock));
        exception
            when others =>
            null;
        end;
        return FALSE;
        end if;
        Set_Lock_Attributes(Node, Lock, "");
        return TRUE;
    end if;

    Was_Locked := TRUE;
    for i in 1 .. Retry_Count loop
        begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(Lock),
             Key      => HL.Get_Item(HL.USER_NAME));
        Was_Locked := FALSE;
        exit;
        exception
        when others =>
            null;
        end;
    end loop;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(WRITE_LOCK));
    exception
        when others =>
        null;
    end;

    if Was_Locked then
        return FALSE;
    end if;
    Set_Lock_Attributes(Node, Lock, HL.Get_Item(HL.USER_NAME));

    return TRUE;

    end Lock_Library;

--------------------------------------------------------------------------------

    function Lock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    ) return BOOLEAN is

    Node   : HND.Node_Type;
    Locked : BOOLEAN;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    Locked := Lock_Library(Node, Lock);
    HNM.Close_Node_Handle(Node);
    return Locked;

    end Lock_Library;

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type
    ) is

    Owner : SP.String_Type;
    Group : SP.String_Type;
    Date  : SP.String_Type;
    Time  : SP.String_Type;

    begin

    if Lock = MASTER_LOCK then
        begin
        Get_Lock_Attributes(Node, Lock, "", Owner, Group, Date, Time);
        if SP.Value(Owner) /= HL.Get_Item(HL.USER_NAME) then
            raise Not_Authorized;
        else
            begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(Lock));
            exception
            when others =>
                null;
            end;
            return;
        end if;
        exception
        when others =>
            return;
        end;
    end if;

    if Lock = WRITE_LOCK then
        begin
        Get_Lock_Attributes(Node, Lock, "", Owner, Group, Date, Time);
        if SP.Value(Owner) /= HL.Get_Item(HL.USER_NAME) then
            raise Not_Authorized;
        else
            begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(Lock));
            exception
            when others =>
                null;
            end;
            return;
        end if;
        exception
        when others =>
            return;
        end;
    end if;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(Lock),
               Key      => HL.Get_Item(HL.USER_NAME));
    exception
        when others =>
        null;
    end;

    end Unlock_Library;

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    ) is

    Node  : HND.Node_Type;
    Owner : SP.String_Type;
    Date  : SP.String_Type;
    Time  : SP.String_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    Unlock_Library(Node, Lock);
    HNM.Close_Node_Handle(Node);

    end Unlock_Library;

--------------------------------------------------------------------------------

    procedure Check_Master_Lock(
    Node : in HND.Node_Type
    ) is

    begin

    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(MASTER_LOCK));
    exception
        when others =>
        raise Library_Master_Locked;
    end;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(MASTER_LOCK));
    exception
        when others =>
        null;
    end;

    end Check_Master_Lock;

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Node  : in HND.Node_Type
    ) return BOOLEAN is

    Was_Locked : BOOLEAN;
    Iterator   : HNM.Node_Iterator;
    Temp_Node  : HND.Node_Type;

    begin

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(READ_LOCK),
             Key      => HL.Get_Item(HL.USER_NAME));
        Was_Locked := FALSE;
    exception
        when others =>
        Was_Locked := TRUE;
    end;

    if not Was_Locked then
        begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(READ_LOCK),
               Key      => HL.Get_Item(HL.USER_NAME));
        exception
        when others =>
            null;
        end;
        raise Invalid_Upgrade;
    end if;

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(WRITE_LOCK));
    exception
        when others =>
        raise Internal_Error;
    end;

    HNM.Iterate(Iterator     => Iterator,
            Node         => Node,
            Relation     => Lock_Type'image(READ_LOCK),
            Primary_Only => FALSE);
    while HNM.More(Iterator) loop
        HNM.Get_Next(Iterator, Temp_Node);
        if HNM.Path_Key(Temp_Node) /= HL.Get_Item(HL.USER_NAME) then
        begin
            HNM.Unlink(Base     => Node,
                   Relation => Lock_Type'image(WRITE_LOCK));
        exception
            when others =>
            raise Internal_Error;
        end;
        return FALSE;
        end if;
        HNM.Close_Node_Handle(Node => Temp_Node);
    end loop;

    Set_Lock_Attributes(Node, WRITE_LOCK, "");

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(READ_LOCK),
               Key      => HL.Get_Item(HL.USER_NAME));
    exception
        when others =>
        raise Internal_Error;
    end;
    return TRUE;

    end Upgrade_Lock;

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Library : in SP.String_Type
    ) return BOOLEAN is

    Node   : HND.Node_Type;
    Locked : BOOLEAN;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Invalid_Library_Name;
    end if;
    Locked := Upgrade_Lock(Node);
    HNM.Close_Node_Handle(Node);
    return Locked;

    end Upgrade_Lock;

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Node  : in HND.Node_Type
    ) is

    Was_Locked : BOOLEAN;
    Owner      : SP.String_Type;
    Group      : SP.String_Type;
    Date       : SP.String_Type;
    Time       : SP.String_Type;

    begin

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(WRITE_LOCK));
        Was_Locked := FALSE;
    exception
        when others =>
        Was_Locked := TRUE;
    end;

    if Was_Locked then
        Get_Lock_Attributes(Node, WRITE_LOCK, "", Owner, Group, Date, Time);
        if SP.Value(Owner) /= HL.Get_Item(HL.USER_NAME) then
        raise Invalid_Downgrade;
        end if;
    end if;

    if not Was_Locked then
        begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(WRITE_LOCK));
        exception
        when others =>
            null;
        end;
        raise Invalid_Downgrade;
    end if;

    Check_Master_Lock(Node);
    begin
        HNM.Link(To_Node  => Node,
             New_Base => Node,
             Relation => Lock_Type'image(READ_LOCK),
             Key      => HL.Get_Item(HL.USER_NAME));
        Set_Lock_Attributes(Node, READ_LOCK, "");
    exception
        when others =>
        raise Internal_Error;
    end;

    begin
        HNM.Unlink(Base     => Node,
               Relation => Lock_Type'image(WRITE_LOCK));
    exception
        when others =>
        raise Internal_Error;
    end;

    end Downgrade_Lock;

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Library : in SP.String_Type
    ) is

    Node : HND.Node_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Invalid_Library_Name;
    end if;
    Downgrade_Lock(Node);
    HNM.Close_Node_Handle(Node);

    end Downgrade_Lock;

--------------------------------------------------------------------------------

    function Get_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING
    ) return STRING is

    Library_Node     : HND.Node_Type;
    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;

    begin

    Is_Library(Library_Node, Library);
    if not HNM.Is_Open(Library_Node) then
        raise Library_Does_Not_Exist;
    end if;
    HA.Get_Node_Attribute(Node       => Library_Node,
                  Attrib     => Attribute,
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    HNM.Close_Node_Handle(Library_Node);
    return Attribute_Value(1 .. Attribute_Length);

    end Get_Library_Attribute;

--------------------------------------------------------------------------------

    procedure Set_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING;
    Value     : in STRING
    ) is

    Library_Node : HND.Node_Type;

    begin

    Is_Library(Library_Node, Library);
    if not HNM.Is_Open(Library_Node) then
        raise Library_Does_Not_Exist;
    end if;
    HA.Set_Node_Attribute(Node   => Library_Node,
                  Attrib => Attribute,
                  Value  => Value);
    HNM.Close_Node_Handle(Library_Node);

    end Set_Library_Attribute;

--------------------------------------------------------------------------------

    procedure Open_Standard_Node_Handle(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    ) is

    begin

    if HNM.Is_Open(Node) then
        HNM.Close_Node_Handle(Node => Node);
    end if;
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Name));
    Set_Standard_Attributes(Node);

    end Open_Standard_Node_Handle;

--------------------------------------------------------------------------------

    procedure Set_Standard_Attributes(
    Node : in HND.Node_Type
    ) is

    Time : HL.Time_Value;

    begin

    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "OWNER",
                  Value  => HL.Get_Item(HL.USER_NAME));
    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "GROUP",
                  Value  => HL.Get_Item(HL.ACCOUNT));
    HL.Get_Time(Time);
    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "DATE",
                  Value  => HL.Date(Time));
    HA.Set_Node_Attribute(Node   => Node,
                  Attrib => "TIME",
                  Value  => HL.Time(Time));

    end Set_Standard_Attributes;

--------------------------------------------------------------------------------

    procedure Set_Lock_Attributes(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type;
    Key   : in STRING
    ) is

    Time      : HL.Time_Value;
    Lock_Node : HND.Node_Type;

    begin

    HNM.Open_Node_Handle(Node => Lock_Node,
                 Base => Node,
                 Name => ''' & Lock_Type'image(Lock) & '(' & Key & ')');
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "OWNER",
                  Value  => HL.Get_Item(HL.USER_NAME));
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "GROUP",
                  Value  => HL.Get_Item(HL.ACCOUNT));
    HL.Get_Time(Time);
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "DATE",
                  Value  => HL.Date(Time));
    HA.Set_Path_Attribute(Node   => Lock_Node,
                  Attrib => "TIME",
                  Value  => HL.Time(Time));
    HNM.Close_Node_Handle(Lock_Node);

    end Set_Lock_Attributes;

--------------------------------------------------------------------------------

    procedure Get_Lock_Attributes(
    Node       : in     HND.Node_Type;
    Lock       : in     Lock_Type;
    Key        : in     STRING;
    Owner      : in out SP.String_Type;
    Group      : in out SP.String_Type;
    Date       : in out SP.String_Type;
    Time       : in out SP.String_Type
    ) is

    Lock_Node        : HND.Node_Type;
    Attribute_Value  : STRING(1 .. Maximum_Owner_Name);
    Attribute_Length : INTEGER;

    begin

    HNM.Open_Node_Handle(Node => Lock_Node,
                 Base => Node,
                 Name => ''' & Lock_Type'image(Lock) & '(' & Key & ')');
    HA.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "OWNER",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Owner := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HA.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "GROUP",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Group := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HA.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "DATE",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Date := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HA.Get_Path_Attribute(Node       => Lock_Node,
                  Attrib     => "TIME",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    Time := SP.Create(Attribute_Value(1 .. Attribute_Length));
    HNM.Close_Node_Handle(Lock_Node);

    end Get_Lock_Attributes;

--------------------------------------------------------------------------------

    function Get_Item_Date_Time(
    Library : in SP.String_Type;
    Item    : in SP.String_Type;
    Version : in SP.String_Type
    ) return STRING is

    Node      : HND.Node_Type;
    Date_Attr : STRING(1 .. 8);
    Date_Len  : INTEGER;
    Time_Attr : STRING(1 .. 8);
    Time_Len  : INTEGER;

    begin

    Is_Version(Node, Library, Item, Version);
    if not HNM.Is_Open(Node) then
        raise Version_Not_Found;
    end if;
    HA.Get_Node_Attribute(Node       => Node,
                  Attrib     => "DATE",
                  Value      => Date_Attr,
                  Value_Last => Date_Len);
    HA.Get_Node_Attribute(Node       => Node,
                  Attrib     => "TIME",
                  Value      => Time_Attr,
                  Value_Last => Time_Len);
    HNM.Close_Node_Handle(Node);
    return Date_Attr(1 .. Date_Len) & ' ' & Time_Attr(1 .. Time_Len);

    end Get_Item_Date_Time;

--------------------------------------------------------------------------------

    function Get_Version(
    Node    : in HND.Node_Type;
    Version : in SP.String_Type
    ) return SL.List is

    Version_Number  : INTEGER := 0;
    Current_Version : INTEGER;
    List            : SL.List;
    Version_Value   : STRING(1 .. 16);
    Version_Length  : INTEGER;
    Temp_Node       : HND.Node_Type;
    Temp_Str        : SP.String_Type;

    begin

    if not SP.Equal(Version, "") and then SP.Match_C(Version, '*') = 0 then
        begin
        Version_Number := INTEGER'value(SP.Value(Version));
        exception
        when others =>
            raise Invalid_Version;
        end;
        if Version_Number > 0 then
            begin
            HNM.Open_Node_Handle(Node => Temp_Node,
                     Base => Node,
                     Name => ".V" & SU.Image(Version_Number));
            HNM.Close_Node_Handle(Temp_Node);
        exception
            when others =>
            raise Version_Not_Found;
        end;
        return SL.MakeList(SS.Image(Version_Number));
        end if;
    end if;

    HA.Get_Node_Attribute(Node       => Node,
                  Attrib     => "V",
                  Value      => Version_Value,
                  Value_Last => Version_Length);
    Current_Version := INTEGER'value(Version_Value(1 .. Version_Length));
    if SP.Match_C(Version, '*') = 0 then
        Version_Number := Current_Version + Version_Number;
        if Version_Number <= 0 then
        raise Version_Not_Found;
        end if;
        return SL.MakeList(SS.Image(Version_Number));
    else
        List := SL.Create;
        for i in reverse 1 .. Current_Version loop
        begin
            HNM.Open_Node_Handle(Node => Temp_Node,
                     Base => Node,
                     Name => ".V" & SU.Image(i));
            Temp_Str := SS.Image(i);
            if SS.Match(Version, Temp_Str) then
            SL.Attach(List, Temp_Str);
            else
            SP.Flush(Temp_Str);
            end if;
            HNM.Close_Node_Handle(Temp_Node);
        exception
            when others =>
            null;
        end;
        end loop;
        return List;
    end if;

    end Get_Version;

--------------------------------------------------------------------------------

    procedure Iterate_Item(
    Library  : in     SP.String_Type;
    Item     : in     SP.String_Type;
    Iterator : in out HNM.Node_Iterator
    ) is

    Node : HND.Node_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    HNM.Close_Node_Handle(Node => Node);
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Node_Name(Library, SP.Create("*"))));
    begin
        HNM.Iterate(Iterator     => Iterator,
            Node         => Node,
            Relation     => "DOT",
            Key          => Internal_Name(Item, "*"),
            Primary_Only => TRUE);
        HNM.Close_Node_Handle(Node);
    exception
        when others =>
        HNM.Close_Node_Handle(Node);
        raise Item_Not_Found;
    end;

    end Iterate_Item;

--------------------------------------------------------------------------------

    procedure Open_Property_Node(
    Library : in     SP.String_Type;
    Keyword : in     SP.String_Type;
    Value   : in     SP.String_Type;
    Mode    : in     Edit_Mode;
    Node    : in out HND.Node_Type
    ) is

    Property_List    : HLU.List_Type;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    HNM.Close_Node_Handle(Node => Node);
    if Mode /= LIST then
        if SP.Equal(Keyword, "") or else not Is_Ada_Id(Keyword) then
        raise Invalid_Keyword;
        end if;
    end if;
    if Mode = ADD or Mode = MODIFY then
        if SP.Equal(Value, "") or else not Is_Ada_Id(Value) then
        raise Invalid_Value;
        end if;
    end if;
    HNM.Open_Node_Handle(Node => Node,
                 Name => SP.Value(Node_Name(Library, SP.Create("*"))));
    if Mode /= LIST then
        HA.Get_Node_Attribute(Node       => Node,
                  Attrib     => SP.Value(Keyword),
                  Value      => Property_List);
        if (Mode = DELETE or Mode = MODIFY) and HLU.Empty(Property_List) then
        HLU.Free_List(Property_List);
        raise Keyword_Not_Found;
        end if;
        if Mode = ADD and not HLU.Empty(Property_List) then
        HLU.Free_List(Property_List);
        raise Keyword_Already_Exists;
        end if;
        HLU.Free_List(Property_List);
    end if;

    end Open_Property_Node;

--------------------------------------------------------------------------------

    procedure Delete(
    Item_Node : in out HND.Node_Type;
    Versions  : in     SL.List;
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    ) is

    Version_Iterator : SL.ListIter;
    Version_Number   : SP.String_Type;
    Version_Node     : HND.Node_Type;
    Current_Version  : SL.List;
    All_Version      : SL.List;
    Library          : SP.String_Type;
    Item             : SP.String_Type;
    Version          : SP.String_Type;
    Remainder_List   : SL.List;
    Delete           : BOOLEAN := FALSE;

    begin

    if SL.IsEmpty(Versions) then
        return;
    end if;
    Parse_Node(Node    => Item_Node,
           Library => Library,
           Item    => Item,
           Version => Version);
    if Privileged(Privilege, Library, Item) then
        All_Version := Get_Version(Item_Node, SP.Create("*"));
        if SL.Equal(All_Version, Versions) then
        Destroy_String_List(All_Version);
        HNM.Delete_Tree(Item_Node);
        return;
        end if;
        Destroy_String_List(All_Version);
        Delete := TRUE;
    end if;
    Version_Iterator := SL.MakeListIter(Versions);
    while SL.More(Version_Iterator) loop
        SL.Next(Version_Iterator, Version_Number);
        HNM.Open_Node_Handle(Node         => Version_Node,
                 Base         => Item_Node,
                 Relation     => "DOT",
                 Key          => 'V' & SP.Value(Version_Number));
        if Delete then
        HNM.Delete_Tree(Version_Node);
        else
        Parse_Node(Node    => Version_Node,
               Library => Library,
               Item    => Item,
               Version => Version);
        if Privileged(Privilege, Library, Item, SP.Value(Version)) then
            HNM.Delete_Tree(Version_Node);
        else
            Remainder_List := SL.MakeList(Library);
            SL.Attach(Remainder_List, Item);
            SL.Attach(Remainder_List, Version);
            SL.Attach(Remainder_List, SP.Make_Persistent(Privilege_Reason));
            LL.Attach(Remainder, Remainder_List);
        end if;
        end if;
        HNM.Close_Node_Handle(Version_Node);
    end loop;
    Current_Version := Get_Version(Item_Node, SP.Create("*"));
    if not SL.IsEmpty(Current_Version) then
        HA.Set_Node_Attribute(Node   => Item_Node,
                  Attrib => "V",
                  Value  => SP.Value(SL.FirstValue(Current_Version)));
    else
        HNM.Delete_Tree(Item_Node);
    end if;
    Destroy_String_List(Current_Version);

    exception
    when others =>
        HNM.Close_Node_Handle(Version_Node);
        raise;

    end Delete;

--------------------------------------------------------------------------------

    procedure Purge(
    Library   : in     SP.String_Type;
    Item      : in     SP.String_Type := SP.Create("*");
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    ) is

    Item_Node        : HND.Node_Type;
    Item_Iterator    : HNM.Node_Iterator;
    Versions         : SL.List;

    begin

    Iterate_Item(Library, Item, Item_Iterator);
    while HNM.More(Item_Iterator) loop
        HNM.Get_Next(Item_Iterator, Item_Node);
        Versions := Get_Version(Item_Node, SP.Create("*"));
        SL.DeleteHead(Versions);
        Delete(Item_Node, Versions, Privilege, Remainder);
        Destroy_String_List(Versions);
        HNM.Close_Node_Handle(Item_Node);
    end loop;

    exception
    when others =>
        HNM.Close_Node_Handle(Item_Node);
        raise;

    end Purge;

--------------------------------------------------------------------------------

    procedure Rename_Item(
    Library   : in SP.String_Type;
    From_Item : in SP.String_Type;
    To_Item   : in SP.String_Type;
    Privilege : in Privilege_Type;
    Remainder : in out LL.List
    ) is

    Item_Node      : HND.Node_Type;
    Remainder_List : SL.List;

    begin

    Is_Item(Item_Node, Library, To_Item);
    if HNM.Is_Open(Item_Node) then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Already_Exists;
    end if;
    Is_Item(Item_Node, Library, From_Item);
    if not HNM.Is_Open(Item_Node) then
        raise Item_Not_Found;
    end if;
    if Is_Checked_Out(Item_Node) then
        HNM.Close_Node_Handle(Item_Node);
        raise Item_Checked_Out;
    end if;
    if not Privileged(Privilege, Library, From_Item) then
        Remainder_List := SL.MakeList(Library);
        SL.Attach(Remainder_List, From_Item);
        SL.Attach(Remainder_List, SP.Make_Persistent(""));
        SL.Attach(Remainder_List, SP.Make_Persistent(Privilege_Reason));
        LL.Attach(Remainder, Remainder_List);
        return;
    end if;
    HNM.Rename(Node     => Item_Node,
           New_Name => SP.Value(Node_Name(Library, To_Item)));
    HNM.Close_Node_Handle(Item_Node);

    exception
    when others =>
        HNM.Close_Node_Handle(Item_Node);
        raise;

    end Rename_Item;

--------------------------------------------------------------------------------

    procedure Rename_Version(
    Library      : in     SP.String_Type;
    Item         : in     SP.String_Type;
    From_Version : in     SP.String_Type;
    To_Version   : in     SP.String_Type;
    Privilege    : in     Privilege_Type;
    Remainder    : in out LL.List
    ) is

    Library_Name      : SP.String_Type;
    Item_Name         : SP.String_Type;
    Version_Name      : SP.String_Type;
    Reason            : SP.String_Type;
    Version_Node      : HND.Node_Type;
    Item_Node         : HND.Node_Type;
    Item_Iterator     : HNM.Node_Iterator;
    From_Version_List : SL.List;
    To_Version_List   : SL.List;
    Remainder_List    : SL.List;
    Add_To_List       : BOOLEAN;

    begin

    if SP.Match_C(From_Version, '*') /= 0 then
        raise Invalid_Version;
    end if;
    if SP.Match_C(To_Version, '*') /= 0 then
        raise Invalid_Version;
    end if;
    Iterate_Item(Library, Item, Item_Iterator);
    while HNM.More(Item_Iterator) loop
        HNM.Get_Next(Item_Iterator, Item_Node);
        if not Is_Checked_Out(Item_Node) then
        Parse_Node(Item_Node, Library_Name, Item_Name, Version_Name);
        SP.Flush(Version_Name);
        From_Version_List := Get_Version(Item_Node, From_Version);
        Is_Version(Version_Node,
               Library_Name,
               Item_Name,
               SL.FirstValue(From_Version_List));
        Add_To_List := FALSE;
        begin
            To_Version_List := Get_Version(Item_Node, To_Version);
            if not SP.Equal(SL.FirstValue(From_Version_List),
               SL.FirstValue(To_Version_List)) then
            Add_To_List := TRUE;
            Reason := SP.Make_Persistent(Version_Exists_Reason);
            end if;
        exception
            when Version_Not_Found =>
            if Privileged(Privilege,
                      Library_Name,
                      Item_Name,
                      SP.Value(SL.FirstValue(From_Version_List))) then
                HNM.Rename(Node     => Version_Node,
                       New_Name => SP.Value(Node_Name(Library_Name, Item_Name, SP.Value(To_Version))));
            else
                Add_To_List := TRUE;
                Reason := SP.Make_Persistent(Privilege_Reason);
            end if;
        end;
        Destroy_String_List(From_Version_List);
        Destroy_String_List(To_Version_List);
        HNM.Close_Node_Handle(Version_Node);
        HNM.Close_Node_Handle(Item_Node);
        else
        Add_To_List :=TRUE;
        Reason := SP.Make_Persistent(Item_Checked_Out_Reason);
        end if;
        if Add_To_List then
        Remainder_List := SL.MakeList(Library);
        SL.Attach(Remainder_List, Item_Name);
        SL.Attach(Remainder_List, From_Version);
        SL.Attach(Remainder_List, Reason);
        LL.Attach(Remainder, Remainder_List);
        end if;
    end loop;

    exception
    when others =>
        HNM.Close_Node_Handle(Version_Node);
        HNM.Close_Node_Handle(Item_Node);
        raise;

    end Rename_Version;

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Node      : in HND.Node_Type
    ) return BOOLEAN is

    Attribute_Value  : STRING(1 .. 64);
    Attribute_Length : INTEGER;

    begin

    case Privilege is
        when WORLD =>
        return TRUE;
        when GROUP =>
        HA.Get_Node_Attribute(Node       => Node,
                      Attrib     => "GROUP",
                      Value      => Attribute_Value,
                      Value_Last => Attribute_Length);
        return Attribute_Value(1 .. Attribute_Length) = HL.Get_Item(HL.ACCOUNT);
        when OWNER =>
        HA.Get_Node_Attribute(Node       => Node,
                      Attrib     => "OWNER",
                      Value      => Attribute_Value,
                      Value_Last => Attribute_Length);
        return Attribute_Value(1 .. Attribute_Length) = HL.Get_Item(HL.USER_NAME);
    end case;

    exception
    when HND.Name_Error =>
        raise Internal_Error;

    end Privileged;

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Library   : in SP.String_Type;
    Item      : in SP.String_Type := SP.Create("");
    Version   : in STRING := ""
    ) return BOOLEAN is

    Node  : HND.Node_Type;
    Owned : BOOLEAN := FALSE;

    begin

    if Version /= "" then
        Is_Node(Node, Node_Name(Library, Item, Version));
        if not HNM.Is_Open(Node) then
        raise Internal_Error;
        end if;
        Owned := Privileged(Privilege, Node);
        HNM.Close_Node_Handle(Node);
    end if;
    if Owned then
        return TRUE;
    end if;

    if not SP.Is_Empty(Item) then
        Is_Node(Node, Node_Name(Library, Item));
        if not HNM.Is_Open(Node) then
        raise Internal_Error;
        end if;
        Owned := Privileged(Privilege, Node);
        HNM.Close_Node_Handle(Node);
    end if;
    if Owned then
        return TRUE;
    end if;

    Is_Node(Node, Node_Name(Library));
    if not HNM.Is_Open(Node) then
        raise Internal_Error;
    end if;
    Owned := Privileged(Privilege, Node);
    HNM.Close_Node_Handle(Node);
    return Owned;

    end Privileged;

--------------------------------------------------------------------------------

    function Get_Hif_File_Name(
    Lib_Name : in SP.String_Type;
    Item     : in SP.String_Type;
    Version  : in SP.String_Type
    ) return SP.String_Type is

    Node : HND.Node_Type;
    Path : SP.String_Type;
    File : SP.String_Type;

    begin

    SP.Mark;
    HNM.Open_Node_Handle(Node, SP.Value(Node_Name(Lib_Name, Item, SP.Value(Version))));
    File := SP.Make_Persistent(HFM.Host_File_Name(Node));
    SP.Release;
    HNM.Close_Node_Handle(Node);
    return File;

    end Get_Hif_File_Name;

--------------------------------------------------------------------------------

    function Is_Item_Checked_Out(
    Library : in SP.String_Type
    ) return BOOLEAN is

    Node             : HND.Node_Type;
    Attribute_Value  : STRING(1 .. 16);
    Attribute_Length : INTEGER;
    Check_Out_Count  : NATURAL;

    begin

    Is_Library(Node, Library);
    if not HNM.Is_Open(Node) then
        raise Library_Does_Not_Exist;
    end if;
    HA.Get_Node_Attribute(Node       => Node,
                  Attrib     => "CHECKED_OUT",
                  Value      => Attribute_Value,
                  Value_Last => Attribute_Length);
    HNM.Close_Node_Handle(Node);
    begin
        Check_Out_Count := NATURAL'value(Attribute_Value(1 .. Attribute_Length));
    exception
        when CONSTRAINT_ERROR =>
        Check_Out_Count := 0;
    end;
    return Check_Out_Count /= 0;

    end Is_Item_Checked_Out;

--------------------------------------------------------------------------------

    procedure Display_List(
    List   : in out LL.List;
    Header : in     STRING
    ) is

    List_Iter   : LL.ListIter;
    Value_List  : SL.List;
    Value_Iter  : SL.ListIter;
    Value       : SP.String_Type;
    Work_String : SP.String_Type;

    begin

    List_Iter := LL.MakeListIter(List);
    HL.Put_Message_Line(SU.Left_Justify(Header, Maximum_Item_Name) & " Reason");
    HL.Put_Message_Line(Separator);
    while LL.More(List_Iter) loop
        LL.Next(List_Iter, Value_List);
        Value_Iter := SL.MakeListIter(Value_List);
        SP.Mark;
        SL.Forward(Value_Iter);
        SL.Next(Value_Iter, Value);
        Work_String := Value;
        Work_String := SP."&"(Work_String, "/");
        SL.Next(Value_Iter, Value);
        Work_String := SP."&"(Work_String, Value);
        SL.Next(Value_Iter, Value);
        HL.Put_Message_Line(SS.Left_Justify(Work_String, Maximum_Item_Name) & ' ' & SP.Value(Value));
        SP.Release;
    end loop;

    end Display_List;

--------------------------------------------------------------------------------

end Item_Library_Manager_Utilities;
                                                                    pragma page;
::::::::::::::
lmutils.spc
::::::::::::::
with Item_Library_Manager_Declarations;    use Item_Library_Manager_Declarations;
with String_Pkg;
with HIF_Node_Defs;
with HIF_Node_Management;
with String_Lists;

package Item_Library_Manager_Utilities is

    package SP  renames String_Pkg;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package SL  renames String_Lists;

--------------------------------------------------------------------------------

    function Internal_Name(
    External_Name : in SP.String_Type;
    Exclude       : in STRING := ""
    ) return STRING;

--| Effects:
--| Translate representation internal to the Library Manager to its
--| external representation.  (Needed to satisfy the condition that
--| node names be Ada identifiers)

--------------------------------------------------------------------------------

    function External_Name(
    Internal_Name : in STRING
    ) return STRING;

--| Effects:
--| Translate external representation to the Library Manager
--| external representation.

--------------------------------------------------------------------------------

    procedure Is_Node(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    );

--| Effects:
--| Verifies that the given node name is indeed a node and if so opens
--| the node for processing.  Otherwise the node is closed.

--------------------------------------------------------------------------------

    function Node_Name(
    Library : in SP.String_Type;
    Item    : in SP.String_Type := SP.Create("");
    Version : in STRING := ""
    ) return SP.String_Type;

--| Effects:
--| Creates a node name representation of a library, item in a library, or
--| a version of an item in a library

--------------------------------------------------------------------------------

    procedure Parse_Node(
    Node    : in     HND.Node_Type;
    Library :    out SP.String_Type;
    Item    :    out SP.String_Type;
    Version :    out SP.String_Type
    );

--| Effects:
--| Given a node handle, parses the node name into library name, item name,
--| and version number

--------------------------------------------------------------------------------

    function Is_Ada_Id(
    Value : in SP.String_Type
    ) return BOOLEAN;

--| Effects:
--| Verifies that th e given value is an Ada identifier

--------------------------------------------------------------------------------

    procedure Is_Library(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type
    );

--| Effects:
--| Verifies that the given library exists and opens the node handle to
--| the library.  Otherwise the node is not opened.

--------------------------------------------------------------------------------

    procedure Is_Item(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type
    );

--| Effects:
--| Verifies that the given item exists and opens the node handle to
--| the item. Otherwise the node is not opened.

--------------------------------------------------------------------------------

    procedure Is_Version(
    Node    : in out HND.Node_Type;
    Library : in     SP.String_Type;
    Item    : in     SP.String_Type;
    Version : in     SP.String_Type
    );

--| Effects:
--| Verifies that the version of an item exists and opens the node handle to
--| the version of the item.  Otherwise the node is not opened.

--------------------------------------------------------------------------------

    function Is_Checked_Out(
    Item_Node : in HND.Node_Type
    ) return BOOLEAN;

--| Effects:
--| Verifies that the item (given as a node handle) is checked out for
--| update.

--------------------------------------------------------------------------------

    function Lock_Library(
    Node : in HND.Node_Type;
    Lock : in Lock_Type
    ) return BOOLEAN;

--| Effects:
--| Locks the library (given as a node handle) with the appropriate Lock_Type.
--| Returns TRUE iff the locking was successful.

--------------------------------------------------------------------------------

    function Lock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    ) return BOOLEAN;

--| Effects:
--| Locks the library (given as a library name) with the appropriate
--| Lock_Type.  Returns TRUE iff the locking was successful.

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type
    );

--| Effects:
--| Unlocks the library (given as a node handle).

--------------------------------------------------------------------------------

    procedure Unlock_Library(
    Library : in SP.String_Type;
    Lock    : in Lock_Type
    );

--| Effects:
--| Unlocks the library (given as a library name).

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Node  : in HND.Node_Type
    ) return BOOLEAN;

--| Effects:
--| Upgrades the library lock to a write lock.

--------------------------------------------------------------------------------

    function Upgrade_Lock(
    Library : in SP.String_Type
    ) return BOOLEAN;

--| Effects:
--| Upgrades the library lock to a write lock.

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Node  : in HND.Node_Type
    );

--| Effects:
--| Downgrades the library lock to a read lock.

--------------------------------------------------------------------------------

    procedure Downgrade_Lock(
    Library : in SP.String_Type
    );

--| Effects:
--| Downgrades the library lock to a read lock.

--------------------------------------------------------------------------------

    function Get_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING
    ) return STRING;

--| Effects:
--| Returns the value of a given attribute associated with the library

--------------------------------------------------------------------------------

    procedure Set_Library_Attribute(
    Library   : in SP.String_Type;
    Attribute : in STRING;
    Value     : in STRING
    );

--| Effects:
--| Sets the value of a given attribute associated with the library

--------------------------------------------------------------------------------

    procedure Open_Standard_Node_Handle(
    Node : in out HND.Node_Type;
    Name : in     SP.String_Type
    );

--| Effects:
--| Open the node handle associated with a given node name and set the
--| standard attributes for this node.

--------------------------------------------------------------------------------

    procedure Set_Standard_Attributes(
    Node : in HND.Node_Type
    );

--| Effects:
--| Set the common attributes (eg. OWNER, DATE) of a given node.

--------------------------------------------------------------------------------

    procedure Set_Lock_Attributes(
    Node  : in HND.Node_Type;
    Lock  : in Lock_Type;
    Key   : in STRING
    );

--| Effects:
--| Set the common lock attributes (eg. DATE).

--------------------------------------------------------------------------------

    procedure Get_Lock_Attributes(
    Node       : in     HND.Node_Type;
    Lock       : in     Lock_Type;
    Key        : in     STRING;
    Owner      : in out SP.String_Type;
    Group      : in out SP.String_Type;
    Date       : in out SP.String_Type;
    Time       : in out SP.String_Type
    );

--| Effects:
--| Get the values of common lock attributes.

--------------------------------------------------------------------------------

    function Get_Item_Date_Time(
    Library : in SP.String_Type;
    Item    : in SP.String_Type;
    Version : in SP.String_Type
    ) return STRING;

--| Effects:
--| Return the create date and time (MM/DD/YY HH:MM:SS format) associated
--| with a version of an item in a library.

--------------------------------------------------------------------------------

    function Get_Version(
    Node    : in HND.Node_Type;
    Version : in SP.String_Type
    ) return SL.List;

--| Effects:
--| Return a list of version numbers of an item satifying the given condition.

--------------------------------------------------------------------------------

    procedure Iterate_Item(
    Library  : in     SP.String_Type;
    Item     : in     SP.String_Type;
    Iterator : in out HNM.Node_Iterator
    );

--| Effects:
--| Creates an iterator over all items satisfying the given codition.

--------------------------------------------------------------------------------

    procedure Open_Property_Node(
    Library : in     SP.String_Type;
    Keyword : in     SP.String_Type;
    Value   : in     SP.String_Type;
    Mode    : in     Edit_Mode;
    Node    : in out HND.Node_Type
    );

--| Effects:
--| Open the node handle for a node which has properties associated with it
--| for the given library

--------------------------------------------------------------------------------

    procedure Delete(
    Item_Node : in out HND.Node_Type;
    Versions  : in     SL.List;
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    );

--| Effects:
--| Delete the given version(s) of an item (given as a node handle).  Return
--| a list of list(s) containing item and version number that were not deleted.

--------------------------------------------------------------------------------

    procedure Purge(
    Library   : in     SP.String_Type;
    Item      : in     SP.String_Type := SP.Create("*");
    Privilege : in     Privilege_Type;
    Remainder : in out LL.List
    );

--| Effects:
--| Purge the given item. Return a list of list(s) containing item and version
--| number that were not purged.

--------------------------------------------------------------------------------

    procedure Rename_Item(
    Library   : in SP.String_Type;
    From_Item : in SP.String_Type;
    To_Item   : in SP.String_Type;
    Privilege : in Privilege_Type;
    Remainder : in out LL.List
    );

--| Effects:
--| Renames a given item in the item library.  Remainder is a list of lists
--| containing item/version of entities not renamed together with the reason.

--------------------------------------------------------------------------------

    procedure Rename_Version(
    Library      : in     SP.String_Type;
    Item         : in     SP.String_Type;
    From_Version : in     SP.String_Type;
    To_Version   : in     SP.String_Type;
    Privilege    : in     Privilege_Type;
    Remainder    : in out LL.List
    );

--| Effects:
--| Renames a given version of item(s) in the item library.  Remainder is a
--| list of lists containing item/version of entities not renamed together
--| with the reason.

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Node      : in HND.Node_Type
    ) return BOOLEAN;

--| Effects:
--| Verify that the given node may be deleted (purged) in terms of
--| ownership privileges.

--------------------------------------------------------------------------------

    function Privileged(
    Privilege : in Privilege_Type;
    Library   : in SP.String_Type;
    Item      : in SP.String_Type := SP.Create("");
    Version   : in STRING := ""
    ) return BOOLEAN;

--| Effects:
--| Verify that the given library, item in a library or a version of an item
--| in a library may be deleted (purged) in terms of ownership privileges.

--------------------------------------------------------------------------------

    function Get_Hif_File_Name(        --| return the hif file name for a Lib item
    Lib_Name : in SP.String_Type;    --| name of the Lib
    Item     : in SP.String_Type;    --| name of the item in the Lib
    Version  : in SP.String_Type    --| version number
    ) return SP.String_Type;

--| Effects:
--| Return the Hif file name for a particular version of a given item
--| in an item library.

--------------------------------------------------------------------------------

    function Is_Item_Checked_Out(    --| check if any items are checked out
    Library : in SP.String_Type    --| name of the library
    ) return BOOLEAN;

--| Effects:
--| Return TRUE if any item is checked out for update in the specified library.

--------------------------------------------------------------------------------

    procedure Display_List(        --| display a list of lists
    List   : in out LL.List;    --| list of lists
    Header : in     STRING        --| display header
    );

--| Effects:
--| Write Header and contents of a list of lists

--------------------------------------------------------------------------------

end Item_Library_Manager_Utilities;
                                                                    pragma page;
::::::::::::::
lock.bdy
::::::::::::::
with hif_node_management;
with hif_node_defs; use hif_node_defs;
with hif_attributes;
with hif_list_utils;
with host_system_calls;

package body catalog_locks is

--| Note: At this time the parameter max_wait on each of the locking
--| programs is not used.  It is in the spec in order to eliminate a lot
--| of modifications to other packages when a waiting procedure is
--| implemented.

package NM renames hif_node_management;
package ND renames hif_node_defs;
package Attr renames hif_attributes;
package LU renames hif_list_utils;
package HS renames host_system_calls;

function write_lock (
    max_wait : duration
    ) return boolean is

--| Effects: Puts a write lock on the root of the catalog and returns true
--| if the lock is able to be set.  It returns false if for any reason the
--| lock cannot be set.  No operations can be performed if the lock is not
--| set.  This is the default lock for creating a catalog.
    node : node_type;
    list : LU.list_type;
    user : string (1..20);    -- picked 20 as I don't think there are any
                -- operating systems that allow user ids longer
    last : natural;
    iter : NM.node_iterator;

    begin
    NM.get_current_node (node);
    -- node is the current node.  The write lock will be a relation from
    -- this node to itself with the name write lock.  The key will be
    -- empty and it must not already exist.
    NM.link (to_node => node,
         new_base => node,
         key => "",
         relation => "write_lock",
           requirement => must_not_exist);
    LU.init_list (list);
    -- put the user id of the person setting the lock as an attribute on
    -- the lock path itself.
    HS.get_username (user, last);
    LU.add_positional (list, user (1..last));
    Attr.set_path_attribute (current_node & "'write_lock()",
                 "userid",
                 list);
    -- At this point the write lock is set.  If there was already a
    -- write lock the link would have failed, and once the link is there
    -- another cannot be put on.  However, the presence of read_locks
    -- would make the write lock invalid.  So make an iterator of
    -- relations with the name "read_lock" and if there are any remove
    -- the write lock.
    NM.iterate(iter, node, relation => "read_lock", primary_only => false);
    if NM.more (iter) then
        NM.unlink (node, relation => "write_lock");
        return false;
    end if;
    -- ok the write lock is set, there are no read_locks so true can
    -- be returned.
    return true;
    exception
        when ND.name_error =>
    -- the relation already existed, so the new one couldn't be made
        return false;
    end;

function read_lock (
    max_wait : duration
    ) return boolean is

--| Effects: Puts a read lock on the root of the catalog and returns true
--| if the lock is able to be set.  It returns false if for any reason the
--| lock cannot be set.  No operations can be performed if the lock is not
--| set.  The default when entering the catalog is a read lock.

    node : node_type;
    list : LU.list_type;
    user : string (1..20);    -- picked 20 as I don't think there are any
                -- operating systems that allow user ids longer
    last : natural;

    begin
    --| Algorithm: First it must set a temporary write lock so that some
    --| one trying to get a write lock at the same time won't mess things
    --| up.  When the write lock is in place add a read_lock.  When the
    --| read lock is set release the write lock.
    NM.get_current_node (node);
    -- node is the current node.  The write lock will be a relation from
    -- this node to itself with the name write lock.  The key will be
    -- empty and it must not already exist.
    NM.link (to_node => node,
         new_base => node,
         key => "",
         relation => "write_lock",
           requirement => must_not_exist);
    LU.init_list (list);
    HS.get_username (user, last);
    LU.add_positional (list, user (1..last));
    Attr.set_path_attribute (current_node & "'write_lock()",
                 "userid",
                 list);
    -- The write lock is set.
    begin
        NM.link (to_node => node,
         new_base => node,
         key => user (1..last),
         relation => "read_lock",
         requirement => must_not_exist);
    exception
        when ND.name_error =>
        -- this name error occurs when the relation read_lock(user) for
        -- this user already exists
        NM.unlink (node, relation => "write_lock");
        raise lock_already_exists;
    end;
    -- the read_lock is set
    NM.unlink (node, relation => "write_lock");
    return true;
    -- the read_lock is set, the temporary write lock removed so
    -- everything is done.
    exception
    when ND.name_error =>
        -- the write lock failed so someone else has a write lock and
        -- this user cannot have a read_lock anyway.
        return false;
    end read_lock;

function upgrade_lock (
    max_wait : duration
    ) return boolean is

--| Effects: Upgrades a read lock by a person to a write lock.  Since the
--| default lock for the catalog is the read lock there needs to be some
--| way to upgrade to a write lock when the user tries to perform an
--| operation which requires a write lock.  This function returns true if
--| the lcok can be placed, and false if for any reason the lock fails.
--| The read lock cannot be upgraded if any other user has a read lock.
    node : node_type;
    list : LU.list_type;
    user : string (1..20);    -- picked 20 as I don't think there are any
                -- operating systems that allow user ids longer
    last : natural;
    iter : NM.node_iterator;
    read_node : node_type;

    begin
    NM.get_current_node (node);
    -- node is the current node.  The write lock will be a relation from
    -- this node to itself with the name write lock.  The key will be
    -- empty and it must not already exist.
    NM.link (to_node => node,
         new_base => node,
         key => "",
         relation => "write_lock",
           requirement => must_not_exist);
    LU.init_list (list);
    HS.get_username (user, last);
    LU.add_positional (list, user (1..last));
    Attr.set_path_attribute (current_node & "'write_lock()",
                 "userid",
                 list);
    -- Note that if anyone other than the current user has a read lock the
    -- write lock is invalid.  So iterate over the current read locks and
    -- remove the write lock if any is not the same as the current user.
    NM.iterate(iter, node, relation => "read_lock", primary_only => false);
    while NM.more (iter) loop
        NM.get_next (iter, read_node);
        if NM.path_key (read_node) /= user (1..last) then
        -- you can't have a write lock if some one else has a read_lock
        NM.unlink (node, relation => "write_lock");
        return false;
        end if;
    end loop;
    -- the write lock is set.  The current user is the only one with a
    -- read lock so the write lock is ok.
    return true;
    exception
    when ND.name_error =>
        -- write lock is not unique
        return false;
    end upgrade_lock;

    procedure remove_write is

    node : node_type;
    list : LU.list_type;
    user : string (1..20);    -- picked 20 as I don't think there are any
                -- operating systems that allow user ids longer
    last : natural;

    begin
    -- This would just be a simple unlink except that a user shouldn't be
    -- able to remove another person's lock.  So first get all the
    -- information from the path and check it.
    NM.get_current_node (node);
    HS.get_username (user, last);
    Attr.get_path_attribute (current_node & "'write_lock", "userid", list);
    if LU.identifier(LU.positional(list, 1)) /= user (1..last) then
    -- if the userid on the lock doesn't match the current user this
    -- user cannot remove the lock
        raise unauthorized;
    end if;
    NM.unlink (node, relation => "write_lock");
    exception
    when ND.name_error =>
        raise lock_doesnt_exist;
    end remove_write;

    procedure remove_read is

    node : node_type;
    user : string (1..20);    -- picked 20 as I don't think there are any
                -- operating systems that allow user ids longer
    last : natural;

    begin
    NM.get_current_node (node);
    HS.get_username (user, last);
    NM.unlink (node, key => user(1..last), relation => "read_lock");
    exception
    when ND.name_error =>
        raise lock_doesnt_exist;
    end remove_read;

procedure get_write_user (    --| Get the name of the user that owns the
                --| write lock
    user : in out SP.string_type--| name of the user
    ) is

    list : LU.list_type;

    begin
    Attr.get_path_attribute (current_node & "'write_lock", "userid", list);
        user := SP.create (LU.identifier (LU.positional (list, 1)));
    end get_write_user;

end catalog_locks;
::::::::::::::
lock.spc
::::::::::::::
with string_pkg;

package  catalog_locks is

---- Package renames:

package SP renames string_pkg;

---- Exception declarations:

unauthorized : exception;    -- raised when someone tries to remove a
                -- write lock they don't own
lock_doesnt_exist : exception;    -- raised when the lock doesn't exist
lock_already_exists : exception;-- raised when the lock already exists

---- Declarations of visible subprograms:

function write_lock (
    max_wait : duration
    ) return boolean;

--| Effects: Puts a write lock on the root of the catalog and returns true
--| if the lock is able to be set.  It returns false if for any reason the
--| lock cannot be set.  No operations can be performed if the lock is not
--| set.  This is the default lock for creating a catalog.

function read_lock (
    max_wait : duration
    ) return boolean;

--| Effects: Puts a read lock on the root of the catalog and returns true
--| if the lock is able to be set.  It returns false if for any reason the
--| lock cannot be set.  No operations can be performed if the lock is not
--| set.  The default when entering the catalog is a read lock.

function upgrade_lock (
    max_wait : duration
    ) return boolean;

--| Effects: Upgrades a read lock by a person to a write lock.  Since the
--| default lock for the catalog is the read lock there needs to be some
--| way to upgrade to a write lock when the user tries to perform an
--| operation which requires a write lock.  This function returns true if
--| the lcok can be placed, and false if for any reason the lock fails.
--| The read lock cannot be upgraded if any other user has a read lock.

procedure remove_write;

--| Effects: removes a write lock owned by the person invcoking it.
--| raises unauthorized if the person doesn't own the write lock.
--| Also, it just removes the write lock, so someone that upgraded
--| a read to a write still has the read lock in place.

procedure remove_read;

--| Effects: removes a read lock belonging to the current user.  If the
--| person does not have a read lock, lock_doesnt_exist is raised.

procedure get_write_user (    --| Get the name of the user that owns the
                --| write lock
    user : in out SP.string_type--| name of the user
    );

end catalog_locks;
::::::::::::::
modifyp.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Declarations;

function Modify_Property return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package STR is new SI.String_Argument(
                String_Type_Name => "string");

    Modify_Property_Process : SI.Process_Handle;
    Library                 : SP.String_Type;
    Keyword                 : SP.String_Type;
    Value                   : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Modify_Property_Process,
    Name    => "Modify_Property",
    Help    => "Change a Property Keyword/Value in the Item Library");

    LIB.Define_Argument(
    Proc => Modify_Property_Process,
    Name => "library",
    Help => "Name of the item library");

    STR.Define_Argument(
    Proc    => Modify_Property_Process,
    Name    => "keyword",
    Help    => "Property keyword");

    STR.Define_Argument(
    Proc    => Modify_Property_Process,
    Name    => "value",
    Help    => "Property value");

    SP.Release;

    SI.Parse_Line(Modify_Property_Process);

    Library := LIB.Get_Argument(
            Proc => Modify_Property_Process,
            Name => "library");

    Keyword := STR.Get_Argument(
            Proc => Modify_Property_Process,
            Name => "keyword");

    Value := STR.Get_Argument(
            Proc => Modify_Property_Process,
            Name => "value");

    ILM.Modify_Property(Library   => Library,
            Keyword   => Keyword,
            Value     => Value,
            Privilege => ILD.OWNER);
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Keyword =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) & """ invalid.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Value =>
        HL.Put_Error("Property value """ & SP.Value(SP.Upper(Value)) & """ invalid.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Keyword_Not_Found =>
        HL.Put_Error("Property keyword """ & SP.Value(SP.Upper(Keyword)) &
             """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Modify Property internal error.");
    return HL.Return_Code(HL.SEVERE);

end Modify_Property;

::::::::::::::
modifyp.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;
with HIF_List_Utils;

function Modify_Property_Interface(
    Library   : in String_Pkg.String_Type;
    Keyword   : in String_Pkg.String_Type;
    Value     : in String_Pkg.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;
    package HLU renames HIF_List_Utils;

    Node : HND.Node_Type;
    Trap : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    if not LU.Privileged(Privilege, Library) then
    raise No_Privilege;
    end if;
    LU.Open_Property_Node(Library, Keyword, Value, MODIFY, Node);
    HA.Set_Node_Attribute(Node   => Node,
              Attrib => SP.Value(Keyword),
              Value  => HLU.To_List(SP.Value(Value)));
    HNM.Close_Node_Handle(Node);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Property " & SP.Value(SP.Upper(Keyword)) &
        " changed to value " & SP.Value(SP.Upper(Value)) &
        " for library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Keyword =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Keyword, Keyword);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Value =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_Value, Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Keyword_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Keyword_Not_Found, Keyword);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Modify_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Modify_Property"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Modify_Property_Interface;
                                                                    pragma page;
::::::::::::::
modifyp.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Modify_Property_Interface(        --| Change Property Keyword/Value
    Library   : in String_Pkg.String_Type;    --| Item library
    Keyword   : in String_Pkg.String_Type;    --| Property keyword
    Value     : in String_Pkg.String_Type;    --| Property value
    Privilege : in Privilege_Type := WORLD    --| Modify privilege
    ) return Host_Lib.Severity_Code;

--| Requires:
--| The names of the library, and the keyword-value pair.

--| Effects:
--| The value of the keyword-value pair associated with the specified item
--| in the library is changed.

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
opencat.ada
::::::::::::::

--------- SPEC ----------------------------------------------------------

function open_catalog return INTEGER;

--------- BODY ----------------------------------------------------------

with Standard_Interface;
with Tool_Identifier;
with String_Pkg;
with Host_Lib;
with catalog_interface;

function open_catalog return INTEGER is

    package SP renames String_Pkg;
    package CI renames catalog_interface;
    package SI renames Standard_Interface;

    package input is new SI.String_Argument(        -- instantiate with
    String_Type_Name => "string");            -- subtype string


    process      : SI.Process_Handle;    -- handle to process structure
    catalog     : SP.string_type;    -- name of the catalog

begin

    SI.set_tool_identifier (Tool_Identifier);
    SI.Define_Process(            -- define this process
    Name    => "open_catalog",    -- name of the process
    Help    => "Open a configuration item catalog",
    Proc    => process);        -- handle to be returned

    Input.Define_Argument(    -- define the first argument
    Proc => Process,        -- process
    Name => "catalog_name",        -- name of the argument
    Help => "Name of the catalog to be opened");

    SI.define_help (process,
    "Opens the specified catalog and places the user in interactive");
    SI.append_help (process,
    "mode.  The name given must belong to an existent catalog.");
    SI.append_help (process,
    "Create_Catalog should be run first if the catalog does not exist");
    SI.append_help (process,
    "The user must be a document system manager user to run this tool");
    SI.append_help (process,
    "(see Add_User).");

    SI.Parse_Line(Process);        -- parse the command line

    catalog := Input.Get_Argument(    -- get the first argument
            Proc => Process,
            Name => "catalog_name");

    SI.Undefine_Process(Proc => Process);    -- destroy the process block

    CI.open_catalog (catalog);

    return Host_Lib.Return_Code(Host_Lib.SUCCESS);-- return successful return code

exception

    when SI.Process_Help =>
    --
    -- Help message was printed
    --
    return Host_Lib.Return_Code(Host_Lib.INFORMATION);

    when SI.Abort_Process =>
    --
    -- Parse error
    --
    return Host_Lib.Return_Code(Host_Lib.ERROR);

end open_catalog;
::::::::::::::
paginate.ada
::::::::::::::
with TEXT_IO;
with Standard_Interface;
with String_Pkg;
with String_Lists;
with String_Utilities;
with File_Manager;
with Paginated_Output;
with Host_Lib;


function Paginate return INTEGER is

    subtype Page_Number is INTEGER range 1 .. 999;
    subtype Margin_Number is INTEGER range 0 .. 20;
    type Switch is (ON, OFF);

    package TIO        renames TEXT_IO;
    package SP         renames String_Pkg;
    package SL         renames STRING_Lists;
    package SU         renames String_Utilities;
    package FM         renames File_Manager;
    package PO         renames Paginated_Output;
    package HL         renames Host_Lib;
    package Sources    is new Standard_Interface.String_List_Argument(
                String_Type_Name => "file_name",
                String_Type_List => "source_list");
    package Output     is new Standard_Interface.String_Argument(
                String_Type_Name => "file_name");
    package Stringtype is new Standard_Interface.String_Argument(
                String_Type_Name => "string");
    package Pagetype   is new Standard_Interface.Integer_Argument(
                Integer_Type      =>  Page_Number,
                Integer_Type_Name => "page_type");
    package Margintype is new Standard_Interface.Integer_Argument(
                Integer_Type      =>  Margin_Number,
                Integer_Type_Name => "margin_type");
    package Numbertype is new Standard_Interface.Enumerated_Argument(
                Enum_Type      =>  Switch,
                Enum_Type_Name => "switch");


    Paginate_Process : Standard_Interface.Process_Handle;
    Found            : BOOLEAN;
    Files            : SL.List;
    File_List        : SL.List := SL.Create;
    File_Name        : SP.String_Type;
    File_Iter        : SL.ListIter;
    Out_File         : SP.String_Type;
    Out_Handle       : PO.Paginated_File_Handle;
    Header           : SP.String_Type;
    Footer           : SP.String_Type;
    Page             : INTEGER;
    Margin           : INTEGER;
    Input_Line       : STRING (1 .. 512);
    Input_Len        : INTEGER;
    File_Type        : TIO.FILE_TYPE;
    File_Mode        : TIO.FILE_MODE    := TIO.IN_FILE;
    Line_Num         : NATURAL;
    Numbering        : Switch;
    Status           : HL.Severity_Code := HL.SUCCESS;
                                                                    pragma page;
begin  -- procedure MAIN

    SP.Mark;

    Standard_Interface.Set_Tool_Identifier(
    Identifier => "1.00");

    Standard_Interface.Define_Process(
    Proc    => Paginate_Process,
    Name    => "Paginate",
    Help    => "Formats file(s) as specified");

    Sources.Define_Argument(
    Proc => Paginate_Process,
    Name => "source_list",
    Help => "List of file name(s) to be formatted");

    Output.Define_Argument(
    Proc => Paginate_Process,
    Name => "output",
    Help => "Output file name (defaults to standard output)");

    Stringtype.Define_Argument(
    Proc    => Paginate_Process,
    Name    => "header",
    Default => "~F(L50) ~D  ~T   Page ~P(R3)",
    Help    => "Header text");

    Stringtype.Define_Argument(
    Proc    => Paginate_Process,
    Name    => "footer",
    Default => "",
    Help    => "Footer text");

    Pagetype.Define_Argument(
    Proc    => Paginate_Process,
    Name    => "page",
    Default => 60,
    Help    => "Number of lines per page (excluding header/footer)");

    Margintype.Define_Argument(
    Proc    => Paginate_Process,
    Name    => "margin",
    Default => 0,
    Help    => "Left margin size");

    Numbertype.Define_Argument(
    Proc    => Paginate_Process,
    Name    => "number",
    Default => off,
    Help    => "Line numbering");

    Standard_Interface.Parse_Line(Paginate_Process);

    Files    := Sources.Get_Argument(
            Proc => Paginate_Process,
            Name => "source_list");

    Out_File := Output.Get_Argument(
            Proc => Paginate_Process,
            Name => "output");

    Page     := Pagetype.Get_Argument(
            Proc => Paginate_Process,
            Name => "page");

    Margin   := Margintype.Get_Argument(
            Proc => Paginate_Process,
            Name => "margin");

    Header   := Stringtype.Get_Argument(
            Proc => Paginate_Process,
            Name => "header");

    Footer   := Stringtype.Get_Argument(
            Proc => Paginate_Process,
            Name => "footer");

    Numbering := Numbertype.Get_Argument(
            Proc => Paginate_Process,
            Name => "number");

    SP.Release;

    HL.Set_Error;

    File_Iter := SL.MakeListIter(Files);
    while SL.More(File_Iter) loop
    SP.Mark;
    SL.Next(File_Iter, File_Name);
    begin
        SL.Attach(File_List, FM.Expand(SP.Value(File_Name)));
    exception
        when FM.Directory_Not_Found |
         FM.Expand_Error        |
         FM.File_Name_Error     |
         FM.Parse_Error         =>
        HL.Put_Message_Line("Warning : Invalid file name " & SP.Value(File_Name) & ".");
        Status := HL.WARNING;
        when FM.File_Not_Found =>
        HL.Put_Message_Line("Warning : Input file " & SP.Value(File_Name) & " not found.");
        Status := HL.WARNING;
    end;
    SP.Release;
    end loop;

    if not SL.IsEmpty(File_List) then
    PO.Create_Paginated_File(SP.Value(Out_File), Out_Handle, Page+6, 3, 3);
    PO.Set_Header(Out_Handle, 2, Header);
    PO.Set_Footer(Out_Handle, 2, Footer);
    else
    HL.Put_Error("No input files to print.");
    Status := HL.ERROR;
    end if;

    File_Iter := SL.MakeListIter(File_List);
    while SL.More(File_Iter) loop
    SP.Mark;
    SL.Next(File_Iter, File_Name);
    TIO.Open(File_Type, File_Mode, SP.Value(File_Name), "");
    PO.Set_File_Name(Out_Handle, SP.Value(File_Name));
    SP.Release;
    Line_Num := 1;
    begin
        loop
        PO.Space(Out_Handle, Margin);
        if Numbering = ON then
            PO.Put(Out_Handle, STRING'(SU.Image(Line_Num, 5)));
            PO.Space(Out_Handle, 3);
            Line_Num := Line_Num + 1;
        end if;
        TIO.Get_Line(File_Type, Input_Line, Input_Len);
         PO.Put_Line(Out_Handle, Input_Line(1 .. Input_Len));
        end loop;
    exception
        when TIO.End_Error =>
        TIO.Close(File_Type);
        PO.Put_Page(Out_Handle);
    end;
    end loop;

    return HL.Return_Code(Status);

exception

    when TIO.Status_Error =>
        HL.Put_Error("File " & SP.Value(File_Name) & " already open.");
    return HL.Return_Code(HL.ERROR);

    when TIO.Name_Error =>
        HL.Put_Error("Unable to open file " & SP.Value(File_Name) & " for input.");
    return HL.Return_Code(HL.ERROR);

    when TIO.Use_Error =>
        HL.Put_Error("Invalid file name " & SP.Value(File_Name) & ".");
    return HL.Return_Code(HL.ERROR);

    when PO.File_Already_Open =>
        HL.Put_Error("File " & SP.Value(Out_File) & " already open.");
    return HL.Return_Code(HL.ERROR);

    when PO.File_Error =>
        HL.Put_Error("Unable to open " & SP.Value(Out_File) & " for output.");
    return HL.Return_Code(HL.ERROR);

    when Standard_Interface.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when Standard_Interface.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Paginate internal error.");
    return HL.Return_Code(HL.SEVERE);

end Paginate;
                                                                    pragma page;
::::::::::::::
prop.bdy
::::::::::::::

package body properties is

use string_pkg;

function "<" (        --| returns true if two properties have the same
            --| keyword.
    p1 : in property;
    p2 : in property
    ) return boolean is

    begin
    return (p1.key < p2.key);
    end "<";

function image (    --| returns a string representation of the property.
            --| keyword first, value second
    p : in property
    ) return string is

    s : SP.string_type;
    begin
    s := p.key & " - " & p.val;
    return SP.value (s);
    end image;

end properties;
::::::::::::::
prop.spc
::::::::::::::
with string_pkg;

package properties is

package SP renames string_pkg;

type property is
    record
    key : SP.string_type;
    val : SP.string_type;
    end record;

function "<" (        --| returns true if two properties have the same
            --| keyword.
    p1 : in property;
    p2 : in property
    ) return boolean;

function image (    --| returns a string representation of the property.
            --| keyword first, value second
    p : in property
    ) return string;

end properties;

with orderedsets;
with properties;

package property_set is new orderedsets (properties.property, properties."<");
::::::::::::::
purgei.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Utilities;
with Item_Library_Manager_Declarations;

function Purge_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILU renames Item_Library_Manager_Utilities;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(
                String_Type_Name => "item_name");

    Purge_Item_Process : SI.Process_Handle;
    Library            : SP.String_Type;
    Item               : SP.String_Type;
    List               : ILD.LL.List;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Purge_Item_Process,
    Name    => "Purge_Item",
    Help    => "Purge Item(s) in an Item Library");

    LIB.Define_Argument(
    Proc => Purge_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc => Purge_Item_Process,
    Name => "item",
    Help => "Name of the item(s) to be purged in the item library");

    SP.Release;

    SI.Parse_Line(Purge_Item_Process);

    Library := LIB.Get_Argument(
            Proc => Purge_Item_Process,
            Name => "library");

    Item := ITM.Get_Argument(
            Proc => Purge_Item_Process,
            Name => "item");

    ILM.Purge_Item(Library   => Library,
           Item      => Item,
           Privilege => ILD.OWNER,
           Remainder => List);

    if not ILD.LL.IsEmpty(List) then
    ILU.Display_List(List, "Item/Version not purged");
    ILD.Destroy_List_of_Lists(List);
    else
        HL.Put_Message_Line("Item """ & SP.Value(SP.Upper(Item)) & """ purged.");
    end if;
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Not_Found =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Checked_Out =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ checked out.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Purge Item internal error.");
    return HL.Return_Code(HL.SEVERE);

end Purge_Item;

::::::::::::::
purgei.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;

function Purge_Item_Interface(
    Library   : in String_Pkg.String_Type;
    Item      : in String_Pkg.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;

    List_of_Lists : LL.List;
    Trap          : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    LU.Purge(Library, Item, Privilege, List_of_Lists);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if not LL.IsEmpty(List_of_Lists) then
    if Message_on_Error then
        LU.Display_List(List_of_Lists, "Item/Version not purged");
    end if;
    elsif Message_on_Completion then
        HL.Put_Message_Line(
        "Item " & SP.Value(SP.Upper(Item)) &
        " purged in library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Found, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Checked_Out =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Checked_Out, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Purge_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Purge_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Purge_Item_Interface;
                                                                    pragma page;
::::::::::::::
purgei.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Purge_Item_Interface(            --| Purge Item(s)
    Library   : in String_Pkg.String_Type;    --| Item library
    Item      : in String_Pkg.String_Type;    --| Item (s) to be purged
    Privilege : in Privilege_Type := WORLD    --| Purge privilege
    ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the libray, and name of the item

--| Effects:
--| Purges (delete all but the current version) item(s) of the library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
rdparser.bdy
::::::::::::::
with ci_index_mgr;

package body rd_parser is

package CI renames ci_index_mgr;

procedure parse (s : in string_pkg.string_type) is

    set1 : ci_set;
    begin
    scan := SS.make_scanner (s);
    advance;
    expression (set1);
    -- when expression gets done the whole expression should have been
    -- evaluated so set1 is the final result.  Set1 should then be made
    -- the current_set.  If the whole expression was not evaluated it is
    -- a parse_error
    if token.term /= EOS then
        raise parse_error;
       end if;
    current_set := CS.copy(set1);
    CS.destroy (set1);
    end parse;

procedure clear_set is
    begin
    CS.destroy (current_set);
    end clear_set;

procedure expression (set : in out ci_set) is

    set2 : ci_set;
    begin
    factor (set);
    expression_prime (set, set2);
    end expression;

procedure expression_prime (
    set1 : in out ci_set;
    set2 : in out ci_set
    ) is

    operation   : op_type;
    begin

    if token.term = intersect or token.term = union then
        operation := token.term;
        advance;
        expression (set2);
        eval_operation (set1, set2, operation);
        expression_prime (set1, set2);
    end if;
    end expression_prime;

procedure factor (
    set : in out ci_set
    ) is

    begin
    if token.term = terminal then
        set := CS.copy(token.set);
        advance;
    elsif token.term = left_paren then
        advance;
        expression (set);
        if token.term = right_paren then
        advance;
        else
        raise parse_error;
        end if;
    else
        raise parse_error;
    end if;
    end factor;

procedure advance is

    char : character;
    begin
    if SU.more(scan) then
    SU.skip_space(scan);
    char := SU.get (scan);
    case char is
        when '(' =>
        token.term := left_paren;
        SU.forward (scan);
        when ')' =>
        token.term := right_paren;
        SU.forward (scan);
        when '&' =>
        token.term := intersect;
        SU.forward (scan);
        when '|' =>
        token.term := union;
        SU.forward (scan);
        when others =>
        token.set := scan_phrase;
        token.term := terminal;
    end case;
    else
    token.term := EOS;    -- end of string
    end if;
    end advance;

function scan_phrase return ci_set is

    key   : SP.string_type;
    value : SP.string_type;
    found : boolean;
    skip  : boolean := true;
    char  : character;
    begin
    SS.scan_ada_id (scan, found, key, skip);
    -- the first ada id can either be the reserved word CURRENT_SET or
    -- the keyword in a phrase like "language = ada"
    if not found then
        raise parse_error;
    end if;
    if SP.equal(SP.upper(key),SP.create("CURRENT_SET")) then
        -- if the id is CURRENT_SET then return current set.
        return current_set;
    else
        -- otherwise scan the rest of the string for the rest of the phrase
        -- if at any point it finds anything other than an '=' or an ada id
        -- it is a parse_error.
        while SU.more (scan) loop
        SU.next (scan, char);
        exit when char = '=';
        if char /= ' ' then
            raise parse_error;
        end if;
        end loop;
        SS.scan_ada_id (scan, found, value, skip);
        if not found then
        raise parse_error;
        end if;
        return CI.lookup_ci(key, value);
    end if;
    end scan_phrase;

procedure eval_operation (
    set1 : in out ci_set;
    set2 : in out ci_set;
    operation : in op_type
    ) is

    begin
    if operation = intersect then
        set1 := CS.intersect(set1, set2);
        CS.destroy (set2);
    else
        set1 := CS.union (set1, set2);
        CS.destroy (set2);
    end if;
    end eval_operation;

end rd_parser;
::::::::::::::
rdparser.spc
::::::::::::::
with string_pkg;
with catalog_decls;  use catalog_decls;
with string_utilities;

package rd_parser is

-- This is the grammar for the following procedures
-- terminal     ::= phrase or CURRENT_SET
-- op       ::= &  or  |
-- factor     ::= terminal or ( expression )
-- expression   ::= factor expression'
-- expression'  ::= op expression expression'  or  null

package SU renames string_utilities;
package SP renames string_pkg;
package CS renames ci_sets;        -- a type in catalog_decls

package SS is new SU.generic_string_utilities (SP.string_type,
                           SP.make_persistent,
                           SP.value);

type token_type is (terminal, union, intersect, left_paren, right_paren, eos);
subtype op_type is token_type range union..intersect;
type terminal_type is
    record
    term : token_type;
    set  : ci_set;
    end record;

parse_error : exception;    -- raised when ever there is an error

token         : terminal_type;
scan          : SU.scanner;
current_set : ci_set;

procedure parse (s : in string_pkg.string_type);

procedure clear_set;

procedure expression (    --| Parses a selection criteria expression
    set : in out ci_set
    );

procedure expression_prime (    --| Parses a prime expression
    set1 : in out ci_set;
    set2 : in out ci_set
    );

procedure factor (    --| Parses a factor
    set : in out ci_set
    );

procedure advance;    --| advances to the next token

function scan_phrase return ci_set;
            --| scans a phrase and returns the set indicated by the
            --| phrase

procedure eval_operation (    --| evaluates an expression according to the
                --| operation indicated and the two sets
    set1 : in out ci_set;
    set2 : in out ci_set;
    operation : in op_type
    );

end rd_parser;

::::::::::::::
renamei.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Utilities;
with Item_Library_Manager_Declarations;

function Rename_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILU renames Item_Library_Manager_Utilities;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(
                String_Type_Name => "item_name");

    Rename_Item_Process : SI.Process_Handle;
    Library             : SP.String_Type;
    From_Item           : SP.String_Type;
    To_Item             : SP.String_Type;
    List                : ILD.LL.List;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Rename_Item_Process,
    Name    => "Rename_Item",
    Help    => "Rename an Item in an Item Library");

    LIB.Define_Argument(
    Proc => Rename_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc => Rename_Item_Process,
    Name => "from_item",
    Help => "Name of the item to be renamed in the item library");

    ITM.Define_Argument(
    Proc => Rename_Item_Process,
    Name => "to_item",
    Help => "New item name");

    SP.Release;

    SI.Parse_Line(Rename_Item_Process);

    Library := LIB.Get_Argument(
            Proc => Rename_Item_Process,
            Name => "library");

    From_Item := ITM.Get_Argument(
            Proc => Rename_Item_Process,
            Name => "from_item");

    To_Item := ITM.Get_Argument(
            Proc => Rename_Item_Process,
            Name => "to_item");

    ILM.Rename_Item(Library   => Library,
            From_Item => From_Item,
            To_Item   => To_Item,
            Privilege => ILD.OWNER,
            Remainder => List);

    if not ILD.LL.IsEmpty(List) then
    ILU.Display_List(List, "Item/Version not renamed");
    ILD.Destroy_List_of_Lists(List);
    else
        HL.Put_Message_Line("Item """ & SP.Value(SP.Upper(From_Item)) &
             """ renamed to """ & SP.Value(SP.Upper(To_Item)) &
             """.");
    end if;
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Not_Found =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(From_Item)) & """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Checked_Out =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(From_Item)) & """ checked out.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Already_Exists =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(To_Item)) & """ already exists.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Rename Item internal error.");
    return HL.Return_Code(HL.SEVERE);

end Rename_Item;

::::::::::::::
renamei.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;

function Rename_Item_Interface(
    Library   : in String_Pkg.String_Type;
    From_Item : in String_Pkg.String_Type;
    To_Item   : in String_Pkg.String_Type;
    Privilege : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;

    List_of_Lists : LL.List;
    Trap          : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    if not LU.Privileged(Privilege, Library) then
    raise No_Privilege;
    end if;
    LU.Rename_Item(Library, From_Item, To_Item, Privilege, List_of_Lists);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if not LL.IsEmpty(List_of_Lists) then
    if Message_on_Error then
        LU.Display_List(List_of_Lists, "Item/Version not renamed");
    end if;
    elsif Message_on_Completion then
        HL.Put_Message_Line(
        "Item " & SP.Value(SP.Upper(From_Item)) &
        " renamed to " & SP.Value(SP.Upper(To_Item)) &
        " in library " & SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Found, From_Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Checked_Out =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Checked_Out, From_Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Already_Exists =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Already_Exists, To_Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Rename_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Rename_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Rename_Item_Interface;
                                                                    pragma page;
::::::::::::::
renamei.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Rename_Item_Interface(            --| Rename Item
    Library   : in String_Pkg.String_Type;    --| Item library
    From_Item : in String_Pkg.String_Type;    --| Item to be renamed
    To_Item   : in String_Pkg.String_Type;    --| New item name
    Privilege : in Privilege_Type := WORLD    --| Rename privilege
    ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the libray, item name to be renamed, and the new item name

--| Effects:
--| Renames item in the library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
renamev.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Utilities;
with Item_Library_Manager_Declarations;

function Rename_Version return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package ILM renames Item_Library_Manager;
    package ILU renames Item_Library_Manager_Utilities;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(
                String_Type_Name => "item_name");
    package VER is new SI.String_Argument(
                String_Type_Name => "version");

    Rename_Version_Process : SI.Process_Handle;
    Library                : SP.String_Type;
    Item                   : SP.String_Type;
    From_Version           : SP.String_Type;
    To_Version             : SP.String_Type;
    List                   : ILD.LL.List;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Rename_Version_Process,
    Name    => "Rename_Version",
    Help    => "Rename Version of Item(s) in an Item Library");

    LIB.Define_Argument(
    Proc => Rename_Version_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc => Rename_Version_Process,
    Name => "item",
    Help => "Name of the item(s) to be renamed in the item library");

    VER.Define_Argument(
    Proc => Rename_Version_Process,
    Name => "from_version",
    Help => "Version of item(s) to be renamed");

    VER.Define_Argument(
    Proc => Rename_Version_Process,
    Name => "to_version",
    Help => "New version of item(s)");

    SP.Release;

    SI.Parse_Line(Rename_Version_Process);

    Library := LIB.Get_Argument(
            Proc => Rename_Version_Process,
            Name => "library");

    Item := ITM.Get_Argument(
            Proc => Rename_Version_Process,
            Name => "item");

    From_Version := VER.Get_Argument(
            Proc => Rename_Version_Process,
            Name => "from_version");

    To_Version := VER.Get_Argument(
            Proc => Rename_Version_Process,
            Name => "to_version");

    ILM.Rename_Version(Library      => Library,
               Item         => Item,
               From_Version => From_Version,
               To_Version   => To_Version,
               Privilege    => ILD.OWNER,
               Remainder    => List);

    if not ILD.LL.IsEmpty(List) then
    ILU.Display_List(List, "Item/Version not renamed");
    ILD.Destroy_List_of_Lists(List);
    else
        HL.Put_Message_Line("Item """ &
             SP.Value(SP.Upper(Item)) & '/' & SP.Value(SP.Upper(From_Version)) &
             """ renamed to """ &
             SP.Value(SP.Upper(Item)) & '/' & SP.Value(SP.Upper(To_Version)) &
             '.');
    end if;
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Not_Found =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Checked_Out =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ checked out.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Version =>
    HL.Put_Error("Invalid version specification.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Version_Not_Found =>
    HL.Put_Error("Version not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Rename Version internal error.");
    return HL.Return_Code(HL.SEVERE);

end Rename_Version;

::::::::::::::
renamev.bdy
::::::::::::::
with Library_Errors;
with Library_Utilities;

function Rename_Version_Interface(
    Library      : in String_Pkg.String_Type;
    Item         : in String_Pkg.String_Type;
    From_Version : in String_Pkg.String_Type;
    To_Version   : in String_Pkg.String_Type;
    Privilege    : in Privilege_Type := WORLD
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;

    List_of_Lists  : LL.List;
    Version_Number : INTEGER;
    Trap           : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    if not LU.Privileged(Privilege, Library) then
    raise No_Privilege;
    end if;
    LU.Rename_Version(Library, Item, From_Version, To_Version, Privilege, List_of_Lists);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if not LL.IsEmpty(List_of_Lists) then
    if Message_on_Error then
        LU.Display_List(List_of_Lists, "Item/Version not renamed");
    end if;
    elsif Message_on_Completion then
        HL.Put_Message_Line("Item(s) renamed to version " & SP.Value(To_Version) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Found, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Version =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    begin
        Version_Number := INTEGER'value(SP.Value(From_Version));
    exception
        when others =>
        if not SP.Is_Empty(From_Version) then
            LE.Report_Error(LE.Invalid_Version, From_Version);
        end if;
    end;
    begin
        Version_Number := INTEGER'value(SP.Value(To_Version));
    exception
        when others =>
        if not SP.Is_Empty(To_Version) then
            LE.Report_Error(LE.Invalid_Version, To_Version);
        end if;
    end;
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Version_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Version_Not_Found, From_Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when No_Privilege =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.No_Privilege, Library, SP.Create(LU.Get_Library_Attribute(Library, "OWNER")));
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Rename_Version"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Rename_Version"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Rename_Version_Interface;
                                                                    pragma page;
::::::::::::::
renamev.spc
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with String_Pkg;
with Host_Lib;

function Rename_Version_Interface(        --| Rename Version of Item(s)
    Library      : in String_Pkg.String_Type;    --| Item library
    Item         : in String_Pkg.String_Type;    --| Item(s) to be renamed
    From_Version : in String_Pkg.String_Type;    --| Version of item(s)
    To_Version   : in String_Pkg.String_Type;    --| New version of item(s)
    Privilege    : in Privilege_Type := WORLD    --| Rename privilege
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the libray, item name, version of the item to be renamed, and
--| the new version specification

--| Effects:
--| Renames the version specification of the given item in the library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
returni.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Tool_Identifier;
with Library_Errors;
with Return_Item_Interface;

function Return_Item return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LIB is new SI.String_Argument(String_Type_Name => "library_name");
    package FN  is new SI.String_Argument(String_Type_Name => "file_name");
    package STR is new SI.String_Argument(String_Type_Name => "string");

    Return_Item_Process : SI.Process_Handle;
    Library             : SP.String_Type;
    File_Name           : SP.String_Type;
    History             : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => Tool_Identifier);

    SI.Define_Process(
    Proc    => Return_Item_Process,
    Name    => "Return_Item",
    Help    => "Return a File to an Item Library");

    LIB.Define_Argument(
    Proc => Return_Item_Process,
    Name => "library",
    Help => "Name of the item library");

    FN.Define_Argument(
    Proc => Return_Item_Process,
    Name => "file",
    Help => "Name of the file to be returned to the item library");

    STR.Define_Argument(
    Proc => Return_Item_Process,
    Name => "history",
    Help => "Description/reason for the change(s) in this item");

    SP.Release;

    SI.Parse_Line(Return_Item_Process);

    Library := LIB.Get_Argument(
            Proc => Return_Item_Process,
            Name => "library");

    File_Name := FN.Get_Argument(
            Proc => Return_Item_Process,
            Name => "file");

    History := STR.Get_Argument(
            Proc => Return_Item_Process,
            Name => "history");

    return HL.Return_Code(Return_Item_Interface(Library, File_Name, History));
exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.ERROR);

    when others =>
    LE.Report_Error(LE.Internal_Error, SP.Create(""));
    return HL.Return_Code(HL.SEVERE);

end Return_Item;
                                                                    pragma page;
::::::::::::::
returni.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with File_Manager;

function Return_Item_Interface(
    Library : in String_Pkg.String_Type;
    File    : in String_Pkg.String_Type;
    History : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package FM  renames File_Manager;

    Item_Value         : SP.String_Type;
    Checked_In_Version : SP.String_Type;
    Trap               : HL.Interrupt_State := HL.Get_Interrupt_State;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, WRITE_LOCK) then
    raise Library_Write_Locked;
    end if;
    Item_Value := SP.Create(FM.Parse_Filename(SP.Value(File), FM.FILE_ONLY));
    LU.Check_In_Item(Library, File, History, RETURN_ITEM, Checked_In_Version);
    LU.Unlock_Library(Library, WRITE_LOCK);
    if Message_on_Completion then
    HL.Put_Message_Line(
        "Item " & SP.Value(SP.Upper(Item_Value)) & '/' & SP.Value(Checked_In_Version) &
        " returned to library " &  SP.Value(SP.Upper(Library)) & '.');
    end if;
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Library_Does_Not_Exist =>
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Write_Locked =>
    LE.Report_Error(LE.Library_Write_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Found, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Checked_Out =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Checked_Out, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_External_Name =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Invalid_External_Name, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when File_Not_Found =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.File_Not_Found, File);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Created =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Item_Not_Created, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Set_Protection_Error =>
    LU.Unlock_Library(Library, WRITE_LOCK);
    LE.Report_Error(LE.Set_Protection_Error, Item_Value);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Return_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    begin
        LU.Unlock_Library(Library, WRITE_LOCK);
    exception
        when others => null;
    end;
    LE.Report_Error(LE.Internal_Error, SP.Create("Return_Item"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Return_Item_Interface;
                                                                    pragma page;
::::::::::::::
returni.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function Return_Item_Interface(            --| Return a File
   Library : in String_Pkg.String_Type;        --| Item library
   File    : in String_Pkg.String_Type;        --| File to be returned
   History : in String_Pkg.String_Type        --| Description/reason
   ) return Host_Lib.Severity_Code;

--| Requires:
--| Name of the library, name of the file to be returned to the library, and
--| description of change(s)

--| Effects:
--| Returns a file back to the named library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
showhist.ada
::::::::::::::
with Standard_Interface;
with String_Pkg;
with Host_Lib;
with Item_Library_Manager;
with Item_Library_Manager_Declarations;
with String_Lists;
with String_Utilities;

function Show_History return INTEGER is

    package SI  renames Standard_Interface;
    package SP  renames String_Pkg;
    package SL  renames String_Lists;
    package HL  renames Host_Lib;
    package SU  renames String_Utilities;
    package ILM renames Item_Library_Manager;
    package ILD renames Item_Library_Manager_Declarations;

    package LIB is new SI.String_Argument(
                String_Type_Name => "library_name");
    package ITM is new SI.String_Argument(
                String_Type_Name => "item_name");
    package VER is new SI.String_Argument(
                String_Type_Name => "version");

    Show_History_Process : SI.Process_Handle;
    Library              : SP.String_Type;
    List                 : ILD.LL.List;
    List_Iter            : ILD.LL.ListIter;
    Value_List           : SL.List;
    Value_Iter           : SL.ListIter;
    History              : SP.String_Type;
    Item                 : SP.String_Type;
    Version              : SP.String_Type;

begin

    SP.Mark;

    SI.Set_Tool_Identifier(Identifier => "1.0");

    SI.Define_Process(
    Proc    => Show_History_Process,
    Name    => "Show_History",
    Help    => "Show History of Item(s) in an Item Library");

    LIB.Define_Argument(
    Proc => Show_History_Process,
    Name => "library",
    Help => "Name of the item library");

    ITM.Define_Argument(
    Proc    => Show_History_Process,
    Name    => "item",
    Default => "*",
    Help    => "Name of the item to list");

    VER.Define_Argument(
    Proc    => Show_History_Process,
    Name    => "version",
    Default => "",
    Help    => "Version specification");

    SP.Release;

    SI.Parse_Line(Show_History_Process);

    Library := LIB.Get_Argument(
            Proc => Show_History_Process,
            Name => "library");

    Item := ITM.Get_Argument(
            Proc => Show_History_Process,
            Name => "item");

    Version := VER.Get_Argument(
            Proc => Show_History_Process,
            Name => "version");

    List := ILM.Show_History(Library, Item, Version);

    List_Iter := ILD.LL.MakeListIter(List);
    while ILD.LL.More(List_Iter) loop
    ILD.LL.Next(List_Iter, Value_List);
    Value_Iter := SL.MakeListIter(Value_List);
    SP.Mark;
    SL.Next(Value_Iter, Item);
    SL.Next(Value_Iter, Version);
    HL.Put_Message_Line(SP.Value(Item) & '/' & SP.Value(Version));
    while SL.More(Value_Iter) loop
        SP.Mark;
        SL.Next(Value_Iter, History);
        HL.Put_Message_Line("   * " & SP.Value(History));
        SP.Release;
    end loop;
    SP.Release;
    end loop;
    ILD.Destroy_List_of_Lists(List);
    return HL.Return_Code(HL.SUCCESS);

exception

    when SI.Process_Help =>
    return HL.Return_Code(HL.INFORMATION);

    when SI.Abort_Process =>
    return HL.Return_Code(HL.SUCCESS);

    when ILD.Library_Does_Not_Exist =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ does not exist.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Master_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is master locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Write_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is write locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Library_Read_Locked =>
        HL.Put_Error("Library """ & SP.Value(SP.Upper(Library)) & """ is read locked.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Item_Not_Found =>
    HL.Put_Error("Item """ & SP.Value(SP.Upper(Item)) & """ not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Invalid_Version =>
    HL.Put_Error("Invalid version specification.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Version_Not_Found =>
    HL.Put_Error("Version not found.");
    return HL.Return_Code(HL.ERROR);

    when ILD.Not_Authorized =>
    HL.Put_Error("Not authorized.");
    return HL.Return_Code(HL.ERROR);

    when ILD.No_Privilege =>
    HL.Put_Error("No privilege for attempted operation.");
    return HL.Return_Code(HL.ERROR);

    when others =>
    HL.Put_Error("Show History internal error.");
    return HL.Return_Code(HL.SEVERE);

end Show_History;

::::::::::::::
showhist.bdy
::::::::::::::
with Library_Declarations;            use Library_Declarations;
with Library_Errors;
with Library_Utilities;
with String_Lists;
with HIF_Utils;
with HIF_Node_Defs;
with HIF_Node_Management;
with HIF_Attributes;
with HIF_List_Utils;

function Show_History_Interface(
    Library : in String_Pkg.String_Type;
    Item    : in String_Pkg.String_Type;
    Version : in String_Pkg.String_Type
    ) return Host_Lib.Severity_Code is

    package SP  renames String_Pkg;
    package SL  renames String_Lists;
    package HL  renames Host_Lib;
    package LE  renames Library_Errors;
    package LU  renames Library_Utilities;
    package HU  renames HIF_Utils;
    package HND renames HIF_Node_Defs;
    package HNM renames HIF_Node_Management;
    package HA  renames HIF_Attributes;
    package HLU renames HIF_List_Utils;

    Item_Name        : SP.String_Type;
    Item_Node        : HND.Node_Type;
    Item_Iterator    : HNM.Node_Iterator;
    Versions         : SL.List;
    Version_Node     : HND.Node_Type;
    Version_Number   : SP.String_Type;
    Version_Iterator : SL.ListIter;
    History_List     : HLU.List_Type;
    L_Name           : SP.String_Type;
    I_Name           : SP.String_Type;
    V_Name           : SP.String_Type;
    Attribute_Value  : STRING(1 .. 16);
    Attribute_Length : INTEGER;
    Found            : BOOLEAN;
    Trap             : HL.Interrupt_State := HL.Get_Interrupt_State;

    procedure Error_Process is

    begin

    begin
        LU.Unlock_Library(Library, READ_LOCK);
    exception
        when others => null;
    end;
    HNM.Close_Node_Handle(Version_Node);
    HNM.Close_Node_Handle(Item_Node);
    Destroy_String_List(Versions);

    exception
    when others => null;

    end Error_Process;

begin

    if HL."="(Trap, HL.DISABLED) then
    HL.Enable_Interrupt_Trap;
    end if;
    if not LU.Lock_Library(Library, READ_LOCK) then
    raise Library_Read_Locked;
    end if;
    LU.Iterate_Item(Library, Item, Item_Iterator);
    while HNM.More(Item_Iterator) loop
    HNM.Get_Next(Item_Iterator, Item_Node);
    LU.Parse_Node(Item_Node, L_Name, I_Name, V_Name);
    Item_Name := SP.Create(LU.External_Name(SP.Value(I_Name)));
    HA.Get_Node_Attribute(Node   => Item_Node,
                  Attrib => "HISTORY",
                  Value  => History_List);
    begin
        Versions := LU.Get_Version(Item_Node, Version);
        Found := TRUE;
    exception
        when Version_Not_Found =>
        Found := FALSE;
    end;
    if Found then
        Version_Iterator := SL.MakeListIter(Versions);
        while SL.More(Version_Iterator) loop
        SL.Next(Version_Iterator, Version_Number);
        HL.Put_Message_Line(SP.Value(Item_Name) & '/' & SP.Value(Version_Number));
        HNM.Open_Node_Handle(Node         => Version_Node,
                     Base         => Item_Node,
                     Relation     => "DOT",
                     Key          => 'V' & SP.Value(Version_Number));
        HU.Get_Node_Attribute(Node       => Version_Node,
                      Attrib     => "HISTORY_INDEX",
                      Value      => Attribute_Value,
                      Value_Last => Attribute_Length);
        HNM.Close_Node_Handle(Version_Node);
        for i in reverse 1 .. INTEGER'value(Attribute_Value(1..Attribute_Length)) loop
            HL.Put_Message_Line("   * " &
                    HLU.Item_Image(HLU.Positional(History_List, HLU.Positive_Count(i)))
                        (HLU.Item_Image(HLU.Positional(History_List, HLU.Positive_Count(i)))'first + 1 ..
                         HLU.Item_Image(HLU.Positional(History_List, HLU.Positive_Count(i)))'last - 1));
        end loop;
        end loop;
        HNM.Close_Node_Handle(Item_Node);
        Destroy_String_List(Versions);
    end if;
    end loop;
    LU.Unlock_Library(Library, READ_LOCK);
    HL.Set_Interrupt_State(Trap);
    return HL.SUCCESS;

exception

    when Invalid_Library_Name =>
    Error_Process;
    LE.Report_Error(LE.Invalid_Library_Name, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Does_Not_Exist =>
    Error_Process;
    LE.Report_Error(LE.Library_Does_Not_Exist, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Master_Locked =>
    Error_Process;
    LE.Report_Error(LE.Library_Master_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Library_Read_Locked =>
    Error_Process;
    LE.Report_Error(LE.Library_Read_Locked, Library);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Item_Not_Found =>
    Error_Process;
    LE.Report_Error(LE.Item_Not_Found, Item);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Invalid_Version =>
    Error_Process;
    LE.Report_Error(LE.Invalid_Version, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when Version_Not_Found =>
    Error_Process;
    LE.Report_Error(LE.Version_Not_Found, Version);
    HL.Set_Interrupt_State(Trap);
    return HL.ERROR;

    when HL.Interrupt_Encountered =>
    Error_Process;
    if HL."="(Trap, HL.ENABLED) then
        raise HL.Interrupt_Encountered;
    end if;
    LE.Report_Error(LE.Process_Interrupted, SP.Create("Show_History"));
    HL.Set_Interrupt_State(Trap);
    return HL.WARNING;

    when others =>
    Error_Process;
    LE.Report_Error(LE.Internal_Error, SP.Create("Show_History"));
    HL.Set_Interrupt_State(Trap);
    return HL.SEVERE;

end Show_History_Interface;
                                                                    pragma page;
::::::::::::::
showhist.spc
::::::::::::::
with String_Pkg;
with Host_Lib;

function Show_History_Interface(        --| Show History of Item(s)
    Library : in String_Pkg.String_Type;    --| Item library
    Item    : in String_Pkg.String_Type;    --| Item  to list
    Version : in String_Pkg.String_Type        --| Version specification
    ) return Host_Lib.Severity_Code;

--| Requires:
--| Library, item, and version names

--| Effects:
--| Displays the history (description) of the specified item/version in the
--| library

--| N/A: Modifies, Raises, Errors
                                                                    pragma page;
::::::::::::::
srcfile
::::::::::::::
::::::::::::::
userutils.ada
::::::::::::::
with Hif_System_Management;
with standard_interface;
with string_pkg;
with file_manager;
with text_io;
with host_lib;

procedure Add_User is

package SI renames standard_interface;
package SP renames string_pkg;
package HL renames host_lib;
package TIO renames text_io;

package string_arg is new SI.string_argument("string");

    directory_exists : exception;    -- raised when the directory to place
                    -- the repository in exists.

    process  : SI.process_handle;
    dir         : SP.string_type;

begin
    SI.set_tool_identifier ("1.0");
    SI.define_process ("add_user",
    "Adds the named user to the set of documentation system users",
    process);
    string_arg.define_argument (process,
                "directory",
      "Name of the directory in which to store documentation information");
    string_arg.define_argument (process,
                "user",
                HL.get_item(HL.user_name),
                "Name of the user to add");
    SI.define_help (process,
     "This procedure can be used to add any user to the set of documentation");
    SI.append_help (process,
     "system users.  If a person wants to be able to use the system they must");
     SI.append_help (process,
     "be entered in the system with the same user name as they have on the");
    SI.append_help (process,
     "host machine.  If this is not the case the person will not be recognized");
    SI.append_help (process,
     "as a documentation system user.  Each user name must be unique");
    SI.parse_line (process);
    dir := string_arg.get_argument(process, "directory");
    dir := SP.create (file_manager.path_name (directory => SP.value (dir),
                          file      => "",
                          absolute  => true));
    if file_manager.is_directory(SP.value(dir)) then
    raise directory_exists;
    end if;
    Hif_System_Management.Add_User(User_Name =>SP.value (
                           string_arg.get_argument(process,
                                       "user")),
                                   Host_File =>SP.value (dir));
exception
    when file_manager.device_not_ready =>
    TIO.put_line ("Directory Error - device not ready");
    when file_manager.directory_not_found =>
    TIO.put_line ("Directory Error - directory not found");
    when file_manager.privilege_violation =>
    TIO.put_line ("Directory Error - privilege violation");
    when file_manager.parse_error =>
    TIO.put_line ("Directory Error - Incorrect syntax for a directory " &
            "specification");
    when directory_exists =>
    TIO.put_line ("Directory Error - Directory already exists");
    when SI.Process_Help =>
    --
    -- Help message was printed
    --
    null;

    when SI.Abort_Process =>
    --
    -- Parse error
    --
    null;

end Add_User;

with Hif_System_Management;
with standard_interface;
with host_lib;

procedure DELETE_USER is

package SI renames standard_interface;

    process  : SI.process_handle;

begin
    SI.set_tool_identifier ("1.0");
    SI.define_process ("delete_user",
               "Delete yourself as a documentation system user",
               process);
    SI.parse_line (process);
    Hif_System_Management.Remove_User(
        User_Name =>host_lib.get_item(host_lib.user_name));
exception
    when SI.Process_Help =>
    -- Help message was printed
    null;
    when SI.Abort_Process =>
    -- Parse error
    null;

end DELETE_USER;

with Hif_System_Management;
with Hif_Node_management;
with Hif_Node_Defs;
with Document_Manager_Declarations;
with standard_interface;
with string_pkg;


procedure DELETE_HIF_USER is

package SI renames standard_interface;
package SP renames string_pkg;
package HNM renames Hif_Node_management;
package HND renames Hif_Node_Defs;
package DMD renames Document_Manager_Declarations;

package string_arg is new SI.string_argument("string");
    process  : SI.process_handle;

doc_node : HND.node_type;
name     : SP.string_type;

begin
    SI.set_tool_identifier ("1.0");
    SI.define_process ("delete_hif_user",
               "Delete a hif user",
               process);
    string_arg.define_argument (process,
                "user",
                "Name of the user to delete");
    SI.define_help (process,
     "This process can be used to delete any hif user in the documentation");
    SI.append_help (process,
     "system.  That includes catalogs and libraries as well as system users.");
    SI.append_help (process,
     "For this reason this executable should be used with extreme care.  To");
    SI.append_help (process,
     "delete a library or catalog instead of a user, simply give the name of");
    SI.append_help (process,
     "the library or catalog in place of the user name.");
    SI.parse_line (process);
    name := string_arg.get_argument (process, "user");
    HNM.open_node_handle (doc_node, DMD.document_manager_list_path);

    -- In case this user is a catalog or library try and unlink it from
    -- the docmgr list node before deleting the user.  Notice that if the link
    -- doesn't exist and name error is raised nothing happens.
    begin
    HNM.unlink (base     => doc_node,
            key      => SP.value(name),
            relation => "CATALOG");
    exception when HND.name_error =>
    null;
    end;
    begin
    HNM.unlink (base     => doc_node,
            key      => SP.value(name),
            relation => "LIBRARY");
    exception when HND.name_error =>
    null;
    end;
    Hif_System_Management.Remove_User(User_Name =>SP.value (name));
    HNM.close_node_handle (doc_node);
exception
    when SI.Process_Help =>
    -- Help message was printed
    null;
    when SI.Abort_Process =>
    -- Parse error
    null;

end DELETE_HIF_USER;

::::::::::::::
vlist.spc
::::::::::::::
with Lists;
package version_lists is new Lists(positive);