[Bps-public-commit] r10387 - in bpsbuilder/BPB/lib/BPB: Backend Source
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Fri Jan 18 04:00:27 EST 2008
Author: sunnavy
Date: Fri Jan 18 04:00:26 2008
New Revision: 10387
Modified:
bpsbuilder/BPB/lib/BPB/Backend/SVK.pm
bpsbuilder/BPB/lib/BPB/Backend/SVN.pm
bpsbuilder/BPB/lib/BPB/Script/Import.pm
bpsbuilder/BPB/lib/BPB/Script/Maintain.pm
bpsbuilder/BPB/lib/BPB/Source/Base.pm
Log:
require.yml now supports requires, recommends and build_requires deps seperately
Modified: bpsbuilder/BPB/lib/BPB/Backend/SVK.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVK.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVK.pm Fri Jan 18 04:00:26 2008
@@ -151,7 +151,7 @@
my $self = shift;
my $type = shift;
my %args = @_;
- $args{path} ||= '';
+ $args{path} ||= '';
$args{comment} ||= '';
for ( @{ $REQUIRE_OPTIONS{$type} } ) {
@@ -259,23 +259,24 @@
sub update_order {
my $self = shift;
- $self->log->info( "update order for " . $self->repository );
+ my %args = @_;
- my ($out) =
- BPB::Util->run( [ 'svk', 'ls', $self->repository . '/scripts' ] );
- my $sep = $/;
- my @dists = split /$sep/, $out;
+ $self->log->info( "update order for " . $self->repository );
- chomp @dists;
+ my @dists = @{ $args{for_dists} || [] };
+ unless (@dists) {
+ my ($out) =
+ BPB::Util->run( [ 'svk', 'ls', $self->repository . '/scripts' ] );
+ my $sep = $/;
+ @dists = split /$sep/, $out;
+ chomp @dists;
+ s{/$}{} for @dists;
+ }
- my $require;
+ my $require = {};
for (@dists) {
- s{/$}{};
- my ($string) = BPB::Util->run(
- [ 'svk', 'cat', $self->repository . "/scripts/$_/require.yml" ] );
- my $req = BPB::Config::Load($string);
- $require->{$_} = [ keys %$req ];
+ $self->_fill_deps( %args, require => $require, dist => $_ );
}
require Algorithm::Dependency::Ordered;
@@ -286,9 +287,38 @@
my $dep = Algorithm::Dependency::Ordered->new( source => $source, )
or die $@;
my $order = $dep->schedule_all();
+
$self->order($order);
}
+sub _fill_deps {
+ my $self = shift;
+ my %args = @_;
+ my $require = $args{require};
+ my $dist = $args{dist};
+
+ my ($string) = BPB::Util->run(
+ [ 'svk', 'cat', $self->repository . "/scripts/$dist/require.yml" ] );
+ my $req = BPB::Config::Load($string);
+
+ if ( $req->{requires} ) {
+ for (qw/requires recommends build_requires/) {
+ push @{ $require->{$dist} }, keys %{ $req->{$_} }
+ if $args{"keep_$_"};
+ }
+ }
+ else {
+
+ #for back compatbility
+ push @{ $require->{$dists} }, keys %$req;
+ }
+
+ for my $dep ( @{ $require->{$dist} } ) {
+ next if $require->{$dep};
+ $self->_fill_deps( %args, dist => $dep );
+ }
+}
+
=head2 order
get or set order
@@ -361,7 +391,6 @@
$self->log->warn($err) if $err;
}
-
=head2 test_script
set test_script for a project, aka. udpate t/test script
Modified: bpsbuilder/BPB/lib/BPB/Backend/SVN.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVN.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVN.pm Fri Jan 18 04:00:26 2008
@@ -109,7 +109,7 @@
=head2 export
-a wrapper of export cmd of svk
+a wrapper of export cmd of svn
export a project, partly or as a whole
=cut
@@ -125,7 +125,7 @@
=head2 checkout
-a wrapper of checkout cmd of svk
+a wrapper of checkout cmd of svn
checkout a project, partly or as a whole
=cut
@@ -193,7 +193,7 @@
$cmd = [
'svn', 'import',
$script_dir, $self->repository . "/scripts/$args{name}/",
- '-m', q{'} . $args{comment}||'' . q{'},
+ '-m', q{'} . $args{comment} || '' . q{'},
];
}
else {
@@ -259,22 +259,23 @@
sub update_order {
my $self = shift;
+ my %args = @_;
$self->log->info( "update order for " . $self->repository );
- my ($out) =
- BPB::Util->run( [ 'svn', 'ls', $self->repository . '/scripts' ] );
- my $sep = $/;
- my @dists = split /$sep/, $out;
- chomp @dists;
+ my @dists = @{ $args{for_dists} || [] };
+ unless (@dists) {
+ my ($out) =
+ BPB::Util->run( [ 'svn', 'ls', $self->repository . '/scripts' ] );
+ my $sep = $/;
+ @dists = split /$sep/, $out;
+ chomp @dists;
+ s{/$}{} for @dists;
+ }
- my $require;
+ my $require = {};
for (@dists) {
- s{/$}{};
- my ($string) = BPB::Util->run(
- [ 'svn', 'cat', $self->repository . "/scripts/$_/require.yml" ] );
- my $req = BPB::Config::Load($string);
- $require->{$_} = [ keys %$req ];
+ $self->_fill_deps( %args, require => $require, dist => $_ );
}
require Algorithm::Dependency::Ordered;
@@ -288,6 +289,35 @@
$self->order($order);
}
+sub _fill_deps {
+ my $self = shift;
+ my %args = @_;
+ my $require = $args{require};
+ my $dist = $args{dist};
+
+ my ($string) = BPB::Util->run(
+ [ 'svn', 'cat', $self->repository . "/scripts/$_/require.yml" ] );
+
+ my $req = BPB::Config::Load($string);
+
+ if ( $req->{requires} ) {
+ for (qw/requires recommends build_requires/) {
+ push @{ $require->{$dist} }, keys %{ $req->{$_} }
+ if $args{"keep_$_"};
+ }
+ }
+ else {
+
+ #for back compatbility
+ push @{ $require->{$dists} }, keys %$req;
+ }
+
+ for my $dep ( @{ $require->{$dist} } ) {
+ next if $require->{$dep};
+ $self->_fill_deps( %args, dist => $dep );
+ }
+}
+
=head2 order
get or set order
@@ -361,9 +391,7 @@
my %args = @_;
my $dir = tempdir( CLEANUP => 1 );
- $self->checkout(
- target => $dir,
- );
+ $self->checkout( target => $dir, );
BPB::Util->run(
$self->_cmd(
propset => %args,
Modified: bpsbuilder/BPB/lib/BPB/Script/Import.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Script/Import.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Script/Import.pm Fri Jan 18 04:00:26 2008
@@ -133,36 +133,38 @@
my @sources = readdir $d;
close $d;
- for my $module ( keys %$req ) {
- my $dist = $map->{$module} || $module;
- $dist =~ s/::/-/g;
-
- unless ( $imported{$dist}++ ) {
- my $s = ( grep { /^$dist/ } @sources )[0];
- warn "we don't have $dist in source which is for "
- . $self->source
- unless $s;
- $s = File::Spec->catfile( $dir, $s );
-
- $self->import_req( $s, $bpb );
-
- my $script_dir = tempdir( CLEANUP => 1 );
- move(
- File::Spec->catfile( $s, '__require.yml' ),
- File::Spec->catfile( $script_dir, 'require.yml' )
- );
-
- $self->generate_build( $s, $script_dir, $bpb );
-
- $bpb->backend->import(
- comment => 'deps for ' . $source,
- source => $s,
- );
- $bpb->backend->import(
- source => $s,
- comment => 'import scripts for' . $s,
- build_script => $script_dir,
- );
+ for my $type (qw/requires recommends build_requires/) {
+ for my $module ( keys %{ $req->{$type} } ) {
+ my $dist = $map->{$module} || $module;
+ $dist =~ s/::/-/g;
+
+ unless ( $imported{$dist}++ ) {
+ my $s = ( grep { /^$dist/ } @sources )[0];
+ warn "we don't have $dist in source which is for "
+ . $self->source
+ unless $s;
+ $s = File::Spec->catfile( $dir, $s );
+
+ $self->import_req( $s, $bpb );
+
+ my $script_dir = tempdir( CLEANUP => 1 );
+ move(
+ File::Spec->catfile( $s, '__require.yml' ),
+ File::Spec->catfile( $script_dir, 'require.yml' )
+ );
+
+ $self->generate_build( $s, $script_dir, $bpb );
+
+ $bpb->backend->import(
+ comment => 'deps for ' . $source,
+ source => $s,
+ );
+ $bpb->backend->import(
+ source => $s,
+ comment => 'import scripts for' . $s,
+ build_script => $script_dir,
+ );
+ }
}
}
}
Modified: bpsbuilder/BPB/lib/BPB/Script/Maintain.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Script/Maintain.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Script/Maintain.pm Fri Jan 18 04:00:26 2008
@@ -5,7 +5,10 @@
use Carp;
use base qw/App::CLI::Command Class::Accessor::Fast/;
-__PACKAGE__->mk_accessors(qw/config name update_order/);
+__PACKAGE__->mk_accessors(
+ qw/config name update_order keep_recommends
+ keep_build_requires keep_requires for_dists/
+);
use BPB;
@@ -14,9 +17,13 @@
sub options {
(
- 'c|config=s' => 'config',
- 'n|name=s' => 'name',
- 'update-order' => 'update_order',
+ 'c|config=s' => 'config',
+ 'n|name=s' => 'name',
+ 'update-order' => 'update_order',
+ 'keep-recommends=s' => 'keep_recommends',
+ 'keep-requires=s' => 'keep_requires',
+ 'keep-build-requires=s' => 'keep_build_requires',
+ 'for-dists=s' => 'for_dists',
);
}
@@ -24,10 +31,7 @@
=cut
sub run {
- my $self = shift;
- my $source = shift;
-
- $self->source($source) if $source;
+ my $self = shift;
for (qw/name/) {
die "need $_ arg" unless $self->$_();
@@ -39,11 +43,25 @@
);
if ( $self->update_order ) {
- $bpb->backend->update_order;
+ $bpb->backend->update_order(
+
+ # just for completeness, normally you never need this ;)
+ keep_requires =>
+ ( defined $self->keep_requires ? $self->keep_requires : 1 ),
+
+ keep_recommends => (
+ defined $self->keep_recommends ? $self->keep_recommends
+ : $bpb->config->name->{source}{keep_recomemnds}
+ ),
+ keep_build_requires => (
+ defined $self->keep_build_requires ? $self->keep_build_requires
+ : $bpb->config->name->{source}{keep_build_requires}
+ ),
+ for_dists => [ split /,\s*/, $self->for_dists ],
+ );
}
}
-
1;
__END__
Modified: bpsbuilder/BPB/lib/BPB/Source/Base.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Source/Base.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Source/Base.pm Fri Jan 18 04:00:26 2008
@@ -11,7 +11,7 @@
use base qw/Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(
qw/source directory download_directory follow min_perl_version map_path
- skip map keep_recommends name log/
+ skip map keep_recommends keep_build_requires name log/
);
=head2 new
@@ -56,12 +56,21 @@
my $meta = BPB::Config::LoadFile($meta_path);
for my $module ( keys %{ $meta->{requires} } ) {
- $require->{$module}{version} = $meta->{requires}{$module};
+ $require->{requires}{$module}{version} =
+ $meta->{requires}{$module};
}
if ( $self->keep_recommends && $meta->{recommends} ) {
for my $module ( keys %{ $meta->{recommends} } ) {
- $require->{$module}{version} = $meta->{recommends}{$module};
+ $require->{recommends}{$module}{version} =
+ $meta->{recommends}{$module};
+ }
+ }
+
+ if ( $self->keep_build_requires && $meta->{build_requires} ) {
+ for my $module ( keys %{ $meta->{build_requires} } ) {
+ $require->{build_requires}{$module}{version} =
+ $meta->{build_requires}{$module};
}
}
}
@@ -69,74 +78,77 @@
}
if ( my $require = BPB::Config::LoadFile($require_path) ) {
- for my $module ( keys %$require ) {
-
- # we don't want to require perl
- if ( $module eq 'perl' ) {
- delete $require->{$module};
- next;
- }
-
- if (
- Module::CoreList->first_release( $module,
- $require->{$module}{version} )
- && Module::CoreList->first_release( $module,
- $require->{$module}{version} ) <= $self->min_perl_version
- )
- {
- delete $require->{$module};
- next;
- }
+ for my $type (qw/requires recommends build_requires/) {
+ for my $module ( keys %{ $require->{$type} } ) {
+ # we don't want to require perl
+ if ( $module eq 'perl' ) {
+ delete $require->{$type}{$module};
+ next;
+ }
- if ( $self->_is_skipped($module) ) {
- delete $require->{$module};
- next;
- }
+ if (
+ Module::CoreList->first_release( $module,
+ $require->{$type}{$module}{version} )
+ && Module::CoreList->first_release( $module,
+ $require->{$type}{$module}{version} ) <=
+ $self->min_perl_version
+ )
+ {
+ delete $require->{$type}{$module};
+ next;
+ }
- opendir my $dir, $self->directory;
- my @sources = readdir $dir;
+ if ( $self->_is_skipped($module) ) {
+ delete $require->{$type}{$module};
+ next;
+ }
- # remove version number
- s/-\d[.\w]+$// for @sources;
+ opendir my $dir, $self->directory;
+ my @sources = readdir $dir;
- close $dir;
+ # remove version number
+ s/-\d[.\w]+$// for @sources;
- my $name;
- if ( $map->{$module} ) {
- $name = $map->{$module};
- }
- else {
- $name = $module;
- $name =~ s/::/-/g;
- }
+ close $dir;
- unless ( grep { $name eq $_ } @sources ) {
- my $s;
- if ( $require->{$module}{source}
- && $require->{$module}{source} ne 'CPAN' )
- {
- $s = BPB::Source->new(
- %$self,
- source => $require->{$module}{source},
- name => $name
- );
+ my $name;
+ if ( $map->{$module} ) {
+ $name = $map->{$module};
}
else {
- $s = BPB::Source->new(
- %$self,
- source => $module,
- name => $name,
- );
+ $name = $module;
+ $name =~ s/::/-/g;
}
- $s->run();
- }
- # reload map
- if ( -e $self->map_path ) {
- $map = BPB::Config::LoadFile( $self->map_path );
- }
+ unless ( grep { $name eq $_ } @sources ) {
+ my $s;
+ if ( $require->{$type}{$module}{source}
+ && $require->{$type}{$module}{source} ne 'CPAN' )
+ {
+ $s = BPB::Source->new(
+ %$self,
+ source => $require->{$type}{$module}{source},
+ name => $name
+ );
+ }
+ else {
+ $s = BPB::Source->new(
+ %$self,
+ source => $module,
+ name => $name,
+ );
+ }
+ $s->run();
+ }
- $require->{ $map->{$module} || $name } = delete $require->{$module};
+ # reload map
+ if ( -e $self->map_path ) {
+ $map = BPB::Config::LoadFile( $self->map_path );
+ }
+
+ $require->{$type}{ $map->{$module} || $name } =
+ delete $require->{$type}{$module};
+ }
}
BPB::Config::DumpFile( $require_path, $require );
More information about the Bps-public-commit
mailing list