MODULE Chop;

(*

Chop v0.92 by Terry Brown, 1991

Chop filename [-sn] [-bn] [-cn] [-Bs|-As] [-in] [-Ps] [-p]

-sn  skip first n bytes, start from start if omitted
-bn  take only n byte chunks, take remainder of file if omitted
-cn  take only n chunks, take chunks to end of file if omitted
-Bs  after taking -bn bytes, take bytes until string s is reached
-As  after taking -bn bytes, take bytes until end of string s is reached
-in  buffer size n kilobytes, default 40, needs two of them
-Ps  string s is path and file name for output
-p   prompt before writing each file

s must conatin no spaces, ? matches anything, and `hh is a hex constant

watch for shells which pre-expand wild cards etc.

Eg. Chop dh0:bigText -b10000 -B`0A`20 -Pdf0:textBit -p

breaks bigText into roughly 10000 byte peices before lines starting with a
space, saving them to df0:textBit.1, df0:textBit.2 etc., and giving you a
chance to change disks before each write.
(`0A`20 is hex for newline + space)


*)


FROM CommandLine    IMPORT GetCL,CLStrings;
FROM InOut          IMPORT WriteString,WriteLn;
IMPORT InOut; (* need Read from here and DOSFiles *)
FROM LongInOut      IMPORT WriteLongCard;
FROM Memory         IMPORT AllocMem,FreeMem,MemReqSet;
FROM DOSFiles       IMPORT Open,Close,FileHandle,ModeNewFile,ModeOldFile,
                           Seek,OffsetBeginning,Read,Write,DeleteFile;
FROM Strings        IMPORT Copy,InitStringModule,Concat,CompareResults,
                           Compare,Length,Delete,Insert;
FROM Conversions    IMPORT ConvertFromString,ConvertToString;
FROM SYSTEM         IMPORT ADDRESS,NULL;

CONST
maxArgs         = 9;
skpArg          = "-s";
szeArg          = "-b";
cntArg          = "-c";
bfrArg          = "-B";
aftArg          = "-A";
bufArg          = "-i";
preArg          = "-P";
pmtArg          = "-p";

multiWild       = "*";
singleWild      = "?";
hexPrecur       = "`";
defaultBuf      = 40*1024;

TYPE
states          = (srchI,endI,endN,done,writeI,writeN);

VAR
inFile,outFile      : FileHandle;
inFileNm,outFileNm  : CLStrings;
iBuf,nBuf,tBuf,
iStrt,iEnd,
nStrt,nEnd          : ADDRESS;
bufSize,skpSize,
blkSize,blkCount,
blkNum,actRead,
actWrite,curSize    : LONGCARD;
split,before        : BOOLEAN;
splitStr            : CLStrings;
arg                 : ARRAY [1..maxArgs] OF CLStrings;
args                : CARDINAL;
lcard               : LONGCARD;
lint                : LONGINT;
i,j,iOld            : CARDINAL;
bool,more,bufSwt,
killSrch,prompt,
falseMatch          : BOOLEAN;
s                   : CLStrings;
c                   : CHAR;
cPtr,matchStrt      : POINTER TO CHAR;
matchPos            : CARDINAL;
state               : states;

PROCEDURE ErrMsg;

BEGIN

WriteLn;
WriteLn; WriteString("Chop v0.92 by Terry Brown, 1991");
WriteLn;
WriteLn; WriteString("Chop filename [-sn] [-bn] [-cn] [-Bs|-As] [-in] [-Ps] [-p]");
WriteLn;
WriteLn; WriteString("-sn  skip first n bytes, start from start if omitted");
WriteLn; WriteString("-bn  take only n byte chunks, take remainder of file if omitted");
WriteLn; WriteString("-cn  take only n chunks, take chunks to end of file if omitted");
WriteLn; WriteString("-Bs  after taking -bn bytes, take bytes until string s is reached");
WriteLn; WriteString("-As  after taking -bn bytes, take bytes until end of string s is reached");
WriteLn; WriteString("-in  buffer size n kilobytes, default 40, needs two of them");
WriteLn; WriteString("-Ps  string s is path and file name for output");
WriteLn; WriteString("-p   prompt before writing each file");
WriteLn;
WriteLn; WriteString("s must conatin no spaces, ? matches anything, and `hh is a hex constant");
WriteLn;
WriteLn; WriteString("watch for shells which pre-expand wild cards etc.");
WriteLn;
WriteLn; WriteString("Eg. Chop dh0:bigText -b10000 -B`0A`20 -Pdf0:textBit -p");
WriteLn;
WriteLn; WriteString("breaks bigText into roughly 10000 byte peices before lines starting with a");
WriteLn; WriteString("space, saving them to df0:textBit.1, df0:textBit.2 etc., and giving you a");
WriteLn; WriteString("chance to change disks before each write.");
WriteLn; WriteString("(`0A`20 is hex for newline + space)");
WriteLn;
END ErrMsg;


PROCEDURE begins(a,b : CLStrings) : BOOLEAN;

(* return true if string a matches string a begins with string b *)

VAR
s : CLStrings; 

BEGIN

  Copy(a,0,Length(b),s);
  IF Compare(s,b)=Equal THEN 
  RETURN TRUE
  ELSE
  RETURN FALSE
  END;

END begins;


PROCEDURE nextOut(fn : CLStrings; n : LONGCARD) : FileHandle;

VAR
done      : BOOLEAN;
s         : CLStrings;
x         : FileHandle;
c         : CHAR;

BEGIN

  ConvertToString(n,10,FALSE,s,done);
  WHILE Length(s)<3 DO
    Insert("0",s,0);
  END;
  Concat(".",s,s);
  Concat(fn,s,s);
  
  IF prompt THEN
    WriteString("Hit RETURN to write file ");
    WriteString(s);
    InOut.Read(c);
  END;
  
  x:=Open(s,ModeNewFile);
  IF x=0 THEN
    WriteString("Couldn't open output file");
    WriteLn;
  END;  

  RETURN x;

END nextOut;


PROCEDURE flush; (* rest of buffer *)

BEGIN

   actWrite:=Write(outFile,iStrt,LONGCARD(iEnd-iStrt));
   curSize:=curSize+actWrite; (* everything we've got *)

END flush;


PROCEDURE switch;

(* swap buffer and load next, if it exists *)

BEGIN

   IF (nEnd=nBuf) THEN
     more:=FALSE; (* that's all of it *)
   ELSE
     tBuf:=iBuf; (* don't lose track of buffer *)
     iBuf:=nBuf;
     iStrt:=nStrt;
     iEnd:=nEnd;
     nBuf:=tBuf;
     IF iEnd=iBuf+ADDRESS(bufSize) THEN (* that was a full buffer *)
       actRead:=Read(inFile,nBuf,bufSize);
       nStrt:=nBuf; nEnd:=nBuf+ADDRESS(actRead);
     ELSE
       nStrt:=nBuf; nEnd:=nBuf;
     END; (* getting next buffer if possible *)
   END; (* buffer switching *)
   
END switch;


(* the program ************************************************************)

BEGIN

  InitStringModule; (* why ? *)
  
  IF NOT GetCL(args,arg) OR (args<2) THEN
    ErrMsg;
    RETURN;
  END;
  
  FOR i:=1 TO args DO
    IF arg[i,Length(arg[i])-1]=CHR(10) THEN
	  Delete(arg[i],Length(arg[i])-1,1);
	END;
  END;
  
  inFileNm:=arg[1];
  outFileNm:=inFileNm;
  prompt:=FALSE;
  skpSize:=0;
  blkSize:=0;
  blkCount:=0; (* indicates keep taking blocks until there's none left *)
  split:=FALSE;
  bufSize:=defaultBuf;
  
  i:=2;

  iOld:=maxArgs+10; (* make sure iOld<>i *)
  
  WHILE (i<=args) AND (iOld<>i) DO
  
    iOld:=i;
  
    IF begins(arg[i],skpArg) THEN
      Copy(arg[i],Length(skpArg),Length(arg[i])-Length(skpArg),s);
      ConvertFromString(s,10,FALSE,MAX(LONGCARD),lcard,bool);
      IF bool THEN skpSize:=lcard END;
      INC(i);
    END;
    
    IF begins(arg[i],szeArg) THEN
      Copy(arg[i],Length(szeArg),Length(arg[i])-Length(szeArg),s);
      ConvertFromString(s,10,FALSE,MAX(LONGCARD),lcard,bool);
      IF bool THEN blkSize:=lcard END;
      INC(i);
    END;
  
    IF begins(arg[i],cntArg) THEN
      Copy(arg[i],Length(cntArg),Length(arg[i])-Length(cntArg),s);
      ConvertFromString(s,10,FALSE,MAX(LONGCARD),lcard,bool);
      IF bool THEN blkCount:=lcard END;
      INC(i);
    END;

    IF begins(arg[i],preArg) THEN
      Copy(arg[i],Length(bfrArg),Length(arg[i])-Length(bfrArg),outFileNm);
      INC(i);
    END;
    
    IF begins(arg[i],pmtArg) THEN
      prompt:=TRUE;
      INC(i);
    END;
    
    IF begins(arg[i],bfrArg) THEN
      split:=TRUE; before:=TRUE;
      Copy(arg[i],Length(bfrArg),Length(arg[i])-Length(bfrArg),splitStr);
      INC(i);
    END;
    
    IF begins(arg[i],aftArg) THEN
      split:=TRUE; before:=FALSE;
      Copy(arg[i],Length(aftArg),Length(arg[i])-Length(aftArg),splitStr);
      INC(i);
    END;
    
    IF begins(arg[i],bufArg) THEN
      Copy(arg[i],Length(cntArg),Length(arg[i])-Length(cntArg),s);
      ConvertFromString(s,10,FALSE,MAX(LONGCARD),lcard,bool);
      IF bool THEN bufSize:=1024*lcard END;
      INC(i);
    END;
    
  END; (* WHILE args to parse *)

  IF i<args THEN (* not all command line arguments were used *)
    ErrMsg;
    RETURN;
  END;

  WriteString("inFile : "); WriteString(inFileNm); WriteLn;
  WriteString("skip   : "); WriteLongCard(skpSize,10); WriteLn;
  WriteString("size   : "); WriteLongCard(blkSize,10); WriteLn;
  WriteString("count  : "); WriteLongCard(blkCount,10); WriteLn;
  IF split THEN
    IF before THEN
      WriteString("before : "); WriteString(splitStr); WriteLn;
    ELSE
      WriteString("after  : "); WriteString(splitStr); WriteLn;
    END;
  END;
  WriteString("buffer : "); WriteLongCard(bufSize,10);
  WriteString(" (");
  WriteLongCard(2*bufSize,10); WriteString(" bytes total)");
  WriteLn;
  IF Compare(inFileNm,outFileNm)<>Equal THEN
    WriteString("prefix : "); WriteString(outFileNm); WriteLn;
  END;
  IF prompt THEN 
    WriteString("Prompt before each file");WriteLn;
  END;
  
  WriteLn;
  WriteString("Continue ? (y/n) ");
  InOut.Read(c);
  IF (c<>"y") AND (c<>"Y") THEN RETURN END;

  IF split THEN (* pre-parse search string *)
    i:=0;
    WHILE INTEGER(i)<INTEGER(Length(splitStr))-2 DO
      IF splitStr[i]=hexPrecur THEN (* a hex thing *)
        Copy(splitStr,i+1,2,s);
        Delete(splitStr,i,2);
        ConvertFromString(s,16,FALSE,255,lcard,bool);
        splitStr[i]:=CHR(SHORT(lcard));
      END;
      INC(i); (* as usual, I forgot the first time *)
    END;
  END;


  IF prompt THEN
    InOut.Read(c); (* seems to need flushing *)
  END;

  
 (* start setup **************************************************************)
  
  inFile:=Open(inFileNm,ModeOldFile);
  IF inFile=0 THEN
    WriteString("Couldn't open input file");
    WriteLn;
    RETURN;
  END;  
  
    
  iBuf:=AllocMem(bufSize,MemReqSet{});
  IF iBuf=0 THEN
    WriteString("Couldn't get mem for input buffer 1");
    WriteLn;
    Close(inFile);
    Close(outFile);
    RETURN;
  END;
  
  nBuf:=AllocMem(bufSize,MemReqSet{});
  IF nBuf=0 THEN
    WriteString("Couldn't get mem for input buffer 2");
    WriteLn;
    Close(inFile);
    Close(outFile);
    FreeMem(iBuf,bufSize);
    RETURN;
  END;
  
  (* load buffers ******************************************************)
  
   
  IF skpSize<>0 THEN
    lint:=Seek(inFile,LONGINT(skpSize),OffsetBeginning);
    IF lint=-1 THEN
      Close(inFile);
      Close(outFile);
      FreeMem(iBuf,bufSize);
      FreeMem(nBuf,bufSize);
      WriteString("Error skipping data - skipped whole file?");
      WriteLn;
      RETURN
    END;
  END;

  IF blkSize=0 THEN (* now just copy out rest of file *)
  
   blkNum:=1;
   outFile:=nextOut(outFileNm,blkNum);
   IF outFile=0 THEN
     Close(inFile);
	 RETURN;
   END;
	 
  
    REPEAT
      actRead:=Read(inFile,iBuf,bufSize);
      actWrite:=Write(outFile,iBuf,actRead);
    UNTIL actRead<>bufSize;
    
    Close(outFile);
    
  ELSE (* got to chop it up *)
  
    (* first, load both buffers *)
    
    actRead:=Read(inFile,iBuf,bufSize);
    iStrt:=iBuf; iEnd:=iBuf+ADDRESS(actRead);
    IF actRead=bufSize THEN
      actRead:=Read(inFile,nBuf,bufSize);
      nStrt:=nBuf; nEnd:=nBuf+ADDRESS(actRead);
    ELSE
      nStrt:=nBuf; nEnd:=nBuf;
    END;
    
    more:=TRUE; (* more available *)
    blkNum:=1;
    
    
    REPEAT
    
      outFile:=nextOut(outFileNm,blkNum);
      IF outFile=0 THEN
        Close(inFile);
   	    RETURN;
      END;
         
      curSize:=0; (* number of bytes out to the current block *)

      killSrch:=FALSE;
    
      
      WHILE (curSize<blkSize) AND more DO
        IF ADDRESS(blkSize-curSize)<=iEnd-iStrt THEN
          actWrite:=Write(outFile,iStrt,blkSize-curSize);
          curSize:=curSize+actWrite;
          iStrt:=iStrt+ADDRESS(actWrite);
          matchPos:=0;
          
          IF split THEN
          
            cPtr:=iStrt;
            matchPos:=0;
            state:=srchI;
            
            WHILE state<>done DO
            
              CASE state OF
              
              srchI :
                WHILE (cPtr^<>splitStr[matchPos]) AND more DO
                  INC(cPtr);
                  IF cPtr>=iEnd THEN
                    flush;
                    switch;
                    cPtr:=iStrt;
                  END;
                END;
                IF NOT more THEN
                  state:=done; (* didn't find start of target *)
                ELSE
                  matchStrt:=cPtr;
                  state:=endI; (* found start *)
                END;
              | (* all for srchI *)
                
              endI :
                REPEAT
                  INC(matchPos);
                  INC(cPtr);
                UNTIL (cPtr=iEnd) OR (matchPos>=Length(splitStr)) OR (cPtr^<>splitStr[matchPos]);
                IF matchPos>=Length(splitStr) THEN
                  state:=writeI;
                ELSE
                  IF cPtr=iEnd THEN
                    cPtr:=nStrt;
                    state:=endN;
                  ELSE  (* not target *)
                    state:=srchI;
                    matchPos:=0;
                    cPtr:=matchStrt;
                    INC(cPtr);
                  END;
                END;
              | (* end of search in iBuf *)
                
              endN :
                WHILE ((cPtr^=splitStr[matchPos]) OR (cPtr^=singleWild)) AND (matchPos<Length(splitStr)) AND (cPtr<nEnd) DO
                  INC(cPtr);
                  INC(matchPos);
                END;
                IF matchPos=Length(splitStr) THEN
                  state:=writeN;
                ELSE
                  IF cPtr=nEnd THEN
                    WriteString("Out of range search for end of target");
                    state:=srchI;
                    cPtr:=matchStrt;
                    INC(cPtr);
                  ELSE (* not target *)
                    state:=srchI;
                    cPtr:=matchStrt;
                    INC(cPtr);
                  END;
                END;
              | (* end of endN *)
                
              writeI :
                IF before THEN
                  actWrite:=Write(outFile,iStrt,LONGCARD(ADDRESS(matchStrt)-iStrt));
                  iStrt:=matchStrt;
                  state:=done;
                ELSE
                  actWrite:=Write(outFile,iStrt,LONGCARD(ADDRESS(cPtr)-iStrt));
                  iStrt:=cPtr;
                  state:=done;
                END;
                
              | (* done i Write *)
              
              writeN :
                IF before THEN 
                  actWrite:=Write(outFile,iStrt,LONGCARD(ADDRESS(matchStrt)-iStrt));
                  iStrt:=matchStrt;
                  state:=done;
                ELSE  
                  flush; (* send all of iBuf *)
                  actWrite:=Write(outFile,nBuf,LONGCARD(ADDRESS(cPtr)-nBuf));
                  nStrt:=cPtr;
                  switch;
                  state:=done;
                END;
              | (* done n Write *)
              
              ELSE (* case shouldn't come here ! *)
              
              END; (* case *)                  
                
            END; (* when state=done *)
          END; (* if split *)
                
        ELSE (* not enough in buffer *)
          flush;  (* give it what there is *)
          switch; (* see if theres more, will set more=FALSE if not *)
        END; (* sending buffer (or part of) to block *)
      END; (* making block *)
    
      Close(outFile);
	  
      IF curSize=0 THEN (* whoops, created empty file *)
        ConvertToString(blkNum,10,FALSE,s,bool);
        WHILE Length(s)<3 DO
          Insert("0",s,0);
        END;
        Concat(".",s,s);
        Concat(outFileNm,s,s);
		IF NOT DeleteFile(s) THEN
		  WriteLn;
		  WriteString("Whoops, error deleting empty file.");
		  WriteLn;
		END;
      END;
	  
      INC (blkNum);
      
      IF (blkNum>blkCount) AND (blkCount<>0) THEN
        more:=FALSE; (* even if it's not *)
      END;
        
    UNTIL NOT more; (* all blocks made *)
  
  END; (* end of cut up *)
  

  Close(inFile);
  
  FreeMem(iBuf,bufSize);
  FreeMem(nBuf,bufSize);

END Chop.