* Demande un nom de fichier, biblio, éventuellement un préfix.
* Génère dans un fichier source "srcg",
* et des cartes D.
* afin d'éviter l'emploi de * (toute les zones).
*
Hdftactgrp(*no)
Hactgrp('milan')
Hoption(*srcstmt:*nodebugio)
Ftst020D cf e workstn
D sds
Dproc_name *proc
Duserr2 254 263
Dbouclew s n Do *hival
Diw s 3 0 Ctr
Dimaxw s 3 0 Ctr zones
Dtrvw s n Trouvé
Dokw s n OK
Dzerow s 3 0 Pour anom
Dopenw s n ouverture curseur
Dbibfichw s 21 varying Pour message info
* Attn, certaines longueurs tronquées...
DcolomnDS ds
Dsys_column_name 10
Ddata_type 8
Dlength 3 0
Dnumeric_scale 3 0
Dis_nullable 1
Dcolumn_heading 60
Dcolumn_text 50
Dsrcdtaw s 100
Dsrcseqw s 6 0
Despacesw s 10
Despace5w s 5
Dnumeric_scale2w s 3
Dtextew s 60
Dvirgw s 1
Dcmdw s 2000 varying
* La spécif D
Dspecifdds ds
Dddw 1 inz('D')
Ddnomw 15
Dsp1W 2
Dddeclaw 2
Dsp2W 7
Ddlongw 7
Ddtypew 1
Dddecw 2
Ddkw 37
Dsp3W 1
Ddcommentw 20
Dfetchsql pr
D NextFirstw 9 value
Dvrfsql pr
Ddegrossissage pr
Diplus pr
Dquoiw 10 value varying
Dclosecurseur pr
Dqcmdexc pr extpgm('QCMDEXC')
D cmd 32702 options(*varsize) const
D cmdlen 15 5 const
/free
exec sql
set option commit = *none, datfmt = *iso;
exec sql
declare curseur scroll cursor for
select system_column_name, data_type,
length, ifnull(numeric_scale, -1), is_nullable,
ifnull(column_heading, ''),
ifnull(column_text, '')
from syscolumns
where system_table_name = :fichierw and
system_table_schema = :bibliow;
monitor;
dou bouclew; // B o u c l e 1
closecurseur();
exfmt ecran01; // A f f i c h a g e
if *inkc or *inkl; //
exsr srfin; // Fin
endif;
if fichierw= *blanks;
*in51 = *on; // Saisir le nom d'un fichier !
iter;
endif;
if bibliow= *blanks;
*in52 = *on; // Saisir le nom de bibliothèque !
iter;
endif;
bibfichw = %trim(bibliow) + '/' + %trim(fichierw);
messw = *blanks;
cmdw = 'clrpfm srcg'; // Mise à blanc du fichier résultat
qcmdexc(cmdw:%len(cmdw));
srcseqw = 0;
// P h a s e 1 , g é n é r a t i o n d e S e l e c t :
exec sql -- Ouverture du curseur
open curseur;
vrfsql();
openw = *on;
iw = 0;
dou bouclew; // Boucle de lecture
fetchsql('NEXT');
if sqlstate = '02000';
leave; // Retour affichage
endif;
iw += 1;
if iw = 1;
srcseqw += 1;
srcdtaw = espacesw + 'Declare curseur scroll cursor for select';
exec sql -- Première ligne
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
endif;
degrossissage();
srcseqw += 1;
srcdtaw = espacesw + sys_column_name + ', -- ' + textew +
%editc(length:'J') + ' ' + numeric_scale2W;
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
enddo;
imaxw = iw; // Nbre de zones
srcseqw += 1;
if iw > 0;
srcdtaw = espacesw + 'from ' + fichierw + ' where ... ' +
%editc(iw:'J') + ' zones ' + %char(%timestamp());
else;
srcdtaw = espacesw + 'Fichier ' + bibfichw + ' NON trouvé !';
endif;
exec sql -- Dernière ligne
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
if iw > 0;
messw = 'Fichier ' + bibfichw + ' traité. ' + %editc(imaxw:'J') +
' zones. ' + %char(%timestamp());
else;
*in53 = *on; // Fichier NON trouvé !
iter;
endif;
// P h a s e 2 , g é n é r a t i o n d e F e t c h :
srcseqw += 1;
srcdtaw = '2 * * * * * * * * * * * * *';
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
srcseqw += 1;
srcdtaw = espacesw + 'fetch next from curseur into';
exec sql -- Première ligne
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('FIRST');
virgw = ',';
iw = 0;
dou bouclew; // Boucle de lecture
if sqlstate = '02000';
leave;
endif;
iplus(';');
degrossissage();
srcseqw += 1;
srcdtaw = espacesw + ':' +
%replace(%trim(prefixw):sys_column_name:1:carasuppw) +
virgw + ' -- ' + textew +
%editc(length:'J') + ' ' + numeric_scale2W;
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('NEXT');
enddo;
// P h a s e 3 , g é n é r a t i o n d e I n s e r t :
srcseqw += 1;
srcdtaw = '3 * * * * * * * * * * * * *';
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
srcseqw += 1;
srcdtaw = espacesw + 'insert into ' + fichierw + ' (';
exec sql -- Première ligne
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('FIRST');
virgw = ',';
iw = 0;
dou bouclew; // Boucle de lecture
if sqlstate = '02000';
leave;
endif;
iplus(' ');
degrossissage();
srcseqw += 1;
srcdtaw = espacesw + sys_column_name + virgw + ' -- ' + textew +
%editc(length:'J') + ' ' + numeric_scale2W;
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('NEXT');
enddo;
srcseqw += 1;
srcdtaw = espacesw + ') values (';
exec sql -- Transition
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('FIRST'); // Insert, 2°partie
virgw = ',';
iw = 0;
dou bouclew; // Boucle de lecture
if sqlstate = '02000';
leave;
endif;
iplus(');');
degrossissage();
srcseqw += 1;
srcdtaw = espacesw + ':' +
%replace(%trim(prefixw):sys_column_name:1:carasuppw) +
virgw + ' -- ' + textew +
%editc(length:'J') + ' ' + numeric_scale2W;
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('NEXT');
enddo;
// P h a s e 4 , g é n é r a t i o n d e U p d a t e :
srcseqw += 1;
srcdtaw = '4 * * * * * * * * * * * * *';
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
srcseqw += 1;
srcdtaw = espacesw + 'update ' + fichierw + ' set';
exec sql -- Première ligne
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('FIRST');
virgw = ',';
iw = 0;
dou bouclew; // Boucle de lecture
if sqlstate = '02000';
leave;
endif;
iplus(' ');
degrossissage();
srcseqw += 1;
srcdtaw = espacesw + sys_column_name + ' = ' +
':' + %replace(%trim(prefixw):sys_column_name:1:carasuppw) +
virgw + ' -- ' + %subst(textew:1:45) +
%editc(length:'J') + ' ' + numeric_scale2W;
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('NEXT');
enddo;
srcseqw += 1;
srcdtaw = espacesw + 'where ???';
exec sql -- Dernière ligne
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
// P h a s e 5 , g é n é r a t i o n d e S p é c i f D :
srcseqw += 1;
srcdtaw = '5 * * * * * * * * * * * * *';
exec sql -- Pam
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
srcseqw += 1;
dnomw = %trim(fichierw) + 'DS';
ddeclaw = 'ds';
srcdtaw = espace5w + specifdds;
exec sql -- Première ligne
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('FIRST');
ddeclaw = '';
iw = 0;
dou bouclew; // Boucle de lecture
if sqlstate = '02000';
leave;
endif;
iplus(' ');
degrossissage();
dnomw = %replace(%trim(prefixw):sys_column_name:1:carasuppw);
if numeric_scale2w = 'D' or numeric_scale2W = 'Z'; // Type D ou Z
dtypew = numeric_scale2w;
dlongw = *blanks;
ddecw = *blanks;
else; // Usual type
dtypew = *blanks;
evalr dlongw = %editc(length:'3');
evalr ddecw = %editc(numeric_scale:'3');
endif;
dcommentw = textew;
srcseqw += 1;
srcdtaw = espace5w + specifdds;
exec sql -- Ecriture
insert into srcg(srcseq, srcdta) values(:srcseqw, :srcdtaw);
vrfsql();
fetchsql('NEXT');
enddo;
enddo;
on-error;
exfmt ecranom; // Anomalie grave
exsr srfin;
endmon;
// S o u s - p r o g r a m m e ( s ) * * * * * * * * * * * * * * * * * *
begsr srfin; // Fin de programme
closecurseur();
*inlr = *on;
return;
endsr;
/end-free
// S o u s - p r o c é d u r e ( s ) *****************************************************
Pvrfsql b
D pi
C select
C when sqlstate = '00000'
C when sqlstate = '02000'
C when sqlstate = '01504'
C other
* Anomalie grave : remontée dans le "main"...
C eval zerow = 1/zerow
C endsl
C return
P e
Pfetchsql b
D pi
D NextFirstw 9 value
/free
select;
when nextfirstw = 'NEXT';
exec sql -- Le suivant
fetch next from curseur into
:sys_column_name, :data_type,
:length, :numeric_scale, :is_nullable,
:column_heading, :column_text;
when nextfirstw = 'FIRST';
exec sql -- Le premier
fetch first from curseur into
:sys_column_name, :data_type,
:length, :numeric_scale, :is_nullable,
:column_heading, :column_text;
endsl;
vrfsql();
return;
/end-free
P e
Piplus b
D pi
Dquoiw 10 value varying
/free
iw += 1;
if iw = imaxw;
virgw = quoiw;
endif;
return;
/end-free
P e
Pdegrossissage b
D pi
/free
exec sql
values lower(:sys_column_name)
into :sys_column_name; -- En minuscule
vrfsql();
if numeric_scale = -1;
numeric_scale2w = *blanks;
else;
numeric_scale2w = %editc(numeric_scale:'3');
endif;
select;
when data_type = 'DATE';
numeric_scale2w = 'D';
when data_type = 'TIMESTMP';
numeric_scale2w = 'Z';
endsl;
if column_text = ''; // Heading ou Text
textew = column_heading;
else;
textew = column_text;
endif;
return;
/end-free
P e
Pclosecurseur b
D pi
/free
if openw; // Si nécessaire
exec sql
close curseur;
vrfsql();
openw = *off;
endif;
return;
/end-free
P e
