DataMuseum.dk

top - download

    Length: 5919 (0x171f)
    Types: TextFile
    Names: »B«

└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
    └─ ⟦bb34fe6e2⟧ »DATA« 
        └─⟦15d8b76c6⟧ 
            └─⟦this⟧ 

TextFile

with Bounded_String;
with String_Utilities;
with String_Table;
with Directory_Tools;
with Ftp;
with Unix_Remote_Commands;
with Text_Io;
procedure Install (Remote_Machine : String := "<Ftp_Profile>";
                   Username : String := "<Ftp_Profile>";
                   Password : String := "<Ftp_Profile>";
                   Remote_Directory : String := "<Ftp_Profile>";
                   Output : String := "<DEFAULT>";
                   Error : String := "<DEFAULT>";
                   Response : String := "<profile>") is
    use Directory_Tools;
    Suffix : constant String := ".ad";
    Iter : Object.Iterator;
    Compilation_Kind : Ada_Object.Compilation_Kind;
    Compilation_Kind_Suffixes :
       constant array (Ada_Object.Library_Unit .. Ada_Object.Subunit) of
                   Character :=
       (Ada_Object.Library_Unit => 'a',
        Ada_Object.Library_Unit_Body => 'b',
        Ada_Object.Subunit => 's');
    Table : String_Table.Table := String_Table.New_Table;
    Item : String_Table.Item;
    function "=" (L, R : String_Table.Item) return Boolean
        renames String_Table."=";
    St_Iter : String_Table.Iterator;
    Target_Name_Max_Length : constant := 14;
    Target_Name_Prefix_Max_Length : Integer :=
       Target_Name_Max_Length - (Suffix'Length + 1);
    Target_Name : Bounded_String.Variable_String
                     (Target_Name_Prefix_Max_Length);
    Collision_Resolver : Character;
begin
    Iter := Naming.Resolution
               (Name => "!machine.release.rpc.[_current].[_current]",
                Objects_Only => True);
    while not Object.Done (Iter) loop
        declare
            Simple_Name : constant String :=
               String_Utilities.Lower_Case
                  (Naming.Simple_Name (Object.Value (Iter)));
        begin
            Compilation_Kind := Ada_Object.Kind (Object.Value (Iter));
            if Compilation_Kind in Ada_Object.Library_Unit ..
                                      Ada_Object.Subunit then

                if Simple_Name'Length <= Target_Name_Prefix_Max_Length then
                    Bounded_String.Copy (Target_Name, Simple_Name);
                else
                    Bounded_String.Copy
                       (Target_Name,
                        Simple_Name (Simple_Name'First ..
                                        Simple_Name'First +
                                           Target_Name_Prefix_Max_Length - 1));
                end if;
                Collision_Resolver := '0';
                loop
                    Item :=
                       String_Table.Find
                          (Bounded_String.Image (Target_Name) & Suffix &
                           Compilation_Kind_Suffixes (Compilation_Kind), Table);

                    exit when Item = String_Table.Nil;

                    Bounded_String.Replace
                       (Target_Name, Bounded_String.Length (Target_Name),
                        Collision_Resolver);

                    if Collision_Resolver = '9' then
                        Collision_Resolver := 'a';
                    else
                        Collision_Resolver :=
                           Character'Succ (Collision_Resolver);
                    end if;
                end loop;
                Item :=
                   String_Table.Unique
                      (Bounded_String.Image (Target_Name) & Suffix &
                       Compilation_Kind_Suffixes (Compilation_Kind), Table);
                Ftp.Put (From_Local_File =>
                            Naming.Unique_Full_Name (Object.Value (Iter)),
                         To_Remote_File => String_Table.Image (Item),
                         Remote_Machine => Remote_Machine,
                         Username => Username,
                         Password => Password,
                         Remote_Directory => Remote_Directory,
                         Append_To_File => False);

            elsif String_Utilities.Equal (Simple_Name, "Transport_body") then
                Item := String_Table.Unique ("transport.adb", Table);


                Ftp.Put (From_Local_File =>
                            Naming.Unique_Full_Name (Object.Value (Iter)),
                         To_Remote_File => String_Table.Image (Item),
                         Remote_Machine => Remote_Machine,
                         Username => Username,
                         Password => Password,
                         Remote_Directory => Remote_Directory,
                         Append_To_File => False);


            end if;
        end;
        Object.Next (Iter);
    end loop;
    Unix_Remote_Commands.Put_Text_File
       (From_Local_File => "!machine.release.rpc.[_current].makefile",
        To_Remote_File => "ada.make.out",
        Remote_Machine => Remote_Machine,
        Remote_Username => Username,
        Remote_Password => Password,
        Remote_Directory => Remote_Directory,
        Append_To_File => False,
        Response => Response);

    Unix_Remote_Commands.Run (Command => "chmod +x ada.make.out",
                              Remote_Machine => Remote_Machine,
                              Remote_Username => Username,
                              Remote_Password => Password,
                              Remote_Directory => Remote_Directory,
                              Output => Output,
                              Error => Error,
                              Response => Response);
    Unix_Remote_Commands.Run (Command => "ada.make.out",
                              Remote_Machine => Remote_Machine,
                              Remote_Username => Username,
                              Remote_Password => Password,
                              Remote_Directory => Remote_Directory,
                              Output => Output,
                              Error => Error,
                              Response => Response);
end Install;