From: Didier Morandi [Didier.Morandi@gmx.fr]
Sent: Thursday, February 14, 2002 4:50 PM
To: Info-VAX@Mvb.Saic.Com
Subject: DCL Minute of the St Valentine's Day: DCL_ANALYST
$!+
$! DCL_ANALYST.COM
$!
$! Builds statistics on OPEN, CLOSE, READ etc and variable assignments and
$! substitution. Also does simple checking on unclosed single or double quotes.
$!
$!
$! DCL procedure name to be analysed.
$!
$!
$! Display statistics on user terminal or in a resulting file.
$! (see help at the end of this procedure)
$!
$!
$! Creates a work file in the same location as the analysed file, named
$! 'filename'.WORK (this file is actually preprocessed by DCL_DIET first).
$!
$! NOTE: DCL_DIET is (c) 1998 Charlie HAMMOND, COMPAQ Computer Corporation
$! and is available from the COMPAQ OpenVMS freeware CDs v4 and v5
$! or from the following URL on the COMPAQ WEB site:
$! http://www.openvms.compaq.com/freeware/freeware40/dcl_diet/
$!
$! QUALITY
$! Due to the complexity of this processing, your feedback is VERY welcome to
$! mailto:Didier.Morandi@Free.fr or within the comp.os.vms forum. Thank you.
$!
$! LEGAL
$! This procedure is a NothingWare product from MORANDI Consultants illimited.
$! (http://didier.morandi.free.fr/index_us.html).
$!
$! Revision history
$!
$! Version Date Author action
$! ------- ----------- ---------- ---------------------------------------------
$! v1.0-0 07-feb-2002 D. Morandi creation
$v="1.1-0"!14-feb-2002 DMo. add comments before release to c.o.v.
$!-
$ on warning then exit
$ say = "write sys$output" !terminal or file
$ if p1 .eqs. "" then goto HELP
$ say1 = "write sys$error" !always visible
$ if f$search(p1) .eqs. ""
$ then
$ say "File ",p1," not found."
$ exit
$ endif
$ say ""
$ say "This is DCL_ANALYST v",v
$ say ""
$ say2 = "!" !"V" quiet mode
$ say3 = "!" !idem for "C"
$ param = f$edit(p2,"upcase")
$ if f$locate("V",param) .ne. f$len(param) then say2 = say
$ if f$locate("C",param) .ne. f$len(param) then say3 = say
$ dq[0,8]=34 ! "
$ sq[0,8]=39 ! '
$ qq = sq + sq ! ''
$ nb_at = 0
$ nb_read = 0
$ nb_write = 0
$ nb_openr = 0
$ nb_openw = 0
$ nb_opena = 0
$ nb_close = 0
$ nb_locas = 0
$ nb_glbas = 0
$ nb_subst = 0
$!+
$! If we have good old DCL_DIET in our login directory, as all DCL programmers
$! should, let's diet the procedure before starting the processing (faster).
$!-
$ workfile = p1 - f$parse(p1,,,"type") - f$parse(p1,,,"version") + ".WORK"
$ if f$search("SYS$LOGIN:DCL_DIET.COM") .nes. ""
$ then
$ say1 "preprocessing file with DCL_DIET..."
$ define/nolog sys$output nl:
$ @sys$login:dcl_diet 'p1' 'workfile'
$ deass sys$output
$ say1 "done."
$ else
$ say -
"Source file will not be DIETed, DCL_DIET.COM missing in sys$login (how come?)"
$ copy 'p1' 'workfile'
$ endif
$!+
$! Now we ease line analysis by removing these spaces which break f$element...
$!-
$ temp_file = "sys$login:edt_temp_" + f$getjpi(0,"pid") + ".temp"
$ crea 'temp_file'
$DECK
s/$ /$/w/not
s/ == /==/w/not
s/ ==/==/w/not
s/== /==/w/not
s/ = /=/w/not
s/= /=/w/not
s/ =/=/w/not
s/ := /:=/w/not
s/:= /:=/w/not
s/ :=/:=/w/not
exit
$EOD
$ edit = "edit"
$ edit/edt/command='temp_file' 'workfile'
$ delete = "delete"
$ delete 'temp_file';
$!+
$! Let's redirect the result into the user supplied file.
$!-
$ if p3 .nes. ""
$ then
$ say "Processing output redirected to ",p3
$ define/nolog sys$output 'p3'
$ endif
$!+
$! Now we load the source file in memory, to have direct access to all lines.
$!-
$ close/nolog ch
$ open/read ch 'workfile'
$ i==1 !this one should be a global s.
$ say1 "Loading file..."
$LOOP:
$ read/end=EOF ch line_'i'
$ line = f$edit(line_'i',"trim,upcase,compress,uncomment")
$ if line .eqs. "" .or. line .eqs. "$" .or. line .eqs. " " then goto LOOP
$ j=i !this one allows src navigation
$LOOP_CONT:
$!+
$! we have a continuation line, let's concatenate it (much easier to process)
$!-
$ if f$extract(f$len(line_'i')-1,1,line_'i') .eqs. "-"
$ then
$ j=j+1
$ read/end=EOF ch line_'j'
$ line_'i' = f$extract(0,f$len(line_'i')-1,line_'i') + line_'j'
$ goto LOOP_CONT
$ endif
$ i==i+1
$ goto LOOP
$!+
$! We have loaded all the source, let's process each line now.
$!-
$EOF:
$ close ch
$ purge ="purge"
$ purge 'workfile'
$ nb_max = i - 1
$ i==1
$ we_are_within_a_DECK = 0
$ we_are_within_a_HTML_comment = 0
$LOOP2:
$ line = f$edit(line_'i',"trim,upcase,compress,uncomment") !in case we
$ line_len = f$len(line) !did not have
$ if line_len .eq. 0 then pipe i==i+1 ; goto LOOP2 !DCL_DIET.
$ if line .eqs. "$" then pipe i==i+1 ; goto LOOP2
$!+
$! If we are within a DECK/EOD pair, this is plain text, do nothing.
$!-
$ if we_are_within_a_DECK
$ then
$ if f$extract(0,4,line) .eqs. "$EOD" then we_are_within_a_DECK = 0
$ i==i+1
$ if i .gt. nb_max then goto ERROR_IN_DECK
$ goto LOOP2
$ endif
$!+
$! are we entering a DECK/EOD pair?
$!-
$ if f$extract(0,5,line) .eqs. "$DECK"
$ then
$ we_are_within_a_DECK = 1
$ i==i+1
$ if i .gt. nb_max then goto ERROR_IN_DECK
$ goto LOOP2
$ endif
$!+
$! If we are within an HTML comment, do nothing too.
$!-
$ if we_are_within_a_HTML_comment
$ then
$ if f$extract(0,,line) .eqs. "-->" then we_are_within_a_HTML_comment = 0
$ i==i+1
$ if i .gt. nb_max then goto ERROR_IN_HTML_COMMENT
$ goto LOOP2
$ endif
$!+
$! are we entering an HTML comment?
$!-
$ if f$extract(0,4,line) .eqs. "