[Bps-public-commit] r10798 - Shipwright/lib/Shipwright/Script

sunnavy at bestpractical.com sunnavy at bestpractical.com
Mon Feb 11 07:41:07 EST 2008


Author: sunnavy
Date: Mon Feb 11 07:40:36 2008
New Revision: 10798

Modified:
   Shipwright/lib/Shipwright/Script/Update.pm

Log:
added follow arg for update cmd

Modified: Shipwright/lib/Shipwright/Script/Update.pm
==============================================================================
--- Shipwright/lib/Shipwright/Script/Update.pm	(original)
+++ Shipwright/lib/Shipwright/Script/Update.pm	Mon Feb 11 07:40:36 2008
@@ -5,7 +5,7 @@
 use Carp;
 
 use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
-__PACKAGE__->mk_accessors(qw/repository log_level name all/);
+__PACKAGE__->mk_accessors(qw/repository log_level name all follow/);
 
 use Shipwright;
 use File::Spec;
@@ -14,6 +14,7 @@
 use File::Temp qw/tempdir/;
 use Config;
 use Hash::Merge;
+use List::MoreUtils qw/uniq/;
 
 Hash::Merge::set_behavior('RIGHT_PRECEDENT');
 
@@ -26,6 +27,7 @@
         'l|log-level=s'  => 'log_level',
         'name=s'         => 'name',
         'a|all'          => 'all',
+        'follow'         => 'follow',
     );
 }
 
@@ -54,17 +56,24 @@
     $map    = $shipwright->backend->map    || {};
     $source = $shipwright->backend->source || {};
 
-    my $dists = $shipwright->backend->order || [];
-
     if ( $self->all ) {
-
+        my $dists = $shipwright->backend->order || [];
         for (@$dists) {
-            $self->update($_);
+            update($_);
         }
     }
-    else {
+    elsif ( $self->follow ) {
+        if ( !$source->{$name} && $map->{$name} ) {
+            $self->name( $map->{$name} );  # in case the name is module name
+        }
 
-        $self->update( $self->name );
+        my @dists = find_deps( $self->name );
+        for ( @dists, $self->name ) {
+            update($_);
+        }
+    }
+    else {
+        update( $self->name );
     }
 }
 
@@ -72,13 +81,12 @@
 =cut
 
 sub update {
-    my $self = shift;
     my $name = shift;
 
     if ( $source->{$name} ) {
         $shipwright->source(
             Shipwright::Source->new(
-                name   => $self->name,
+                name   => $name,
                 source => $source->{$name},
                 follow => 0,
             )
@@ -97,8 +105,7 @@
             $name = $map->{$name};
         }
         else {
-            $self->log->error( 'invalid name: ' . $self->name );
-            die 'invalid name ' . $self->name;
+            die 'invalid name ' . $name;
         }
 
         $shipwright->source(
@@ -119,6 +126,29 @@
 
 }
 
+=head2 find_deps
+
+find all the deps for one dist
+
+=cut
+
+my %found;
+
+sub find_deps {
+    my $name = shift;
+
+    return if $found{$name}++;
+
+    my ($require) = $shipwright->backend->require( $name );
+    my @deps;
+    for my $type (qw/requires build_requires recommends/) {
+        for ( keys %{$require->{$type}} ) {
+            push @deps, find_deps( $_ ), $_;
+        }
+    }
+    return uniq @deps;
+}
+
 1;
 
 __END__



More information about the Bps-public-commit mailing list