Ada 95 :: x80_exp.ada

with Ada.Text_io;   -- **** FIXED
use  Ada.Text_io;   -- **** FIXED
package Class_line is
  type Line_status is ( TEXT_LINE, FILE_NAME, UNKNOWN );
  type Line is private;
  procedure get_line( the:in out Line; fd:in Ada.Text_io.File_type );
  procedure put_line( the:in Line; fd:in Ada.Text_io.File_type );
  procedure get_fd( the:in out Line; fd:in out Ada.Text_io.File_type );
  function  status( the:in Line ) return Line_status;
private
  MAX_LINE : CONSTANT := 200;
  subtype Line_index is Integer range 0 .. MAX_LINE+1;
  subtype Line_range is Line_index range 1 .. MAX_LINE;
  subtype Line_array is String( Line_range );
  type Line is record
    chs : Line_array;       -- Characters of line
    len : Line_index;       -- Positions used
    open: Boolean := FALSE; -- Output file open
  end record;
  name     : Line_array;    -- File name from file
  name_pos : Line_index;    -- Characters in name
end Class_line;

with Ada.Text_io, Ada.Characters.handling;
use  Ada.Text_io, Ada.Characters.handling;
package body Class_line is
  procedure get_line( the:in out Line; fd:in Ada.Text_io.File_type ) is
    pos : Line_index := 0;
    ch  : Character;
  begin
    while not end_of_line( fd ) loop
      get( fd, ch );
      if pos < MAX_LINE then
        pos := pos + 1;
        the.chs(pos) := ch;
      end if;
    end loop;
    the.len := pos;
    skip_line( fd );
  end get_line;
     
  procedure put_line( the:in Line; fd:in Ada.Text_io.File_type ) is
  begin
    if the.open then
      for i in 2 .. the.len loop
        put( fd, the.chs(i) );
      end loop;
      new_line( fd );
    end if;
  end put_line;

  function status( the:in Line ) return Line_status is
    pos  : Line_index := 0;
  begin
    if the.len >= 1 and then the.chs(1) = '+' then 
      return TEXT_LINE;
    end if;
    if the.len >= 2 and then the.chs(1..2) = "@@" then
      for i in 3 .. the.len-2 loop
        if is_upper( the.chs(i) ) or is_lower( the.chs(i) ) or
           is_digit( the.chs(i) ) or the.chs(i) = '_' or 
           the.chs(i) = '.' then 
          pos := pos + 1;
          name(pos) := the.chs(i);
        end if;
      end loop;
      name_pos := pos;
      put( "Extracting file " & name(1..pos) ); new_line;
      return FILE_NAME;
    end if;
    return UNKNOWN;
  end status;
      
  procedure get_fd( the:in out Line; fd:in out Ada.Text_io.File_type ) is
  begin
    if the.open then                    -- Output file open
      close( fd ); the.open := FALSE;
    end if;
    create( File=>fd, Mode=>out_FILE,   -- Create file
            Name=>name(1..name_pos) );
    the.open := TRUE;
  exception
    when Name_error =>
      put("Exp: Can not create file " & name(1..name_pos) ); 
      new_line;
    when Status_error =>
      put("Exp: " & name(1..name_pos) & " all ready open" );
      new_line;
    when others =>
      put("Exp: " & name(1..name_pos) & " unknown error" );
      new_line;
  end;

end Class_line;
      
    
with Ada.Text_io, Ada.Command_line, Class_line; -- **** FIXED
use  Ada.Text_io, Ada.Command_line, Class_line;
procedure main is
  i_fd   : Ada.Text_io.File_type;        -- File descriptor
  o_fd   : Ada.Text_io.File_type;        -- File descriptor
  a_line : Class_line.Line;
begin
  if argument_count >= 1 then
    for i in 1 .. argument_count loop    -- Repeat for each file
      begin
        open( File=>i_fd, Mode=>IN_FILE, -- Open file
              Name=>argument(i) );
        while not end_of_file(i_fd) loop -- For each Line
          get_line( a_line, i_fd );
          case status(a_line) is
            when TEXT_LINE =>            -- Write to file
              put_line( a_line, o_fd );
            when FILE_NAME =>            -- Get file name
              get_fd( a_line, o_fd );    
            when UNKNOWN =>              -- Ignore
              null;
          end case;
        end loop;
        close(i_fd);                     -- Close file
      exception
        when Name_error =>
          put("Exp: " & argument(i) & " no such file" );
          new_line;
        when Status_error =>
          put("Exp: " & argument(i) & " all ready open" );
          new_line;
        when others =>
          put("Exp: " & argument(i) & " unknow error" );
          new_line;
      end;
    end loop;
  else
    put("Usage: Exp file1 ... "); new_line;
  end if;
end main;


© M.A.Smith University of Brighton. Created September 1995 last modified May 1997.
Comments, suggestions, etc. M.A.Smith@brighton.ac.uk * [Home page]