├── README.md
└── ClassVis.xml


/README.md:
--------------------------------------------------------------------------------
 1 | ClassVis
 2 | ========
 3 | 
 4 | ClassVis is a utility to generate diagrams of relationships between InterSystems Caché Classes. 
 5 | 
 6 | ClassVis uses the open source Graphviz tool to render the diagrams. See http://www.graphviz.org/
 7 | 
 8 | Installation
 9 | ------------
10 | 
11 | 1) Install Graphviz (http://www.graphviz.org/)
12 | 
13 | 2) Load and compile the ClassVis.xml file in Caché:
14 | 
15 | 	do $system.OBJ.Load("ClassVis.xml","c")
16 | 
17 | 3) Ensure that the Graphviz 'dot' command is on the System Path OR call SetPath^ClassVis(path), and pass the path to the Graphviz bin directory.
18 | 
19 | 	do SetPath^ClassVis("/usr/local/graphviz/bin/")
20 | 
21 | Note that the trailing slash is required.
22 | 
23 | Usage
24 | -----
25 | 
26 | ClassVis has two modes: one for showing compile dependencies, and one for showing relationships between the classes. They are both called the same way:
27 | 
28 | 	do CompileDeps^ClassVis(clslist,flags,outfile,imgtype,keepfiles)
29 | 
30 | 	do Schema^ClassVis(clslist,flags,outfile,imgtype,keepfiles)
31 | 
32 | the parameters are:
33 | 
34 | 	clslist - The list of starting classes. Related classes will be included based on the flags. This can use the * wildcard 
35 | 			  (e.g., Sample.*), or be a regular expression contained in '/' characters (e.g., '/Sample\..*/'.).
36 | 
37 | 	flags - Controls the output. See ShowQualifiers^ClassVis() for details. values are:
38 | 
39 | 		Common:
40 | 			/includeEns - include Ensemble System classes.
41 | 			/includePercent - include %-classes.
42 | 			/includeHS - include HealthShare System classes.
43 | 			/clsPersistent - include Persistent classes.
44 | 			/clsSerial - include Serial classes.
45 | 			/clsRegistered - include Registered classes.
46 | 			/clsDatatype - include Datatype classes.
47 | 			/recurse - recursively include related classes: 
48 | 				- (0) no recursion
49 | 				- (-1) recursively include all classes
50 | 				- (recurse>0) recursively include classes up to a depth of <recurse>
51 | 
52 | 		Schema:
53 | 			/dependsOn - include DependsOn/CompileAfter classes.
54 | 			/inheritance - include superclasses.
55 | 
56 | 		CompileDeps:
57 | 			/reverseDeps - include reverse dependencies.
58 | 		
59 | 	outfile - the path and name of the file to contain the image.
60 | 	
61 | 	imgtype -  the type of image. The default is 'svg'. Valid values are any of the supported formats for GraphViz. See here 
62 | 			   for the complete list: http://www.graphviz.org/content/output-formats
63 | 
64 | 	keepfiles - This parameter is for debugging only. If 1, do not delete intermediate files. The defualt is 0.


