CP/M/CPM_CDROM.iso/cpm/turbopas/decuf10.ark/DECUF.PAS

Pascal/Delphi Source File | 1989-09-27 | 15KB | 415 lines

program DECode_Uuencoded_File ;
{$A+}  { Generate NON-recursive code (shorter and faster) }
{$C+}  { Do check for ^C and ^S during console output     }
{$R-}  { Check all subrange variables to be within range  }
{$U-}  { Do NOT check for ^C continuously                 }
{$W2}  { Allow up to 2 simultanous active WITH statements }
{* ====================================================================
 *
 * DecUF - Decode 'uuencoded' files.  The input file may contain one
 *         or more 'uuencoded' files.
 *
 * Version 0.1 , 199101, original coding
 *  Wim J.M. Nelis      ([e-mail])
 *  Rozenhof 4
 *  8316 CX  Marknesse
 *  the Netherlands
 * Version 0.2 , 199105, include extended file name unit.
 *
 * Note that this is a preliminary version: both parameters and error
 * control still need to be implemented!
 *}
const
   CurrentDrive     =     0  ;  { Indication for current drive in DOS calls }
   DefaultExtension = '.UUE' ;  { Default extension of input file name }
   MaxChunkSize     =   512  ;  { Max size of one chunk of converted data }

type
   KeyWordString = string[16] ;  { A keyword, possibly a file name }
   Message       = string[50] ;  { (Error) message }

   ChunkPtr   = ^Chunks ;
   ChunkSizes = 0..MaxChunkSize ;
   Chunks   = record
                NextChunk :   ChunkPtr ;  { Pointer to next chunk }
                ChunkSize : ChunkSizes ;  { Size of this chunk }
                Data : array[1..MaxChunkSize] of Byte ;
              end ;

   DecodingStates   = ( Sextet0,   { Decode 4 sextets into 3 octets }
                        Sextet1,
                        Sextet2,
                        Sextet3 ) ;

   LineFormats      = ( Unknown,   { Format is not known yet }
                        Single ,   { Length only at start of line }
                        Double ) ; { Length at start and end of line }

   ProcessingStates = ( Look_For_Start,   { Look for either TABLE or BEGIN }
                        Reading_Table ,   { Read the conversion table }
                        Reading_Begin ,   { Proces BEGIN statement }
                        Reading_Data  ,   { Convert the next data line }
                        Completed     ) ; { END encountered }

   ErrorTypes = ( Catastrophic,   { Error is fatal to program execution }
                  Fatal       ,   { Error is fatal to file conversion }
                  Warning     ,   { Error can optionally be ignored }
                  Informative ) ; { Error is result of other error }

   LineErrors = ( IllegalCharacter,   { Control character skipped }
                  Overflow        ,   { Line buffer too short }
                  IllegalFormat   ,   { Length field cannot be decoded }
                  WrongLength     ,   { Line length mismatch }
                  WrongTerminator ) ; { Terminator is not 'M' }

{$IEXTFN.UNT}

var
{* --- Input/Output files --- *}
   InputFile       :            Text ;  { Input file }
   InputFileName   :   FullFileNames ;  { Input file Name }
   InputFileDesc   : FileDescriptors ;  { Input file name, internal format }
   OutputFile      :            File ;  { Result file, may be any type }
   OutputFilePath  :   FullFileNames ;  { Path to directory to receive result file }
   OutputFileName  :   FullFileNames ;  { Full name of result file }
   OutputFileDesc  : FileDescriptors ;  { Outputfile name, internal format }
   OutputFileOpen  :         Boolean ;  { OutputFile is opened }

