{$A-}
PROGRAM CHAPTER3;
{$I TOOLU.PAS}
VAR CMDPTR:FILE;
PROCEDURE COMPARE;FORWARD;
PROCEDURE INCLUDE;FORWARD;
PROCEDURE CONCAT;FORWARD;

PROCEDURE MAKECOPY;
VAR
  INNAME,OUTNAME:XSTRING;
  FIN,FOUT:FILEDESC;
BEGIN
  IF(NOT GETARG(2,INNAME,MAXSTR))
    OR (NOT GETARG(3,OUTNAME,MAXSTR))THEN
      ERROR('USAGE:MAKECOPY OLD NEW');
  FIN:=MUSTOPEN(INNAME,IOREAD);
  FOUT:=MUSTCREATE(OUTNAME,IOWRITE);
  FCOPY(FIN,FOUT);
  XCLOSE(FIN);
  XCLOSE(FOUT)
END;

PROCEDURE PRINT;
VAR
  NAME:XSTRING;
  NULL:XSTRING;
  I:INTEGER;
  FIN:FILEDESC;
  JUNK:BOOLEAN;

PROCEDURE FPRINT(VAR NAME:XSTRING;FIN:FILEDESC);
CONST
  MARGIN1=2;
  MARGIN2=2;
  BOTTOM=64;
  PAGELEN=66;
VAR
  LINE:XSTRING;
  LINENO,PAGENO:INTEGER;

PROCEDURE SKIP(N:INTEGER);
VAR
  I:INTEGER;
BEGIN
  FOR I:=1 TO N DO
    PUTC(NEWLINE)
END;

PROCEDURE HEAD(VAR NAME:XSTRING;PAGENO:INTEGER);
VAR
  PAGE:XSTRING;
BEGIN
  PAGE[1]:=ORD(' ');
  PAGE[2]:=ORD('P');
  PAGE[3]:=ORD('a');
  PAGE[4]:=ORD('g');
  PAGE[5]:=ORD('e');
  PAGE[6]:=ORD(' ');
  PAGE[7]:=ENDSTR;
  PUTSTR(NAME,STDOUT);
  PUTSTR(PAGE,STDOUT);
  PUTDEC(PAGENO,1);
  PUTC(NEWLINE)
END;

BEGIN(*FPRINT*)
  PAGENO:=1;
  SKIP(MARGIN1);
  HEAD(NAME,PAGENO);
  SKIP(MARGIN2);
  LINENO:=MARGIN1+MARGIN2+1;
  WHILE(GETLINE(LINE,FIN,MAXSTR))DO BEGIN
    IF(LINENO=0)THEN BEGIN
      SKIP(MARGIN1);;
      PAGENO:=PAGENO+1;
      HEAD(NAME,PAGENO);
      SKIP(MARGIN2);
      LINENO:=MARGIN1+MARGIN2+1
    END;
    PUTSTR(LINE,STDOUT);
    LINENO:=LINENO+1;
    IF(LINENO>=BOTTOM)THEN BEGIN
      SKIP(PAGELEN-LINENO);
      LINENO:=0
    END
  END;
  IF(LINENO>0)THEN
    SKIP(PAGELEN-LINENO)
END;
  
BEGIN(*PRINT*)
  NULL[1]:=ENDSTR;
  IF(NARGS=1)THEN
    FPRINT(NULL,STDIN)
  ELSE
    FOR I:=2 TO NARGS DO BEGIN
      JUNK:=GETARG(I,NAME,MAXSTR);
      FIN:=MUSTOPEN(NAME,IOREAD);
      FPRINT(NAME,FIN);
      XCLOSE(FIN)
    END
END;

PROCEDURE COMPARE;
VAR
  LINE1,LINE2:XSTRING;
  ARG1,ARG2:XSTRING;
  LINENO:INTEGER;
  INFILE1,INFILE2:FILEDESC;
  F1,F2:BOOLEAN;
  
PROCEDURE DIFFMSG (N:INTEGER; VAR LINE1,LINE2:XSTRING);
BEGIN
  PUTDEC(N,1);
  PUTC(COLON);
  PUTC(NEWLINE);
  PUTSTR(LINE1,STDOUT);
  PUTSTR(LINE2,STDOUT)
END;

BEGIN(*COMPARE*)
  IF (NOT GETARG(2,ARG1,MAXSTR))
   OR (NOT GETARG(3,ARG2,MAXSTR)) THEN
     ERROR('USAGE:COMPARE FILE1 FILE2');
  INFILE1:=MUSTOPEN(ARG1,IOREAD);
  INFILE2:=MUSTOPEN(ARG2,IOREAD);
  LINENO:=0;
  REPEAT
    LINENO:=LINENO+1;
    F1:=GETLINE(LINE1,INFILE1,MAXCTR);
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  EGER;
VAR
  C:CHARACTER;
  FD:FILEDESC;
  N:INTEGER;