--------------------------------------------------------------------------------
/ClassVis.xml:
--------------------------------------------------------------------------------
  1 | <?xml version="1.0" encoding="UTF-8"?>
  2 | <Export generator="Cache" version="25" zv="Cache for UNIX (Apple Mac OS X for x86-64) 2015.1 (Build 224U)" ts="2014-09-04 11:12:59">
  3 | <Routine name="ClassVis" type="MAC" languagemode="0" timestamp="63434,40200.828308"><![CDATA[
  4 | ClassVis
  5 | 	quit
  6 | 
  7 | #define Queue(%name) set %queue($increment(%queue))=%name
  8 | #define Dequeue() %queue($increment(%queue,-1)+1)
  9 | 
 10 | #define OriginAttrs "fontcolor=""orange"""
 11 | #define TerminalAttrs "fontcolor=""red"""
 12 | #define PersistentAttrs "color=""blue"""
 13 | #define SerialAttrs "color=""red"""
 14 | #define RegisteredAttrs "color=""purple"""
 15 | #define DatatypeAttrs "color=""green"""
 16 | 
 17 | ///Calculate compile dependencies
 18 | ///Default flags: /clsPersistent=1 /clsSerial=1 /clsRegistered=1 /clsDatatype=1 /recurse=0
 19 | CompileDeps(clslist,flags="",outfile,imgtype="svg",keepfiles=0) public
 20 | {	
 21 | #define DepTypeLabel(%type) $case(%type,0:"List",1:"SQL",2:"Include",3:"PropCls",4:"Index",5:"Super",6:"CompileAfter",7:"PropDataType",8:"Parent",9:"Projection",10:"FK",11:"Child",12:"SubClass",13:"Query",14:"DependsOn",15:"",16:"Argument")
 22 | 
 23 | 	new %queue,%nameIdx,%nodes,%links,%files,%qualifiers
 24 | 	do parseQualifiers("/clsPersistent=1/clsSerial=1/clsRegistered=1/clsDatatype=1/recurse=0"_flags)
 25 | 	
 26 | 	do expandList(clslist)
 27 | 	
 28 | 	while $g(%queue)>0 {
 29 | 		set cls = $$$Dequeue
 30 | 		set depth = $list(cls,2)
 31 | 		set cls = $list(cls,1)
 32 | 		
 33 | 		if '##class(%Dictionary.ClassDefinition).%ExistsId(cls) continue
 34 | 		set c1=$$node(cls,depth) 
 35 | 		if c1="" continue
 36 | 		
 37 | 		for d=0:1:16 {
 38 | 			set c2name = ""
 39 | 			for { 
 40 | 				set c2name=$order(^oddDEP(cls,d,c2name)) 
 41 | 				if c2name="" quit
 42 | 				
 43 | 				set c2 = $$node(c2name,depth+1)
 44 | 				if c2="" continue
 45 | 				
 46 | 				set label = $$$DepTypeLabel(d)
 47 | 				do link(c1,c2,"label="""_label_"""")
 48 | 			}
 49 | 			if %qstruct("reverseDeps") {
 50 | 				for { 
 51 | 					set c2name=$order(^oddDEP(0,cls,d,c2name)) 
 52 | 					if c2name="" quit
 53 | 					
 54 | 					set c2 = $$node(c2name,depth+1)
 55 | 					if c2="" continue
 56 | 					
 57 | 					set label = $$$DepTypeLabel(d)
 58 | 					do link(c1,c2,"color=""red"" label="""_label_"""")
 59 | 				}
 60 | 			}
 61 | 		}
 62 | 	}
 63 | 	
 64 | 	do buildGV(.file)
 65 | 	set st=$$callGV(file,outfile,imgtype)
 66 | 	
 67 | 	if 'keepfiles {
 68 | 		do cleanup()
 69 | 	}
 70 | }
 71 | 
 72 | /// Calculate class relationships
 73 | /// Notes: does not look at Projections or Methods/Queries
 74 | /// default flags: /clsPersistent=1 /recurse=-1
 75 | Schema(clslist,flags="",outfile,imgtype="svg",keepfiles=0) public
 76 | {
 77 | 	new %queue,%nameIdx,%nodes,%links,%files,%qstruct
 78 | 	
 79 | 	set flags = $zconvert(flags,"l")
 80 | 	do parseQualifiers("/clsPersistent=1/recurse=-1"_flags)
 81 | 	
 82 | 	do expandList(clslist)
 83 | 	
 84 | 	while $g(%queue)>0 {
 85 | 		set clsname = $$$Dequeue
 86 | 		
 87 | 		set depth = $list(clsname,2)
 88 | 		set clsname = $list(clsname,1)
 89 | 		
 90 | 		set cls=##class(%Dictionary.CompiledClass).%OpenId(clsname)
 91 | 		if cls="" continue
 92 | 		
 93 | 		set c1=$$node(clsname,depth) 
 94 | 		if c1="" continue
 95 | 		
 96 | 		//Properties
 97 | 		for i=1:1:cls.Properties.Count() {
 98 | 			set prop = cls.Properties.GetAt(i)
 99 | 			set type = prop.Type
100 | 			if type="" continue
101 | 			
102 | 			//Is this prop inherited? 
103 | 			//don't include inherited props if superclasses are included
104 | 			if %qstruct("inheritance"),cls.Name'=prop.Origin continue
105 | 			
106 | 			set c2 = $$node(type,depth+1)
107 | 			if c2 = "" continue
108 | 			set label = $select(prop.Relationship:"R:",1:"P:")_prop.Name
109 | 			do link(c1,c2,"label="""_label_"""")
110 | 		}
111 | 		
112 | 		//ForeignKey
113 | 		if %qstruct("clsPersistent") {
114 | 			for i=1:1:cls.ForeignKeys.Count() {
115 | 				set fk = cls.ForeignKeys.GetAt(i)
116 | 				//is fk inherited?
117 | 				if %qstruct("inheritance"),cls.Name'=fk.Origin continue
118 | 				
119 | 				set c2 = $$resolveClass(fk.ReferencedClass,fk.Origin)
120 | 				set c2 = $$node(c2,depth+1)
121 | 				if c2 = "" continue
122 | 				do link(c1,c2,"label=""FK:"_fk.Name_"""")
123 | 			}
124 | 		}
125 | 		
126 | 		//Inheritance/DependsOn/CompilAfter
127 | 		if %qstruct("inheritance") {
128 | 			set clslist = cls.Super
129 | 			if clslist'="" {
130 | 				for i=1:1:$length(clslist,",") {
131 | 					set c2 = $$node($piece(clslist,",",i),depth+1)
132 | 					if c2 = "" continue
133 | 					do link(c2,c1,"dir=back label=""Super""")
134 | 				}
135 | 			}
136 | 		}
137 | 		if %qstruct("dependsOn") {
138 | 			set clslist = cls.DependsOn
139 | 			if clslist'="" {
140 | 				for i=1:1:$length(clslist,",") {
141 | 					set c2 = $$node($piece(clslist,",",i),depth+1)
142 | 					if c2 = "" continue
143 | 					do link(c2,c1,"dir=back label=""DependsOn""")
144 | 				}
145 | 			}
146 | 			set clslist = cls.CompileAfter
147 | 			if clslist'="" {
148 | 				for i=1:1:$length(clslist,",") {
149 | 					set c2 = $$node($piece(clslist,",",i),depth+1)
150 | 					if c2 = "" continue
151 | 					do link(c2,c1,"dir=back label=""CompileAfter""")
152 | 				}
153 | 			}
154 | 		}
155 | 		
156 | 		//Method Signature -- too unstable
157 | 		/*
158 | 		if method {
159 | 			for i=1:1:cls.Methods.Count() {
160 | 				set meth = cls.Methods.GetAt(i)
161 | 				
162 | 				if %qstruct("inheritance"),cls.Name'=meth.Origin continue 
163 | 				
164 | 				if meth.ReturnType'="" {
165 | 					set c2 = $$node(meth.ReturnType)
166 | 					if c2'="" do link(c1,c2)
167 | 				}
168 | 				
169 | 				set sig = meth.FormalSpecParsed
170 | 				for j=1:1:$listlength(sig) {
171 | 					set type = $listget($listget(sig,j),2)
172 | 					if type="" continue
173 | 					set c2 = $$node(type)
174 | 					if c2'="" do link(c1,c2,"label=""M:"_meth.Name_"""")
175 | 				}
176 | 			}
177 | 		}
178 | 		*/
179 | 	}
180 | 	
181 | 	do buildGV(.file)
182 | 	set st=$$callGV(file,outfile,imgtype)
183 | 	
184 | 	if 'keepfiles {
185 | 		do cleanup()
186 | 	}
187 | }
188 | 
189 | expandList(clslist) 
190 | {
191 | 	for i=1:1:$length(clslist,",") {
192 | 		set cls = $piece(clslist,",",i)
193 | 		if $extract(cls,*)="*" {
194 | 			set cls = $zconvert($extract(cls,1,*-1),"U")
195 | 			set c = ""
196 | 			for {
197 | 				set c = $order(^rINDEXCLASS(c),1,d)
198 | 				if c="" quit
199 | 				if $extract(c,1,$length(cls))=cls {
200 | 					do node($list(d,2),0,$$$OriginAttrs)
201 | 				}
202 | 			}
203 | 		} elseif $extract(cls,1)="/",$extract(cls,*)="/" {
204 | 			set cls = $extract(cls,2,*-1)
205 | 			set c = ""
206 | 			for {
207 | 				set c = $order(^rINDEXCLASS(c),1,d)
208 | 				if c="" quit
209 | 				set tmpcls = $list(d,2)
210 | 				if $match(tmpcls,cls) {
211 | 					do node(tmpcls,0,$$$OriginAttrs)
212 | 				}
213 | 			}
214 | 		} else {
215 | 			do node(cls,0,$$$OriginAttrs)
216 | 		}
217 | 	}
218 | }
219 | ///		/clsPersistent
220 | ///		/clsSerial
221 | ///		/clsRegistered
222 | ///		/clsDataType
223 | ///		/inheritance
224 | ///		/dependsOn
225 | ///
226 | ///		/includePercent
227 | ///		/includeEns
228 | ///		/includeHS
229 | ///     /recurse
230 | ShowQualifiers() public
231 | {
232 | 	write "Common:",!
233 | 	write "	/includeEns - include Ensemble System classes.",!
234 | 	write "	/includePercent - include %-classes.",!
235 | 	write "	/includeHS - include HealthShare System classes.",!
236 | 	write "	/clsPersistent - include Persistent classes.",!
237 | 	write "	/clsSerial - include Serial classes.",!
238 | 	write "	/clsRegistered - include Registered classes.",!
239 | 	write "	/clsDatatype - include Datatype classes.",!
240 | 	write "	/recurse - recursively include related classes: ",!
241 | 	write "		- (0) no recursion",!
242 | 	write "		- (-1) recursively include all classes",!
243 | 	write "		- (recurse>0) recursively include classes up to a depth of <recurse>",!
244 | 	write !,"Schema() only:",!
245 | 	write "	/dependsOn - include DependsOn/CompileAfter classes.",!
246 | 	write "	/inheritance - include superclasses.",!
247 | 	write !,"CompileDeps() only:",!
248 | 	write "	/reverseDeps - include reverse dependencies.",!
249 | }
250 | parseQualifiers(flags)
251 | {
252 | 	#define flags ",includeEns,includePercent,includeHS,clsPersistent,clsSerial,clsRegistered,clsDatatype,dependsOn,inheritance,reverseDeps,recurse,"
253 | 	
254 | 	for i=2:1:$length($$$flags,",")-1 {
255 | 		set f = $piece($$$flags,",",i)
256 | 		set %qstruct(f)=0
257 | 	}
258 | 	set flags = $listfromstring(flags,"/")
259 | 	for i=1:1:$listlength(flags) {
260 | 		set f=$list(flags,i)
261 | 		if f["=" {
262 | 			set v = $piece(f,"=",2)
263 | 			set f = $piece(f,"=",1)
264 | 		} else {
265 | 			set v = 1
266 | 		}
267 | 		
268 | 		if $$$flags[(","_f_",") {
269 | 			set %qstruct(f)=v
270 | 		}
271 | 	}
272 | 	
273 | 	if %qstruct("recurse")=0 set %qstruct("recurse")=1
274 | }
275 | node(name,depth,attrs="")
276 | {
277 | 	set idx = $get(%nameIdx(name))
278 | 	if idx'="" {
279 | 		if attrs'="" {
280 | 			set oldattrs = $listget(%nodes(idx),2)
281 | 			if oldattrs'[attrs set $list(%nodes(idx),2)=oldattrs_" "_attrs
282 | 		}
283 | 		quit idx
284 | 	}
285 | 	
286 | 	if %qstruct("recurse")'=-1,depth>%qstruct("recurse") quit ""
287 | 	
288 | 	if '%qstruct("includePercent"),$extract(name)="%" quit ""
289 | 	if '%qstruct("includeEns"),(($extract(name,1,4)="Ens.")||($extract(name,1,7)="EnsLib.")) quit ""
290 | 	if '%qstruct("includeHS"),$extract(name,1,3)="HS." quit ""
291 | 	
292 | 	set clsType = $$sqlgetvalue("select ClassType from %Dictionary.CompiledClass where %Id=?",.sc,name)
293 | 	if clsType="" set clsType="registered"
294 | 	set clsType=$zconvert(clsType,"l")
295 | 	
296 | 	if '%qstruct("clsPersistent"),clsType="persistent" quit ""
297 | 	if '%qstruct("clsSerial"),clsType="serial" quit ""
298 | 	if '%qstruct("clsRegistered"),clsType="registered" quit ""
299 | 	if '%qstruct("clsDatatype"),((clsType="datatype")||(clsType="stream")) quit ""
300 | 	
301 | 	set typeAttrs = $case(clsType,"datatype":$$$DatatypeAttrs,"stream":$$$DatatypeAttrs,"registered":$$$RegisteredAttrs,"serial":$$$SerialAttrs,"persistent":$$$PersistentAttrs,:"")
302 | 	set attrs = $select(attrs="":typeAttrs,1:attrs_" "_typeAttrs)
303 | 	
304 | 	if depth=%qstruct("recurse") set attrs=attrs_" "_$$$TerminalAttrs
305 | 	
306 | 	set idx = $increment(%nodes)
307 | 	set %nodes(idx)=$listbuild(name,attrs)
308 | 	
309 | 	set %nameIdx(name)=idx
310 | 	//don't queue nodes whose relations will be excluded
311 | 	if depth'=%qstruct("recurse") $$$Queue($lb(name,depth))
312 | 	quit idx
313 | }
314 | link(n1,n2,attrs="")
315 | {
316 | 	if (n1=n2)||(n1="")||(n2="") quit 0
317 | 	set idx = $increment(%links)
318 | 	set %links(idx)=$listbuild(n1,n2,attrs)
319 | 	quit idx
320 | 	
321 | }
322 | buildGV(file="")
323 | {
324 | 	set stream = ##class(%Stream.FileCharacter).%New()
325 | 	if file="" {
326 | 		set file = ##class(%File).TempFilename("gv")
327 | 		set %files("gv")=file	
328 | 	}
329 | 	
330 | 	set stream.Filename=file
331 | 	
332 | 	do stream.WriteLine("digraph visualization {")
333 | 	
334 | 	set i=""
335 | 	for {
336 | 		set i=$order(%nodes(i),1,node)
337 | 		if i="" quit
338 | 		set attrs = $list(node,2)
339 | 		do stream.WriteLine("n"_i_" [label="""_$list(node)_""""_$select(attrs="":"",1:" "_attrs)_"];")
340 | 	}
341 | 
342 | 	set i=""
343 | 	for {
344 | 		set i=$order(%links(i),1,link)
345 | 		if i="" quit
346 | 		
347 | 		set attrs=$list(link,3)
348 | 		if attrs'="" set attrs="["_attrs_"]"
349 | 		do stream.WriteLine("n"_$list(link,1)_" -> n"_$list(link,2)_" "_attrs_";")
350 | 	}	
351 | 	do stream.WriteLine("}")
352 | 	do stream.%Save()
353 | }
354 | callGV(file,outfile,imgtype="svg")
355 | {
356 | 	set ret = ""
357 | 	set log = ##class(%File).TempFilename("log")
358 | 	set %files("log")=log
359 | 	set gvpath = $get(^ClassVis("gvpath"))
360 | 	
361 | 	set st=$zf(-1,gvpath_"dot -T"_imgtype_" -o "_outfile_" "_file_" > "_log)
362 | 	quit ret
363 | }
364 | SetPath(path) public
365 | {
366 | 	if path="" {
367 | 		kill ^ClassVis("gvpath")
368 | 	} else {
369 | 		set ^ClassVis("gvpath")=path
370 | 	}
371 | }
372 | cleanup()
373 | {
374 | 	set i=""
375 | 	for {
376 | 		set i=$order(%files(i),1,f)
377 | 		if i="" quit
378 | 		do ##class(%File).Delete(f)
379 | 	}
380 | 	
381 | 	kill %queue,%nameIdx,%nodes,%links,%files
382 | }
383 | 
384 | sqlgetvalue(sql,sc,args...)
385 | {
386 | 	set stmt = ##class(%SQL.Statement).%New()
387 | 	set sc = stmt.%Prepare(sql)
388 | 	if 'sc quit ""
389 | 	
390 | 	set rs = stmt.%Execute(args...)
391 | 	if rs.%SQLCODE<0 set sc = $System.Status.Error(5001,rs.%Message) quit ""
392 | 	
393 | 	do rs.%Next()
394 | 	set val = rs.%GetData(1)
395 | 	quit val
396 | }
397 | 
398 | resolveClass(name,origin)
399 | {
400 | 	if $extract(name)="%" {
401 | 		if $extract(name,1,9)="%Library." { quit name }
402 | 		else { quit "%Library."_$extract(name,2,*) }
403 | 	} 
404 | 	elseif name["." {
405 | 		quit name
406 | 	}
407 | 	else {
408 | 		set pkg = $piece(origin,".",1,*-1)
409 | 		quit pkg_"."_name
410 | 	}
411 | 	
412 | 	quit ""
413 | }
414 | ]]></Routine>
415 | </Export>
416 | 


--------------------------------------------------------------------------------