home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: SysTools / SysTools.zip / spm2.zip / spmapp02.cmd < prev    next >
OS/2 REXX Batch file  |  1993-10-20  |  13KB  |  619 lines
  1. /**/
  2.   arg state
  3.  
  4.   if Pop() <> 0 then exit 9902
  5.  
  6.   if state = 'START'
  7.   then
  8.     do
  9.       say GetMsg(8,'02')
  10.       rc = prologue()
  11.       return rc
  12.     end
  13.  
  14.   if state = 'FINISH'
  15.   then
  16.     do
  17.       rc = epilogue()
  18.       say GetMsg(9,'02')
  19.       return rc
  20.     end
  21.  
  22.   if state = 'CLEANUP'
  23.   then
  24.     do
  25.       rc = cleanup()
  26.       say GetMsg(9,'02')
  27.       return rc
  28.     end
  29.  
  30.   oldq = rxqueue('SET','spmapp_q')
  31.  
  32.   ord = ''
  33.  
  34.   select
  35.     when LVL_2_SEQ = 0 then             /* file header */
  36.       do
  37.         queue 'version = '''SPMVERSN','OS2VERSN','SFTWNME','PRGMNME''''
  38.         queue 'pvwseq = ""'
  39.         queue 'spmseq = ""'
  40.         say GetMsg(16)
  41.         rc = 1
  42.       end
  43.  
  44.     when LVL_3_SEQ = 0 then             /* new group */
  45.       do
  46.         rc = CheckGroup()
  47.  
  48.         x = PutDot() /* say '  ' GROUPNME 'group' GROUPORD */
  49.  
  50.         queue 'pvw.'GROUPORD' = '''GROUPNME''''
  51.         queue 'pvw.'GROUPORD'.1 = '''GROUPDSC''''
  52.         queue 'pvw.'GROUPORD'.2 = 'LVL_2_SEQ
  53.         queue 'spm.'LVL_2_SEQ' = '''GROUPTAG''''
  54.         queue 'spm.'LVL_2_SEQ'.1 = 'GROUPORD
  55.         queue 'spm.'LVL_2_SEQ'.2 = 'GROUPSRC
  56.         queue 'spm.'LVL_2_SEQ'.3 = 'GROUPTYP
  57.         queue 'spm.'LVL_2_SEQ'.4 = 0'
  58.  
  59.         queue 'spmseq = spmseq||" "||'LVL_2_SEQ
  60.         ord = GROUPORD
  61.       end
  62.  
  63.     otherwise                           /* new field */
  64.       if ALIASNME <> ''                 /* or alias  */
  65.       then
  66.         do
  67.           rc = CheckAlias()
  68.  
  69.           x = PutDot() /* say '  ' ALIASNME 'group' ALIASORD ', alias of group' GROUPORD */
  70.  
  71.           queue 'pvw.'ALIASORD' = '''ALIASNME''''
  72.           queue 'pvw.'ALIASORD'.1 = '''ALIASDSC''''
  73.           queue 'pvw.'ALIASORD'.2 = 'LVL_2_SEQ
  74.  
  75.           ord = ALIASORD
  76.         end
  77.       else
  78.         do
  79.           rc = CheckField()
  80.  
  81.           queue 'spm.'LVL_2_SEQ'.4 = spm.'LVL_2_SEQ'.4 + 1'
  82.           queue 'spm.'LVL_2_SEQ'.4.'LVL_3_SEQ' = 'FIELDTYP
  83.           queue 'spm.'LVL_2_SEQ'.4.'LVL_3_SEQ'.1 = '''FIELDNME''''
  84.           queue 'spm.'LVL_2_SEQ'.4.'LVL_3_SEQ'.2 = '''FIELDTAG''''
  85.           queue 'spm.'LVL_2_SEQ'.4.'LVL_3_SEQ'.3 = '''FIELDDSC''''
  86.         end
  87.  
  88.   end /* select */
  89.  
  90.   if rc = 0
  91.   then
  92.     do
  93.       if ord <> ''
  94.       then
  95.         do
  96.           queue 'pvwseq = pvwseq||" "||'ord
  97.           if ord = 'defaultord'
  98.             then queue 'defaultord = defaultord + 1'
  99.         end
  100.  
  101.       x = rxqueue('SET',oldq)
  102.     end
  103.   else
  104.     if rc = 1 then rc = 0
  105.  
  106.   return rc
  107.  
  108.  
  109.  /* - - - - */
  110.  
  111. prologue:
  112.   x = rxqueue('DELETE','spmapp_q')
  113.   x = rxqueue('CREATE','spmapp_q')
  114.   return 0
  115.  
  116.  /* - - - - */
  117.  
  118. epilogue:
  119.   say ' '
  120.   say GetMsg(17)
  121.  
  122.   x = Version()
  123.   x = Groups()
  124.  
  125.   x = Types('groupsrc')
  126.   x = Types('grouptyp')
  127.   x = Types('fieldtyp',0)
  128.  
  129.   cTypeFld = TypeCount
  130.   TypeFld = TypeDesc
  131.  
  132.   x = Types('DEFS')
  133.  
  134.   x = PutDot()
  135.  
  136.   oldq = rxqueue('SET','spmapp_q')
  137.  
  138.   do while queued() <> 0
  139.     parse pull setvar
  140.     interpret setvar
  141.     /* rc = lineout("SPMAPP.TRC",setvar) */
  142.   end
  143.  
  144.   x = PutDot()
  145.  
  146.   do q = 1 to words(OrdList)
  147.     i = word(OrdList,q)
  148.  
  149.     if datatype(i,'N')
  150.     then
  151.       do
  152.         do p = 1 to words(pvwseq) until i = j
  153.           j = word(pvwseq,p)
  154.         end
  155.  
  156.         if i <> j then pvwseq = pvwseq||' '||i
  157.                   else rc = PutDot()
  158.       end
  159.   end
  160.  
  161.   pvwseq = SortSeq(pvwseq)
  162.   spmseq = SortSeq(spmseq)
  163.  
  164.   x = rxqueue('DELETE','spmapp_q')
  165.   x = rxqueue('SET',oldq)
  166.  
  167.   x = PutDot(',')
  168.  
  169.   NULL = x2c('00')
  170.  
  171.   Names = ''
  172.   szNP = 0
  173.   Desc = ''
  174.   szDP = 0
  175.  
  176.   do q = 1 to words(pvwseq)
  177.     i = word(pvwseq,q)
  178.     j = pvw.i.2
  179.  
  180.     if datatype(j,'N')
  181.     then
  182.         base = spm.j.1
  183.     else
  184.       do
  185.         base = substr(j,2)
  186.  
  187.         if i <> base & datatype(pvw.base.2,'N')
  188.         then
  189.           do
  190.             say ' '
  191.             say GetMsg(19,k)
  192.             drop pvw.k.
  193.             iterate
  194.           end
  195.       end
  196.  
  197.     do p = 1 to q - 1
  198.       o = word(pvwseq,p)
  199.       if pvw.i = pvw.o
  200.       then
  201.         do
  202.           say ' '
  203.           say GetMsg(21,pvw.i,base,o)
  204.           leave
  205.         end
  206.     end
  207.  
  208.     cb = length(pvw.i)
  209.     ofNm = szNP
  210.     Names = Names||d2c(cb)||pvw.i||NULL
  211.     szNP = szNP + cb + 2
  212.  
  213.     cb = length(pvw.i.1)
  214.     ofDs = szDP
  215.     Desc = Desc||d2c(cb)||pvw.i.1||NULL
  216.     szDP = szDP + cb + 2
  217.  
  218.     pvw.i.0 = d2s(i)||d2s(base)||d2s(ofNm)||d2s(ofDs)
  219.  
  220.     /* say 'PGD' c2x(pvw.i.0) */
  221.   end /* do q = 1 to words(pvwseq) */
  222.  
  223.   pvw.0.1 = Names||NULL
  224.   pvw.0.2 = Desc||NULL
  225.   szPN = szNP + 1
  226.   szPD = szDP + 1
  227.  
  228.   /* say 'PName' szPN  c2x(pvw.0.1) */
  229.   /* say 'PDesc' szPD  c2x(pvw.0.3) */
  230.  
  231.   do q = 1 to words(spmseq)
  232.     j = word(spmseq,q)
  233.  
  234.     rc = Verify(spm.j.1)
  235.  
  236.     x = PutDot() /* say '  ' spm.j 'group' spm.j.1 rc */
  237.  
  238.     cb = length(spm.j)
  239.  
  240.     Names = d2c(cb)||spm.j||NULL
  241.     szNP = cb + 2
  242.     Tags = Names
  243.     szTP = szNP
  244.     Desc = ''
  245.     szDP = 0
  246.     szGP = 0
  247.  
  248.     szPT = szPT + szTP
  249.  
  250.     do k = 1 to spm.j.4
  251.       l = c2d(substr(TypeFld,(spm.j.4.k*4)+3,1))
  252.       szGP = szGP + l
  253.  
  254.       spm.j.4.k.0 = d2c(l)||d2c(spm.j.4.k)||,
  255.                     d2s(szNP)||d2s(szTP)||d2s(szDP)
  256.  
  257.       cb = length(spm.j.4.k.1)
  258.       Names = Names||d2c(cb)||spm.j.4.k.1||NULL
  259.       szNP = szNP + cb + 2
  260.  
  261.       cb = length(spm.j.4.k.2)
  262.       Tags = Tags||d2c(cb)||spm.j.4.k.2||NULL
  263.       szTP = szTP + cb + 2
  264.  
  265.       cb = length(spm.j.4.k.3)
  266.       Desc = Desc||d2c(cb)||spm.j.4.k.3||NULL
  267.       szDP = szDP + cb + 2
  268.  
  269.       /* say 'SED' c2x(spm.j.4.k.0) */
  270.     end /* do k = 1 to spm.j.4 */
  271.  
  272.     spm.j.0.1 = Names||NULL
  273.     spm.j.0.2 = Tags||NULL
  274.     spm.j.0.3 = Desc||NULL
  275.     szNP = szNP + 1
  276.     szTP = szTP + 1
  277.     szDP = szDP + 1
  278.     mxGP = max(mxGP,szGP)
  279.  
  280.     /* say 'SName' szNP c2x(spm.j.0.1) */
  281.     /* say 'STags' szTP c2x(spm.j.0.2) */
  282.     /* say 'SDesc' szDP c2x(spm.j.0.3) */
  283.  
  284.     spm.j.0 = d2c(spm.j.2)||d2c(spm.j.3)||,
  285.               d2s(szNP)||d2s(szTP)||d2s(szDP)||,
  286.               d2s(spm.j.4)
  287.  
  288.     /* say 'SGD' c2x(spm.j.0) */
  289.  
  290.     ctGS = ctGS + 1
  291.     ctEL = ctEL + spm.j.4
  292.     szSN = szSN + szNP
  293.     szST = szST + szTP
  294.     szSD = szSD + szDP
  295.   end /* do q = 1 to words(spmseq) */
  296.  
  297.   PGD = ''
  298.   ctGP = 0
  299.  
  300.   do q = 1 to words(pvwseq)
  301.     i = word(pvwseq,q)
  302.     if symbol('pvw.i') = 'VAR'
  303.     then
  304.       do
  305.         PGD  = PGD||pvw.i.0
  306.  
  307.         ctGP = ctGP + 1
  308.         hiGP = max(hiGP,i)
  309.         loGP = min(loGP,i)
  310.       end
  311.   end
  312.  
  313.   /* say 'PGD' c2x(PGD) */
  314.  
  315.   /* say '.. number of ordinals         =' ctGP */
  316.   /* say '.. low ordinal                =' loGP */
  317.   /* say '.. high ordinal               =' hiGP */
  318.   /* say '.. number of base ordinals    =' ctGS */
  319.   /* say '.. number of elements         =' ctEL */
  320.   /* say '.. largest counter group size =' mxGP */
  321.  
  322.   Ver = d2s(ctGP)||d2s(ctGS)||d2s(ctEL)||,
  323.         d2s(loGP)||d2s(hiGP)||,
  324.         d2s(szPN)||d2s(szPT)||d2s(szPD)||,
  325.         d2s(szSN)||d2s(szST)||d2s(szSD)||,
  326.         d2s(cTypeFld)||d2s(mxGP)||,
  327.         version||NULL
  328.  
  329.   /* say 'VER' c2x(Ver) */
  330.  
  331.   say ' '
  332.   say GetMsg(18)
  333.  
  334.   x = Update('SPM', 'VERSION', "Ver")
  335.   x = Update('SPM', 'ELEMENTS', "PGD")
  336.   x = Update('SPM', 'NAMES', "pvw.0.1")
  337.   x = Update('SPM', 'DESC', "pvw.0.2")
  338.  
  339.   do q = 1 to words(spmseq)
  340.     j = word(spmseq,q)
  341.  
  342.     App = '_'||spm.j.1
  343.  
  344.     SGD = spm.j.0
  345.  
  346.     do k = 1 to spm.j.4
  347.       SGD = SGD||spm.j.4.k.0
  348.     end
  349.  
  350.     x = Update(App, 'ELEMENTS', "SGD")
  351.     x = Update(App, 'NAMES', "spm.j.0.1")
  352.     x = Update(App, 'TAGS', "spm.j.0.2")
  353.     x = Update(App, 'DESC', "spm.j.0.3")
  354.  
  355.     /* say 'SGD' c2x(SGD) */
  356.   end
  357.  
  358.   x = Retrieve('DCL','DEFS',"item")
  359.  
  360.   item = substr(item,1,4)||d2s(defaultord)||substr(item,7)
  361.  
  362.   x = Update('DCL','DEFS',"item")
  363.  
  364.   say ' '
  365.   return 0
  366.  
  367.  /* - - - - */
  368.  
  369. cleanup:
  370.   say ' '
  371.   x = rxqueue('DELETE','spmapp_q')
  372.   return 0
  373.  
  374.  /* * * * * */
  375.  
  376. Types:
  377.   parse arg Key,seq
  378.  
  379.   x = Retrieve('DCL',Key,"item")
  380.  
  381.   TypeCount = s2d(substr(item,1,2))
  382.   TypeDesc  = substr(item,3,TypeCount*4)
  383.   TypeNames = substr(item,3+length(TypeDesc))
  384.  
  385.   j = 4 * TypeCount
  386.  
  387.   do i = 1 to j by 4
  388.     var = szstr(TypeNames,s2d(substr(TypeDesc,i,2))+2)
  389.  
  390.     if seq = ''
  391.     then
  392.         interpret var '=' s2d(substr(TypeDesc,i+2,2))
  393.     else
  394.       do
  395.         interpret var '=' seq
  396.         seq = seq + 1
  397.       end
  398.   end
  399.  
  400.   return 0
  401.  
  402.  /* * * * * */
  403.  
  404. Groups:
  405.   OrdList = ''
  406.  
  407.   if Retrieve('SPM','ELEMENTS',"item",'opt') <> 0 then return 0
  408.  
  409.   x = Retrieve('SPM','NAMES',"name")
  410.   x = Retrieve('SPM','DESC',"desc")
  411.  
  412.   j = length(item)
  413.  
  414.   do i = 1 to j by 8
  415.     grp = s2d(substr(item,i,2))
  416.  
  417.     pvw.grp   = szstr(name,s2d(substr(item,i+4,2))+2)
  418.     pvw.grp.1 = szstr(desc,s2d(substr(item,i+6,2))+2)
  419.     pvw.grp.2 = '_'||s2d(substr(item,i+2,2))
  420.  
  421.     if substr(item,i,2) = substr(item,i+2,2) then t = 'b'
  422.                                              else t = 'a'
  423.     OrdList = OrdList||grp||' '||t||' '
  424.   end
  425.  
  426.   return 0
  427.  
  428.  /* * * * * */
  429.  
  430. Version:
  431.   if Retrieve('SPM','VERSION',"item",'opt') <> 0
  432.   then
  433.     do
  434.       ctGS = 0
  435.       ctEL = 0
  436.       loGP = 99999
  437.       hiGP = 0
  438.       szPT = 1
  439.       szSN = 0
  440.       szST = 0
  441.       szSD = 0
  442.       mxGP = 0
  443.     end
  444.   else
  445.     do
  446.       ctGS = s2d(substr(item,3,2))
  447.       ctEL = s2d(substr(item,5,2))
  448.       loGP = s2d(substr(item,7,2))
  449.       hiGP = s2d(substr(item,9,2))
  450.       szPT = s2d(substr(item,13,2))
  451.       szSN = s2d(substr(item,17,2))
  452.       szST = s2d(substr(item,19,2))
  453.       szSD = s2d(substr(item,21,2))
  454.       mxGP = s2d(substr(item,25,2))
  455.     end
  456.  
  457.   return 0
  458.  
  459.  /* * * * * */
  460.  
  461. Verify:
  462.   arg grp
  463.  
  464.   p = wordpos(grp,OrdList)
  465.  
  466.   if p = 0 then return ' '
  467.  
  468.   if Retrieve('_'||grp, 'ELEMENTS',"item",'opt') <> 0 then return 0
  469.  
  470.   ctGS = ctGS - 1
  471.   szSN = szSN - s2d(substr(item,3,2))
  472.   szST = szST - s2d(substr(item,5,2))
  473.   szSD = szSD - s2d(substr(item,7,2))
  474.   ctEL = ctEL - s2d(substr(item,9,2))
  475.  
  476.   szPT = szPT - s2d(substr(item,13,2))
  477.  
  478.   say ' '
  479.   say GetMsg(20,grp)
  480.  
  481.   return ' '
  482.  
  483.  /* * * * * */
  484.  
  485. Retrieve:
  486.   parse arg _app,_key,_item,_opt
  487.  
  488.   _data = SysIni(INIFILE,_app,_key)
  489.  
  490.   if _data = 'ERROR:'
  491.   then
  492.     do
  493.       if _opt = ''
  494.       then
  495.         do
  496.           say GetMsg(14,_app,_key)
  497.           exit 14
  498.         end
  499.       else
  500.         do
  501.           /* say '.. item' _app'/'_key 'not retrieved' */
  502.           return 4
  503.         end
  504.     end
  505.   else
  506.     do
  507.       interpret _item '= _data'
  508.       return 0
  509.     end
  510.  
  511. Update:
  512.   parse arg _app,_key,_item
  513.  
  514.   interpret 'x = SysIni(INIFILE,_app,_key,'_item')'
  515.  
  516.   if x = ''
  517.   then
  518.     do
  519.       x = PutDot() /* say '.. item' _app'/'_key 'updated' */
  520.       return 0
  521.     end
  522.   else
  523.     do
  524.       say GetMsg(15,_app,_Key)
  525.       return 8
  526.     end
  527.  
  528.   /*
  529.      pvw.i        =      PVW group name
  530.      pvw.i.1      =      description
  531.      pvw.i.2      = j =  link to spm.
  532.  
  533.      spm.j        =      SPM group tag
  534.      spm.j.1      =      ordinal
  535.      spm.j.2      =      source
  536.      spm.j.3      =      type
  537.      spm.j.4      = k =  count of fields
  538.      spm.j.4.k    =      field type
  539.      spm.j.4.k.1  =      PVW field name
  540.      spm.j.4.k.2  =      SPM field tag
  541.  
  542.      pvw.0.1      =      PGD names pool
  543.      pvw.0.2      =      PGD description pool
  544.      pvw.i.0      =      PGD item
  545.  
  546.      spm.j.0      =      SGD item
  547.      spm.j.0.1    =      SGD names pool
  548.      spm.j.0.2    =      SGD tags pool
  549.      spm.j.0.3    =      SGD description pool
  550.   */
  551.  
  552. CheckGroup:
  553.   x = Require(GROUPNME,'groupnme')
  554.   x = Require(GROUPTAG,'grouptag')
  555.  
  556.   if GROUPORD = '' then GROUPORD = 'defaultord'
  557.   if GROUPSRC = '' then GROUPSRC = 'defaultsrc'
  558.   if GROUPTYP = '' then GROUPTYP = 'defaulttyp'
  559.   if GROUPDSC = '' then GROUPDSC = GROUPNME
  560.   return 0
  561.  
  562. CheckAlias:
  563.   x = Require(ALIASNME,'groupnme')
  564.  
  565.   if ALIASORD = '' then ALIASORD = 'defaultord'
  566.   if ALIASDSC = '' then ALIASDSC = ALIASNME
  567.   return 0
  568.  
  569. CheckField:
  570.   x = Require(FIELDNME,'fieldnme')
  571.   x = Require(FIELDTAG,'fieldtag')
  572.   x = Require(FIELDTYP,'fieldtyp')
  573.  
  574.   if FIELDDSC = '' then FIELDDSC = FIELDNME
  575.   return 0
  576.  
  577. Require:
  578.   if arg(1) <> ''
  579.   then
  580.       return 0
  581.   else
  582.     do
  583.       say GetMsg(13,INPUT_SEQ,arg(2))
  584.       exit 13
  585.     end
  586.  
  587. SortSeq:
  588.   arg istr
  589.  
  590.   ostr = word(istr,1)
  591.   istr = subword(istr,2)
  592.  
  593.   do p = 1 to words(istr)
  594.  
  595.     wd = word(istr,p)
  596.     wc = words(ostr)
  597.  
  598.     do q = 1 to wc while q > 0
  599.       if wd = word(ostr,q)
  600.       then
  601.         do
  602.           q = 0
  603.           leave
  604.         end
  605.  
  606.       if wd < word(ostr,q)
  607.       then
  608.         do
  609.           ostr = subword(ostr,1,q-1)||' '||wd||' '||subword(ostr,q)
  610.           q = 0
  611.           leave
  612.         end
  613.     end
  614.  
  615.     if q > 0 then ostr = ostr||' '||wd
  616.   end
  617.  
  618.   return ostr
  619.