********************************************************************** * transformation du fichier des cours au format XML * ********************************************************************** FAF4MBRP1 if e k disk extfile(qualif) Dqualif s 21 inz('AF400/AF4MBRP1') D***************************************************************** D* PROTOTYPES IFS pour open() , write() et close() D***************************************************************** D*** open sur IFS Dopen PR 10I 0 EXTPROC('open') D nomfichier * VALUE D openflags 10I 0 VALUE D mode 10U 0 VALUE OPTIONS(*NOPASS) D codepage 10U 0 VALUE OPTIONS(*NOPASS) D*** lecture IFS Dread PR 10I 0 EXTPROC('read') D filehandle 10I 0 VALUE D datareceived * VALUE D nbytes 10U 0 VALUE D*** écriture IFS Dwrite PR 10I 0 EXTPROC('write') D filehandle 10I 0 VALUE D datatowrite * VALUE D nbytes 10U 0 VALUE D*** fermeture IFS Dclose PR 10I 0 EXTPROC('close') D filehandle 10I 0 VALUE D***************************************************************** D* CONSTANTES IFS D***************************************************************** D*** File Access Modes for open() D O_RDONLY S 10I 0 INZ(1) D O_WRONLY S 10I 0 INZ(2) D O_RDWR S 10I 0 INZ(4) D*** oflag Values for open() D O_CREAT S 10I 0 INZ(8) D O_EXCL S 10I 0 INZ(16) D O_TRUNC S 10I 0 INZ(64) D*** File Status Flags for open() and fcntl() D O_NONBLOCK S 10I 0 INZ(128) D O_APPEND S 10I 0 INZ(256) D*** oflag Share Mode Values for open() D O_SHARE_NONE S 10I 0 INZ(2000000) D O_SHARE_RDONLY S 10I 0 INZ(0200000) |
D O_SHARE_RDWR S 10I 0 INZ(1000000) D O_SHARE_WRONLY S 10I 0 INZ(0400000) D*** file permissions D S_IRUSR S 10I 0 INZ(256) D S_IWUSR S 10I 0 INZ(128) D S_IXUSR S 10I 0 INZ(64) D S_IRWXU S 10I 0 INZ(448) D S_IRGRP S 10I 0 INZ(32) D S_IWGRP S 10I 0 INZ(16) D S_IXGRP S 10I 0 INZ(8) D S_IRWXG S 10I 0 INZ(56) D S_IROTH S 10I 0 INZ(4) D S_IWOTH S 10I 0 INZ(2) D S_IXOTH S 10I 0 INZ(1) D S_IRWXO S 10I 0 INZ(7) D*** misc D O_TEXTDATA S 10I 0 INZ(16777216) D O_CODEPAGE S 10I 0 INZ(8388608) D O_CCSID S 10I 0 INZ(32) D***************************************************************** D* DEFINITIONS D***************************************************************** D*** divers D nomfichier S 255A INZ('/Af4dir/courshtm/xml/cours.xml') D lgfichier S 9B 0 D AsciiCodePage S 10U 0 INZ(1252) D FullName S 512A D ReturnInt S 10I 0 D*** D File_Hdl S 10I 0 D Byteswrt S 10I 0 D EOR S 2A Inz(X'0D25') D Null S 1A Inz(X'00') ** divers ************************************************************ Dligne s 4096 D I s 10I 0 D pos s 10I 0 D***************************************************************** D* Caractères interdit en XML D***************************************************************** DDS_invalide DS D origine 5 inz('&<>"''') D tbo 1 DIM(5) overlay(ds_invalide) DDS_remplace DS |
D remplacement1 6 inz('&') D remplacement2 6 inz('<') D remplacement3 6 inz('>') D remplacement4 6 inz('"') D remplacement5 6 inz(''') D tbr 6 DIM(5) overlay(ds_remplace) * * DEBUT DU PGM * C*** Open file C*** la première ouverture créé le fichier C Eval FullName = %TRIMR(nomfichier) + Null C**** avant la V5R10, il fallait ouvrir le fichier avec O_CODEPAGE C**** plutôt que O_CCSID C Eval file_Hdl = open(%ADDR(FullName) C : O_CREAT + O_WRONLY + O_TRUNC + C O_CCSID C : S_IRWXU + S_IROTH C : AsciiCodePage) C Eval ReturnInt = close(file_Hdl) C*** la deuxième ouverture tiens compte du code page rencontré C*** et fera donc la conversion EBCDIC -> ASCII lors des write C Eval file_Hdl = open(%ADDR(FullName) C : O_TEXTDATA + O_RDWR) C exsr liste C Eval ReturnInt = close(file_Hdl) C MOVE *ON *INLR * * SOUS PROGRAMME * /free BEGSR LISTE;   // entête (une seule fois) eval ligne = '<?xml version="1.0" encoding="ISO-8859-1"?>' ; exsr writeln; eval ligne = '<AF400 COPYRIGHT="Volubis">' ; exsr writeln; eval ligne = ' ' ; exsr writeln;   read af4mbrf1; dow not %eof; // mise en place d'une ligne |
eval ligne = ' <COURS NOM="' + %trim(af4mbr) + '" MODULE="' + %trim(AF4MDL) + '">' ; exsr writeln; // recherche des caractère & , < , > , " , ' // qui sont invalides et remplacement (& < etc) comme HTML // sinon, encadrer les données de <![CDATA[ et ]] // ligne = ' <TEXTE><![CDATA[' + %trim(ligne) + ']]</TEXTE>'; eval ligne = af4txt; exsr verif_texte ; eval ligne = ' <TEXTE>' + %trim(ligne) + '</TEXTE>';   exsr writeln; eval ligne = ' <TYPE>' + %trim(af4typ) + '</TYPE>'; exsr writeln; eval ligne = ' <SRCFIL>' + %trim(srcfil) + '</SRCFIL>' ; exsr writeln; eval ligne = ' <SRCLIB>' + %trim(srclib) + '</SRCLIB>' ; exsr writeln; eval ligne = ' <SRCMBR>' + %trim(srcfil) + '</SRCMBR>' ; exsr writeln; eval ligne = ' <CHEMIN>' + %trim(infocp) + '</CHEMIN>' ; exsr writeln; eval ligne = ' <SUJET>' + %trim(sujet) + '</SUJET>' ; exsr writeln; eval ligne = ' <MOT_DIRECTEUR>' ; exsr writeln; eval ligne = ' <MOTCLE1>' + %trim(motcl1) + '</MOTCLE1>' ; exsr writeln; eval ligne = ' <MOTCLE2>' + %trim(motcl2) + '</MOTCLE2>' ; exsr writeln; eval ligne = ' <MOTCLE3>' + %trim(motcl3) + '</MOTCLE3>' ; exsr writeln; eval ligne = ' <MOTCLE4>' + %trim(motcl4) + '</MOTCLE4>' ; exsr writeln; eval ligne = ' <MOTCLE5>' + %trim(motcl5) + '</MOTCLE5>' ; exsr writeln; eval ligne = ' </MOT_DIRECTEUR>' ; exsr writeln; eval ligne = ' <DATREF>' + %CHAR(%date(datref : *CYMD)) +'</DATREF>'; exsr writeln; eval ligne = ' </COURS>'; exsr writeln;   read af4mbrf1; |
enddo; // fin de liste eval ligne = ' ' ; exsr writeln; eval ligne = '</AF400>' ; exsr writeln;   ENDSR ;   BEGSR VERIF_TEXTE; // recherche er remplacement des caractères spéciaux   for i = 1 to %elem(tbo) ; pos = 1; dow %scan(tbo(i) : ligne : pos) > 0 ; pos = %scan(tbo(i) : ligne : pos); ligne = %replace(%trim(tbr(i)) : ligne : pos : %len(%trim(tbo(i))) ) ; pos = pos + %len(%trim(tbr(i))); if pos > %len(ligne); leave; endif; enddo; endfor;   ENDSR; /end-free C Writeln BEGSR C*** Ecriture IFS [utilisation du write() du langage C (*SRVPGM) ] C Eval ligne = %Trimr(ligne) + EOR C Eval byteswrt = write(file_Hdl C : %ADDR(ligne) C : %LEN(%TRIMR(ligne))) C*** C endsr |