BEGIN
  N:=0;
  FD:=MUSTOPEN(NAME,IOREAD);
  WHILE(GETCF(C,FD)<>ENDFILE)DO
    N:=N+1;
  XCLOSE(FD);
  FSIZE:=N
END;

BEGIN
  SCOPY(ARCHHDR,1,HEAD,1);
  I:=XLENGTH(HEAD)+1;
  HEAD[I]:=BLANK;
  SCOPY(NAME,1,HEAD,I+1);
  I:=XLENGTH(HEAD)+1;
  HEAD[I]:=BLANK;
  I:=ITOC(FSIZE(NAME),HEAD,I+1);
  HEAD[I]:=NEWLINE;
  HEAD[I+1]:=ENDSTR
END;

BEGIN
  NFD:=OPEN(NAME,IOREAD);
  IF(NFD=IOERROR)THEN BEGIN
    PUTSTR(NAME,STDERR);
    WRITELN(':CAN''T ADD');
    ERRCOUNT:=ERRCOUNT+1
  END;
  IF(ERRCOUNT=0)THEN BEGIN
    MAKEHDR(NAME,HEAD);
    PUTSTR(HEAD,FD);
    FCOPY(NFD,FD);
    XCLOSE(NFD)
  END
END;


PROCEDURE REPLACE(AFD,TFD:FILEDESC;CMD:INTEGER);
VAR
  PINLINE,UNAME:XSTRING;
  SIZE:INTEGER;
BEGIN
  WHILE(GETHDR(AFD,PINLINE,UNAME,SIZE))DO
    IF(FILEARG(UNAME))THEN BEGIN
      IF(CMD=ORD('U'))THEN
        ADDFILE(UNAME,TFD);
      FSKIP(AFD,SIZE)
    END
    ELSE BEGIN
      PUTSTR(PINLINE,TFD);
      ACOPY(AFD,TFD,SIZE)
    END
END;

PROCEDURE HELP;
BEGIN
  ERROR('USAGE:ARCHIVE -[CDPTUX] ARCHNAME [FILES...]')
END;


PROCEDURE GETFNS;
VAR
  I,J:INTEGER;
  JUNK:BOOLEAN;
BEGIN
  ERRCOUNT:=0;
  NFILES:=NARGS-3;
  IF(NFILES>MAXFILES)THEN
    ERROR('ARCHIVE:TO MANY FILE NAMES');
  FOR I:=1 TO NFILES DO
    JUNK:=GETARG(I+3,FNAME[I],MAXSTR);
  FOR I:=1 TO NFILES DO
   FSTAT[I]:=FALSE;
  FOR I:=1 TO NFILES-1 DO
    FOR J:=I+1 TO NFILES DO
      IF(EQUAL(FNAME[I],FNAME[J]))THEN BEGIN
        PUTSTR(FNAME[I],STDERR);
        ERROR(':DUPLICATE FILENAME')
      END
END;


PROCEDURE UPDATE(VAR ANAME:XSTRING;CMD:CHARACTER);
VAR
  I:INTEGER;
  AFD,TFD:FILEDESC;
BEGIN
  TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  IF(CMD=ORD('u')) THEN BEGIN
   AFD:=MUSTOPEN(ANAME,IOREAD);
   REPLACE(AFD,TFD,ORD('u'));(*UPDATE EXISTING*)
   XCLOSE(AFD)
 END;
 FOR I:=1 TO NFILES DO
   IF(FSTAT[I]=FALSE)THEN BEGIN
      ADDFILE(FNAME[I],TFD);
      FSTAT[I]:=TRUE
    END;
    XCLOSE(TFD);
    IF(ERRCOUNT=0)THEN
      FMOVE(ARCHTEMP,ANAME)
    ELSE
      WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
    REMOVE (ARCHTEMP)
  END;
PROCEDURE TABLE(VAR ANAME:XSTRING);
VAR
  HEAD,NAME:XSTRING;
  SIZE:INTEGER;
  AFD:FILEDESC;
PROCEDURE TPRINT(VAR BUF:XSTRING);
VAR
  I:INTEGER;
  TEMP:XSTRING;
BEGIN
  I:=GETWORD(BUF,1,TEMP);
  I:=GETWORD(BUF,I,TEMP);
  PUTSTR(TEMP,STDOUT);
  PUTC(BLANK);
  I:=GETWORD(BUF,I,TEMP);(*SIZE*)
  PUTSTR(TEMP,STDOUT);
  PUTC(NEWLINE)
END;

