DataMuseum.dk

top - metrics - download

    Length: 5947 (0x173b)
    Types: TextFile
    Names: »TAR'BODY«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦f8040168a⟧ 
                └─⟦this⟧ »TAR'BODY« 

TextFile

with Bounded_String;
with Device_Independent_Io;
with Directory;
with Io_Exceptions;
with Log;
with Profile;
with System;
with Tape_Specific;

package body Tar is

    package Dio renames Device_Independent_Io;

    function Image (Status : Directory.Naming.Name_Status) return String
                  renames Directory.Naming.Name_Status'Image;


    -- utility software

    procedure Put_Bytes (Data : System.Byte_String) is separate;

    procedure Put_Line (Data : String := "") is
    begin
        Log.Put_Line (Data);
    end Put_Line;

    procedure Open_Out_File (File : in out Device_Independent_Io.File_Type; 
                             Name : String; 
                             Form : String := "") is
    begin
        Dio.Open (File, Dio.Out_File, Name, Form);
    exception
        when Dio.Name_Error => 
            Dio.Create (File, Dio.Out_File, Name, Form);
            Put_Line (Name & " was created.");
    end Open_Out_File;

    package Block_Buffer is

        type Buffer_Type is private;

        procedure Open (Buffer : in out Buffer_Type; 
                        Mode : Dio.File_Mode; 
                        Name : String; 
                        Record_Size : Positive; 
                        Records_Per_Block : Positive; 
                        Swap_Bytes : Boolean);

        procedure Close (Buffer : in out Buffer_Type);

        procedure Read (Buffer : in out Buffer_Type; 
                        Data : out System.Byte_String);

        procedure Write (Buffer : in out Buffer_Type; 
                         Data : System.Byte_String);

    private
        Max_Block_Size : constant Positive := Tape_Specific.Byte_Range'Last;
        type Buffer_Type is
            record
                File  : Dio.File_Type;
                Block : Positive;
                Swap  : Boolean;
                Count : Natural;
                Data  : System.Byte_String (1..Max_Block_Size);
            end record;
    end Block_Buffer;

    package body Block_Buffer is separate;

    function To_Byte_String (Item : String) return System.Byte_String is
        Answer : System.Byte_String (Item'Range);
    begin
        for I in Answer'Range loop
            Answer (I) := System.Byte (Character'Pos (Item (I)));
        end loop;
        return Answer;
    end To_Byte_String;

    function To_String (Item : System.Byte_String) return String is
        Answer : String (1..Item'Length);
    begin
        for I in Answer'Range loop
            Answer (I) := Character'Val (Item (Item'First + I - 1));
        end loop;
        return Answer;
    end To_String;

    package Tar_Header is

        Namsiz : constant := 100;

        subtype Name_Type is Bounded_String.Variable_String
             (Maximum_Length => Namsiz - 1);

        type Short is new Natural range 0..2 ** 16 - 1;
        type Long is new Natural;

        type Header is
            record
                Name     : Name_Type;
                Mode     : Short;
                Uid      : Short;
                Gid      : Short;
                Size     : Long;
                Mtime    : Long;
                Linkflag : Character;
                Linkname : Name_Type;
            end record;

        function Default return Header;

        procedure Put (Data : Header; Into : out System.Byte_String);
        procedure Get (Data : out Header; From : System.Byte_String);

    end Tar_Header;

    package body Tar_Header is separate;

    function File_Byte_Count (Header : System.Byte_String) return Natural is
        Hdr : Tar_Header.Header;
    begin
        Tar_Header.Get (Hdr, From => Header);
        return Natural (Hdr.Size);
    end File_Byte_Count;

    function File_End (Header : System.Byte_String) return Boolean is
    begin
        return System."=" (Header (Header'First), 0);
    end File_End;

    function File_Name (Header : System.Byte_String) return String is
        Hdr : Tar_Header.Header;
    begin
        Tar_Header.Get (Hdr, From => Header);
        return Bounded_String.Image (Hdr.Name);
    end File_Name;

    package Naming is
        function To_Unix_Name (Rational_Name : String) return String;
        function To_Rational_Name (Unix_Name : String) return String;
        function Matches (Name, Template : String) return Boolean;
    end Naming;

    package body Naming is separate;

    function Length (File_Name : String) return Natural is
        File   : Dio.File_Type;
        Buffer : System.Byte_String (1..1024);
        Count  : Natural;
        Total  : Natural := 0;
    begin
        Dio.Open (File, Dio.In_File, File_Name);
        while not Dio.End_Of_File (File) loop
            Dio.Read (File, Buffer, Count);
            Total := Total + Count;
        end loop;
        Dio.Close (File);
        return Total;
    end Length;


    -- operations in visible part

    procedure Write (Files : Name := ""; 
                     Archive : Name := Tar.Tape; 
                     Record_Size : Positive := Tar.Tblock; 
                     Records_Per_Block : Positive := 8; 
                     Swap_Bytes : Boolean := False) is separate;

    procedure Read (Files : Name := "?"; 
                    Archive : Name := Tar.Tape; 
                    Record_Size : Positive := Tar.Tblock; 
                    Records_Per_Block : Positive := 8; 
                    Swap_Bytes : Boolean := False) is separate;

    procedure List (Files : Name := "?"; 
                    Archive : Name := Tar.Tape; 
                    Record_Size : Positive := Tar.Tblock; 
                    Records_Per_Block : Positive := 8; 
                    Swap_Bytes : Boolean := False) is separate;

    procedure Dump (Files : Name := "?"; 
                    Archive : Name := Tar.Tape; 
                    Record_Size : Positive := Tar.Tblock; 
                    Records_Per_Block : Positive := 8; 
                    Swap_Bytes : Boolean := False) is separate;

end Tar;