[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