#!/usr/bin/perl

#naming CONVENTION
#it is assumed cubes and processes do not have identical names

#problem with carriage returns breaking lines being parsed
#intracubes flows


use strict;

my %ExistLink;
my $process;
my $View;
my $AccumulateFlag;

sub cleanstring {
  my $name = join('_',@_);
  #my $name = lc(join('_',@_));
  #$name =~ s/[\}\{} \+\)\(\.\-\\\$\:\&]/_/g;
  $name =~ s/^\s+//;
  $name =~ s/\s+$//;
  $name =~ s/'//g;
  $name =~ s/\\/\\\\/g;
  $name = "\"$name\"";
return $name;
}

sub ParseCellPutGet {
  my ($Source, $line) = @_;
  #add zeroout and import view names in label if available
  my $edge = "";
  #add import view name
  $edge = ", label=$View" if ($View ne "");
  #normal = store, bold = accumulate
  $edge = "$edge, style=bold, arrowhead=dot" if ($AccumulateFlag);
  
  #exit parsing if CellPutGet function commented out
  return if (/\#.*Cell/);
  if (/Cell(Put|Get)(N|S)\(([^,]*),([^,]*)/i) {
      my $flow = $1;
      my $c3 = cleanstring($3);
      my $c4 = cleanstring($4);

      if ($line =~ /CellPut.\((.*)$/i) {
        #parse CellPutArgs
        my $CellPutArgs = $1;
        my $cube = "";
        my $nested = 0;
        my $reached = 0;

        #1 character at a time
        while ($CellPutArgs =~ /(.)/g) {
          my $c = $1;
          $nested++ if $c eq "(";
          $nested-- if $c eq ")";
          #if we reached the 2nd argument, 
          if($reached) {
          #keep filling the cube name until next comma
            if($c eq ",") {
              $reached--;
            } else {
              $cube = "$cube$1";
            }
          } else {
          #if we get an unnested comma then we reached the 2nd argument i.e cube name
            $reached++ if ($c eq "," && $nested == 0 && $cube eq "");
          }
        }
        #print STDERR "$cube\n";
        $c4 = cleanstring($cube);
      }

      if (($flow =~ /put/i) && ($ExistLink{"$process$c4"} ne "yes")) {
        $ExistLink{"$process$c4"} = "yes";
        #create a link: process -> cube
        print FLR "$process -> $c4 [color=darkturquoise$edge];\n" if ($c4 ne "");
        if ($ExistLink{"$Source$process"} ne "yes") {
        #create a link: source -> process -> cube
          $ExistLink{"$Source$process"} = "yes";
          print FLR "$Source -> $process [color=red$edge];\n" if ($Source ne "");
        }
      }

      if (($flow =~ /get/i) && ($ExistLink{"$c3$process"} ne "yes")) {
        $ExistLink{"$c3$process"} = "yes";
        print FLR "$c3 -> $process [color=blue$edge];\n" if ($c3 ne "");
      }      
  }
}

print "Enter the path to your TM1 server data folder: ";
my $dirname = <STDIN>;
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 (<FLH>) {
            #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 = "";
        $AccumulateFlag = 0;
        $View = "";
        $process = cleanstring($1);
        
        #setup color and shape of processes
        if ($ExistLink{$process} ne "shape") {
          $ExistLink{$process} = "shape";
          print FLR "$process [shape = record, color=blue];\n";
        }
        
        while (<FLH>) {
            #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);
              #same paths/files may be captilalised differently so get all lower cases
              $Source = lc($Source) if ($SourceType ne "VIEW");
              if ($ExistLink{$Source} ne "shape") {
                $ExistLink{$Source} = "shape";
                my $shape = "ellipse";
                $shape = "egg" if ($SourceType eq "ODBC");
                $shape = "parallelogram" if ($SourceType eq "CHARACTERDELIMITED");
                print FLR "$Source [color=red, shape=$shape];\n"
              }
            }
            if ((/^570,(.*)/) && ($SourceType eq "VIEW")) {
              #VIEW name
              $View = cleanstring($1);
            }
            #check for preset ZeroOut views
            if (/ZeroOut=1.ViewName=(.*).CubeLogChanges/) {
              my $ZeroOut = $1;
              my $labelprocess =$process;
              $labelprocess =~ s/^\"//;
              $labelprocess =~ s/\"$//;
              print FLR "$process [shape = record, color=blue, label=\"$labelprocess | 0out: $ZeroOut\"];\n";
            }
            #1503 = store (overwrite cell content with new value), 1504 = accumulate values
            #won't display because it comes after all the CellPut commands
            $AccumulateFlag = 1 if (/DataAction=1504/);
            
            ParseCellPutGet($Source, $_);
         }
    }
    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");