home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
fileutil
/
rxdecode
/
rxdecode.cmd
next >
Wrap
OS/2 REXX Batch file
|
1993-11-13
|
33KB
|
867 lines
/*
program: RxDecode.cmd
type: REXXSAA-OS/2, 32bit OS/2 !
purpose: harvest all XX- and UU-chunks, reorder them, reassamble them to the original, provide
for the translation table, if it is missing (thereby allowing decoding with both,
XXDECODE and UUDECODE), strip mail-headers, -trailers, comments, shar-leadins,
shar-ends etc. and finally have
them decoded. After successful decoding the chunks- and work-files will be deleted, if
an error occurs, they remain untouched. It takes care of the newer UU-codetables which
replace the blank-character with the `-character (unfortunately some use both characters
in the coded file, so `-characters are translated into blank-characters).
version: 2.3
date: 1992-02-04
changed: 1992-06-05, RGF, load all RexxUtils, if not loaded
1993-09-08, RGF, added additional logic to find first valid encoded data and
last valid encoded data, check leadin of first line in order
to determine encoding set, if no translation-table was
provided
1993-09-20, changed the definition of ANSI-color-sequences; gets them from
procedure ScrColor.CMD
1993-11-06, allow more than one encoded part within a file, added more colors
1993-11-13, took care of cases, in which lines coincidentally look like encoded
ones, right before the truely encoded body;
if RxDecode has to supply the UU-translation table, do a translation
of ` to blanks by default
needs: SysFileTree(), SysTempFileName() loaded (in 32bit OS/2 available),
SCRCOLOR.CMD
usage: RXDECODE [X|U] [/B]
... decodes all XX- and UU-encoded files in present directory
X ... use XXDECODE only to process UU- and XX-encoded files
U ... use UUDECODE only to process UU- and XX-encoded files
possible formats:
chunks-order in file extension:
foo.uu1 foo.uu2 foo.uu3 foo.uu4 foo.uu5 foo.uu6
foo.uu7 foo.uu8 foo.uu9 foo.u10 foo.u11 foo.u12
chunks-order in file-body:
foo1.uue foo2.uue foo3.uue foo4.uue foo5.uue foo6.uue
foo7.uue foo8.uue foo9.uue foo10.uue foo11.uue foo12.uue
normal encoded file:
foo.xxe
author: Rony G. Flatscher,
Wirtschaftsuniversitaet/Vienna
RONY@AWIWUW11.BITNET
rony@wu-wien.ac.at
All rights reserved, copyrighted 1992, 1993, no guarantee that it works without
errors, etc. etc.
donated to the public domain granted that you are not charging anything
(money etc.) for it and derivates based upon it, as you did not write it,
etc. if that holds you may bundle it with commercial programs too
Please, if you find an error, post me a message describing it, I will
try to fix and rerelease it to the net.
RxDecode.cmd: catenate XX- and UU-encoded files and execute UUDECODE or XXDECODE
*/
SIGNAL ON HALT /* if user presses CTL-C */
/* check whether RxFuncs are loaded, if not, load them */
IF RxFuncQuery('SysLoadFuncs') THEN
DO
/* load the load-function */
CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
/* load the Sys* utilities */
CALL SysLoadFuncs
END
/* UUencoded files */
file. = "" /* default is empty */
file.1 = "*.u*" /* uu-encoded files */
file.1.ext = "UUE"
file.1.text = "processing" file.1.ext"-encoded files..."
file.1.pgm = "UUDECODE" /* decoding program */
file.2 = "*.x*" /* xx-encoded files */
file.2.ext = "XXE"
file.2.text = "processing" file.2.ext"-encoded files..."
file.2.pgm = "XXDECODE" /* decoding program */
g. = "" /* default for g.-elements (global-array) is empty string */
PARSE UPPER ARG argument
IF POS("/B", argument) = 0 THEN /* get screen-colors */
PARSE VALUE ScrColor() WITH g.eScrNorm g.eScrInv g.eTxtNorm g.eTxtInf g.eTxtHi,
g.eTxtAla g.eTxtNormInv g.eTxtInfInv g.eTxtHiInv g.eTxtAlaInv .
ELSE /* remove "/B" from argument */
DO
PARSE VAR argument left "/B" right
argument = left right
END
IF argument <> "" THEN
DO
IF POS("X", argument) > 0 THEN file.1.pgm = "XXDECODE" /* use XXDECODE for both, XX- & UU-encoded files */
ELSE IF POS("U", argument) > 0 THEN file.2.pgm = "UUDECODE" /* use UUDECODE for both, XX- & UU-encoded files */
ELSE SIGNAL usage
END
files_to_delete.0 = 0 /* initialize stem-count to 0 */
DO i = 1 TO 2
CALL say_c COPIES("=", 79)
CALL say_c g.eTxtHi || file.i.text
CALL say_c
CALL SysFileTree file.i, "filestmp", "FO" /* get fully qualified filenames */
CALL say_c " " || g.eTxtHi || filestmp.0 || g.eTxtInf "file(s) found"
IF filestmp.0 = 0 THEN /* if no files were found iterate */
DO
DROP filestmp.
ITERATE
END
CALL say_c
CALL sort_procedure /* sort files according to ASCII-table */
CALL reorder /* reorder those files which consist of more than 9 chunks,
because ASCII-sort sorts numbers before letters ! */
IF (filestmp.0 - files.0) <> 0 THEN
DO
CALL say_c g.eTxtAla || " ("filestmp.0 - files.0 "file(s) cannot be processed.)"
CALL say_c
END
DROP filestmp. /* not needed anymore */
CALL say_c " " || g.eTxtHi || files.0 || g.eTxtInf "file(s) is (are) being processed..."
/* catenate and decode files */
g.eTempFile = "" /* temporary file to hold concatenated chunks */
g.eTargetFile = "" /* name of target to build */
g.eTranslate = 0 /* for UUencoded files only: if the UUencoded file does not have a translation
table, it will be provided; if it is encoded with a newer UUencode-program
there will be `-characters instead of blank-characters; unfortunately some
UUencode programs will use both characters in the same file; in order for
XXdecode or older UUdecode programs to work correctly, this program will
use the original UU-translation table with blank-characters instead of
the newer `-characters */
g.eLinesWritten = 0
DO j = 1 TO files.0 /* process files */
g.eLinesWritten = g.eLinesWritten + assemble(files.j, file.i.ext)
IF files.j.iChange = "LAST" | j = files.0 THEN /* last chunks, decode temporary file */
DO
IF g.eLinesWritten > 0 THEN
DO
CALL decode
END
ELSE IF g.eTmpFile <> "" THEN /* if in error, tmpFile could have been deleted already */
DO
CALL error g.eTmpFile": no lines to decode found !", "DELETE"
END
g.eTranslate = 0
g.eLinesWritten = 0
g.eLeadin = ""
END
END
END
EXIT
/*********************************** reordering --begin -- ********************************/
/*
This procedure takes care of the correct ordering of the encoded file-chunks, after
the ASCII-sort, which may yield the following results:
foo.u10 foo.u11 foo.u12 foo.uu1 foo.uu2 foo.uu3
foo.uu4 foo.uu5 foo.uu6 foo.uu7 foo.uu8 foo.uu9
foo.uue
foo10.uue foo11.uue foo12.uue foo1.uue foo2.uue foo3.uue
foo4.uue foo5.uue foo6.uue foo7.uue foo8.uue foo9.uue
the correct ordering, so that the encoded chunks are assembled in the correct order, should be:
foo.uu1 foo.uu2 foo.uu3 foo.uu4 foo.uu5 foo.uu6
foo.uu7 foo.uu8 foo.uu9 foo.u10 foo.u11 foo.u12
foo.uue
foo1.uue foo2.uue foo3.uue foo4.uue foo5.uue foo6.uue
foo7.uue foo8.uue foo9.uue foo10.uue foo11.uue foo12.uue
*/
REORDER: PROCEDURE EXPOSE files. filestmp. g.
tmp = ''
files. = "" /* set default to "" */
work. = "" /* set default to "" for unassigned elements */
chunks = 0 /* reset chunks-counter */
highest = 0 /* set the highest serial number to 0 */
dirty = 0 /* clear dirty-flag */
base = 1 /* start-index for next set of chunks */
first = 1 /* starting out */
last_state = 0 /* last state */
last_body_name = "" /* last name of body of filename */
DO i = 1 TO filestmp.0
name = FILESPEC("NAME", filestmp.i) /* have filename extracted */
pos = LASTPOS(".", name) /* get last dot in filename */
name_body = SUBSTR(name, 1, pos - 1) /* get stem-name of file, without dot */
name_ext = SUBSTR(name, pos + 1) /* get extension */
serial = ""
ext_length = LENGTH(name_ext)
body_length = LENGTH(name_body)
IF DATATYPE(SUBSTR(name_ext, ext_length, 1), "N") THEN
filetype = 1 /* number in extension, chunksed */
ELSE IF DATATYPE(SUBSTR(name_body, body_length, 1), "N") THEN
filetype = 2 /* number in body, chunks expected */
ELSE filetype = 3 /* no number found, chunks is entire file */
IF filetype = 1 THEN /* files come in like foo.uu1, foo.uu2, foo.xx1, foo.xx2, etc. */
DO
DO j = ext_length TO 1 BY -1 FOR 3 /* the last three digits at a maximum */
char = SUBSTR(name_ext, j, 1)
IF \DATATYPE(char, "N") THEN
LEAVE j
serial = char || serial /* build sequence number */
END
tmp = name_body
END
ELSE IF filetype = 2 THEN /* files come in like foo1.uue, foo2.uue, foo1.xxe, foo2.xxe, etc. */
DO
DO j = body_length TO 1 BY -1 FOR 3 /* use the last three digits */
char = SUBSTR(name_body, j, 1)
IF \DATATYPE(char, "N") THEN
LEAVE j
serial = char || serial /* build sequence number */
END
tmp = SUBSTR(name_body, 1, body_length - LENGTH(serial))
END
ELSE tmp = name_body /* encoded file is not chunksed */
IF first THEN /* first time in loop ? */
DO
last_state = filetype
last_body_name = tmp
first = 0 /* no need to get into this IF-statement anymore */
END
/* did the state or the body of the filename change ? */
IF last_state <> filetype | last_body_name <> tmp THEN
DO
CALL set_up_this_series_of_chunks /* save present intermediate work-files */
last_state = filetype
last_body_name = tmp
END
CALL populate_work_array /* memorize present chunks with the needed position in array */
END
IF dirty THEN CALL set_up_this_series_of_chunks /* one set to process left */
files.0 = base - 1 /* set number of elements in array */
/*
/* debug */
say ""
say "Result: files.0="files.0
say
DO i = 1 TO files.0
CALL say_c files.i "|" files.i.iChange "|"
END
*/
RETURN
POPULATE_WORK_ARRAY:
chunks = chunks + 1 /* process present chunks */
dirty = 1 /* chunks pending */
work.chunks.iFilename = filestmp.i /* save fully qualified filename */
work.chunks.iFiletype = last_state /* save filetype */
IF serial = '' THEN serial = 1
work.chunks.iPosition = serial /* serial number */
highest = MAX(highest, serial) /* get highest serial number, so one knows of how many pieces
the file consists of */
RETURN
SET_UP_THIS_SERIES_OF_CHUNKS:
/* if more than one chunk, the highest serial number must be the same as
the number of total chunks, otherwise some pieces are missing */
error = (chunks > 1 & chunks <> highest)
/*
error = 0 /* default to no error */
/* if chunks expected, there must be more than one */
IF work.1.iFiletype = '1' | work.1.iFiletype = '2' THEN
DO
error = error | (chunks = 1) /* several chunks expected, only one received */
END
*/
/*
say "debug: filetype ["work.1.iFiletype"], chunks ["chunks"], highest["highest"] ---> error ["error"]"
*/
IF error THEN
DO
CALL BEEP 500, 100
max_length = MAX(LENGTH(chunks), LENGTH(highest))
CALL say_c
CALL say_c "PROBLEM:"
CALL say_c
CALL say_c " according to the highest serial number availabe, there must be"
CALL say_c " >>>" g.eTxtAla || RIGHT(highest, max_length) g.eTxtInf || "<<< encoded files to be merged, but there could be only "
CALL say_c " >>>" g.eTxtAla || RIGHT(chunks, max_length) g.eTxtInf || "<<< file(s) found !"
CALL say_c
CALL say_c " This is a list of the available pieces among which some are missing:"
CALL say_c
DO q = 1 TO chunks
CALL say_c " " g.eTxtAla || work.q.iFilename
END
CALL say_c
END
ELSE /* insert chunks in the correct sequence into the files-array */
DO
DO j = 1 TO chunks
IF chunks = 1 THEN nr1 = base
ELSE nr1 = base + work.j.iPosition - 1
files.nr1 = work.j.iFilename
END
nr1 = base + chunks - 1 /* calculate next starting index into array */
files.nr1.iChange = "LAST" /* indicate that last chunks was processed */
base = base + chunks /* new index for rest of files */
END
chunks = 0 /* reset chunks-counter */
DROP work. /* DROP work-array */
work. = "" /* set default to "" for unassigned elements */
highest = 0 /* set the highest serial number to 0 */
dirty = 0 /* clear dirty-flag */
RETURN
/************************************* reordering --end-- ********************************/
/* do the decoding stuff */
DECODE:
/*
call debug "total of lines written:", g.eLinesWritten
*/
IF g.eTargetFile = "" THEN
DO
IF g.eLinesWritten <> 0 THEN
CALL error g.eTempFile": no target-filename found !", "DELETE"
END
ELSE
DO
CALL say_c " decoding:" g.eTempFile || g.eTxtInf "====>" g.eTxtHi || g.eTargetFile || g.eTxtInf "("file.i.pgm")"
ADDRESS CMD "@"file.i.pgm '"'g.eTempFile'"' '"'g.eTargetFile'" >NUL' /* decode file */
IF rc <> 0 THEN
DO
CALL BEEP 1500, 1000
CALL say_c g.eTxtAla || " return code:" rc "--- something went wrong while decoding!"
CALL say_c g.eTxtAla || "look up temporary file:" || g.eTxtAla g.eTempFile
ADDRESS CMD '@DEL "'g.eTargetFile'"' /* delete uncompleted target file */
END
ELSE /* everything went fine, delete files */
DO
CALL say_c " done."
ADDRESS CMD "@DEL" '"'g.eTempFile'"'
DO z = 1 to files_to_delete.0
ADDRESS CMD "@DEL" '"'files_to_delete.z'"'
END
CALL BEEP 150, 100
END
END
CALL say_c
g.eTargetFile = "" /* name of target to build */
g.eTempFile = "" /* temporary file to hold concatenated chunks */
DROP files_to_delete.
files_to_delete.0 = 0
RETURN
/* read the XX- or UU-encoded file and build a new, clean working file */
ASSEMBLE: PROCEDURE EXPOSE g.eTargetFile g.eTempFile files_to_delete. g.eTranslate table_00x_char g.
workfile = ARG(1)
ext = ARG(2)
IF g.eLeadin = "" THEN
DO
IF ext = "UUE" THEN g.eLeadin = "M" /* normal leadin for UUencoded lines */
ELSE g.eLeadin = "h" /* normal leadin for XXencoded lines */
END
/* get name of target file */
CALL STREAM workfile, 'C', 'OPEN READ' /* open file for input */
first = (g.eTempFile = "")
IF first THEN /* no g.eTempFile as of yet, therefore first chunks */
DO
tmp = FILESPEC("NAME", workfile)
/* create unique filename, use first 1 letter to be appended after "tmp" */
tmp = "tmp" || SUBSTR(tmp, 1, 1) || "????." || ext
g.eTempFile = SysTempFileName(tmp)
CALL say_c
CALL say_c "temporary file:" || g.eTxtHi g.eTempFile
END
CALL say_c " processing:" g.eTxtHi || FILESPEC("NAME", workfile) || g.eTxtInf "====>" g.eTempFile
tmp = files_to_delete.0 + 1 /* increase index */
files_to_delete.tmp = workfile /* insert this file to be deleted, if everything works o.k. */
files_to_delete.0 = tmp /* update index-counter */
CALL STREAM g.eTempFile, "C", "OPEN WRITE" /* open output file */
table = 0 /* translation table written ? */
begin = 0 /* begin-line with filename written ? */
valid_encoded_data = 0 /* writing encoded body */
i = 0 /* number of lines written */
DO WHILE LINES(workfile) > 0 /* as long as lines are left to be read */
line = LINEIN(workfile) /* read line */
IF g.eTranslate THEN /* g.eTranslate "`" into blank (" ") */
line = TRANSLATE(line, " ", "`")
IF line = "" THEN
DO
IF \valid_encoded_data THEN ITERATE /* skip empty lines from the top */
ELSE
DO /* sometimes there is an empty line before the very last line */
tmp = LINEIN(workfile) /* get next line */
IF tmp = "end" THEN
DO
/* indicate by the means of the table-code that no values
are to be expected (empty line right before the end-line */
CALL LINEOUT g.eTempFile, table_00x_char || "M"
CALL LINEOUT g.eTempFile, tmp
i = i + 2
END
valid_encoded_data = 0 /* look for another valid chunk within file */
ITERATE
/*
LEAVE /* empty line at the end, leave */
*/
END
END
IF first THEN /* first chunks ? */
DO
IF POS("BEGIN", line) > 0 THEN ITERATE /* e.g. BEGIN ---cut here--- , "sed .../^BEGIN..." */
IF \table THEN /* table in encoded file ? */
DO
IF line = "table" THEN /* table line found */
DO
CALL LINEOUT g.eTempFile, line
i = i + 1
table = 1 /* table found */
line = LINEIN(workfile) /* get first table-line */
table_00x_char = LEFT(line, 1) /* get code for x00 */
CALL LINEOUT g.eTempFile, line
i = i + 1
g.eDecodeTable = line
/* get & write second table-line */
line = LINEIN(workfile)
CALL LINEOUT g.eTempFile, line
i = i + 1
g.eDecodeTable = g.eDecodeTable || line
ITERATE
END
END
/* find first valid encoded data */
IF \begin THEN
DO
PARSE VAR line "begin" mode g.eTargetFile .
IF \table & \DATATYPE(mode, "N") THEN ITERATE /* leadin e.g. "begin ---cut here --" */
IF \table THEN /* no table information, supply defaults */
DO
/* check whether UU- (leadin 'M') or XX-encoded (leadin 'h') data are in the file */
save_pos = STREAM(workfile, "C", "SEEK +0") /* get present read/write position in workfile */
g.eLeadin = LEFT(LINEIN(workfile),1) /* read first char of next line */
IF g.eLeadin = 'h' THEN /* XXencoded (original translation table) */
DO
/* XX-translation table */
tmpCode1 = "+-0123456789ABCDEFGHIJKLMNOPQRST"
tmpCode2 = "UVWXYZabcdefghijklmnopqrstuvwxyz"
tmpCoding = "XX"
END
ELSE /* assume UUencoded (translation table) */
DO
/*
removed, imply translation all the time, if RxDecode has to supply the translation table
/* check for `-char in encoded file for older UUDECODE-programs */
g.eTranslate = original_uue_table()
*/
g.eTranslate = 1 /* translate ` to blanks in any case,
so older UUDECODErs and XXDECODErs
can handle the encoded files */
/* original UU-translation table */
tmpCode1 = " !""#$%&'()*+,-./0123456789:;<=>?"
tmpCode2 = "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_"
tmpCoding = "UU"
END
/* produce assumed-table */
CALL LINEOUT g.eTempFile, "table"
CALL LINEOUT g.eTempFile, tmpCode1
CALL LINEOUT g.eTempFile, tmpCode2
g.eDecodeTable = tmpCode1 || tmpCode2
table_00x_char = LEFT(g.eDecodeTable, 1) /* code for x00 */
CALL say_c " [" || g.eTxtHi || tmpCoding || g.eTxtInf || "-encoding assumed, translation-table inserted.]"
i = i + 3
CALL STREAM workfile, "C", "SEEK =" || save_pos /* reposition to initial read/write position */
END
CALL LINEOUT g.eTempFile, line /* write begin-line */
i = i + 1
begin = 1 /* beginning line found */
valid_encoded_data = 1 /* writing body is ok now */
first = 0 /* no need to get into this IF-block anymore */
END
ITERATE
END
/* not the first chunk, find first valid encoded data */
IF \valid_encoded_data THEN /* search first line to write */
DO
tmp = TRANSLATE(line)
/* does line contain "BEGIN" ? */
IF POS("BEGIN", tmp) > 0 THEN
DO
/* is it a Unix-shar-script using sed and the key-word "BEGIN" ?
or is there a unix-shell-comment leadin,
if so, then skip until "BEGIN" appears */
IF POS("SED", tmp) > 0 | LEFT(tmp, 1) = '#' THEN
ITERATE
valid_encoded_data = 1
ITERATE
END
/* first line, assuming 62 characters long, sometimes 61 only */
tmp = LENGTH(line)
IF \(tmp = 61 | tmp = 62) | LEFT(line, 1) <> g.eLeadin THEN ITERATE
/* is this truly an encoded line ? */
IF VERIFY(line, g.eDecodeTable) <> 0 THEN
ITERATE
valid_encoded_data = 1 /* no "BEGIN"-leadin, but assuming being in coding-part of file */
END
ELSE /* search for last line to write */
DO
IF last_line(line) THEN
DO
valid_encoded_data = 0 /* look for another valid chunk within file */
ITERATE
END
END
CALL LINEOUT g.eTempFile, line /* write line in hand */
i = i + 1
/*
/* debug */
tmp_rgf_length = POS(LEFT(line,1), g.eDecodeTable) - 1
tmp_line_length = length(line)
tmp_rgf_chars = tmp_rgf_length * 4 / 3
if line <> "end" & tmp_rgf_chars <> (tmp_line_length-1) & tmp_rgf_chars <> (tmp_line_length) then
do
say "assemble(): line_no ["i"], expected ["tmp_rgf_chars"] <> ["length(line)"] chars[" || tmp_rgf_length || "]"
end
*/
IF line = "end" THEN LEAVE /* last chunks, writing finished */
END
CALL STREAM workfile, 'C', 'CLOSE' /* close file */
CALL STREAM g.eTempFile, 'C', 'CLOSE' /* close file */
IF \begin & first THEN /* no begin found, error in hand !!! */
CALL error "ASSEMBLE() no begin-line found !", "DELETE"
/*
call debug "number of lines written", i
call debug "worked on:", "["workfile"]"
say
call debug "first couple of lines in file", g.eTempFile
"@head "g.eTempFile
call debug "last couple of lines in file", g.eTempFile
"@tail "g.eTempFile
say
"@pause"
*/
RETURN i
/* not necessary anymore, implying translation all the time,
if RxDecode has to supply the UU-translation table
/* Is the content of the workfile made up of the original UUencoding set ?
If not, then replace the `-character with the blank-character */
ORIGINAL_UUE_TABLE: PROCEDURE EXPOSE workfile ext g.
save_pos = STREAM(workfile, "C", "SEEK +0") /* get present read/write position in workfile */
found = 0
DO WHILE LINES(workfile) > 0 /* scan encoded UU-part for ` */
line = LINEIN(workfile) /* read line */
IF last_line(line) THEN /* last line in this chunks */
LEAVE
found = POS("`", line) /* search for `-character */
IF found > 0 THEN LEAVE
END
CALL STREAM workfile, "C", "SEEK =" || save_pos /* reposition to initial read/write position */
RETURN found > 0
*/
/* is it the last line (the one which indicates the end of the encoding part) ? */
LAST_LINE: PROCEDURE EXPOSE g.
line = ARG(1)
/* this is not the end-indication for this part of the encoded file, but
the end of the encoded file itself and the line needs to be written
*/
IF line = "end" THEN RETURN 0
/* if any line greater than maximum line for XX- or UU-encoded files (62 char)
assume that EOF for this chunks has arrived */
IF LENGTH(line) > 62 THEN RETURN 1
tmp_line = TRANSLATE(line)
/* assume that a lead-in of "end" means EOF for this chunk has arrived */
IF POS("END", tmp_line) > 0 THEN
DO
IF LEFT(tmp_line, 3) = "END" THEN RETURN 1
IF POS("---", tmp_line) > 0 | POS("===", tmp_line) > 0 THEN RETURN 1
END
/* "cut here" means EOF for this chunk has arrived */
IF POS("CUT HERE", tmp_line) > 0 THEN RETURN 1
/* "C U T" means EOF for this chunk has arrived */
IF POS("C U T", tmp_line) > 0 THEN RETURN 1
/*
/*
temporary, sometimes encoded files are truly in error in the
line right before the last, therefore not activated
*/
IF g.eDecodeTable <> "" THEN
DO
tmp_rgf_length = POS(LEFT(line,1), g.eDecodeTable) - 1 /* get number of char expected */
tmp_line_length = length(line) /* length of line */
tmp_rgf_chars = tmp_rgf_length * 4 / 3 /* number of chars encoded */
if (tmp_rgf_chars <> tmp_line_length) & (tmp_rgf_chars <> (tmp_line_length - 1)) then
do
say " assemble(): line ["line"]"
say " assemble(): expected char ["tmp_rgf_chars"] <> length(line) ["length(line)"] # of chars indicated [" || tmp_rgf_length || "]"
return 1
end
END
/* temporary end */
*/
RETURN 0 /* no last line-indicator in hand */
/* one of Knuth's algorithms; sort read lines in array */
SORT_PROCEDURE: PROCEDURE EXPOSE filestmp. g.
DO i = 1 TO filestmp.0 /* translate filenames into uppercase */
filestmp.i = TRANSLATE(filestmp.i)
END
/* define M for passes */
M = 1
DO WHILE (9 * M + 4) < filestmp.0
M = M * 3 + 1
END
/* sort stem */
DO WHILE M > 0
K = filestmp.0 - M
DO J = 1 TO K
Q = J
DO WHILE Q > 0
L = Q + M
/* tell REXX to do comparison exact, i.e. take
leading & trailing blanks into account */
IF filestmp.Q <<= filestmp.L THEN LEAVE
/* switch elements */
tmp = filestmp.Q
filestmp.Q = filestmp.L
filestmp.L = tmp
Q = Q - M
END
END
M = M % 3
END
RETURN
ERROR: PROCEDURE EXPOSE g.
CALL Beep 500, 10
CALL say_c g.eTxtAla || ARG(1)
IF TRANSLATE(LEFT(ARG(2), 1)) = "D" & g.eTempFile <> "" THEN
DO
CALL STREAM g.eTempFile, "C", "CLOSE" /* close it */
ADDRESS CMD "@DEL" '"'g.eTempFile'"' /* erase temp-file */
g.eTempFile = ""
END
RETURN
DEBUG:
CALL say_c "***debug:" ARG(1) ">"ARG(2)"<"
RETURN
/* display error message & terminate program */
HALT:
/* Is there a temporary file open */
IF g.eTempFile <> "" THEN
DO
CALL STREAM g.eTempFile, "C", "CLOSE" /* close it */
ADDRESS CMD "@DEL" '"'g.eTempFile'"' /* erase it */
END
PARSE SOURCE . . this_file /* get this procedure's filename */
this_file = FILESPEC('NAME', this_file) /* get filename only */
/* error message on device "STDERR" */
'@ECHO' g.eTxtInf || this_file || g.eTxtNorm':' g.eTxtAla || 'Ctrl-C pressed, aborting ...' || g.eScrNorm '>&2'
EXIT ''
USAGE:
CALL say_c g.eTxtHi || "RxDecode" || g.eTxtInf || ": concatenates XX- or UU-encoded file chunks and decodes them"
CALL say_c " usage: " || g.eTxtHi || "RXDECODE [X|U] [/B]"
CALL say_c
CALL say_c " option [X|U]:" g.eTxtHi || "X" || g.eTxtInf " ... use XXDECODE to decode UU- and XX-encoded files"
CALL say_c " " g.eTxtHi || "U" || g.eTxtInf " ... use UUDECODE to decode UU- and XX-encoded files"
CALL say_c
CALL say_c " option [/B]: " g.eTxtHi || "/B" || g.eTxtInf '... show output in' g.eTxtHi || 'b' || g.eTxtInf || 'lack/white (no ANSI-colors)'
CALL say_c
CALL say_c "This program decodes XX- or UU-encoded files (even if split), e.g.:"
CALL say_c
CALL say_c " chunks-order in file extension:" g.eTxtNorm g.eTxtInf
CALL say_c g.eTxtHi || " foo.uu"||g.eTxtNorm||"1"||g.eTxtHi "foo.uu"||g.eTxtNorm||"2"||g.eTxtHi "foo.uu"||g.eTxtNorm||"3"||g.eTxtHi,
"foo.uu"||g.eTxtNorm||"4"||g.eTxtHi "foo.uu"||g.eTxtNorm||"5"|| g.eTxtHi "foo.uu"||g.eTxtNorm||"6"
CALL say_c g.eTxtHi || " foo.uu"||g.eTxtNorm||"7"||g.eTxtHi "foo.uu"||g.eTxtNorm||"8"||g.eTxtHi "foo.uu"||g.eTxtNorm||"9"||g.eTxtHi,
"foo.u"||g.eTxtNorm||"10"||g.eTxtHi "foo.u"||g.eTxtNorm||"11"||g.eTxtHi "foo.u"||g.eTxtNorm||"12"
CALL say_c
CALL say_c " chunks-order in file-body:"
CALL say_c g.eTxtHi || " foo"||g.eTxtNorm||"1"||g.eTxtHi||."uue foo"||g.eTxtNorm||"2"||g.eTxtHi||."uue foo"||g.eTxtNorm||"3"||g.eTxtHi||."uue foo"||g.eTxtNorm||,
"4"||g.eTxtHi||."uue foo"||g.eTxtNorm||"5"||g.eTxtHi||."uue foo"||g.eTxtNorm||"6"||g.eTxtHi||."uue"
CALL say_c g.eTxtHi || " foo"||g.eTxtNorm||"7"||g.eTxtHi||."uue foo"||g.eTxtNorm||"8"||g.eTxtHi||."uue foo"||g.eTxtNorm||"9"||g.eTxtHi||."uue",
"foo"||g.eTxtNorm||"10"||g.eTxtHi||".uue foo"||g.eTxtNorm||"11"||g.eTxtHi||".uue foo"||g.eTxtNorm||"12"||g.eTxtHi||".uue "
CALL say_c
CALL say_c " normal encoded file:"
CALL say_c g.eTxtHi || " foo.xxe"
CALL say_c
CALL say_c "It handles XX- and UU-encoded files, removes mail-headers and mail-trailers, "
CALL say_c "as well as information supplied by the sender. In addition it takes care of "
CALL say_c "newer UU-encoded files which changed the translation-table. Chunks are ordered"
CALL say_c "in the ascending order implied by the chunks-number (serial-number)."
CALL say_c "Hint: A 'chunk' may contain several parts of an encoded file."
EXIT
SAY_C: PROCEDURE EXPOSE g.
SAY g.eTxtInf || ARG(1) || g.eScrNorm
RETURN