#!/usr/bin/perl #naming CONVENTION #it is assumed cubes and processes do not have identical names #TODO #pick a measure -> display flow from there back and forth #recursive parsing for CellGet, catch all instances: done? #SQL -> large box named by database name, include all tables names/files in there #problem with carriage returns breaking lines being parsed #intracubes flows #include manual inputs? #pb to differentiate update dimension and update cube processes #add drills, attr, dimensions (dotted lines)? #add view name on line #problem if cube string is a variable #line density, the more cellget/put the more dense the link is -> use option "single" #color shades to indicate how many cellget go through #check for conditional feeders use strict; sub cleanstring { my $name = lc(join('_',@_)); $name =~ s/[\}\{} \+\)\(\.\-\\\$\:\&]/_/g; $name =~ s/'//g; return $name; } my %ExistLink; print "Enter the path to your TM1 server data folder: "; my $dirname = ; chomp($dirname); #my $dirname = $ARGV[0]; if ($dirname eq "") { print "graphviz file generator\n"; print "Usage: genflow.pl dirname > flow.dot\n"; print "dot -Tgif flow.dot > flow.gif\n;"; exit; } open(FLR, "> flow.dot") or die "Cannot create output file mychores.txt!\n"; print FLR "digraph TM1 {\nrankdir = LR;\n"; opendir THISDIR, $dirname or die "Cannot open $dirname $!"; while (my $thisfile = readdir THISDIR) { my $DataSource = ""; my $SourceType = ""; open(FLH, "$dirname/$thisfile"); if ($thisfile =~ /(.*)\.rux$/i) { #print "#$dirname/$thisfile\n"; my $cube = cleanstring($1); while () { #inter-cubes flow if(/.*=>\s*DB\(\'([^\']*)\'/) { my $destcube = cleanstring($1); #test if link already added in graph my $link = "${cube}${destcube}rulefeed"; print FLR "$cube -> $destcube [color=green];\n" if ($ExistLink{$link} ne "yes"); $ExistLink{$link} = "yes"; } if(/.*=[^>]*DB\(\'([^\']*)\'/) { #loop as DB calls could be nested foreach my $sourcecube (/DB\(\'([^\']*)\'/) { $sourcecube = cleanstring($sourcecube); print FLR "$sourcecube -> $cube [color=darkgreen];\n" if ($ExistLink{"${sourcecube}${cube}rule"} ne "yes"); $ExistLink{"${sourcecube}${cube}rule"} = "yes"; } } } } if ($thisfile =~ /(.*)\.pro$/i) { my $SourceType = ""; my $Source = ""; my $View = ""; my $process = cleanstring($1); while () { #replace $cube with SQL statement,ascii file import, TM1 view #add print for special shape #datasource type if (/^562,"([A-Z])"/) { $SourceType = $1; } if (/^586,"(.*)"/) { #ASCII or VIEW source $Source = cleanstring($1); if ($ExistLink{$Source} ne "shape") { $ExistLink{$Source} = "shape"; print FLR "$Source [color=red];\n" } } #commented coz dont need view detail if ((/^570,(.*)/) && ($SourceType eq "VIEW")) { #VIEW name $View = cleanstring($1); $View = " [name=$View]"; } foreach my $flow (/Cell(Put|Get)(N|S)\(([^,]*),([^,]*)/i) { # my $flow = $1; my $c3 = cleanstring($3); my $c4 = cleanstring($4); if (($flow =~ /put/i) && ($ExistLink{"$process$c4"} ne "yes")) { $ExistLink{"$process$c4"} = "yes"; print FLR "$process -> $c4 [color=darkturquoise];\n" if ($c4 ne ""); if ($ExistLink{"$Source$process"} ne "yes") { $ExistLink{"$Source$process"} = "yes"; print FLR "$Source -> $process [color=red];\n"; } } if (($flow =~ /get/i) && ($ExistLink{"$c3$process"} ne "yes")) { $ExistLink{"$c3$process"} = "yes"; print FLR "$c3 -> $process [color=blue];\n" if ($c3 ne ""); } if ($ExistLink{$process} ne "shape") { $ExistLink{$process} = "shape"; print FLR "$process [shape = invtrapezium,color=blue];\n"; } } } } if ($thisfile =~ /(.*)\.cub$/i) { my $cube = cleanstring($1); #skip control cubes #print "$cube;\n" if ($cube !~ /^_/); } close FLH; } print FLR "\}\n"; print "Generating graph. Please wait until this window closes."; system("dot -Tgif flow.dot > flow.gif");