home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / dclgen2.zip / DCLGEN2.CMD < prev    next >
OS/2 REXX Batch file  |  1993-09-06  |  11KB  |  378 lines
  1. /*---------------------------------------------------------*/
  2. /*  DCLGEN2 - DCLGEN for Data Base Manager                 */
  3. /*---------------------------------------------------------*/ 
  4. /*  By Alberto Forlai - 75840141 at ITHXA01/ITHVM03        */ 
  5. /*                      Add. Mktg.                         */ 
  6. /*                      Viale F. Testi 250                 */ 
  7. /*                      Milano (Italy)                     */
  8. /*---------------------------------------------------------*/ 
  9. arg data_base tabella linguaggio
  10. call test_args                /* test sull'input letto */
  11. i  = 0
  12. rc = 0
  13. cblfloat = 0                  /* indicatore di errore per FLOAT in COBOL */ 
  14. file_pre  = 'DBTM'            /* prefisso nome file di output */
  15. file_num  = 1                 /* numero file di output        */
  16. file_log  = 'DCLGEN2.LOG'     /* file di log                  */
  17. signal on error
  18. say 'Starting DBM'
  19. if  Rxfuncquery('SQLDBS')  <> 0 then rcy=Rxfuncadd('SQLDBS' ,'SQLAR','SQLDBS' )
  20. if  Rxfuncquery('SQLEXEC') <> 0 then rcy=Rxfuncadd('SQLEXEC','SQLAR','SQLEXEC')
  21. call sqldbs 'START DATABASE MANAGER'
  22. select
  23.    when sqlca.sqlcode = -1026 then nop /* database gia' attivo  */
  24.    when sqlca.sqlcode = 0     then nop /* attivazione  riuscita */
  25.    otherwise signal error
  26. end
  27. call sqldbs 'START USING DATABASE' data_base 'IN SHARED MODE'
  28. select
  29.    when sqlca.sqlcode = -1098 then nop /* gia' collegato        */
  30.    when sqlca.sqlcode = 0     then nop /* collegamento riuscito */
  31.    otherwise signal error
  32. end
  33. say 'DBM Started'
  34. tabella = "'" || strip(tabella) || "'"
  35. sqlstmt = "SELECT NAME , COLTYPE , LENGTH , SCALE "
  36. sqlstmt = sqlstmt "FROM   SYSIBM.SYSCOLUMNS " 
  37. sqlstmt = sqlstmt "WHERE  TBNAME =" tabella
  38.  
  39. call sqlexec 'PREPARE s1 FROM :sqlstmt' ; if sqlca.sqlcode <> 0 then signal error
  40. call sqlexec 'DECLARE c1 CURSOR FOR s1' ; if sqlca.sqlcode <> 0 then signal error 
  41. call sqlexec 'OPEN    c1'               ; if sqlca.sqlcode <> 0 then signal error 
  42. call sqlexec 'FETCH   c1 INTO :name , :type , :clen , :scle'
  43.  
  44. if sqlca.sqlcode <> 0 &  sqlca.sqlcode <> 100 then signal error
  45. do while sqlca.sqlcode = 0
  46.    i = i + 1
  47.    tbname.i = strip(name)
  48.    tbtype.i = strip(type)
  49.    tbleng.i = strip(clen)
  50.    tbscle.i = strip(scle)
  51.    call sqlexec 'FETCH   c1 INTO :name , :type , :clen , :scle'
  52.    if sqlca.sqlcode <> 0 &  sqlca.sqlcode <> 100 then signal error
  53. end
  54.  
  55. if i = 0 then signal error
  56. call sqlexec 'CLOSE   c1'
  57. call sqldbs  'STOP USING DATABASE'
  58. tabella = strip(tabella,,"'")
  59. numcol = i
  60. if linguaggio = 'COBOL' then do  
  61.    record.1 = '      *' || copies('*',59)
  62.    record.2 = '      *  DATABASE : ' || left(data_base,9)
  63.    record.2 = record.2 || '    *  TABLE : ' || left(tabella,18) || '   *'
  64.    record.3 = '      *' || copies('*',59)
  65. end 
  66. if linguaggio = 'C' then do  
  67.    say ''  
  68.    say '    You can rappresent a VARCHAR columns as :'
  69.    say ''  
  70.    say '    0 ) structure ( length + NOT NULL terminating string )'
  71.    say '    1 ) NULL terminatig string'
  72.    say ''  
  73.    say '    Type 0 or 1 , press ENTER to exit'
  74.    pull usertype
  75.    if usertype = '' then exit
  76.    do while usertype <> '0' & usertype <> '1' 
  77.       say '    Please type 0 or 1 , press ENTER to exit'
  78.       pull usertype
  79.       if usertype = '' then exit
  80.    end
  81.    record.1 = '/*' || copies('=',60) || '*/'  
  82.    record.2 = '/*       DATABASE : ' || left(data_base,9)
  83.    record.2 = record.2 || '    *  TABLE : ' || left(tabella,18) || '*/'
  84.    record.3 = '/*' || copies('=',60) || '*/'
  85. end  
  86. record.0 = 3
  87. j = record.0
  88. do i = 1 to numcol
  89.    if linguaggio = 'C' then tbname.i = lowercase(tbname.i);
  90.    select
  91.       when tbtype.i = 'SMALLINT' then  call sqlsmallint
  92.       when tbtype.i = 'INTEGER'  then  call sqlinteger
  93.       when tbtype.i = 'FLOAT'    then  call sqlfloat   
  94.       when tbtype.i = 'DECIMAL'  then  call sqldecimal
  95.       when tbtype.i = 'CHAR'     then  call sqlchar
  96.       when tbtype.i = 'VARCHAR'  then  call sqlvarchar
  97.       when tbtype.i = 'LONGVAR'  then  call sqllvarchar
  98.       when tbtype.i = 'DATE'     then  call sqldate
  99.       when tbtype.i = 'TIME'     then  call sqltime
  100.       when tbtype.i = 'TIMESTMP' then  call sqltimestamp
  101.       otherwise do
  102.          say 'Type :' tbtype.i ' not valid'                 
  103.          signal error
  104.       end
  105.    end
  106. end
  107. j = j + 1
  108. if linguaggio = 'COBOL' then do  
  109.    record.j = '      *' || copies('-',59)
  110. end 
  111. if linguaggio = 'C' then do 
  112.    record.j = '/*' || copies('-',59) || '*/'  
  113. end 
  114. record.0 = j
  115. call RxFuncAdd 'SysLoadFuncs' , 'RexxUtil' , 'SysLoadFuncs'
  116. call SysLoadFuncs
  117. call find_file_number
  118. call write_record
  119. say 'DCLGEN2 ended with no errors'
  120. exit
  121.  
  122. sqlsmallint:
  123. j = j + 1
  124. if linguaggio = 'COBOL' then do  
  125.    record.j = '       01' left(tbname.i,20) 'PIC S9(4) COMP-5.'
  126. end  
  127. if linguaggio = 'C' then do 
  128.    record.j = '   short int' strip(tbname.i) ';'
  129. end  
  130. record.0 = j
  131. return
  132.  
  133. sqlinteger:
  134. j = j + 1
  135. if linguaggio = 'COBOL' then do  
  136.    record.j = '       01' left(tbname.i,20) 'PIC S9(9) COMP-5.'
  137. end  
  138. if linguaggio = 'C' then do 
  139.    record.j = '   long  int' strip(tbname.i) ';'
  140. end  
  141. record.0 = j
  142. return
  143.  
  144. sqlfloat:
  145. j = j + 1
  146. if linguaggio = 'COBOL' then do 
  147.    cblfloat = 1  /* FLOAT non supportato dal COBOL */
  148.    signal error
  149. end
  150. if linguaggio = 'C' then do 
  151.    record.j = '   double   ' strip(tbname.i) ';'
  152. end  
  153. return 
  154.  
  155. sqldecimal:
  156. j = j + 1
  157. if linguaggio = 'COBOL' then do  
  158.    record.j = '       01' left(tbname.i,20)
  159.    record.j = record.j 'PIC S9(' ||  tbleng.i || ')'
  160.    record.j = record.j     'V9(' ||  tbscle.i || ') COMP-3.'
  161. end  
  162. if linguaggio = 'C' then do 
  163.    record.j = '   double   ' strip(tbname.i) ';'
  164.    say 'WARNING : SQL type DECIMAL transated as DOUBLE'
  165. end  
  166. record.0 = j
  167. return
  168.  
  169. sqlchar:
  170. j = j + 1
  171. if linguaggio = 'COBOL' then do  
  172.    record.j = '       01' left(tbname.i,20) 'PIC X(' || tbleng.i || ').' 
  173. end  
  174. if linguaggio = 'C' then do 
  175.    if tbleng.i = 1 then do  
  176.       record.j = '   char     ' strip(tbname.i) || ';' 
  177.    end
  178.    else do  
  179.       record.j = '   char     ' strip(tbname.i) || '[' || tbleng.i || '];' 
  180.    end
  181. end  
  182. record.0 = j
  183. return
  184.  
  185. sqlvarchar:
  186. if linguaggio = 'COBOL' then do  
  187.    j = j + 1
  188.    record.j = '       01' strip(tbname.i) || '.'
  189.    j = j + 1
  190.    record.j = '           49 L' || left(tbname.i,20) 'PIC S9(4) COMP-5.'
  191.    j = j + 1
  192.    record.j = '           49 D' || left(tbname.i,20) 'PIC X(' || tbleng.i || ').'
  193. end  
  194. if linguaggio = 'C' then do 
  195.    if usertype = 1 then do
  196.       j = j + 1
  197.       record.j = '   char     ' strip(tbname.i) || '[' || tbleng.i || '];' 
  198.    end
  199.    else do 
  200.       j = j + 1 
  201.       record.j = '   struct   ' strip(tbname.i) || '{' 
  202.       j = j + 1 
  203.       record.j = '                short int L' || strip(tbname.i) || ';' 
  204.       j = j + 1
  205.       record.j = '                     char D' || strip(tbname.i) || '[' || tbleng.i || '];' 
  206.       j = j + 1
  207.       record.j = '              };' 
  208.    end
  209. end  
  210. record.0 = j
  211. return
  212.  
  213. sqllvarchar:
  214. if linguaggio = 'COBOL' then do  
  215.    j = j + 1
  216.    record.j = '       01' strip(tbname.i) || '.'
  217.    j = j + 1
  218.    record.j = '           49 L' || left(tbname.i,20) 'PIC S9(4) COMP-5.'
  219.    j = j + 1
  220.    record.j = '           49 D' || left(tbname.i,20) 'PIC X(' || tbleng.i || ').'
  221. end  
  222. if linguaggio = 'C' then do  
  223.    j = j + 1 
  224.    record.j = '   struct   ' strip(tbname.i) || '{' 
  225.    j = j + 1 
  226.    record.j = '                short int L' || strip(tbname.i) || ';' 
  227.    j = j + 1
  228.    record.j = '                     char D' || strip(tbname.i) || '[' || tbleng.i || '];' 
  229.    j = j + 1
  230.    record.j = '              };' 
  231. end 
  232. record.0 = j
  233. return
  234.  
  235. sqldate:
  236. j = j + 1
  237. if linguaggio = 'COBOL' then do  
  238.    record.j = '       01' left(tbname.i,20) 'PIC X(10).'
  239. end  
  240. if linguaggio = 'C' then do  
  241.    record.j = '   char     ' strip(tbname.i) || '[10];'
  242. end  
  243. record.0 = j
  244. return
  245.  
  246. sqltime:
  247. j = j + 1
  248. if linguaggio = 'COBOL' then do  
  249.    record.j = '       01' left(tbname.i,20) 'PIC X(8).'
  250. end  
  251. if linguaggio = 'C' then do  
  252.    record.j = '   char     ' strip(tbname.i) || '[8];'
  253. end  
  254. record.0 = j
  255. return
  256.  
  257. sqltimestamp:
  258. j = j + 1
  259. if linguaggio = 'COBOL' then do  
  260.    record.j = '       01' left(tbname.i,20) 'PIC X(26).'
  261. end  
  262. if linguaggio = 'C' then do  
  263.    record.j = '   char     ' strip(tbname.i) || '[26];'
  264. end  
  265. record.0 = j
  266. return
  267.  
  268. find_file_number:
  269. call SysFileTree 'DBTM*.' || ext , 'list' , 'FO'
  270. if list.0 = 0 then do
  271.    call gen_file_out
  272.    return
  273. end
  274. do k = 1 to list.0
  275.    call SysFileSearch record.2 , list.k , 'dummy.'
  276.    if dummy.0 = 1 then do
  277.       posb = lastpos('\',list.k) 
  278.       file_out = substr(list.k,posb + 1)
  279.       call write_log 
  280.       return
  281.    end
  282. end
  283. maxnum = 0
  284. do k = 1 to list.0
  285.    posb = lastpos('\',list.k) 
  286.    num  = substr(list.k , posb + 5 , 3)
  287.    if num > maxnum then maxnum = num
  288. end
  289. file_num = maxnum + 1
  290. call gen_file_out
  291. return
  292.  
  293. gen_file_out:
  294. file_out = file_pre || right(file_num,3,'0') || '.' || ext
  295. call write_log 
  296. return
  297.  
  298. write_log:
  299. log_line = date('E') time() left(file_out,12)
  300. log_line = log_line '- Table :' left(tabella,18) || ', DBase :' data_base
  301. call lineout file_log , log_line
  302. call lineout file_log
  303. return
  304.  
  305. write_record:
  306. signal on error
  307. rc =  SysFileDelete(file_out)
  308.    call beep 2500, 70 
  309. if rc = 2 then say '------> Start writing :' file_out
  310. if rc = 0 then say '------> Start RE-writing :' file_out
  311. do i = 1 to record.0
  312.    call lineout file_out , record.i
  313. end
  314. call lineout file_out
  315. return
  316.  
  317. test_args:
  318. if data_base = '' | data_base = '?' then call help 
  319.  
  320. do while tabella = ''
  321.    say 'TABLE NAME missing, reenter this field'
  322.    say '           or press ENTER to exit'
  323.    pull tabella
  324.    if tabella = '' then exit
  325. end  
  326. if linguaggio = '' then do  
  327.    linguaggio = 'COBOL'  
  328.    say 'WARNING : language missing, COBOL assumed'
  329. end  
  330. do while linguaggio <> 'COBOL' & linguaggio <> 'C' 
  331.    say 'LANGUAGE :' strip(linguaggio) 'is not valid'
  332.    say '           reenter this field as COBOL or C'
  333.    say '           press ENTER to exit'
  334.    pull linguaggio
  335.    if linguaggio = '' then exit
  336. end 
  337. if linguaggio = 'COBOL' then ext = 'CBL' 
  338.                         else ext = 'H'                         
  339. return  
  340.  
  341. lowercase: 
  342. arg low      
  343. lc = 'abcdefghijklmnopqrstuvwxyz'  
  344. uc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 
  345. low = translate(low , lc , uc  )
  346. return low
  347.  
  348. error:
  349. call beep  80,500 
  350. if sqlca.sqlcode <> 0 then do
  351.    say copies('-',79)
  352.    say 'SQLCODE =' sqlca.sqlcode
  353.    say sqlmsg
  354.    say copies('-',79)
  355. end
  356. if rc <> 0 then do
  357.    say 'an ERROR was found in this line :'
  358.    say sourceline(sigl)
  359.    say 'RC =' rc
  360. end
  361. if cblfloat = 1 then do  
  362.    say 'FLOAT column type not supported by COBOL' 
  363. end 
  364.  
  365. call sqlexec 'CLOSE   c1'
  366. call sqldbs  'STOP USING DATABASE'
  367. say 'DCLGEN2 ended with errors'
  368. exit
  369.  
  370. help: 
  371. say '                                                '
  372. say ' Syntax :                                       '
  373. say '                                                '
  374. say '   dclgen2 <data_base> <table_name> (language)  '
  375. say '                                                '
  376. say ' language can be : COBOL (default) or C         '
  377. exit
  378.