[Bps-public-commit] r18472 - in Shipwright/trunk/lib/Shipwright: Script

[jesse at bestpractical.com]

Author: jesse
Date: Thu Feb 19 14:18:54 2009
New Revision: 18472

Modified:
   Shipwright/trunk/lib/Shipwright/Backend/Base.pm
   Shipwright/trunk/lib/Shipwright/Script/Maintain.pm

Log:
* Added support for graphing dependencies using graphviz

Modified: Shipwright/trunk/lib/Shipwright/Backend/Base.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Backend/Base.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Backend/Base.pm	Thu Feb 19 14:18:54 2009
@@ -358,6 +358,45 @@
     $self->order($order);
 }
 
+=item graph_deps
+
+Output a dependency graph in graphviz format to stdout
+
+=cut
+
+sub graph_deps {
+    my $self = shift;
+    my %args = @_;
+
+    $self->log->info( "Outputting a graphviz order for " . $self->repository );
+
+    my @dists = @{ $args{for_dists} || [] };
+    unless (@dists) {
+        @dists = $self->dists;
+    }
+
+    s{/$}{} for @dists;
+
+    my $require = {};
+
+    for my $distname (@dists) {
+        $self->_fill_deps( %args, require => $require, name => $distname );
+    }
+
+    print 'digraph g {
+        graph [ ];
+        node [ fontsize = "18", shape = record, fontsize = 18 ];
+    ';
+
+    for my $dist (@dists) {
+        print qq{ "$dist" [shape = record, fontsize = 18, label = "$dist" ];\n};
+        for my $dep ( @{ $require->{$dist} } ) {
+            print qq{"$dist" -> "$dep";\n};
+        }
+    }
+    print "\n};\n";
+}
+
 sub _fill_deps {
     my $self    = shift;
     my %args    = @_;

Modified: Shipwright/trunk/lib/Shipwright/Script/Maintain.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Maintain.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Script/Maintain.pm	Thu Feb 19 14:18:54 2009
@@ -6,7 +6,7 @@
 
 use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
 __PACKAGE__->mk_accessors(
-    qw/update_order keep_recommends update_refs
+    qw/update_order keep_recommends update_refs graph_deps
       keep_build_requires keep_requires for_dists/
 );
 
@@ -14,6 +14,7 @@
 
 sub options {
     (
+        'graph-deps'            => 'graph_deps',
         'update-order'          => 'update_order',
         'update-refs'           => 'update_refs',
         'keep-recommends=s'     => 'keep_recommends',
@@ -45,6 +46,18 @@
             for_dists => [ split /,\s*/, $self->for_dists || '' ],
         );
         print "updated order with success\n";
+    } 
+    if ($self->graph_deps)  {
+        $shipwright->backend->graph_deps(
+
+            # just for completeness, normally you never need this ;)
+            keep_requires => ( defined $self->keep_requires ? $self->keep_requires : 1 ),
+            keep_recommends => ( ! defined $self->keep_recommends ? $self->keep_recommends : 1 ),
+            keep_build_requires => ( defined $self->keep_build_requires ? $self->keep_build_requires : 1),
+            for_dists => [ split /,\s*/, $self->for_dists || '' ],
+        );
+
+
     }
 
     if ( $self->update_refs ) {
@@ -73,7 +86,8 @@
  --log-file FILENAME          : specify the log file
  --update-order               : update the build order
  --update-refs                : update refs( times a dist shows in all the require.yml )
-
+ --graph-deps                 : output a graph of all the dependencies in your vessel
+                                suitable for rendering by dot (http://graphviz.org) 
 =head1 AUTHORS
 
 sunnavy  C<< <sunnavy at bestpractical.com> >>