Class::C3 - 0.07 release;

[gitmo/Class-C3.git] / util / visualize_c3.pl

diff --git a/util/visualize_c3.pl b/util/visualize_c3.pl
new file mode 100644 (file)
index 0000000..7a328d7
--- /dev/null
+++ b/util/visualize_c3.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+=pod
+
+This is a visualization tool to help with 
+understanding large MI hierarchies. It will
+output a DOT file for rendering with Graphviz.
+
+NOTE:
+This program is currently very primative, and 
+may break under some circumstances. If you 
+encounter one of those circumstances, please
+email me about it so that I can improve this 
+tool. 
+
+GRAPH LEGEND:
+In the graphs the green arrows are the ISA, 
+and the red arrows are the C3 dispatch order.
+
+=cut
+
+use Class::C3 ();
+
+@ARGV || die "usage : visualize_c3.pl <class-to-visualize> | <file-to-load> <class-to-visualize> <file-to-output>";
+
+my ($class, $OUT);
+if (scalar @ARGV == 1) {
+    $class = shift @ARGV;
+    eval "use $class";
+    die "Could not load '$class' :\n$@" if $@;
+}
+else {
+    my $file = shift @ARGV;
+    $class = shift @ARGV;    
+    $OUT = shift @ARGV;
+    do $file;
+    die "Could not load '$file' :\n$@" if $@;    
+}
+
+Class::C3->initialize();
+
+my @MRO = Class::C3::calculateMRO($class);
+
+sub get_class_str {
+    my $class = shift;
+    (join "_" => (split '::' => $class));    
+}
+
+my $output = "graph test {\n";
+
+my $prev;
+foreach my $class (@MRO) {
+    my $class_str = get_class_str($class);
+    $output .= "node_${class_str} [ label = \"" . $class . "\" ];\n";
+    {
+        no strict 'refs';
+        foreach my $super (@{"${class}::ISA"}) {
+            $output .= "node_" . get_class_str($super) . 
+                       " -- node_${class_str}" .
+                       " [ dir = back, color = green ];\n";
+        }
+    }
+    if ($prev) {
+        $output .= "node_${class_str} -- node_${prev}  [ dir = back, color = red ];\n";
+    }    
+    $prev = $class_str;
+}
+
+$output .= "}\n";
+
+warn $output;
+
+if ($OUT) {
+    open OUT, ">", $OUT || die "could not open '$OUT' for output";
+    print OUT $output;
+    close OUT;
+}
+else {
+    print $output;
+}
\ No newline at end of file