[Bps-public-commit] r12089 - in Shipwright/trunk/lib/Shipwright: Source

sunnavy at bestpractical.com sunnavy at bestpractical.com
Tue May 6 01:00:41 EDT 2008


Author: sunnavy
Date: Tue May  6 01:00:39 2008
New Revision: 12089

Modified:
   Shipwright/trunk/lib/Shipwright/Source.pm
   Shipwright/trunk/lib/Shipwright/Source/Base.pm
   Shipwright/trunk/lib/Shipwright/Source/CPAN.pm
   Shipwright/trunk/lib/Shipwright/Source/Compressed.pm
   Shipwright/trunk/lib/Shipwright/Source/Directory.pm
   Shipwright/trunk/lib/Shipwright/Source/SVK.pm
   Shipwright/trunk/lib/Shipwright/Source/SVN.pm

Log:
keep version when source runs

Modified: Shipwright/trunk/lib/Shipwright/Source.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source.pm	Tue May  6 01:00:39 2008
@@ -13,13 +13,14 @@
     follow            => 1,
 );
 
-$DEFAULT{directory} = tempdir( CLEANUP => 0 );
+$DEFAULT{directory} = '/tmp'; #tempdir( CLEANUP => 0 );
 $DEFAULT{download_directory} =
   File::Spec->catfile( $DEFAULT{directory}, 'download' );
 $DEFAULT{map_path} = File::Spec->catfile( $DEFAULT{directory}, 'map.yml' );
 $DEFAULT{url_path} = File::Spec->catfile( $DEFAULT{directory}, 'url.yml' );
+$DEFAULT{version_path} = File::Spec->catfile( $DEFAULT{directory}, 'version.yml' );
 
-for ( qw/map_path url_path/ ) {
+for ( qw/map_path url_path version_path/ ) {
     open my $fh, '>', $DEFAULT{$_} or die "can't write to $DEFAULT{$_}: $!";
     close $fh;
 }

Modified: Shipwright/trunk/lib/Shipwright/Source/Base.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/Base.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/Base.pm	Tue May  6 01:00:39 2008
@@ -13,7 +13,8 @@
 use base qw/Class::Accessor::Fast/;
 __PACKAGE__->mk_accessors(
     qw/source directory download_directory follow min_perl_version map_path
-      skip map keep_recommends keep_build_requires name log url_path/
+      skip map keep_recommends keep_build_requires name log url_path
+      version_path version/
 );
 
 =head2 new
@@ -214,12 +215,14 @@
                                 %$self,
                                 source => $require->{$type}{$module}{source},
                                 name   => $name,
+                                version => undef,
                             );
                         }
                         else {
                             $s = Shipwright::Source->new(
                                 %$self,
                                 source => $module,
+                                version => undef,
                                 name => '',   # cpan name is automaticaly fixed.
                             );
                         }
@@ -282,6 +285,19 @@
     Shipwright::Util::DumpFile( $self->url_path, $map );
 }
 
+sub _update_version {
+    my $self = shift;
+    my $name = shift;
+    my $version  = shift;
+
+    my $map = {};
+    if ( -e $self->version_path && ! -z $self->version_path ) {
+        $map = Shipwright::Util::LoadFile( $self->version_path );
+    }
+    $map->{$name} = $version;
+    Shipwright::Util::DumpFile( $self->version_path, $map );
+}
+
 sub _is_skipped {
     my $self   = shift;
     my $module = shift;
@@ -323,8 +339,29 @@
     my $self = shift;
     my $name = shift;
     $name .= '.tar.gz' unless $name =~ /(tar\.gz|tgz|tar\.bz2)$/;
+
+    require CPAN::DistnameInfo;
+    my $info = CPAN::DistnameInfo->new( $name );
+    my $dist = $info->dist;
+    return $dist;
+}
+
+=head2 just_version
+
+return version
+
+=cut
+
+sub just_version {
+    my $self = shift;
+    my $name = shift;
+    $name .= '.tar.gz' unless $name =~ /(tar\.gz|tgz|tar\.bz2)$/;
+
     require CPAN::DistnameInfo;
-    return CPAN::DistnameInfo->new($name)->dist;
+    my $info = CPAN::DistnameInfo->new( $name );
+    my $version = $info->version;
+    $version =~ s/^v//;
+    return $version;
 }
 
 1;

Modified: Shipwright/trunk/lib/Shipwright/Source/CPAN.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/CPAN.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/CPAN.pm	Tue May  6 01:00:39 2008
@@ -77,7 +77,9 @@
 
     $module->distribution->get;
 
-    my $dist = CPAN::DistnameInfo->new( $module->cpan_file )->dist;
+    my $info = CPAN::DistnameInfo->new( $module->cpan_file );
+    my $dist = $info->dist;
+
     $self->name( 'cpan-' . $dist );
     $self->_update_map( $self->source, 'cpan-' . $dist );
 

Modified: Shipwright/trunk/lib/Shipwright/Source/Compressed.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/Compressed.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/Compressed.pm	Tue May  6 01:00:39 2008
@@ -15,8 +15,11 @@
     my $self = shift;
 
     $self->name( $self->just_name( $self->path ) ) unless $self->name;
+    $self->version( $self->just_version( $self->path ) ) unless $self->version;
     $self->log->info( 'run source ' . $self->name . ': ' . $self->source );
 
+    $self->_update_version( $self->name, $self->version );
+
     $self->_update_url( $self->name, $self->source )
       unless $self->{_no_update_url};
 

Modified: Shipwright/trunk/lib/Shipwright/Source/Directory.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/Directory.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/Directory.pm	Tue May  6 01:00:39 2008
@@ -29,6 +29,8 @@
     $self->log->info(
         'run source ' . ( $self->name || $self->path ) . ': ' . $self->source );
 
+    $self->_update_version( $self->name, $self->version );
+
     $self->_update_url( $self->name || $self->just_name( $self->path ),
         $self->source ) unless $self->{_no_update_url};
 

Modified: Shipwright/trunk/lib/Shipwright/Source/SVK.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/SVK.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/SVK.pm	Tue May  6 01:00:39 2008
@@ -51,6 +51,17 @@
 sub _run {
     my $self   = shift;
     my $source = $self->source;
+
+    my ($out) = Shipwright::Util->run(
+        [
+            'svk', 'info', $self->source,
+        ]
+    );
+
+    if ( $out =~ /^Revision: (\d+)/m ) {
+        $self->version( $1 );
+    }
+
     my @cmds;
     push @cmds,
       [
@@ -63,6 +74,7 @@
         File::Spec->catfile( $self->download_directory, $self->name )
       ];
 
+
     $self->source(
         File::Spec->catfile( $self->download_directory, $self->name ) );
     Shipwright::Util->run($_) for @cmds;

Modified: Shipwright/trunk/lib/Shipwright/Source/SVN.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/SVN.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/SVN.pm	Tue May  6 01:00:39 2008
@@ -51,6 +51,16 @@
 sub _run {
     my $self   = shift;
     my $source = $self->source;
+
+    my ($out) = Shipwright::Util->run(
+        [
+            'svn', 'info', $source,
+        ]
+    );
+
+    if ( $out =~ /^Revision: (\d+)/m ) {
+        $self->version( $1 );
+    }
     my $cmd    = [
         'svn', 'export', $self->source,
         File::Spec->catfile( $self->download_directory, $self->name )



More information about the Bps-public-commit mailing list