[Bps-public-commit] r10783 - in Shipwright/lib/Shipwright: Backend Source
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Sun Feb 10 00:57:17 EST 2008
Author: sunnavy
Date: Sun Feb 10 00:57:16 2008
New Revision: 10783
Modified:
Shipwright/lib/Shipwright/Backend/SVK.pm
Shipwright/lib/Shipwright/Backend/SVN.pm
Shipwright/lib/Shipwright/Script/Import.pm
Shipwright/lib/Shipwright/Source/Base.pm
Shipwright/lib/Shipwright/Source/CPAN.pm
Log:
added map.yml to build repo
Modified: Shipwright/lib/Shipwright/Backend/SVK.pm
==============================================================================
--- Shipwright/lib/Shipwright/Backend/SVK.pm (original)
+++ Shipwright/lib/Shipwright/Backend/SVK.pm Sun Feb 10 00:57:16 2008
@@ -57,6 +57,7 @@
File::Spec->catfile( $dir, 'bin', 'shipwright-utility' ) => 'utility',
File::Spec->catfile( $dir, 't', 'test' ) => 'null',
File::Spec->catfile( $dir, 'shipwright', 'order.yml' ) => 'null',
+ File::Spec->catfile( $dir, 'shipwright', 'map.yml' ) => 'null',
);
for ( keys %map ) {
@@ -387,6 +388,35 @@
}
}
+=head2 map
+
+get or set map
+
+=cut
+
+sub map {
+ my $self = shift;
+ my $map = shift;
+ if ($map) {
+ my $dir = tempdir( CLEANUP => 1 );
+ my $file = File::Spec->catfile( $dir, 'map.yml' );
+
+ $self->checkout(
+ path => '/shipwright/map.yml',
+ target => $file,
+ );
+
+ Shipwright::Util::DumpFile( $file, $map );
+ $self->commit( path => $file, comment => "set map" );
+ $self->checkout( detach => 1, target => $file );
+ }
+ else {
+ my ($out) = Shipwright::Util->run(
+ [ 'svk', 'cat', $self->repository . '/shipwright/map.yml' ] );
+ return Shipwright::Util::Load($out);
+ }
+}
+
=head2 delete
wrapper of delete cmd of svk
Modified: Shipwright/lib/Shipwright/Backend/SVN.pm
==============================================================================
--- Shipwright/lib/Shipwright/Backend/SVN.pm (original)
+++ Shipwright/lib/Shipwright/Backend/SVN.pm Sun Feb 10 00:57:16 2008
@@ -384,6 +384,35 @@
}
}
+=head2 map
+
+get or set map
+
+=cut
+
+sub map {
+ my $self = shift;
+ my $map = shift;
+ if ($map) {
+ my $dir = tempdir( CLEANUP => 1 );
+ my $file = File::Spec->catfile( $dir, 'map.yml' );
+
+ $self->checkout(
+ path => '/shipwright',
+ target => $dir,
+ );
+
+ Shipwright::Util::DumpFile( $file, $map );
+ $self->commit( path => $file, comment => "set map" );
+
+ }
+ else {
+ my ($out) = Shipwright::Util->run(
+ [ 'svn', 'cat', $self->repository . '/shipwright/map.yml' ] );
+ return Shipwright::Util::Load($out);
+ }
+}
+
=head2 delete
wrapper of delete cmd of svn
Modified: Shipwright/lib/Shipwright/Script/Import.pm
==============================================================================
--- Shipwright/lib/Shipwright/Script/Import.pm (original)
+++ Shipwright/lib/Shipwright/Script/Import.pm Sun Feb 10 00:57:16 2008
@@ -16,6 +16,9 @@
use File::Copy qw/copy move/;
use File::Temp qw/tempdir/;
use Config;
+use Hash::Merge;
+
+Hash::Merge::set_behavior('RIGHT_PRECEDENT');
=head2 options
=cut
@@ -60,7 +63,7 @@
$self->log->warn("we saw '::' in the name, will treat it as '-'");
my $name = $self->name;
$name =~ s/::/-/g;
- $self->name( $name );
+ $self->name($name);
}
if ( $self->name !~ /^[-\w]+$/ ) {
die 'name can only have alphanumeric characters and -';
@@ -77,11 +80,24 @@
skip => $self->skip,
);
-
if ( $self->source ) {
+ unless ( $self->overwrite ) {
+
+ # skip already imported dists
+ push @{ $self->skip() },
+ map { "^$_\$" } @{ $shipwright->backend->order() || [] };
+ $shipwright->source->skip( $self->skip );
+ }
+
+ Shipwright::Util::DumpFile( $shipwright->source->map_path,
+ $shipwright->backend->map || {} );
+
$self->source(
- $shipwright->source->run( '__require.yml' => $self->require_yml ) );
+ $shipwright->source->run(
+ copy => { '__require.yml' => $self->require_yml },
+ )
+ );
my ($name) = $self->source =~ m{.*/(.*)$};
$imported{$name}++;
@@ -116,6 +132,13 @@
build_script => $script_dir,
overwrite => 1,
);
+
+ # merge new map into map.yml in repo
+ my $new_map =
+ Shipwright::Util::LoadFile( $shipwright->source->map_path )
+ || {};
+ $shipwright->backend->map(
+ Hash::Merge::merge( $shipwright->backend->map || {}, $new_map ) );
}
# import tests
@@ -130,6 +153,7 @@
if ( $self->test_script ) {
$shipwright->backend->test_script( source => $self->test_script );
}
+
}
=head2 import_req
@@ -154,6 +178,7 @@
if ( -e $map_file ) {
$map = Shipwright::Util::LoadFile($map_file);
+
}
opendir my ($d), $dir;
@@ -167,10 +192,12 @@
unless ( $imported{$dist}++ ) {
- if ( $shipwright->backend->info( "dists/$dist" ) && !
- $self->overwrite ) {
+ if ( !$self->overwrite && grep { $dist =~ /$_/ }
+ @{ $self->skip } )
+ {
$self->log->warn(
-"have $dist in repo already, skip it. use --overwrite to overwrite");
+"have $dist in repo already, skip it. you can use --overwrite to overwrite"
+ );
next;
}
@@ -255,7 +282,7 @@
push @commands, "clean: make clean";
}
else {
- $self->log->warn( "I have no idea how to build this distribution" );
+ $self->log->warn("I have no idea how to build this distribution");
}
open my $fh, '>', File::Spec->catfile( $script_dir, 'build' ) or die $@;
Modified: Shipwright/lib/Shipwright/Source/Base.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/Base.pm (original)
+++ Shipwright/lib/Shipwright/Source/Base.pm Sun Feb 10 00:57:16 2008
@@ -31,10 +31,11 @@
sub run {
my $self = shift;
+ my %args = @_;
for ( $self->_cmd ) {
Shipwright::Util->run($_);
}
- $self->_copy(@_) if @_;
+ $self->_copy( %{$args{copy}} ) if $args{copy};
}
# you should subclass this method.
@@ -43,11 +44,10 @@
sub _follow {
my $self = shift;
my $path = shift;
- my $cwd = getcwd;
+ my $cwd = getcwd;
my $require_path = File::Spec->catfile( $path, '__require.yml' );
my $map = {};
-
unless ( $self->min_perl_version ) {
no warnings 'once';
require Config;
@@ -71,12 +71,11 @@
my $source = read_file( File::Spec->catfile( '_build', 'prereqs' ) )
or die "can't read _build/prereqs: $!";
my $eval .= '$require = ' . $source;
- eval $eval or die "eval error: $@"; ## no critic
+ eval $eval or die "eval error: $@"; ## no critic
$source = read_file( File::Spec->catfile('Build.PL') )
or die "can't read Build.PL: $!";
- if ( $source =~ /Module::Build/ && $self->name ne 'Module-Build' )
- {
+ if ( $source =~ /Module::Build/ && $self->name ne 'Module-Build' ) {
unless ( $require->{build_requires}{'Module::Build'} ) {
$require->{build_requires} = { 'Module::Build' => 0 };
}
@@ -90,7 +89,7 @@
if ( $source && $source =~ /({.*})/ ) {
my $eval .= '$require = ' . $1;
$eval =~ s/([\w:]+)=>/'$1'=>/g;
- eval $eval or die "eval error: $@"; ## no critic
+ eval $eval or die "eval error: $@"; ## no critic
}
for ( keys %$require ) {
@@ -229,7 +228,7 @@
croak "invalid __require.yml in $path";
}
-# go back to the cwd before we run _follow
+ # go back to the cwd before we run _follow
chdir $cwd;
}
@@ -255,6 +254,9 @@
if ( $self->skip ) {
for ( @{ $self->skip } ) {
+ if ( $module =~ /$_/ ) {
+ $self->log->warn("$module is skipped");
+ }
return 1 if $module =~ /$_/;
}
}
Modified: Shipwright/lib/Shipwright/Source/CPAN.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/CPAN.pm (original)
+++ Shipwright/lib/Shipwright/Source/CPAN.pm Sun Feb 10 00:57:16 2008
@@ -53,7 +53,7 @@
sub run {
my $self = shift;
- $self->log->info("prepare to run source: " . $self->source );
+ $self->log->info( "prepare to run source: " . $self->source );
if ( $self->_run ) {
my $compressed = Shipwright::Source::Compressed->new(%$self);
$compressed->run(@_);
@@ -62,7 +62,7 @@
sub _run {
my $self = shift;
- return if $self->source eq 'perl'; # don't expand perl it self;
+ return if $self->source eq 'perl'; # don't expand perl itself;
my $module = CPAN::Shell->expand( 'Module', $self->source );
@@ -75,15 +75,9 @@
$module->distribution->get;
- my $dist = CPAN::DistnameInfo->new( $module->cpan_file )->dist;
- my $name = $self->source;
- my $moniker = $name;
- $moniker =~ s/::/-/g;
-
- if ( $dist ne $moniker ) {
- $self->name( $dist );
- $self->_make_maps( $name, $dist );
- }
+ my $dist = CPAN::DistnameInfo->new( $module->cpan_file )->dist;
+ $self->name('cpan-' . $dist);
+ $self->_make_maps( $self->source, 'cpan-' . $dist );
$self->source(
File::Spec->catfile(
More information about the Bps-public-commit
mailing list