TkNavigation/test/navigationSchoolCharter.pl

0001 #!/usr/bin/env perl
0002
0003 ## Navigation school plotter:
0004 ##   Takes the output of the NavigationSchoolAnalyzer, and produces a '.dot' file
0005 ##   to be visualized with graphviz (http://www.graphviz.org/)
0006 ##
0007 ## Usage:
0008 ##   - edit the NavigationSchoolAnalyzer cfg.py to select which navigation school to print
0009 ##   - run the cfg.py for the NavigationSchoolAnalyzer
0010 ##   - perl -w navigationSchoolCharter.pl detailedInfo.log > yourSchool.dot
0011 ##   - dot -Tpng -o yourSchool.png yourSchool.dot
0012 ##
0013 ## Output:
0014 ##   - red lines are 'inside-out' only (red = hot = bang = proton-proton collisions = in-out)
0015 ##   - blue lines are 'outside-in' only (blue = sky = cosmics = out-in)
0016 ##   - green lines are two-way links (with the arrow set inside-out)
0017
0018 use Data::Dumper;
0019
0020 ## Parse the set of lines describing one layer
0021 sub parseLayer {
0022     my $txt = shift;
0023     my ($be, $name) = ($txt =~ m/^(barrel|endcap) subDetector: (\w+)/m) or die "Can't parse layer block\n" . $txt . "\n";
0024     my ($l) = ($txt =~ m/^(?:wheel|layer): (\d+)/m) or die "Can't parse layer block\n" . $txt . "\n";
0025     my ($s) = ($txt =~ m/^side: (\w+)/m);
0026     $s = '' if $be ne "endcap";
0027     return sprintf('%s%s_%d', $name,$s,$l);
0028 }
0029
0030 ## Parse the set of lines describing all links starting from one layer
0031 my %layers;
0032 sub parseNavi {
0033    my $txt = shift;
0034    my $start = parseLayer($txt);
0035    my @outIn = ();
0036    my @inOut = ();
0037    if ($txt =~ m/^\*\*\* INsideOUT CONNECTED TO \*\*\*\n((([a-z0-9]+.*\n)+-+\n)+)/m) {
0038         my $list = $1;
0039         #die "VVVVVVVVVVVVVVV\n$list\n^^^^^^^^^^^^^^^^^^^^\n";
0040         foreach (split(/---+/, $list)) { m/subDetector/ and push @inOut, parseLayer($_); }
0041    }
0042    if ($txt =~ m/^\*\*\* OUTsideIN CONNECTED TO \*\*\*\n((([a-z0-9]+.*\n)+-+\n)+)/m) {
0043         my $list = $1;
0044         #die "VVVVVVVVVVVVVVV\n$list\n^^^^^^^^^^^^^^^^^^^^\n";
0045         foreach (split(/---+/, $list)) { m/subDetector/ and push @outIn, parseLayer($_); }
0046    }
0047    $layers{$start} = { 'inOut' => [ @inOut ], 'outIn' => [ @outIn ] };
0048 }
0049
0050 ## Read input and parse it layer by layer
0051 my $text = join('', <>);
0052 while ($text =~ m/^(####+\nLayer.*\n([^#].*\n)+)/gm) {
0053     parseNavi($1);
0054 }
0055
0056 #print Dumper(\%layers);
0057
0058 ## Write the output in a graphviz syntax
0059 print "digraph G {\n";
0060 foreach my $k (sort(keys(%layers))) {
0061     print "$k\n";
0062     foreach my $l1 ( @{$layers{$k}->{'inOut'}} ) {
0063         my $color = 'red';
0064         if (grep($_ eq $k, @{$layers{$l1}->{'outIn'}})) {
0065             $color = 'darkgreen';
0066         }
0067         print "\t$k -> $l1 [color=$color]\n";
0068     }
0069     foreach my $l2 ( @{$layers{$k}->{'outIn'}} ) {
0070         next if (grep($_ eq $k, @{$layers{$l2}->{'inOut'}})) ;
0071         print "\t$k -> $l2 [color=blue]\n";
0072     }
0073 }
0074 print "}\n";