DataMuseum.dk

top - download

    Length: 6984 (0x1b48)
    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 String_Utilities;
separate (Object_Management_System)
package body Any_Object is

    function Is_Library (Any_Object : Library_Object) return Boolean is
    begin
        return Any_Object.Subclass = Library_Subclass;
    end Is_Library;

    function Is_C_Unit (Any_Object : Library_Object) return Boolean is
    begin
        return Any_Object.Subclass = C_Unit_Subclass;
    end Is_C_Unit;

    function Is_Unix_File (Any_Object : Library_Object) return Boolean is
    begin
        return Any_Object.Subclass = Unix_File_Subclass;
    end Is_Unix_File;


    function Make_Library_Object
                (The_Name : String;
                 The_Subclass : Subclass_Enumeration :=
                    Object_Management_System.Unix_File_Subclass)
                return Library_Object is
        Obj : Directory.Object;
    begin
        begin
            Directory.Any_Object.Open (Obj, The_Name);
        exception
            when Directory.Non_Existent_Object_Error =>
                return Nil;
        end;
        case The_Subclass is
            when Library_Subclass =>
                return Library_Object'
                          (Subclass => Library_Subclass,
                           Name => Gs.Value
                                      (Directory.Naming.Simple_Name (Obj)),
                           Unix_Library => Obj,
                           Kind => Library.A_Directory);
            when Unix_File_Subclass =>
                return Library_Object'(Subclass => Unix_File_Subclass,
                                       Name => Gs.Value (The_Name),
                                       Unix_File => Obj);
            when others =>
                return Nil;
        end case;
    end Make_Library_Object;


    procedure Create (The_Object : in out Library_Object;
                      The_Name : String;
                      The_Subclass : Subclass_Enumeration :=
                         Object_Management_System.Unix_File_Subclass) is
        Obj : Directory.Object;
    begin
        case The_Subclass is
            when Library_Subclass =>
                Library.Create (The_Library => The_Object,
                                Name => The_Name,
                                Kind => Library.A_Directory);
            when Unix_File_Subclass =>
                begin
                    Directory.Any_Object.Create
                       (The_Object => Obj,
                        Object_Name => The_Name,
                        Object_Class => Directory.File_Class,
                        Object_Owner_Permissions =>
                           Directory.Statistics.R_W_Permission,
                        Object_Group_Permissions =>
                           Directory.Statistics.R_W_Permission,
                        Object_Other_Permissions =>
                           Directory.Statistics.R_W_Permission);
                    The_Object := Library_Object'
                                     (Subclass => Unix_File_Subclass,
                                      Name => Gs.Value (The_Name),
                                      Unix_File => Obj);
                exception
                    when Directory.Already_Existent_Object_Error =>
                        The_Object := Nil;  
                    when Directory.System_Error =>
                        The_Object := Nil;
                end;
            when others =>
                The_Object := Nil;
        end case;
    end Create;


    procedure Move (The_Object : in out Library_Object; New_Name : String) is
    begin
        The_Object.Name := Gs.Value (New_Name);
        case The_Object.Subclass is
            when Library_Subclass =>
                Directory.Any_Object.Rename (The_Object.Unix_Library, New_Name);
            when Unix_File_Subclass =>
                Directory.Any_Object.Rename (The_Object.Unix_File, New_Name);
            when others =>
                null;
        end case;
    end Move;


    procedure Delete (The_Object : in out Library_Object) is
    begin
        case The_Object.Subclass is
            when Library_Subclass =>
                Directory.Any_Object.Delete (The_Object.Unix_Library);
            when Unix_File_Subclass =>
                Directory.Any_Object.Delete (The_Object.Unix_File);
            when others =>
                null;
        end case;  
        The_Object := Nil;
    end Delete;


    function Enclosing_Library
                (The_Object : Library_Object) return Library_Object is
        Obj : Directory.Object;
    begin
        case The_Object.Subclass is
            when Library_Subclass =>
                Obj := Directory.Traversal.Parent
                          (Directory.Traversal.Parent
                              (The_Object.Unix_Library));
            when Unix_File_Subclass =>
                Obj := Directory.Traversal.Parent
                          (Directory.Traversal.Parent (The_Object.Unix_File));
            when others =>
                return Nil;
        end case;
        return Library_Object'
                  (Subclass => Library_Subclass,
                   Name => Gs.Value (Directory.Naming.Simple_Name (Obj)),
                   Unix_Library => Obj,
                   Kind => Library.A_Directory);
    exception
        when Directory.Non_Existent_Object_Error =>
            return Nil;
    end Enclosing_Library;


    function Image (The_Object : Library_Object) return String is
    begin
        case The_Object.Subclass is
            when Library_Subclass =>
                return Normalise (Gs.Image (The_Object.Name), 30) &
                          "    " & Image (The_Object.Subclass) & " (" &
                          Library.Image (Library.Kind (The_Object)) & ")";
            when C_Unit_Subclass =>
                return Normalise (Gs.Image (The_Object.Name), 30) & " " &
                          Normalise
                             (C_Unit.Image (C_Unit.State (The_Object)), 3) &
                          Image (The_Object.Subclass) & " (" &
                          C_Unit.Image (C_Unit.Kind (The_Object)) & ")";
            when Unix_File_Subclass =>
                return Normalise (Gs.Image (The_Object.Name), 30) &
                          "    " & Image (The_Object.Subclass);
            when others =>
                return " ";
        end case;
    end Image;

    function Value (The_String : String) return Library_Object is
        Iter : Iterator;
        I : constant Natural := String_Utilities.Locate
                                   (' ', The_String, False);
        Str : constant String := The_String (The_String'First .. I - 1);
        Lib_Obj : Library_Object := Nil;
    begin
        Reset (Iter);
        while not Done (Iter) loop
            Lib_Obj := Value (Iter);
            if Gs.Image (Lib_Obj.Name) = Str then
                return Lib_Obj;
            end if;
            Next (Iter);
        end loop;
        return Nil;
    end Value;

end Any_Object;