DataMuseum.dk

top - download

    Length: 6331 (0x18bb)
    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 Text_Io;
separate (Directory)
package body Any_Object is

    procedure Open (The_Object : in out Object; Object_Name : String) is
        O      : Object;
        Result : Boolean;
    begin
        if Di.Existent_Entry (Path => Object_Name) then
            if Directory.Naming.Absolute (The_Name => Object_Name) then
                Gs.Create (O.Name, Object_Name);
            else
                Gs.Create (O.Name,
                           Directory.Naming.Absolute_Name (Object_Name));
            end if;
            The_Object := O;
        else
            raise Non_Existent_Object_Error;
        end if;  
    end Open;

    procedure Create (The_Object               : in out Object;
                      Object_Name              :        String;
                      Object_Class             :        Class_Enumeration :=
                         Directory.Unknown_Class;
                      Object_Owner_Permissions :
                         Statistics.Permission_Enumeration                :=
                         Directory.Statistics.R_W_Permission;
                      Object_Group_Permissions :
                         Statistics.Permission_Enumeration                :=
                         Directory.Statistics.R_W_Permission;
                      Object_Other_Permissions :
                         Statistics.Permission_Enumeration                :=
                         Directory.Statistics.R_W_Permission) is
        O      : Object;
        Result : Boolean;
    begin
        if Di.Existent_Entry (Path => Object_Name) then
            raise Already_Existent_Object_Error;
        else
            case Object_Class is
                when Directory_Class =>
                    if Di.Create_Directory
                          (Path              => Object_Name,
                           Owner_Permissions => Object_Owner_Permissions,
                           Group_Permissions => Object_Group_Permissions,
                           Other_Permissions => Object_Other_Permissions) then
                        if Naming.Absolute (Object_Name) then  
                            Gs.Create (O.Name, Object_Name);
                        else
                            Gs.Create (O.Name,
                                       Naming.Absolute_Name (Object_Name));
                        end if;
                    else
                        Put_Error_Message;
                        raise System_Error;
                    end if;
                when File_Class =>
                    if Di.Create_File (Path              => Object_Name,
                                       Owner_Permissions =>
                                          Object_Owner_Permissions,
                                       Group_Permissions =>
                                          Object_Group_Permissions,
                                       Other_Permissions =>
                                          Object_Other_Permissions) then
                        if Naming.Absolute (Object_Name) then  
                            Gs.Create (O.Name, Object_Name);
                        else
                            Gs.Create (O.Name,
                                       Naming.Absolute_Name (Object_Name));
                        end if;
                    else
                        Put_Error_Message;
                        raise System_Error;
                    end if;
                when others =>
                    Put_Error_Message
                       (The_Message =>
                           "You can only create directories or regular files");
                    raise System_Error;
            end case;
            The_Object := O;
        end if;
    end Create;


    procedure Copy (Source           :        Object;  
                    Destination_Name : in     String;
                    Destination      : in out Object) is
        O : Object;
    begin
        if Naming.Absolute (Destination_Name) then  
            Gs.Create (O.Name, Destination_Name);
        else
            Gs.Create (O.Name, Naming.Absolute_Name (Destination_Name));
        end if;
        case Class (Source) is
            when File_Class =>
                if not Di.Copy_File (The_Path =>
                                        Naming.Full_Name (The_Object => Source),
                                     To_Path  => Naming.Full_Name
                                                    (The_Object => O)) then
                    Put_Error_Message;  
                    raise System_Error;
                end if;  
            when Directory_Class =>
                if not Di.Copy_Directory
                          (The_Path => Naming.Full_Name (The_Object => Source),
                           To_Path  => Naming.Full_Name (The_Object => O)) then
                    Put_Error_Message;
                    raise System_Error;
                end if;
            when others =>
                Put_Error_Message
                   (The_Message =>
                       "Only directories and regular files can be copied");
                raise System_Error;
        end case;
        Destination := O;
    end Copy;

    procedure Rename (Source : in out Object; Destination_Name : in String) is
        O : Object;
    begin
        if Naming.Absolute (Destination_Name) then  
            Gs.Create (O.Name, Destination_Name);
        else
            Gs.Create (O.Name, Naming.Absolute_Name (Destination_Name));
        end if;
        if not Di.Move (The_Path => Naming.Full_Name (Source),
                        To_Path  => Naming.Full_Name (O)) then
            Put_Error_Message;
            raise System_Error;
        end if;
        Source := O;
    end Rename;

    procedure Delete (The_Object : in out Object) is
        Ok : Boolean;
    begin
        case Class (The_Object) is
            when Directory_Class =>
                Ok := Di.Delete_Directory (Path =>
                                              Naming.Full_Name (The_Object));
            when others =>
                Ok := Di.Delete_File (Path => Naming.Full_Name (The_Object));
        end case;
        if not Ok then
            Put_Error_Message;
            raise System_Error;
        end if;
        The_Object := Nil;
    end Delete;

end Any_Object;