{* --- Option flags --- *}
   OnlyOneFile     : Boolean ;  { Input file contains one encoded file }
   StrictChecking  : Boolean ;  { Check every line in encoded file }
   VerboseMode     : Boolean ;  { Give a progres report }

   DecodeTable     : array[' '..#255] of Byte ;  { Decoding table }
   DecodeState     : DecodingStates ;

   HeadChunkList   : ChunkPtr ;  { Head of the list of chunks }
   TailChunkList   : ChunkPtr ;  { Tail of the list of chunks }

   ProcessingState :  ProcessingStates ;  { Current state }
   NextLine        :        string[80] ;  { Current line }
   LineIndex       :             1..80 ;  { Index in NextLine }
   LineFormat      :       LineFormats ;  { Format of encoded lines }
   ErrorsInLine    : set of LineErrors ;  { Errors detected in current line }

{* --- Statistics per result file --- *}
   BytesWritten      : Integer ;  { Number of bytes written }
   CharactersRead    : Integer ;  { Number of characters read }
   CharactersSkipped : Integer ;  { Number of characters skipped }
   HeapFlushes       : Integer ;  { Number of times the heap is flushed }
   LinesRead         : Integer ;  { Number of lines read }
   LinesSkipped      : Integer ;  { Number of lines NOT decoded }
   LinesWritten      : Integer ;  { Number of lines written }


{*
 * The functions Dec and Inc are included to obtain a little bit of
 * compatibility with TP 5.0 and higher.
 *}

procedure Dec( var SomeValue : Integer ) ;
begin
   SomeValue:= Pred( SomeValue ) ;
end ;  { of Dec }

procedure Inc( var SomeValue : Integer ) ;
begin
   SomeValue:= Succ( SomeValue ) ;
end ;  { of Inc }

{$IDECUF.IF0}
{$IDECUF.IF1}

{* ----------------------------------------------------------------- *
 *                                                                   *
 *      S T A T E   P R O C E S S O R    P R O C E D U R E S         *
 *                                                                   *
 * ----------------------------------------------------------------- *}

procedure ProcesBegin ;
{*
 * ProcesBegin - Extract the result file name from the 'begin'
 *               statement and open a file with that name.
 *}
const
   PathDelimiter : array[0..2] of char = ':\/' ;
var
   KeyWord  : KeyWordString ;  { Keyword from line }
   Mode     : KeyWordString ;  { Octal encoded permission flags }
   FileName : KeyWordString ;  { Original file name }
   I        :       Integer ;  { Loop control variable }
begin
   LineIndex:= 1 ;  { Preset index for interpretation of header }
   Keyword:= NextWord ;
   if KeyWord='begin' then
    begin
     Mode    := NextWord ;
     FileName:= NextWord ;
     if FileName<>'' then
      begin
{*
 * Remove any path indication from the file name.  CP/M paths, MS-DOS
 * paths as well as UNIX paths are removed from the supplied name.
 *}
       for I:= 0 to 2 do
         while Pos( PathDelimiter[I], FileName ) <> 0 do
           FileName:= Copy( Filename,
                            Succ(Pos(PathDelimiter[I],FileName)), 255 ) ;
{*
 * Open the output file and swap to the Reading_Data state.  WARNING: The
 * procedure OpenOutputFile might change the processing state as well, in
 * case of an error. Thus the order of the 4 statements below is crucial!
 *}
       OutputFileName := OutputFilePath + FileName ;
       ProcessingState:= Reading_Data ;
       OpenOutputFile ;
       if ProcessingState=Reading_Data then
         WriteLn( 'Decoding to file ', OutputFileName ) ;
      end
     else  { there is no filename on begin statement }
       Panic( Fatal, 'File name missing in begin statement' ) ;
    end
   else  { the line is not a begin statement }
     Panic( Fatal, 'Expecting a begin statement' ) ;
end ;  { of ProcesBegin }

procedure CheckForStart ;
{*
 * CheckForStart - Check the line read for the keywords TABLE or BEGIN,
 *                 which indicate the start of the encoded file.
 *}
var
   KeyWord : KeyWordString ;  { Keyword from line }
begin
   if ErrorsInLine=[] then
     if Length(NextLine)>=5 then
      begin
       KeyWord:= Copy( NextLine, 1, 5 ) ;
       if Keyword='table' then
         ProcessingState:= Reading_Table
       else
         if KeyWord='begin' then
           ProcesBegin ;
      end ;  { of if/if }
end ;  { of CheckForStart }

procedure ReadConversionTable ;
{*
 * ReadConversionTable - Read the conversion table from the input file
 *                       and save it in the DecodeTable.
 *}
var
   EntryCount : Integer ;  { Number of entries in conversion table }
   I0         :    Char ;  { Loop control variable }
   I1         : Integer ;  { Loop control variable }
begin
   for I0:=' ' to Chr(255) do   { Preset conversion table .. }
     DecodeTable[I0]:= $FF ;    { with invalid entriers }

   if (ErrorsInLine<>[]) or (Length(NextLine)<>32) then
    begin
     Panic( Fatal, 'Illegal conversion table' ) ;
     Exit ;
    end ;  { of if }
   for I1:= 1 to 32 do
     DecodeTable[NextLine[I1]]:= Pred(I1) ;

   ReadNextLine ;
   if (ErrorsInLine<>[]) or (Length(NextLine)<>32) then
    begin
     Panic( Fatal, 'Illegal conversion table' ) ;
     Exit ;
    end ;  { of if }
   for I1:= 1 to 32 do
     DecodeTable[NextLine[I1]]:= Pred(I1) + 32 ;

   EntryCount:= 0 ;
   for I0:= ' ' to Chr(255) do
     if DecodeTable[I0]<>$FF then
       Inc( EntryCount ) ;
   if EntryCount<>64 then
    begin
     Panic( Fatal, 'Ambiguous conversion table' ) ;
     Exit ;
    end ;  { of if }

   ProcessingState:= Reading_Begin ;
end ;  { of ReadConversionTable }

procedure ProcesData ;
{*
 * ProcesData - Decode the (encoded) line read if the end of input
 *              is not encountered.  The end of input is signalled
 *              by the END statement.
 *}
var
   ExpectedLength : Integer ;  { Length encoded in line image }
   DeltaLength    : Integer ;  { Expected minus actual length }
   Byte1          :    Byte ;  { Decode bytes }
   Byte2          :    Byte ;
   Byte3          :    Byte ;
   I              : Integer ;  { Loop control variable }

 procedure DecodeCharacter( NextChar : Char ) ;
 {*
  * DecodeCharacter - Decode one character.
  *}
 var
    Sextet : Byte ;  { One decoded character }
 begin
    Sextet:= DecodeTable[NextChar] ;
    if Sextet<>$FF then
      case DecodeState of
        Sextet0 : begin
                    Byte1:= Sextet shl 2 ;
                    DecodeState:= Sextet1 ;
                  end ;  { of case 0 }
        Sextet1 : begin
                    Byte1:= Byte1 + ( (Sextet shr 4) and $03 ) ;
                    Byte2:=           (Sextet shl 4) and $F0   ;
                    WriteByteToChunk( Byte1 ) ;
                    DecodeState:= Sextet2 ;
                  end ;  { of case 1 }
        Sextet2 : begin
                    Byte2:= Byte2 + (Sextet          shr 2) ;
                    Byte3:=         (Sextet and $03) shl 6  ;
                    WriteByteToChunk( Byte2 ) ;
                    DecodeState:= Sextet3 ;
                  end ;  { of case 2 }
        Sextet3 : begin
                    Byte3:= Byte3 + Sextet ;
                    WriteByteToChunk( Byte3 ) ;
                    DecodeState:= Sextet0 ;
                  end ;  { of case 3 }
      end   { of cases }
    else  { character cannot be decoded }
      ErrorsInLine:= ErrorsInLine + [IllegalCharacter] ;
 end ;  { of DecodeCharacter }

begin
{*
 * If in verbose mode, give an indication of the progres.
 *}
   if VerboseMode then
     if (LinesRead and $000F)=0 then
       Write( ^M'Line ', LinesRead ) ;
{*
 * Check if the current line contains the statement 'end'.  If so,
 * swap to the processingstate Completed.
 *}
   if Length(NextLine)=3 then
     if NextLine='end' then
      begin
       FileEpilogue ;  { Finish processing current file }
       FilePrologue ;  { Setup to convert next file }
       ProcessingState:= Completed ;
       Exit ;
      end ;  { of if }

{*
 * Extract the length of the line from the line itself: it is encoded
 * in the first character of the line.  This length should match the
 * actual length of the line.
 *}
   if ErrorsInLine=[] then
    begin
     ExpectedLength:= (DecodeTable[NextLine[1]]*4) div 3 ;
     if (ExpectedLength>=0) then
      begin
       DeltaLength:= Length(NextLine) - ExpectedLength ;
       case LineFormat of
         Unknown : case DeltaLength of
                     1 : begin
                          LineFormat:= Single ;
                          NextLine:= Copy( NextLine, 2, ExpectedLength ) ;
                         end ;  { of case 1 }
                     2 : begin
                          LineFormat:= Double ;
                          NextLine:= Copy( NextLine, 2, ExpectedLength ) ;
                         end ;  { of case 2 }
                   else
                     ErrorsInLine:= ErrorsInLine + [WrongLength] ;
                   end ;  { of case Unknown }
         Single  : if DeltaLength=1 then
                     NextLine:= Copy( NextLine, 2, ExpectedLength )
                   else
                     ErrorsInLine:= ErrorsInLine + [WrongLength] ;
         Double  : if DeltaLength<>2 then
                     ErrorsInLine:= ErrorsInLine + [WrongLength]
                   else
                     if NextLine[Length(NextLine)]<>'M' then
                       ErrorsInLine:= ErrorsInLine + [WrongTerminator]
                     else
                       NextLine:= Copy( NextLine, 2, ExpectedLength ) ;
       end ;  { of case }
      end
     else  { the length field cannot be decoded }
       ErrorsInLine:= ErrorsInLine + [IllegalFormat] ;
   end ;  { of if }

{*
 * If no errors are detected, decode the line.  If any errors are found,
 * the reaction will depend on the checking mode: strict or relaxed.  In
 * the latter case the line and the error(s) are ignored.
 *}
   if ErrorsInLine=[] then
    begin
     I:= 0 ;
     while (ErrorsInLine=[]) and (I<Length(NextLine)) do
      begin
       I:= Succ(I) ;
       DecodeCharacter( NextLine[I] ) ;
       if ErrorsInLine<>[] then
         Panic( Fatal, 'Illegal character : '+NextLine[I] ) ;
      end ;  { of while }
    end
   else
    begin
     Inc( LinesSkipped ) ;
     Panic( Warning, 'Illegal format of line' ) ;
    end ;  { of if }
end ;  { of ProcesData }


{*
 * Start of main program.
 *}
var
   Done : Boolean ;  { Conversion of file completed }
begin
   InitFileNameUnit ;
   ProgramPrologue ;

   OpenInputFile ;
   ProcessingState:= Look_For_Start ;
   Done           :=          False ;
   while not (Eof(InputFile) or Done) do
    begin
     ReadNextLine ;
     case ProcessingState of
       Look_For_Start : CheckForStart ;
       Reading_Table  : ReadConversionTable ;
       Reading_Begin  : ProcesBegin ;
       Reading_Data   : ProcesData ;
       Completed      : if OnlyOneFile then
                          Done:= True
                        else
                          CheckForStart ;
     else
       Panic( Fatal, 'Unexpected processing state' ) ;
     end ;  { of case }
    end ; { of while }

   case ProcessingState of
      Look_For_Start  : Panic( Informative,
                        'No valid encoded data found on '+InputFileName ) ;
      Reading_Table   ,
      Reading_Begin   ,
      Reading_Data    : Panic( Informative,
                        'Unexpected end-of-file found on'+InputFileName ) ;
   end ;  { of cases }

   ProgramEpilogue ;
   UnInitFileNameUnit ;
end.