250 lines
11 KiB
Plaintext
250 lines
11 KiB
Plaintext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; ;
|
|
; Copyright 2012, 2013 Fidelity Information Services, Inc. ;
|
|
; ;
|
|
; This source code contains the intellectual property ;
|
|
; of its copyright holder(s), and is made available ;
|
|
; under a license. If you do not know the terms of ;
|
|
; the license, please stop and do not read further. ;
|
|
; ;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
%DSEWRAP
|
|
%dsewrap
|
|
; Wrappers for DSE to avoid inadvertently making database changes
|
|
set $ETRAP="do errtrap^%DSEWRAP"
|
|
set $ecode=",U255," ; must call an entryref
|
|
quit:$quit 255 quit ; in case error trap does not end the call
|
|
|
|
DUMP(r,o,w,d) ; upper case wrapper for dump
|
|
new tmp
|
|
set tmp=$$dump(r,.o,w,d)
|
|
quit:$quit tmp quit
|
|
|
|
dump(reglist,output,what,detail) ; dump information
|
|
; reglist - comma separated list of regions, "*" (default) for all regions
|
|
; output - required variable passed by reference where output is returned
|
|
; what - optional information to dump - "fileheader" (default) is only option for now
|
|
; detail - optional default is basic information, "all" is full fileheader dump
|
|
; install an error handler if non exists
|
|
if 0=$length($ETRAP) new $ETRAP set $ETRAP="do errtrap^%DSEWRAP"
|
|
new cmd,dse,debug,error,gtmdist,i,io,isVMS,line,mod,nopipe,region,ver
|
|
; save previous $IO to restore once the routine has completed
|
|
set io=$io
|
|
if $data(%DSEWRAP("debug")) do
|
|
. set debug=$increment(%DSEWRAP("debug"))
|
|
. set debug(debug,"input","reglist")=$get(reglist)
|
|
. set debug(debug,"input","what")=$get(what)
|
|
. set debug(debug,"input","detail")=$get(detail)
|
|
;
|
|
; Determine if we can use PIPES or not AND where to find DSE
|
|
set ver=$tr($piece($zversion," ",2),"V-.",""),ver=$select(ver<1000:ver*10,1:$extract(ver,1,5))
|
|
set isVMS=$zversion["VMS"
|
|
set nopipe=((ver<53003)&($get(%DSEWRAP("forcenopipe"),0)))!isVMS,mod=$select(isVMS:"/",1:"-")
|
|
set gtmdist=$select(isVMS:"gtm$dist",1:"gtm_dist")
|
|
;
|
|
; Applicable regions list
|
|
set reglist=$$reglist($$FUNC^%UCASE($get(reglist,"*")),isVMS)
|
|
; What operation? for now, should be just "dump -fileheader [-all]"
|
|
if (0=$length($get(what)))!("fileheader"=$$FUNC^%LCASE($get(what))) set what=mod_"fileheader"
|
|
else set $ecode=",U254," quit:$quit 254 quit
|
|
if 0=$length($get(detail)) set detail=""
|
|
else if "all"=$$FUNC^%LCASE(detail) set detail=mod_"all"
|
|
else if $length(detail," ")>1 do
|
|
. set detail=$$^%MPIECE(detail," "," ")
|
|
. for i=1:1:$length(detail," ") if $piece(detail," ",i)'?1(1"/",1"-").A set $piece(detail," ",i)=mod_$piece(detail," ",i)
|
|
set cmd="dump "_what_" "_detail
|
|
; Use alternate GT.M version - only supported with pipes
|
|
if nopipe&$data(%DSEWRAP("alternate")) set $ecode=",U252," quit:$quit 252 quit
|
|
; DSE command to use
|
|
set dse=$get(%DSEWRAP("alternate"),$ztrnlnm(gtmdist)_"/dse")
|
|
if $data(debug) merge debug(debug,"outputreg")=reglist
|
|
if reglist="" set $ecode=",U251," quit:$quit 251 quit
|
|
; Drive DSE
|
|
if 0=nopipe set error=$$dsepipecmd(.output,reglist,dse,cmd)
|
|
else set error=$$dsefilecmd(.output,reglist,cmd,isVMS)
|
|
use io
|
|
if $data(%DSEWRAP("debug")) merge %DSEWRAP("debug")=debug
|
|
quit:$quit error quit
|
|
|
|
; drive DSE through a PIPE device
|
|
dsepipecmd(output,regionlist,dse,cmd)
|
|
new error,curreg
|
|
open "dseproc":(shell="/bin/sh":command=dse)::"pipe"
|
|
use "dseproc"
|
|
for curreg=2:1:$length(regionlist,",") do
|
|
. set region=$piece(regionlist,",",curreg)
|
|
. if ($length(region)=0)&($data(debug)) set debug(debug,"reg",curreg)="first"_$c(10)
|
|
. if $length(region)>0 do ; should be 0 only when curreg=2
|
|
. . write region,! if $data(debug) set debug(debug,"reg",curreg)=region_$c(10)
|
|
. . set error=$$parsefhead(.output,1)
|
|
. write cmd,! if $data(debug) set debug(debug,"reg",curreg)=$get(debug(debug,"reg",curreg))_cmd
|
|
. set error=$$parsefhead(.output,1)
|
|
write "exit",!
|
|
write /eof
|
|
set error=$$parsefhead(.output,1)
|
|
close "dseproc"
|
|
quit error
|
|
|
|
; when PIPE devices are not supported drive DSE via a HEREDOC in a script
|
|
dsefilecmd(output,regionlist,cmd,isVMS)
|
|
new scriptfile,dsecmd,dumpfile,error,i,hdr,ftr,line,ts
|
|
set ts="_"_$tr($horolog,",","_")
|
|
set scriptfile=$select(isVMS:"dsedump"_ts_".com",1:"dsedump"_ts_".sh")
|
|
set dsecmd=$select(isVMS:"@",1:"chmod 755 "_scriptfile_"; ./")_scriptfile
|
|
set dumpfile="dsedump.txt"
|
|
open scriptfile:newversion use scriptfile
|
|
; print the header
|
|
set hdr=$select(isVMS:"dsecomhdr",1:"dseshhdr")
|
|
for i=1:1 set line=$text(@hdr+i) quit:line["quit" write $piece(line,";",2),!
|
|
; print the dump commands per region
|
|
for curreg=2:1:$length(regionlist,",") do
|
|
. set region=$piece(regionlist,",",curreg)
|
|
. if $length(region)>0 write region,! ; should be 0 only when curreg=2
|
|
. write cmd,!
|
|
; print the footer
|
|
set ftr=$select(isVMS:"dsecomftr",1:"dseshftr")
|
|
for i=1:1 set line=$text(@ftr+i) quit:line["quit" write $piece(line,";",2),!
|
|
; close and execute the script file
|
|
close scriptfile
|
|
zsystem dsecmd
|
|
; read script output and rename the file
|
|
open dumpfile:readonly use dumpfile set error=$$parsefhead(.output)
|
|
close dumpfile:(rename=dumpfile_ts)
|
|
; if no error occurred and debug is UNDEF, delete the script file
|
|
if (0=error)&(0=$data(debug)) open scriptfile:readonly close scriptfile:delete
|
|
quit error
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; generate the applicable region list
|
|
; the output string is a comma separated list of "FIND -REGION=<REGNAME>" and
|
|
; not a list of regions. The first piece is always null as a null string
|
|
; indicates that the script could find no applicable regions. The second piece
|
|
; could be null. If so, that piece represents the first region in which DSE
|
|
; starts up
|
|
reglist(reglist,isVMS)
|
|
; reglist - comma separated list of regions
|
|
; isVMS - use '/' (vms) or '-' (unix) for the modifier
|
|
; determine GT.CM regions, '::' (vms) vs ':' (unix)
|
|
new reg,regavail,i,mod,gtcmKey,regpath
|
|
set mod=$select(isVMS:"/",1:"-")
|
|
set gtcmKey=$select(isVMS:"::",1:":")
|
|
; determine the applicable regions - reglist vs actual available regions
|
|
set reglist=$select($get(reglist)="":"*",reglist="ALL":"*",1:reglist)
|
|
set regavail=""
|
|
if "*"'=reglist for i=1:1:$length(reglist,",") do
|
|
. set reg=$piece(reglist,",",i) set regavail(reg)=1 ; define the region
|
|
kill reg
|
|
for i=1:1 set reg=$view("gvnext",$get(reg)) quit:reg="" do
|
|
. set regpath=$VIEW("GVFILE",reg)
|
|
. quit:(1<$length(regpath,gtcmKey))
|
|
. if ("*"=reglist)!($data(regavail(reg))) do
|
|
. . set $piece(regavail,",",$length(regavail,",")+1)=$select(i>1:"find "_mod_"region="_reg,1:"")
|
|
quit regavail
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
parsefhead(output,active)
|
|
new error,debug,fcnt,field,file,i,line,parsed,region,value
|
|
set error=0
|
|
if $data(%DSEWRAP("debug")) set debug=$increment(%DSEWRAP("debug"))
|
|
if $length($etrap)=0 set $etrap="use $p zshow ""*"" halt"
|
|
;
|
|
for i=1:1 read line(i):5 quit:error quit:$zeof quit:$select($data(active)=0:0,line(i)["DSE>":1,1:0) do
|
|
. if ($test=0)&($length(line(i))=0) write !
|
|
. set line=$tr($$FUNC^%TRIM(line(i)),$c(10,13),"")
|
|
. quit:($length(line)=0)
|
|
. if line["%GTM-E-" set error=1 if $data(%DSEWRAP("debug")) set debug(debug,"error")=line
|
|
. if line?1"DSE>".E kill region,file quit ; DSE prompt means reset header information
|
|
. quit:line["Error: already in region: " ; ignore already in region error
|
|
. if line?1"File"1." ".E set fcnt=$length(line," "),file=$piece(line," ",fcnt) quit
|
|
. if line?1"Region"1." ".E do quit
|
|
. . set fcnt=$length(line," "),region=$piece(line," ",fcnt)
|
|
. . if $data(parsed(region,"File")) kill parsed(region) ; DUPLICATE, throw it away
|
|
. . set parsed(region,"File")=file
|
|
. quit:$data(region)=0
|
|
. if line?1"Date/Time".E set parsed(region,"Date/Time")=$$FUNC^%TRIM($extract(line,10,$length(line))) quit
|
|
. ;;; Match stats like output "DRD : #"
|
|
. else if line?3(1U,1N)1" : #".E do
|
|
. . set field=$$FUNC^%TRIM($piece(line,"0x",1)),value="0x"_$piece(line,"0x",2)
|
|
. . do addfield(.parsed,region,field,value)
|
|
. ;;; Match lines with " : (0x[0-9A0Z]*| (TRUE|FALSE))" in them
|
|
. else if $length(line," : ")>1 do
|
|
. . set field=$$FUNC^%TRIM($piece(line," : ",1)),value=$tr($piece(line," : ",2)," ","")
|
|
. . do addfield(.parsed,region,field,value)
|
|
. ;;; Match all column oriented data
|
|
. else do
|
|
. . ;;;; Adjust for the varying column width - the order matters
|
|
. . if $extract(line,44,45)=" " set $extract(line,44,45)="|" ; dump -all : Snapshot information
|
|
. . else if $extract(line,35,42)=" " set $extract(line,35,42)="|" ; dump -all : all after "Full Block Write.*"
|
|
. . else if $extract(line,42,43)=" " set $extract(line,42,43)="|" ; dump
|
|
. . new columns,col,data,lastfield,lastpiece
|
|
. . set columns=$length(line,"|")
|
|
. . ;;;; Handle the column data
|
|
. . for col=1:1:columns do
|
|
. . . set data=$$FUNC^%TRIM($piece(line,"|",col)) ; trim because of "Snapshot in progress"
|
|
. . . set lastpiece=$length(data," ")
|
|
. . . ;;;;;; Special case - value is a compound statement like "[WAS_ON] OFF"
|
|
. . . if (data["State")&(data["[") set lastpiece=$length(data," ")-1
|
|
. . . ; value is separated by the last space
|
|
. . . set value=$piece(data," ",lastpiece,$length(data," "))
|
|
. . . ; take everything but the value and trim off extra spaces
|
|
. . . set field=$$FUNC^%TRIM($extract(data,1,($length(data)-$length(value))))
|
|
. . . ;;;;;; Special case - fields where value may not exist
|
|
. . . if (data?1"Snapshot file name")!(data?1(1"Journal",1"Temp")1" File:") set value="",field=data
|
|
. . . ;;;;;; Special case - paired records like those with "Transaction ="
|
|
. . . if field="Transaction =" set field=lastfield_" TN" ; handle paired records
|
|
. . . if $data(%DSEWRAP("debug")) set debug(debug,i,field)=value
|
|
. . . do addfield(.parsed,region,field,value)
|
|
. . . set lastfield=field
|
|
merge output=parsed
|
|
if $data(%DSEWRAP("debug")) do
|
|
. merge %DSEWRAP("debug",debug,"line")=line
|
|
. set debug(debug,"pipe0ZOEF")=$zeof,debug(debug,"pipe0DEVICE")=$device,debug(debug,"pipe0ZA")=$ZA
|
|
. merge %DSEWRAP("debug")=debug
|
|
quit:$quit error quit
|
|
|
|
addfield(var,region,field,value)
|
|
if $data(var(region,field))\10 set var(region,field,$increment(var(region,field)))=value
|
|
else if $data(var(region,field)) do
|
|
. set var(region,field,1)=var(region,field),var(region,field)=2,var(region,field,2)=value
|
|
else set var(region,field)=value
|
|
quit
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
errtrap
|
|
use $p
|
|
set $etrap="use $principal write $zstatus,! zhalt 1"
|
|
set userecode=$piece($ecode,",",2)
|
|
set errtext=$select(userecode?1"U"3N:$text(@userecode),1:"")
|
|
if $length(errtext) write $text(+0),@$piece(errtext,";",2),!
|
|
else write $zstatus,!
|
|
if $zlevel<5 zhalt +$extract(userecode,2,$length(userecode))
|
|
quit
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Scripts to drive DSE via ZSystem
|
|
dsecomhdr
|
|
;$ define sys$output dsedump.txt
|
|
;$ define sys$error dsedump.txt
|
|
;$ purge /nolog dsedump.txt
|
|
;$ $gtm$dist:dse.exe
|
|
quit
|
|
dsecomftr
|
|
;$ deassign sys$output
|
|
;$ deassign sys$error
|
|
quit
|
|
dseshhdr
|
|
;#!/bin/sh
|
|
;$gtm_dist/dse > dsedump.txt 2>&1 << EOF
|
|
quit
|
|
dseshftr
|
|
;EOF
|
|
quit
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Error message texts
|
|
U251 ;"-F-NOREGIONS none of the target regions exist"
|
|
U252 ;"-F-NOPIPENOALTERNATE GT.M "_$zversion_" does not support pipes and cannot drive a different version of GT.M"
|
|
U253 ;"-F-ILLEGALDETAIL """_detail_""" is not a valid specification of details to dump"
|
|
U254 ;"-F-ILLEGALSELECTION """_what_""" is not a valid selection of what to dump"
|
|
U255 ;"-F-BADINVOCATION Must invoke as DO DUMP^"_$text(+0)_"(...)"
|