1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; Copyright (c) 2012-2017 Fidelity National Information ;
; Services, Inc. and/or its subsidiaries. All rights reserved. ;
; ;
; 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 $principal zshow ""*"" set $etrap=""zgoto 0"" zhalt 1"
;
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,! set $etrap=""zgoto 0"" 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 set $etrap="zgoto 0" 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)_"(...)"
|
