| 
**********************************************************************
* 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 |
