2011-06-15 11:46

divout: PROCEDURE EXPOSE (dict$.exposestems)
PARSE ARG mode
CALL varserverini()
IF mode \= 'ZIP' THEN DO k= 1 TO dict$.variable_name.0 /* Save all VARIALE files to be used */
   varname=dict$.variable_name.k
   vardir=dict$.variable_dir.k
   vartext=dict$.variable_text.k 
   IF testgetvar(varname'.UPDATE',0)\=1 THEN ITERATE
   SAY ptime()' Save VARIABLE Table 'vartext' started'  
   INTERPRET 'DIVDUMP("'vardir'","'varname'",'varname'.,"'vartext'")' 
   SAY ptime()' Save VARIABLE Table 'vartext' completed'  
END 
ELSE DO 
   SAY ptime()' Save Dictionary Tables started' 
   CALL divzip(dict$.dirr,'divr$',divr$.,'Reference Table')  
   CALL divzip(dict$.diru,'divu$',divu$.,'Usage Table') 
   CALL divzip(dict$.dire,'dive$',dive$.,'Encode Table') 
   SAY ptime()' Save Dictionary Tables completed'  
END
RETURN 

divdump:
USE ARG dirs,pref,pool.,tabmsg
i=0
suffix=0
file=dirs||pref'.'suffix'.rex'
DO varn OVER pool.
   i=i+1
   IF i=1 THEN DO 
      DELETEFILE(file)
      LINEOUT(file,'use arg 'pref'.')
   END
   line=VALUE(pref'.'varn)
   IF POS("'",line)>0 THEN LINEOUT(file,pref'.'varn'="'VALUE(pref"."varn)'"')
      ELSE LINEOUT(file,pref'.'varn"='"VALUE(pref'.'varn)"'")
   IF i>=dict$.partsize THEN DO 
      i=0 
      LINEOUT(file,pref'.next_extension=1')
      SAY ptime() tabmsg' Partition 'suffix' Saved' 
      LINEOUT(file)
      suffix=suffix+1
      file=dirs||pref'.'suffix'.rex'
   END
END
LINEOUT(file,pref'.next_extension=0')
LINEOUT(file)
/* ............ Reset Update Flag  */
INTERPRET pref'.UPDATE=0'        /* reset "to be updated flag " */
/* ............ Update Flag reset  */
SAY ptime() tabmsg' Partition 'suffix' Saved' 
RETURN  

divzip:
USE ARG dirs,pref,pool.,tabmsg
lino=0
suffix=1
DO varn OVER pool.
   IF lino=0 THEN DO 
      writel('use arg 'pref'.')
   END
   line=VALUE(pref'.'varn)
   IF POS("'",line)>0 THEN writel(pref'.'varn'="'VALUE(pref"."varn)'"')
      ELSE writel(pref'.'varn"='"VALUE(pref'.'varn)"'")
   IF lino>=dict$.partsize THEN DO 
      writel(pref'.next_extension=1')
      zip.suffix=zipline
      SAY ptime() tabmsg' Partition 'suffix' Saved' 
      lino=0 
      suffix=suffix+1
   END
END
writel(pref'.next_extension=0')
zip.suffix=zipline
zip.0=suffix
/* call ZIPDICT(dirs||pref,zip.) */
DO i=1 TO suffix
file=dirs||pref'.'i'.Rex'
SAY file
CHAROUT(file,zip.i) 
LINEOUT(file)
END

DROP zip.
SAY ptime() tabmsg' Partition 'suffix' Saved' 
RETURN 
/* --------------------------------------------------------------------------------------------
 * Prepare ZIP File
 * --------------------------------------------------------------------------------------------
 */
writel:
USE ARG zipl
IF lino=0 THEN zipline=zipl
   ELSE zipline=zipline||"0D0A"x||zipl
lino=lino+1
RETURN  
/* --------------------------------------------------------------------------------------------
 * Time
 * --------------------------------------------------------------------------------------------
 */
ptime: PROCEDURE
ptime=TIME('l')
len=LENGTH(ptime)-3
RETURN SUBSTR(ptime,1,len)
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
/*** --------------------------------------------------------------------------- */
/*** Auto Loaded Modules, source changes should be done in the original modules  */
/*** --------------------------------------------------------------------------- */  /*$$AUTOLOAD ALL */
testgetvar:
USE ARG tvar,default
default=ARG(2)
IF EXISTS(tvar)=0 THEN DO 
   tvar=TRANSLATE(tvar)
   IF EXISTS(tvar)=0 THEN RETURN default
END
IF STRIP(VALUE(tvar))='' THEN RETURN default
RETURN VALUE(tvar)              /*$$AUTOLOAD END ALL */
/*** ------------------------------------------------------------------------------------------------------- */
/*** XREF of (Auto-) Loaded Modules                                                                          */
/*** ------------------------------------------------------------------------------------------------------- */
/*** TESTGETVAR.REX          I:\Varserver\\SysProc\                 AUTOLOAD       448BT 03/01/2009 13:01:08 */
/*** ------------------------------------------------------------------------------------------------------- */
/*** XREF of Procedures      Defined  Used in Line   Suffix "+" Label, none Procedure                        */
/*** ------------------------------------------------------------------------------------------------------- */
/***   1 DIVDUMP                28+   15                                                                     */
/***   2 DIVOUT                  6    3                                                                      */
/***   3 DIVZIP                 60+   21 22 23                                                               */
/***   4 PTIME                 107    14 16 20 24 45 57 74 91                                                */
/***   5 TESTGETVAR            134+   13                                                                     */
/***   6 WRITEL                 97+   66 69 70 72 79                                                         */
/*** ------------------------------------------------------------------------------------------------------- */
/*** XREF of Variables              Modified in Line   Suffix "+" Parse Arg, "*" Parse Variable, none SET    */
/*** ------------------------------------------------------------------------------------------------------- */
/***   1 DEFAULT                             136                                                             */
/***   2 FILE                                32 48 84                                                        */
/***   3 I                                   30 34 43                                                        */
/***   4 LEN                                 109                                                             */
/***   5 LINE                                39 68                                                           */
/***   6 LINEOUT(FILE,PREF'.NEXT_EXTENSION   44 51                                                           */
/***   7 LINO                                62 75 101                                                       */
/***   8 MODE                                7+                                                              */
/***   9 PTIME                               108                                                             */
/***  10 SUFFIX                              31 47 63 76                                                     */
/***  11 TVAR                                138                                                             */
/***  12 VARDIR                              11                                                              */
/***  13 VARNAME                             10                                                              */
/***  14 VARTEXT                             12                                                              */
/***  15 WRITEL(PREF'.NEXT_EXTENSION         72 79                                                           */
/***  16 ZIP.0                               81                                                              */
/***  17 ZIP.SUFFIX                          73 80                                                           */

2011-06-15 11:46