/[papo]/papo/zot/zot2dot.pl
ViewVC logotype

Diff of /papo/zot/zot2dot.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by jlenton, Fri Nov 29 18:02:42 2002 UTC revision 1.6 by jlenton, Mon Dec 2 02:02:53 2002 UTC
# Line 5  use Data::Dumper; Line 5  use Data::Dumper;
5  use lib "$ENV{HOME}/public_perl/";  use lib "$ENV{HOME}/public_perl/";
6  use Zot;  use Zot;
7    
8  our ($f, $l, $h, $c);  our ($f, $l, $h, $c, $t);
9    
10  my $compact = $c ? 1 : 0;  my $compact = $c ? 1 : 0;
11  my $full = $f ? 1 : 0;  my $full = $f ? 1 : 0;
12  my $labels = $l ? 1 : 0;  my $labels = $l ? 1 : 0;
13  my $history = $h ? 1 : 0;  my $history = $h ? 1 : 0;
14    my %target_tables;
15    $target_tables{$_}++
16        foreach (split /,/, $t);
17    
18  my $zot = Zot->new(shift);  my $zot = Zot->new(shift);
19  $zot->parse;  $zot->parse;
# Line 21  my %style = ( 'table' => 'shape=box styl Line 24  my %style = ( 'table' => 'shape=box styl
24                'rel' => { 'node' => 'fontsize=8 shape=diamond style=filled fillcolor="#dddddd"',                'rel' => { 'node' => 'fontsize=8 shape=diamond style=filled fillcolor="#dddddd"',
25                           'tail' => 'arrowhead=none',                           'tail' => 'arrowhead=none',
26                           'head' => '',                           'head' => '',
27                           'private' => 'color="#7f7f7f" fontcolor="#7f7f7f"'},                           'private' => 'color="#7f7f7f" fontcolor="#7f7f7f" '},
28                'attr' => { 'node' => 'fontsize=8',                'attr' => { 'node' => 'fontsize=8',
29                            'edge' => 'arrowhead=none',                            'edge' => 'arrowhead=none',
30                            'private' => 'color="#7f7f7f" fontcolor="#7f7f7f"',                            'private' => 'color="#7f7f7f" fontcolor="#7f7f7f"',
# Line 32  my %style = ( 'table' => 'shape=box styl Line 35  my %style = ( 'table' => 'shape=box styl
35                );                );
36    
37    
38  my $out = "digraph foo {\n graph [ overlap=scale epsilon=0.00000001 pack=false remincross=true fontsize=11 ];\n"  my $out = "digraph foo {\n graph [ overlap=scale epsilon=0.00000001 pack=false remincross=true fontsize=11 compound=true ];\n"
39      . "edge [ fontsize=\"8\" decorate=true ];\n";      . "edge [ fontsize=\"8\" decorate=true ];\n";
40  my $rels =   "  node [shape=diamond, style=filled, fillcolor=gray];\n";  my $rels =   "  node [shape=diamond, style=filled, fillcolor=gray];\n";
41  my $tables = "  node [shape=ellipse style=filled fillcolor=\"white\", fontsize=\"10\" ];\n";  my $tables = "  node [shape=ellipse style=filled fillcolor=\"white\", fontsize=\"10\" ];\n";
42  my $subgr = '';  my $subgr = '';
43    
44    my %relh;
45    my @Tables;
46    
47  foreach my $root ($zot->roots)  foreach my $root ($zot->roots)
48  {  {
49      my @kids = @{$zot->root($root)};      my @kids = @{$zot->root($root)};
50        next if %target_tables and not grep $_, @target_tables{@kids};
51        push @Tables, @kids;
52      my $mult = (@kids > 2) || ( (@kids == 2) && !( ($kids[0] eq "_$kids[1]_data") || ($kids[1] eq "_$kids[0]_data")));      my $mult = (@kids > 2) || ( (@kids == 2) && !( ($kids[0] eq "_$kids[1]_data") || ($kids[1] eq "_$kids[0]_data")));
53    
54      $tables .= "  subgraph cluster_HIERARCHY_$root {\n"      $tables .= "  subgraph cluster_HIERARCHY_$root {\n"
# Line 98  foreach my $root ($zot->roots) Line 105  foreach my $root ($zot->roots)
105                                               $table->name, $rel, $rel,                                               $table->name, $rel, $rel,
106                                               $style{'rel'}{'node'},                                               $style{'rel'}{'node'},
107                                               $rel eq '_table' ? $style{'rel'}{'private'} : '' );                                               $rel eq '_table' ? $style{'rel'}{'private'} : '' );
108                  $a{$table->name} .= sprintf( "    %s -> \"%s::%s\" [%s];\n",                  $a{$table->name} .= sprintf( "    %s -> \"%s::%s\" [%s %s];\n",
109                                               $table->name, $table->name, $rel,                                               $table->name, $table->name, $rel,
110                                               $style{'rel'}{'tail'});                                               $style{'rel'}{'tail'});
111    
112                  $rels .= sprintf( "    \"%s::%s\" -> %s [lhead=\"cluster_%s\" %s %s];\n",                  $relh{$table->name}{$table->rel($rel)} .= sprintf( "    \"%s::%s\" -> %s [lhead=\"cluster_%s\" %s %s];\n",
113                                    $table->name, $rel, $table->rel($rel), $table->rel($rel),                                    $table->name, $rel, $table->rel($rel), $table->rel($rel),
114                                    $style{'rel'}{'head'},                                    $style{'rel'}{'head'},
115                                    $labels ? qq'label="$rel"' : '');                                    $labels ? qq'label="$rel"' : '');
# Line 141  foreach my $root ($zot->roots) Line 148  foreach my $root ($zot->roots)
148          if ($mult);          if ($mult);
149  }  }
150    
151    foreach my $table (keys %relh)
152    {
153        foreach my $other (keys %{$relh{$table}})
154        {
155            $rels .= $relh{$table}{$other}  if grep $_ eq $other, @Tables;
156        }
157    }
158  print $out . $tables . $rels . $subgr. "}\n";  print $out . $tables . $rels . $subgr. "}\n";

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26