⟦f4eba243d⟧

TextFile

with Calendar, Log, Text_Io, Time_Utilities, String_Utilities,  
     System_Utilities;  
with Mvs_Builder_Instantiation;  
with Profile;
with Directory_Tools;
with Mvs_Name_Package;  
with Chop_Lines;  
with Write_To_Tape;  
with Tape_Tools;  
package body Mvs_Builder is

    package Naming renames Directory_Tools.Naming;
    package Object renames Directory_Tools.Object;

    Transfer_Directory : constant String :=  
       "!machine.temporary";  
    User_Script_Name : constant String :=  
       System_Utilities.User_Name & "_SCRIPT";  
    User_File_Name : constant String :=  
       System_Utilities.User_Name & "_UNITS";  
    package Builder renames Mvs_Builder_Instantiation;  
    package State renames Mvs_Builder_Instantiation.State;  
    function "=" (L, R : Builder.Error_Status) return Boolean  
        renames Builder."=";  
    function Mvs_Remote_Filename (Target_Context_Name : String;  
                                  Host_Library : String;
                                  Unit_Name : String;  
                                  Unit_Target_Name : String;  
                                  User_Info : String) return String is  
    begin  
        return Target_Context_Name & " " & Unit_Target_Name;  
    end Mvs_Remote_Filename;  
    procedure Mvs_Preprocess (Unit_Name : String;  
                              Unit_Has_Buddy : Boolean;  
                              Host_Library : String;  
                              Unit_Pathname : String;  
                              Modified_Unit_Pathname : out String;  
                              Modified_Pathname_Length : out Natural;  
                              Unit_Modified : out Boolean) is  
        Dest_Filename : constant String :=  
           "!machine.temporary." & System_Utilities.User_Name &  
              "_tbtemp";  
        Source, Dest : Text_Io.File_Type;  
        Buffer : String (1 .. 256) := (others => ' ');  
        Length : Natural := 0;  
    begin  
        Text_Io.Open (Source, Text_Io.In_File, Unit_Pathname);  
        Text_Io.Create (Dest, Text_Io.Out_File, Dest_Filename);  
        Text_Io.New_Line (Dest);  
        declare  
            Hndl : Builder.Handle;  
            Status : Builder.Error_Status;  
        begin  
            State.Open (Host_Library, Hndl, Status);

            Text_Io.Put_Line  
               (Dest, "./ ADD NAME=" &  
                         State.Unit_Target_Name (Hndl, Unit_Pathname));  
            State.Close (Hndl, Status);  
        end;  
        Chop_Lines (Source_File => Source,  
                    Dest_File => Dest);  
        Text_Io.Close (Source);  
        Text_Io.Close (Dest);  
        Modified_Unit_Pathname (1 .. Dest_Filename'Length) := Dest_Filename;  
        Modified_Pathname_Length := Dest_Filename'Length;  
        Unit_Modified := True;  
    end Mvs_Preprocess;

    procedure Mvs_Put_Prolog (Script_File : Builder.File_Type;  
                              Libraries_Simple_Name : String;  
                              User_Info : String) is  
    begin  
        Builder.Put_Line (Script_File, "./ ADD NAME=SCRIPT");  
        Builder.Put_Line (Script_File, "PROC 0");  
        Builder.Put_Line  
           (Script_File,  
            "GLOBAL GLOBAL1 GLOBAL2 GLOBAL3 GLOBAL4 GLOBAL5");  
    end Mvs_Put_Prolog;

    procedure Mvs_Put_Move_Command (Script_File : Builder.File_Type;  
                                    Unit_Tape_Name : String;  
                                    Host_Library : String;  
                                    Target_Conext_Name : String;  
                                    Unit_Name : String;  
                                    Unit_Target_Name : String;  
                                    User_Info : String) is  
    begin  
        null;  
    end Mvs_Put_Move_Command;

    procedure Mvs_Put_Context_Setup_Command (Script_File : Builder.File_Type;  
                                             Target_Context_Name : String;  
                                             Host_Library : String;  
                                             User_Info : String) is  
    begin  
        null;  
    end Mvs_Put_Context_Setup_Command;

    procedure Mvs_Put_Delete_Command (Script_File : Builder.File_Type;  
                                      Target_Context_Name : String;  
                                      Host_Library : String;  
                                      Unit_Name : String;  
                                      Unit_Target_Name : String;  
                                      User_Info : String) is  
    begin  
        null;  
    end Mvs_Put_Delete_Command;  
    procedure Mvs_Put_Compile_Command (Script_File : Builder.File_Type;  
                                       Target_Context_Name : String;  
                                       Host_Library : String;  
                                       Unit_Name : String;  
                                       Unit_Target_Name : String;  
                                       User_Info : String) is  
    begin  
        Builder.Put_Line  
           (Script_File,  
            "EX 'OREN.CLIST(A370)' 'CHUCK.ADA.SOURCE(" &  
               Unit_Target_Name & ") LIS(*)'");  
    end Mvs_Put_Compile_Command;  
    procedure Mvs_Put_Epilog (Script_File : Builder.File_Type;  
                              Libraries_Simple_Name : String;  
                              User_Info : String) is  
    begin  
        null;  
    end Mvs_Put_Epilog;

    package Transfer is new Builder.Transfer  
                               (Remote_Filename => Mvs_Remote_Filename,  
                                Preprocess => Mvs_Preprocess,  
                                Put_Prolog => Mvs_Put_Prolog,  
                                Put_Move_Command => Mvs_Put_Move_Command,  
                                Put_Context_Setup_Command =>
                                   Mvs_Put_Context_Setup_Command,  
                                Put_Delete_Command => Mvs_Put_Delete_Command,  
                                Put_Compile_Command => Mvs_Put_Compile_Command,  
                                Put_Epilog => Mvs_Put_Epilog);

    procedure Put_Status  
                 (Code : Builder.Error_Status;  
                  Operation : String;
                  Note : String := "";  
                  Response : Profile.Response_Profile) is  
    begin  
        if Code = Builder.Ok then  
            Log.Put_Line (Operation & " Status is " &  
                          Builder.Error_Status'Image (Code),  
                          Profile.Positive_Msg,  
                          Response);  
        else  
            Log.Put_Line (Operation & " Status is " &  
                          Builder.Error_Status'Image (Code),  
                          Profile.Error_Msg,  
                          Response);  
        end if;  
        if Note /= "" then  
            Log.Put_Line (Note, Profile.Note_Msg);  
        end if;  
    end Put_Status;  
    procedure Initialize  
                 (World_Or_View : String := "$$";  
                  Dataset_Name : String;  
                  Download_Times_Retention_Count : Positive := 5;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Status : Builder.Error_Status;  
    begin  
        State.Initialize  
           (View_Or_World => World_Or_View,  
            Target_Context_Name => Dataset_Name,  
            Build_Time_Retention_Count => Download_Times_Retention_Count,  
            Status => Status);  
        if Status = Builder.Ok then  
            Text_Io.Put_Line  
               (World_Or_View & "'s download file will be sent to " &  
                Dataset_Name);  
        else  
            Put_Status (Code => Status,  
                        Operation => "Initialize",
                        Note => "",  
                        Response => Response);  
        end if;  
    end Initialize;  
    procedure Display_Dataset_Name  
                 (World_Or_View : String := "$$";  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Status : Builder.Error_Status;  
        Hndl : Builder.Handle;  
    begin  
        State.Open (View_Or_World => World_Or_View,
                    State => Hndl,  
                    Status => Status);  
        if Status = Builder.Ok then  
            Text_Io.Put_Line (World_Or_View & " corresponds to " &  
                              State.Target_Context_Name (Hndl) & " on the 370");  
        end if;  
    end Display_Dataset_Name;  
    procedure Add_Buddy  
                 (World_Or_View : String := "$$";  
                  Unit_Name, Buddy_Name : String;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            State.Add_Buddy (Hndl, Unit_Name, Buddy_Name, Err);  
            State.Close (Hndl, Err);  
        end if;  
        Put_Status (Err, "Add_Buddy", "", Response);  
    end Add_Buddy;

    procedure Remove_Buddy  
                 (World_Or_View : String := "$$";  
                  Unit_Name : String;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            State.Remove_Buddy (Hndl, Unit_Name, Err);  
            State.Close (Hndl, Err);  
        end if;  
        Put_Status (Err, "Remove_Buddy", "", Response);  
    end Remove_Buddy;

    procedure Has_Buddy  
                 (World_Or_View : String := "$$";  
                  Unit_Name : String;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            if State.Has_Buddy (Hndl, Unit_Name) then  
                Text_Io.Put_Line  
                   (Unit_Name & " has" &  
                    State.Buddy_Name (Hndl, Unit_Name) & " as a buddy");  
            else  
                Text_Io.Put_Line (Unit_Name & " Does NOT have a buddy");  
            end if;  
        else  
            Put_Status  
               (Err, "Open", World_Or_View & " could be open", Response);  
        end if;  
    end Has_Buddy;  
    procedure Set_Unit_Target_Name  
                 (World_Or_View : String := "$$";  
                  Unit_Name, Unit_Target_Name : String;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            State.Set_Unit_Target_Name  
               (Hndl, Unit_Name, Unit_Target_Name, Err);  
            State.Close (Hndl, Err);  
        end if;  
        Put_Status (Err, "Set_Unit_Target_Name", "", Response);  
    end Set_Unit_Target_Name;

    procedure Display_Unit_Target_Name  
                 (World_Or_View : String := "$$";  
                  Unit_Name : String;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            Text_Io.Put_Line  
               ("The MVS Target Name of " & Unit_Name & " is " &  
                State.Unit_Target_Name (Hndl, Unit_Name));  
        else  
            Put_Status (Err, "Open", "", Response);  
        end if;  
    end Display_Unit_Target_Name;

    procedure Display_Download_Times  
                 (World_Or_View : String := "$$";  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
        Number_Retained : Natural;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            Number_Retained := State.Build_Times_Retained (Hndl);

            Text_Io.Put_Line  
               ("The download times retained in order (0 is most recent) are: ");  
            Text_Io.New_Line;  
            for I in 0 .. (Number_Retained - 1) loop  
                Text_Io.Put_Line (Natural'Image (I) & " --> " &  
                                  Time_Utilities.Image
                                     (Time_Utilities.Convert_Time  
                                         (State.Build_Time (Hndl, I))));  
            end loop;  
        else  
            Put_Status  
               (Err, "Open", "", Response);  
        end if;  
    end Display_Download_Times;

    procedure Go_Back_Steps  
                 (Libraries : String := "$$";  
                  Number : Positive := 1;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
    begin  
        State.Go_Back_In_Time  
           (Libraries, Err, Number);  
        Put_Status (Err, "Go Back in Time", "", Response);  
    end Go_Back_Steps;

    procedure Go_Back_In_Time  
                 (Libraries : String := "$$";  
                  Last_Download_Before : String :=
                     Mvs_Builder.Beginning_Of_Time;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        The_Time : Calendar.Time := Time_Utilities.Convert_Time  
                                       (Time_Utilities.Value  
                                           (Last_Download_Before));  
    begin  
        State.Go_Back_In_Time  
           (Libraries, Err, The_Time);  
        Put_Status (Err, "Go Back in Time", "", Response);  
    end Go_Back_In_Time;

    procedure Show_Instructions  
                 (Libraries : String := "$$";  
                  Downloaded_Units : Boolean := True;  
                  Recompilation : Boolean := True;  
                  Target_Names : Boolean := True;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Inst : Builder.Download_Instructions;  
    begin  
        State.Make_Consistent  
           (Libraries, Inst, Err, Downloaded_Units,  
            Recompilation, False, False);  
        if Err = Builder.Ok then  
            State.Show_Instructions  
               (Instructions => Inst,  
                Show_Downloaded_Units => Downloaded_Units,  
                Show_Recompilation => Recompilation,  
                Show_Target_Names => Target_Names);  
        end if;  
        Text_Io.New_Line;  
        Put_Status (Err, "Show Instructions", "", Response);  
    end Show_Instructions;  
    procedure Create_Transfer_File  
                 (Libraries : String := "$$";  
                  Uninstalled_Units : Boolean := False;  
                  Compute_Recompilation : Boolean := True;  
                  Script_Log : String := Mvs_Builder_Instantiation.Default_Log;  
                  Response : Profile.Response_Profile := Profile.Get) is

        Status : Builder.Error_Status;  
        Instr : Builder.Download_Instructions;  
    begin  
        State.Make_Consistent  
           (Libraries => Libraries,  
            Result => Instr,  
            Status => Status,
            Download_Units => True,  
            Compute_Recompilation => Compute_Recompilation,  
            Update_Build_Times => True,  
            Download_Uninstalled_Also => Uninstalled_Units);  
        Transfer.Move_To_Directory  
           (Instructions => Instr,  
            Status => Status,  
            Directory_Name => Transfer_Directory,  
            Target_Script_Name => User_Script_Name,  
            Single_File_Name => User_File_Name,
            User_Info => "",  
            Unit_Prefix => Builder.Unit_Tape_Name_Prefix,  
            Unit_Suffix => Builder.Unit_Tape_Name_Suffix,  
            Script_Log => Script_Log,
            Response => Response);  
    end Create_Transfer_File;  
    procedure Move_Via_Network  
                 (Libraries : String := "$$";  
                  Uninstalled_Units : Boolean := False;  
                  Compute_Recompilation : Boolean := True;  
                  Remote_Dataset_Name : String;  
                  Remote_Machine : String := Mvs_Builder.Use_Ftp_Default;  
                  Remote_User : String := Mvs_Builder.Use_Ftp_Default;  
                  Remote_Password : String := Mvs_Builder.Use_Ftp_Default;  
                  Script_Log : String := Mvs_Builder_Instantiation.Default_Log;  
                  Response : Profile.Response_Profile := Profile.Get) is  
    begin
        -- Create_Transfer_File
        --     (Libraries => Libraries, Uninstalled_Units => Uninstalled_Units,
        --      Compute_Recompilation => Compute_Recompilation,
        --      Script_Log => Script_Log,
        --      Response => Response);
        -- Add procedure to move via network here
        Log.Put_Line  
           (Message => "Not implemented yet",  
            Kind => Profile.Negative_Msg);  
    end Move_Via_Network;  
    procedure Move_Via_Tape  
                 (Libraries : String := "$$";  
                  Uninstalled_Units : Boolean := False;  
                  Compute_Recompilation : Boolean := True;  
                  Tape_Filename : String;  
                  Tape_Volume_Id : String;  
                  Script_Log : String := Mvs_Builder_Instantiation.Default_Log;  
                  Response : Profile.Response_Profile := Profile.Get) is  
    begin  
        Create_Transfer_File  
           (Libraries => Libraries,
            Uninstalled_Units => Uninstalled_Units,  
            Compute_Recompilation => Compute_Recompilation,  
            Script_Log => Script_Log,  
            Response => Response);  
        Write_To_Tape  
           (Files => Transfer_Directory & "." & User_File_Name,  
            Volume => Tape_Volume_Id,  
            Format => "Vax/VMS",  
            Record_Format => Tape_Tools.Fixed_Length,
            Record_Length => 80,  
            Block_Length => 2000);  
    end Move_Via_Tape;  
    procedure Set_Unit_Target_Names  
                 (World_Or_View : String := "$$";  
                  Unit_Names : String;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
        Ada_Units : Object.Iterator;  
        function Unique_Name
                    (Of_First_Object_In : Object.Iterator) return String is  
        begin  
            return Naming.Unique_Full_Name (Object.Value (Of_First_Object_In));  
        end Unique_Name;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            Ada_Units := Naming.Resolution (World_Or_View & '.' & Unit_Names);  
            if Object.Done (Ada_Units) then  
                Err := Builder.Name_Error;  
            else  
                while not Object.Done (Ada_Units) loop  
                    State.Set_Unit_Target_Name  
                       (Hndl, Unique_Name (Ada_Units),  
                        Mvs_Name_Package.Get_Mvs_Name  
                           (Unique_Name (Ada_Units)),  
                        Err);  
                    Object.Next (Ada_Units);  
                end loop;  
                State.Close (Hndl, Err);  
            end if;  
            Put_Status (Err, "Set_Unit_Target_Names", "", Response);  
        end if;  
    end Set_Unit_Target_Names;  
    procedure Add_New_Unit_Target_Names  
                 (World_Or_View : String := "$$";  
                  Unit_Names : String;  
                  Response : Profile.Response_Profile := Profile.Get) is  
        Err : Builder.Error_Status;  
        Hndl : Builder.Handle;  
        Ada_Units : Object.Iterator;  
        function Unique_Name
                    (Of_First_Object_In : Object.Iterator) return String is  
        begin  
            return Naming.Unique_Full_Name (Object.Value (Of_First_Object_In));  
        end Unique_Name;  
    begin  
        State.Open (World_Or_View, Hndl, Err);  
        if Err = Builder.Ok then  
            Ada_Units := Naming.Resolution (World_Or_View & '.' & Unit_Names);  
            if Object.Done (Ada_Units) then  
                Err := Builder.Name_Error;  
            else  
                while not Object.Done (Ada_Units) loop  
                    if not State.Has_Unit_Target_Name  
                              (State => Hndl,  
                               Unit_Name => Unique_Name (Ada_Units)) then  
                        State.Set_Unit_Target_Name  
                           (Hndl, Unique_Name (Ada_Units),  
                            Mvs_Name_Package.Get_Mvs_Name  
                               (Unique_Name (Ada_Units)),  
                            Err);  
                    end if;  
                    Object.Next (Ada_Units);  
                end loop;  
                State.Close (Hndl, Err);  
            end if;  
            Put_Status (Err, "Refresh_Unit_Target_Names", "", Response);  
        end if;  
    end Add_New_Unit_Target_Names;  
end Mvs_Builder;
DataMuseum.dk

Rational R1000/400 Tapes

⟦f4eba243d⟧ TextFile

Derivation

TextFile
