::
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]