[Bps-public-commit] r12147 - Shipwright/trunk/lib/Shipwright/Script

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Wed May  7 23:20:56 2008
New Revision: 12147

Modified:
   Shipwright/trunk/lib/Shipwright/Script/List.pm

Log:
we can see the latest version now when list, --with-latest-version will do that

Modified: Shipwright/trunk/lib/Shipwright/Script/List.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/List.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Script/List.pm	Wed May  7 23:20:56 2008
@@ -6,8 +6,7 @@
 
 use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
 __PACKAGE__->mk_accessors(
-    qw/repository log_level log_file dist/
-);
+    qw/repository log_level log_file dist with_latest_version only_update/);
 
 use Shipwright;
 use Data::Dumper;
@@ -17,10 +16,12 @@
 
 sub options {
     (
-        'r|repository=s' => 'repository',
-        'l|log-level=s'  => 'log_level',
-        'log-file=s'     => 'log_file',
-        'dist=s'         => 'dist',
+        'r|repository=s'      => 'repository',
+        'l|log-level=s'       => 'log_level',
+        'log-file=s'          => 'log_file',
+        'dist=s'              => 'dist',
+        'with-latest-version' => 'with_latest_version',
+        'only-update'         => 'only_update',
     );
 }
 
@@ -33,7 +34,7 @@
 
     die "need repository arg" unless $self->repository();
 
-    $self->dist( $dist ) if $dist && ! $self->dist;
+    $self->dist($dist) if $dist && !$self->dist;
 
     my $shipwright = Shipwright->new(
         repository => $self->repository,
@@ -42,25 +43,119 @@
     );
 
     my $versions = $shipwright->backend->versions;
-    my $source = $shipwright->backend->source;
+    my $source   = $shipwright->backend->source;
 
-    if ( $self->dist ) {
-        if ( exists $versions->{$self->dist} ) {
-            print $self->dist, ': ', "\n";
-            print ' ' x 4 . 'version: ', $versions->{$self->dist}, "\n";
-            print ' ' x 4 . 'from: ', $source->{$self->dist} || 'CPAN', "\n";
+    my $latest_version = {};
+
+    if ( $self->with_latest_version || $self->only_update ) {
+        my $map = $shipwright->backend->map;
+
+        if ( $self->dist ) {
+            if ( $self->dist =~ /^cpan-/ ) {
+                my %reversed = reverse %$map;
+                my $module   = $reversed{ $self->dist };
+                $latest_version->{ $self->dist } =
+                  $self->_latest_version( name => $module );
+            }
+            else {
+                $latest_version->{ $self->dist } =
+                  $self->_latest_version( url => $source->{ $self->dist } );
+            }
         }
         else {
-            print $self->dist, " doesn't exist.\n";
+
+            for my $module ( keys %$map ) {
+                next if exists $latest_version->{ $map->{$module} };
+                $latest_version->{ $map->{$module} } =
+                  $self->_latest_version( name => $module );
+            }
+
+            for my $dist ( keys %$source ) {
+                next if exists $latest_version->{$dist};
+                if ( $source->{$dist} =~ m{^(svn|svk|//)} ) {
+                    $latest_version->{$dist} =
+                      $self->_latest_version( url => $source->{$dist} );
+                }
+            }
         }
     }
-    else {
-        for my $dist ( sort keys %$versions ) {
+
+    if ( $self->dist ) {
+        my $new_versions = {};
+        $new_versions->{ $self->dist } = $versions->{ $self->dist }
+          if exists $versions->{ $self->dist };
+        $versions = $new_versions;
+    }
+    for my $dist ( sort keys %$versions ) {
+        my $flip = 1;
+
+        if ( $self->only_update ) {
+            $flip = 0;
+            if ( $latest_version->{$dist} ) {
+                require version;
+                my $latest = version->new( $latest_version->{$dist} );
+                if ( $latest gt $versions->{$dist} ) {
+                    $flip = 1;
+                }
+            }
+
+        }
+
+        if ($flip) {
             print $dist, ': ', "\n";
-            print ' ' x 4 . 'version: ', $versions->{$dist} || '', "\n";
-            print ' ' x 4 . 'from: ', $source->{$dist} || 'CPAN', "\n";
+            print ' ' x 4 . 'version: ', $versions->{$dist} || '',     "\n";
+            print ' ' x 4 . 'from: ',    $source->{$dist}   || 'CPAN', "\n";
+            if ( $self->with_latest_version ) {
+                print ' ' x 4 . 'latest_version: ', $latest_version->{$dist}
+                  || 'unknown', "\n";
+            }
         }
     }
+
+    if ( $self->dist && keys %$versions == 0 ) {
+        print $self->dist, " doesn't exist\n";
+    }
+}
+
+sub _latest_version {
+    my $self = shift;
+    my %args = @_;
+    if ( $args{url} ) {
+
+        my ( $cmd, $out );
+
+        # has url, meaning svn or svk
+        if ( $args{url} =~ /^svn[:+]/ ) {
+            $args{url} =~ s{^svn:(?!//)}{};
+            $cmd = [ 'svn', 'info', $args{url} ];
+        }
+        elsif ( $args{url} =~ m{^(svk:|//)} ) {
+            $args{url} =~ s/^svk://;
+            $cmd = [ 'svk', 'info', $args{url} ];
+        }
+
+        ($out) = Shipwright::Util->run( $cmd, 1 );    # ignore failure
+        if ( $out =~ /^Revision:\s*(\d+)/m ) {
+            return $1;
+        }
+    }
+    elsif ( $args{name} ) {
+
+        # cpan
+        require CPAN;
+        require CPAN::DistnameInfo;
+        open my $fh, '>', '/dev/null';
+        my $stdout = select $fh;
+
+        my $module = CPAN::Shell->expand( 'Module', $args{name} );
+        select $stdout;
+
+        my $info    = CPAN::DistnameInfo->new( $module->cpan_file );
+        my $version = $info->version;
+        $version =~ s/^v//;    # we don't want the leading 'v'
+        return $version;
+    }
+    return;
 }
 
 1;