DataMuseum.dk

top - download

    Length: 20414 (0x4fbe)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with System;
with Ada_C;
with Calendar;
with String_Utilities;
with Text_Io;
package body Directory_Implementation is

    function Scandirectory_C
                (C_Path : System.Address; C_Pattern : System.Address)
                return Integer;
    pragma Interface (C, Scandirectory_C);
    pragma Interface_Information (Scandirectory_C, ".ScanDirectory");

    function Createfile_C (C_Path : System.Address;
                           C_Owner_Mode : Integer;
                           C_Group_Mode : Integer;
                           C_Other_Mode : Integer) return Integer;
    pragma Interface (C, Createfile_C);
    pragma Interface_Information (Createfile_C, ".CreateFile");

    function Createdirectory_C (C_Path : System.Address;
                                C_Owner_Mode : Integer;
                                C_Group_Mode : Integer;
                                C_Other_Mode : Integer) return Integer;
    pragma Interface (C, Createdirectory_C);
    pragma Interface_Information (Createdirectory_C, ".CreateDirectory");

    function Copydirectory_C
                (C_Path1 : System.Address; C_Path2 : System.Address)
                return Integer;
    pragma Interface (C, Copydirectory_C);
    pragma Interface_Information (Copydirectory_C, ".CopyDirectory");

    function Copyfile_C (C_Path1 : System.Address; C_Path2 : System.Address)
                        return Integer;
    pragma Interface (C, Copyfile_C);
    pragma Interface_Information (Copyfile_C, ".CopyFile");

    function Move_C (C_Path1 : System.Address; C_Path2 : System.Address)
                    return Integer;
    pragma Interface (C, Move_C);
    pragma Interface_Information (Move_C, ".Move");

    function Deletefile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Deletefile_C);
    pragma Interface_Information (Deletefile_C, ".DeleteFile");

    function Deletedirectory_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Deletedirectory_C);
    pragma Interface_Information (Deletedirectory_C, ".DeleteDirectory");

    function Directoryentryexistent_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Directoryentryexistent_C);
    pragma Interface_Information
       (Directoryentryexistent_C, ".DirectoryEntryExistent");

    function Directoryentryvalue_C (C_Iter : Integer) return System.Address;
    pragma Interface (C, Directoryentryvalue_C);
    pragma Interface_Information
       (Directoryentryvalue_C, ".DirectoryEntryValue");

    function Directoryentrysize_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Directoryentrysize_C);
    pragma Interface_Information (Directoryentrysize_C, ".DirectoryEntrySize");

    function Directoryentrynumberoflinks_C
                (C_Path : System.Address) return Integer;
    pragma Interface (C, Directoryentrynumberoflinks_C);
    pragma Interface_Information (Directoryentrynumberoflinks_C,
                                  ".DirectoryEntryNumberOfLinks");

    function Directoryentryusername_C
                (C_Path : System.Address) return System.Address;
    pragma Interface (C, Directoryentryusername_C);
    pragma Interface_Information
       (Directoryentryusername_C, ".DirectoryEntryUserName");

    function Directoryentrygroupname_C
                (C_Path : System.Address) return System.Address;
    pragma Interface (C, Directoryentrygroupname_C);
    pragma Interface_Information
       (Directoryentrygroupname_C, ".DirectoryEntryGroupName");

    function Dateoflastupdate_C (C_Path : System.Address) return System.Address;
    pragma Interface (C, Dateoflastupdate_C);
    pragma Interface_Information (Dateoflastupdate_C,
                                  ".DirectoryEntryDateOfLastUpdate");

    function Timeoflastupdate_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Timeoflastupdate_C);
    pragma Interface_Information (Timeoflastupdate_C,
                                  ".DirectoryEntryTimeOfLastUpdate");

    function Dateoflastaccess_C (C_Path : System.Address) return System.Address;
    pragma Interface (C, Dateoflastaccess_C);
    pragma Interface_Information (Dateoflastaccess_C,
                                  ".DirectoryEntryDateOfLastAccess");

    function Timeoflastaccess_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Timeoflastaccess_C);
    pragma Interface_Information (Timeoflastaccess_C,
                                  ".DirectoryEntryTimeOfLastAccess");

    function Isdirectory_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isdirectory_C);
    pragma Interface_Information (Isdirectory_C, ".IsDirectory");

    function Isregularfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isregularfile_C);
    pragma Interface_Information (Isregularfile_C, ".IsRegularFile");

    function Isblocspecialfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isblocspecialfile_C);
    pragma Interface_Information (Isblocspecialfile_C, ".IsBlocSpecial");

    function Ischaracterspecialfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Ischaracterspecialfile_C);
    pragma Interface_Information
       (Ischaracterspecialfile_C, ".IsCharacterSpecial");

    function Isfifo_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isfifo_C);
    pragma Interface_Information (Isfifo_C, ".IsFifo");

    function Issocket_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Issocket_C);
    pragma Interface_Information (Issocket_C, ".IsSocket");

    function Issymboliclink_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Issymboliclink_C);
    pragma Interface_Information (Issymboliclink_C, ".IsSymbolicLink");

    function Ismultiplexfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Ismultiplexfile_C);
    pragma Interface_Information (Ismultiplexfile_C,
                                  ".IsMultiplexCharacterSpecial");

    function Entryownerpermissions_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Entryownerpermissions_C);
    pragma Interface_Information
       (Entryownerpermissions_C, ".EntryOwnerPermissions");

    function Entrygrouppermissions_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Entrygrouppermissions_C);
    pragma Interface_Information
       (Entrygrouppermissions_C, ".EntryGroupPermissions");

    function Entryotherpermissions_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Entryotherpermissions_C);
    pragma Interface_Information
       (Entryotherpermissions_C, ".EntryOtherPermissions");

    procedure Changeownerpermissions_C
                 (C_Path : System.Address; C_Mode : Integer);
    pragma Interface (C, Changeownerpermissions_C);
    pragma Interface_Information
       (Changeownerpermissions_C, ".ChangeOwnerPermissions");

    procedure Changegrouppermissions_C
                 (C_Path : System.Address; C_Mode : Integer);
    pragma Interface (C, Changegrouppermissions_C);
    pragma Interface_Information
       (Changegrouppermissions_C, ".ChangeGroupPermissions");

    procedure Changeotherpermissions_C
                 (C_Path : System.Address; C_Mode : Integer);
    pragma Interface (C, Changeotherpermissions_C);
    pragma Interface_Information
       (Changeotherpermissions_C, ".ChangeOtherPermissions");

    function Changedirectory_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Changedirectory_C);
    pragma Interface_Information (Changedirectory_C, ".ChangeDirectory");

    function Gethomedirectory_C return System.Address;
    pragma Interface (C, Gethomedirectory_C);
    pragma Interface_Information (Gethomedirectory_C, ".GetHomeDirectory");

    function Getabsolutepath_C
                (C_Path1 : in System.Address) return System.Address;
    pragma Interface (C, Getabsolutepath_C);
    pragma Interface_Information (Getabsolutepath_C, ".GetAbsolutePath");

    function Geterrormessage_C return System.Address;
    pragma Interface (C, Geterrormessage_C);
    pragma Interface_Information (Geterrormessage_C, ".GetErrorMessage");



    function Scan_Directory (Path : in String; Pattern : in String := ".*")
                            return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
        C_Pattern : constant String := Ada_C.String_Ada_To_C (Pattern);
    begin
        return Scandirectory_C
                  (C_Path => C_Path (C_Path'First)'Address,
                   C_Pattern => C_Pattern (C_Pattern'First)'Address);
    end Scan_Directory;


    function Create_File (Path : in String;
                          Owner_Permissions : in Integer;
                          Group_Permissions : in Integer;
                          Other_Permissions : in Integer) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return (Createfile_C (C_Path => C_Path (C_Path'First)'Address,
                              C_Owner_Mode => Owner_Permissions,
                              C_Group_Mode => Group_Permissions,
                              C_Other_Mode => Other_Permissions) = 1);
    end Create_File;

    function Create_Directory (Path : in String;
                               Owner_Permissions : in Integer;
                               Group_Permissions : in Integer;
                               Other_Permissions : in Integer) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return (Createdirectory_C (C_Path => C_Path (C_Path'First)'Address,
                                   C_Owner_Mode => Owner_Permissions,
                                   C_Group_Mode => Group_Permissions,
                                   C_Other_Mode => Other_Permissions) = 0);
    end Create_Directory;


    function Copy_Directory
                (The_Path : in String; To_Path : in String) return Boolean is
        C_Path1 : constant String := Ada_C.String_Ada_To_C (The_Path);
        C_Path2 : constant String := Ada_C.String_Ada_To_C (To_Path);
    begin
        return
           (Copydirectory_C (C_Path1 => C_Path1 (C_Path1'First)'Address,
                             C_Path2 => C_Path2 (C_Path2'First)'Address) = 0);
    end Copy_Directory;

    function Copy_File
                (The_Path : in String; To_Path : in String) return Boolean is
        C_Path1 : constant String := Ada_C.String_Ada_To_C (The_Path);
        C_Path2 : constant String := Ada_C.String_Ada_To_C (To_Path);
    begin
        return (Copyfile_C (C_Path1 => C_Path1 (C_Path1'First)'Address,
                            C_Path2 => C_Path2 (C_Path2'First)'Address) = 0);
    end Copy_File;


    function Move (The_Path : in String; To_Path : in String) return Boolean is
        C_Path1 : constant String := Ada_C.String_Ada_To_C (The_Path);
        C_Path2 : constant String := Ada_C.String_Ada_To_C (To_Path);
    begin
        return (Move_C (C_Path1 => C_Path1 (C_Path1'First)'Address,
                        C_Path2 => C_Path2 (C_Path2'First)'Address) = 0);
    end Move;

    function Delete_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return (Deletefile_C (C_Path => C_Path (C_Path'First)'Address) = 0);
    end Delete_File;

    function Delete_Directory (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           (Deletedirectory_C (C_Path => C_Path (C_Path'First)'Address) = 0);
    end Delete_Directory;


    function Existent_Entry (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           (Directoryentryexistent_C (C_Path => C_Path (C_Path'First)'Address) =
            0);
    end Existent_Entry;


    function Entry_Value (Iter : in Integer) return String is
        S : System.Address;
    begin
        S := Directoryentryvalue_C (C_Iter => Iter);
        return Ada_C.String_C_To_Ada (S);
    end Entry_Value;


    function Entry_Size (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Directoryentrysize_C (C_Path => C_Path (C_Path'First)'Address);
    end Entry_Size;

    function Number_Of_Links (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Directoryentrynumberoflinks_C
                  (C_Path => C_Path (C_Path'First)'Address);
    end Number_Of_Links;


    function Entry_Username (Path : in String) return String is
        S : System.Address;  
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        S := Directoryentryusername_C (C_Path => C_Path (C_Path'First)'Address);
        return Ada_C.String_C_To_Ada (S);
    end Entry_Username;

    function Entry_Groupname (Path : in String) return String is
        S : System.Address;  
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        S := Directoryentrygroupname_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
        return Ada_C.String_C_To_Ada (S);
    end Entry_Groupname;

    function Time_Of_Last_Update (Path : in String) return Calendar.Time is
        S : System.Address;
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
        Day : Calendar.Day_Number;
        Month : Calendar.Month_Number;
        Year : Calendar.Year_Number;
        Sec : Calendar.Day_Duration;
    begin
        S := Dateoflastupdate_C (C_Path => C_Path (C_Path'First)'Address);
        declare
            Str : constant String := Ada_C.String_C_To_Ada (S);
            Worked : Boolean := True;
        begin
            String_Utilities.String_To_Number
               (Str (Str'First .. Str'First + 1), Day, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 2 .. Str'First + 3), Month, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 4 .. Str'First + 7), Year, Worked);
        end;
        Sec := Duration (Timeoflastupdate_C
                            (C_Path => C_Path (C_Path'First)'Address));
        return Calendar.Time_Of (Year, Month, Day, Sec);
    end Time_Of_Last_Update;

    function Time_Of_Last_Read (Path : in String) return Calendar.Time is
        S : System.Address;
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
        Day : Calendar.Day_Number;
        Month : Calendar.Month_Number;
        Year : Calendar.Year_Number;
        Sec : Calendar.Day_Duration;
    begin
        S := Dateoflastaccess_C (C_Path => C_Path (C_Path'First)'Address);
        declare
            Str : constant String := Ada_C.String_C_To_Ada (S);
            Worked : Boolean := True;
        begin
            String_Utilities.String_To_Number
               (Str (Str'First .. Str'First + 1), Day, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 2 .. Str'First + 3), Month, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 4 .. Str'First + 7), Year, Worked);
        end;
        Sec := Duration (Timeoflastaccess_C
                            (C_Path => C_Path (C_Path'First)'Address));
        return Calendar.Time_Of (Year, Month, Day, Sec);
    end Time_Of_Last_Read;

    function Is_Directory (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Isdirectory_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Directory;

    function Is_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Isregularfile_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_File;

    function Is_Bloc_Special_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Isblocspecialfile_C (C_Path => C_Path (C_Path'First)'Address)) =
            1);
    end Is_Bloc_Special_File;

    function Is_Character_Special_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Ischaracterspecialfile_C
                    (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Character_Special_File;

    function Is_Fifo (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Isfifo_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Fifo;

    function Is_Socket (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Issocket_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Socket;

    function Is_Symbolic_Link (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Issymboliclink_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Symbolic_Link;

    function Is_Multiplex_Character_Special_File
                (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Ismultiplexfile_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Multiplex_Character_Special_File;

    function Entry_Owner_Permissions (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Entryownerpermissions_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
    end Entry_Owner_Permissions;

    function Entry_Group_Permissions (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Entrygrouppermissions_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
    end Entry_Group_Permissions;

    function Entry_Other_Permissions (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Entryotherpermissions_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
    end Entry_Other_Permissions;

    procedure Change_Owner_Permissions (Path : in String; Mode : in Integer) is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        Changeownerpermissions_C
           (C_Path => C_Path (C_Path'First)'Address, C_Mode => Mode);
    end Change_Owner_Permissions;

    procedure Change_Group_Permissions (Path : in String; Mode : in Integer) is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        Changegrouppermissions_C
           (C_Path => C_Path (C_Path'First)'Address, C_Mode => Mode);
    end Change_Group_Permissions;

    procedure Change_Other_Permissions (Path : in String; Mode : in Integer) is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        Changeotherpermissions_C
           (C_Path => C_Path (C_Path'First)'Address, C_Mode => Mode);
    end Change_Other_Permissions;


    function Change_Directory (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           (Changedirectory_C (C_Path => C_Path (C_Path'First)'Address) = 0);
    end Change_Directory;

    function Get_Home_Directory return String is
    begin
        return Ada_C.String_C_To_Ada (Gethomedirectory_C);
    end Get_Home_Directory;

    function Get_Absolute_Path (The_Path : in String) return String is
        C_Path : constant String := Ada_C.String_Ada_To_C (The_Path);
        S : System.Address;
    begin  
        S := Getabsolutepath_C (C_Path1 => C_Path (C_Path'First)'Address);
        return Ada_C.String_C_To_Ada (S);
    end Get_Absolute_Path;

    function Get_Error_Message return String is
    begin
        return Ada_C.String_C_To_Ada (Geterrormessage_C);
    end Get_Error_Message;

end Directory_Implementation;