*=============================================================================================
* EXPORTED SUBPROCEDURES IN THIS MODULE
* - Decode2 Transforms characters entities (e.g. '>') to characters (e.g. '>')
*=============================================================================================
hnomain
/copy qrpglesrc,hspecs
* CGIDEV2 library prototypes
/copy qrpglesrc,prototypeb
* Standard error data structure
/copy qrpglesrc,usec
* Program status data structure
D psds sds
D psdsdata 429
D psdsjobnam 10 overlay(psdsdata:244)
D psdsusrnam 10 overlay(psdsdata:254)
D psdsjobnbr 6 overlay(psdsdata:264)
* Buffer for IFS stat function
D StatusBuffer ds align
D StsPermissions...
D 10u 0
D StsFileID 10u 0
D StsLinkCount 5u 0
D StsUserIDNbr 10u 0
D StsGroupIdNbr 10u 0
D StsBytesInFile...
D 10i 0
D StsTimeLastAcc...
D 10i 0
D StsTimeLastChg...
D 10i 0
D StsTimeStsLastChg...
D 10i 0
D StsFileSysID 10u 0
D StsBlockSize 10u 0
D StsAllocBytes 10u 0
D StsObjectType 11
D StsCodePage 5u 0
D 62
D StsGenerationID...
D 10u 0
D rc s 10i 0
******************************************************************
* Decode2 subprocedure
******************************************************************
* Uses an input varying length field to create and return a
* varying length field in which selected input character entities
* changed to the their corresponding charactes.
* The characters entities to be converted are defined in an IFS file,
* specified in the third parameter. If the third parameter is
* not passed, a default file, /cgidevexthml/encod2arr.txt, is used.
*
* Characters entities not defined in the IFS file are not converted. Instead,
* the are returned without change. For example:
*
* Input: >HTML<
* Output:
*
* Parameters
* ----------
* - Input
* - Char 65528, varying. The string to be decoded.
* - ReturnCode
* - 10i 0
* 0 successful,
* -1 file error (could be any of the following)
* (at run time, a detailed message is sent to the CGIDEBUG
* debugging file):
* - file not found
* - file not accessible (authority, etc.)
* - file empty
* - file contains no valid records
* -2 one or more data errors, usually invalid entity value
* (details in debugging file)
*
* - EntitiesFile - file that contains the arrays of characters
* and character entities
* - Char 256, *options(*nopass) varying
* - Arrays of characters and entities are loaded at run time
* this file. If the EntitiesFile parameter is not passed, file
* /cgiexthtml/encode2fil.txt is used. Otherwise, the
* EntitiesFile file is used.
*
* Customizing the character entity list
* -------------------------------------
* - The default data are stored in /cgidevExtHTML/encode2fil.txt.
* It is recommended that you NOT modify, move, or rename this
* file because it could be replaced whenever CGIDEV2 is updated
* or reinstalled. Instead,
* - Copy the default file to an IFS file of your own.
* - Make sure user QTMHHTP1 has *RX authority to your file
* - Modify your file.
* - One record per line
* - Comment records
* - Positions 1 -2 must be //.
* - Data records
* - Position 1: the character to be encoded
* - Positions 2 - 9: the character entity to be substituted for
* the character. If these positions are blank,
* the record is ignored.
* - Remainder of record: blanks or comments
* - Use your file in the EntitiesFile parameter.
* The input field can be up to 65528 bytes. Because
* it is varying, be sure that its length is set
* correctly. Here are a few examples:
* - Passing a literal
* eval result = decode2('<html>':rc)
* - Passing a varying field.
* eval vfield = '<html>'
* eval result = encode2(vfield:rc)
* - Passing from a fixed length field
* eval ffield = '<html>'
* eval result = encode2(%trimr(ffield):rc)
P Decode2 b export
D Decode2 pi 65528 varying
D InputString 65528 const options(*varsize) varying
D ReturnCode 10i 0
D EntitiesFile 256 const varying options(*nopass)
D ThisSubProc c 'Decode2: '
* Entities array. Indexed by numeric value of input character
* Loaded from the EntitiesFile file. For optimum performance,
* it is reloaded only when EntitiesFile's name or timestamp changes.
D Entities s 8 varying dim(255) static
D Chars s 1 dim(255) static
* File and file handling variables
D TheFile s like(EntitiesFile)
D inz('/cgidevexthtml/encode2fil.txt')
D FileHandle s 10i 0
D PrevFile s like(EntitiesFile) static
D PrevFileTS s 10i 0 static
D FileData ds 65528 based(FileDataP)
D TheChar 1
D TheEntity 8
D FirstTwo 2 overlay(FileData:1)
D n2 3u 0 overlay(FileData:1)
D WkFileP s *
* Input and output variables
D wkInputString s like(InputString) based(p)
D result s 65528 varying
D OneChar ds based(p)
D c 1
D n 3u 0 overlay(c)
D pVar s *
D pVarEnd s *
D Input8 ds based(pVar)
D ThisInput8 8
D ThisInput8Str 1 overlay(ThisInput8:1)
D ThisEntity s 8
D SemicolPos s 10i 0
D allocSize s 10u 0
D x s 10i 0
* Variables for handling newline characters
D TwoChars ds
D c1 1
D c2 1
D hex250D s 2 inz(x'250D')
D NewLineSeq s 2 varying
D NewLineSeqLen s 10i 0
* Other variables
D GoodRecords s 10i 0 static
D BytesRead s 10i 0
D i s 10i 0
/free
// Set up file name
if %parms = 3;
TheFile = EntitiesFile;
endif;
// Check file's existence
ReturnCode = 0;
if stat(TheFile:%addr(StatusBuffer)) = -1;
wrtDebug(ThisSubproc + 'Could not access IFS file ' +
TheFile + '. errno and text are: ' +
%trim(%editc(errno:'P')) + ', ' +
%trimr(ErrnoTxt(Errno)):*on);
ReturnCode = -1;
PrevFile = '';
PrevFileTS = 0;
GoodRecords = 0;
Return result;
endif;
// If file is not the the same as before, read it
if (PrevFile <> TheFile) or (PrevFileTS <> StsTimeLastChg); // new file
goodRecords = 0;
// Check for empty file
if StsBytesInFile = 0;
wrtDebug(ThisSubproc + ' ' + theFile +
' is empty.':*on);
ReturnCode = -1;
PrevFile = '';
PrevFileTS = 0;
Return result;
endif;
// Open the file
FileHandle = open(TheFile:O_RDONLY + O_TEXTDATA);
if FileHandle = -1;
wrtdebug(ThisSubProc + ' Could not open file ' + TheFile +
' File system reported the following error: ' +
errnotxt(errno):*on);
Returncode = -1;
PrevFile = '';
PrevFileTS = 0;
Return result;
endif;
// Save file name and timestamp
PrevFile = TheFile;
PrevFileTS = StsTimeLastChg;
// Read the file into dynamically allocated storage
FileDataP = %alloc(StsBytesInFile + 32767);
BytesRead = read(FileHandle:FileDataP:StsBytesInFile);
// Close file
rc = close(FileHandle);
// Handle read failed
if BytesRead = -1;
wrtdebug(ThisSubProc + ' Could not read file ' + TheFile +
' File system reported the following error: ' +
errnotxt(errno):*on);
ReturnCode = -1;
PrevFile = '';
PrevFileTS = 0;
Return result;
endif;
// Determine what is being used to define a new line. It is
// usually x'0D25', but could be x'250D', x'25', x'0D'
// Find first x'0d' or x'25'. Then examine next character to
// determine what the end of line sequence is.
i = 1;
dou %scan(c1:hex250d) > 0;
c1 = %subst(FileData:i:1);
i = i + 1;
enddo;
c2 = %subst(FileData:i:1);
if twochars = x'0D25' or twochars = x'250D';
NewLineSeq = twochars;
else;
NewLineSeq = c1;
endif;
NewLineSeqLen = %len(NewLineSeq);
// Add an additional newline to end of file
WkFileP = FileDataP;
FileDataP = FileDataP + StsBytesInFile;
%subst(FileData:1:%len(NewLineSeq)) = NewLineSeq;
FileDataP = WkFileP;
// Build and process array elements
entities(*) = '';
i = 1;
dow FileDataP - WkFileP < StsBytesInFile;
i = %scan(NewLineSeq:FileData);
// skip comments
if firsttwo = '//' or TheEntity = *blanks;
FileDataP = FileDataP + i + NewLineSeqLen - 1;
iter;
endif;
// skip invalid entities but set return code to -2
if %subst(TheEntity:1:1) <> '&' or
%subst(TheEntity:%len(%trimr(theEntity)):1) <> ';';
wrtDebug(ThisSubproc + ' Invalid entity, ' + %trimr(TheEntity) +
' for character ' + theChar + '.':*on);
ReturnCode = -2;
FileDataP = FileDataP + i + NewLineSeqLen - 1;
Iter;
endif;
// add entry to arrays
Entities(n2) = %trim(TheEntity);
Chars(n2) = TheChar;
FileDataP = FileDataP + i + NewLineSeqLen - 1;
GoodRecords = GoodRecords + 1;
enddo;
if GoodRecords = 0;
ReturnCode = -1;
Return result;
endif;
// Deallocate storage
FileDataP = WkFileP;
dealloc FileDataP;
endif; // it's a new file
// Process the request
if GoodRecords = 0;
returnCode = -1;
return result;
endif;
allocSize=%len(InputString)+10;
p=%alloc(allocSize);
wkInputString = InputString;
pVar=p+2;
pVarEnd=pVar+%len(InputString)-1;
dow pVar<=pVarEnd;
if thisInput8Str='&';
semicolPos=%scan(';':thisInput8:2);
if semicolPos>0;
thisEntity=%subst(thisInput8:1:semicolPos);
x=%lookup(thisEntity:Entities);
if x>0;
result=result+Chars(x);
pVar=pVar+semicolPos;
iter;
endif;
endif;
endif;
result=result+thisInput8Str;
pVar+=1;
enddo;
dealloc p;
return result;
//***********************************************************************
// Program status subroutine
//********************************************************************
begsr *pssr;
wrtpsds(psds);
endsr;
/end-free
P Decode2 e
|