BEGIN
  AFD:=MUSTOPEN(ANAME,IOREAD);
  WHILE(GETHDR(AFD,HEAD,NAME,SIZE))DO BEGIN
    IF(FILEARG(NAME))THEN
      TPRINT(HEAD);
    FSKIP(AFD,SIZE)
  END;
  NOTFOUND
END;

PROCEDURE EXTRACT (VAR ANAME:XSTRING;CMD:CHARACTER);
VAR
  ENAME,PINLINE:XSTRING;
  AFD,EFD:FILEDESC;
  SIZE : INTEGER;
BEGIN
  AFD:=MUSTOPEN(ANAME,IOREAD);
  IF (CMD=ORD('p')) THEN
    EFD:=STDOUT
  ELSE
    EFD:=IOERROR;
  WHILE (GETHDR(AFD,PINLINE,ENAME,SIZE)) DO
    IF (NOT FILEARG(ENAME))THEN
      FSKIP(AFD,SIZE)
    ELSE
      BEGIN
      IF (EFD<> STDOUT) THEN
        EFD:=CREATE(ENAME,IOWRITE);
      IF(EFD=IOERROR) THEN BEGIN
        PUTSTR(ENAME,STDERR);
        WRITELN(': CANT''T CREATE');
        ERRCOUNT:=ERRCOUNT+1;
        FSKIP(AFD,SIZE)
      END
      ELSE BEGIN
        ACOPY(AFD,EFD,SIZE);
        IF(EFD<>STDOUT)THEN
        XCLOSE(EFD)
      END
    END;
    NOTFOUND
  END;

PROCEDURE DELETE(VAR ANAME:XSTRING);
VAR
  AFD,TFD:FILEDESC;
BEGIN
  IF(NFILES<=0)THEN(*PROTECT INNOCENT*)
    ERROR('ARCHIVE:-D REQUIRES EXPLICIT FILE NAMES');
  AFD:=MUSTOPEN(ANAME,IOREAD);
  TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  REPLACE(AFD,TFD,ORD('d'));
  NOTFOUND;
  XCLOSE(AFD);
  XCLOSE(TFD);
  IF(ERRCOUNT=0)THEN
    FMOVE(ARCHTEMP,ANAME)
  ELSE
    WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
  REMOVE(ARCHTEMP)
END;


PROCEDURE INITARCH;
BEGIN
  ARCHTEMP[1]:=ORD('A');
  ARCHTEMP[2]:=ORD('R');
  ARCHTEMP[3]:=ORD('T');
  ARCHTEMP[4]:=ORD('E');
  ARCHTEMP[5]:=ORD('M');
  ARCHTEMP[6]:=ORD('P');
  ARCHTEMP[7]:=ENDSTR;
  ARCHHDR[1]:=ORD('-');
  ARCHHDR[2]:=ORD('H');
  ARCHHDR[3]:=ORD('-');
  ARCHHDR[4]:=ENDSTR;
END;


BEGIN
  INITARCH;
  IF (NOT GETARG(2,CMD,MAXSTR))
    OR(NOT GETARG(3,ANAME,MAXSTR)) THEN
      HELP;
  GETFNS;
  IF(XLENGTH(CMD)<>2) OR(CMD[1]<>ORD('-')) THEN
    HELP
  ELSE IF (CMD[2]=ORD('c'))OR(CMD[2]=ORD('u'))THEN
    UPDATE(ANAME,CMD[2])
  ELSE IF (CMD[2]=ORD('t'))THEN
    TABLE(ANAME)
  ELSE IF (CMD[2]=ORD('x'))OR(CMD[2]=ORD('p'))THEN
    EXTRACT(ANAME,CMD[2])
  ELSE IF (CMD[2]=ORD('d'))THEN
    DELETE(ANAME)
  ELSE
    HELP
END;

PROCEDURE COMMAND;
VAR I:INTEGER;XS:XSTRING;B:BOOLEAN;
  S:PACKED ARRAY[1..3]OF CHAR;
BEGIN
  B:=GETARG(1,XS,MAXSTR);
  IF (B=TRUE)THEN BEGIN
    for i:=1 to 3 do
      if islower(xs[i])then s[i]:=chr(xs[i]-32)else s[i]:=chr(xs[i]);
  END
  ELSE {bdos(0,0)} HALT;  {N.J.R}
  IF(S='COM')THEN COMPARE
  ELSE IF (S='INC')THEN INCLUDE
  ELSE IF (S='CON')THEN CONCAT
  ELSE IF (S='PRI')THEN PRINT
  ELSE IF (S='MAK')THEN MAKECOPY
  ELSE IF (S='ARC')THEN ARCHIVE
END;

BEGIN
  COMMAND;
  ENDCMD;ASSIGN(CMDPTR,'SHELL.COM');EXECUTE(CMDPTR);
END.


