[Bps-public-commit] r10228 - in bpsbuilder/BPB: . lib/BPB lib/BPB/Backend lib/BPB/Script lib/BPB/Source
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Wed Jan 2 16:12:05 EST 2008
Author: sunnavy
Date: Wed Jan 2 16:12:04 2008
New Revision: 10228
Modified:
bpsbuilder/BPB/Makefile.PL
bpsbuilder/BPB/lib/BPB.pm
bpsbuilder/BPB/lib/BPB/Backend/SVK.pm
bpsbuilder/BPB/lib/BPB/Backend/SVN.pm
bpsbuilder/BPB/lib/BPB/Build.pm
bpsbuilder/BPB/lib/BPB/Script/Import.pm
bpsbuilder/BPB/lib/BPB/Source/Base.pm
bpsbuilder/BPB/lib/BPB/Source/Compressed.pm
bpsbuilder/BPB/lib/BPB/Source/Directory.pm
bpsbuilder/BPB/lib/BPB/Source/SVK.pm
bpsbuilder/BPB/lib/BPB/Source/SVN.pm
Log:
refactors, also bug fixes
Modified: bpsbuilder/BPB/Makefile.PL
==============================================================================
--- bpsbuilder/BPB/Makefile.PL (original)
+++ bpsbuilder/BPB/Makefile.PL Wed Jan 2 16:12:04 2008
@@ -18,8 +18,10 @@
requires 'File::Find' => 0;
requires 'File::Slurp' => 0;
requires 'File::Basename' => 0;
-requires Algorithm::Dependency::Ordered => 0;
-requires Algorithm::Dependency::Source::HoA => 0;
+requires 'Algorithm::Dependency::Ordered' => 0;
+requires 'Algorithm::Dependency::Source::HoA' => 0;
+requires 'Log::Log4perl' => 0;
+requires 'IPC::Run3' => 0;
no_index( directory => 'examples' );
no_index( directory => 'docs' );
Modified: bpsbuilder/BPB/lib/BPB.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB.pm (original)
+++ bpsbuilder/BPB/lib/BPB.pm Wed Jan 2 16:12:04 2008
@@ -15,6 +15,7 @@
use BPB::Source;
use BPB::Build;
use BPB::Logger;
+use BPB::Util;
=head2 new
Modified: bpsbuilder/BPB/lib/BPB/Backend/SVK.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVK.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVK.pm Wed Jan 2 16:12:04 2008
@@ -47,7 +47,11 @@
close $builder;
$self->delete; # clean repository in case it exists
- $self->import( source => $dir, _initialize => 1 );
+ $self->import(
+ source => $dir,
+ _initialize => 1,
+ comment => 'created project',
+ );
}
=head2 import
@@ -58,8 +62,10 @@
my $self = shift;
return unless @_;
my %args = @_;
- my $cmd = $self->_cmd( import => %args );
- $self->_run($cmd);
+ my $name = $args{source};
+ $name =~ s{^.*/(.+)/?$}{$1.tar.gz};
+ $name = CPAN::DistnameInfo->new($name)->dist;
+ BPB::Util->run( $self->_cmd( import => %args, name => $name ) );
$self->_add_to_order( source => $args{source} ) unless $args{_initialize};
}
@@ -69,8 +75,8 @@
sub export {
my $self = shift;
- my $cmd = $self->_cmd( checkout => @_, extra => ['--export'] );
- $self->_run($cmd);
+ BPB::Util->run( $self->_cmd( checkout => @_ ) );
+ BPB::Util->run( $self->_cmd( checkout => @_, detach => 1 ) );
}
=head2 checkout
@@ -79,22 +85,19 @@
sub checkout {
my $self = shift;
- my $cmd = $self->_cmd( checkout => @_ );
- $self->_run($cmd);
+ BPB::Util->run( $self->_cmd( checkout => @_ ) );
}
sub commit {
my $self = shift;
- my $cmd = $self->_cmd( commit => @_ );
- $self->_run($cmd);
+ BPB::Util->run( $self->_cmd( commit => @_ ) );
}
sub _cmd {
my $self = shift;
my $type = shift;
my %args = @_;
- $args{extra} ||= [];
- $args{path} ||= '';
+ $args{path} ||= '';
for ( @{ $REQUIRE_OPTIONS{$type} } ) {
croak "$type need option $_" unless $args{$_};
@@ -104,52 +107,58 @@
if ( $type eq 'checkout' ) {
if ( $args{detach} ) {
- $cmd = join ' ', 'svk', 'checkout', '--detach', $args{target};
+ $cmd = [ 'svk', 'checkout', '-d', $args{target} ];
}
else {
- $cmd = join ' ', 'svk', 'checkout', $self->repository . $args{path},
- $args{target};
+ $cmd = [
+ 'svk', 'checkout',
+ $self->repository . $args{path}, $args{target}
+ ];
}
}
elsif ( $type eq 'import' ) {
- push @{ $args{extra} }, '-m',
- q{'} . ( $args{comment} || 'import' ) . q{'};
-
if ( $args{_initialize} ) {
- $cmd = join ' ', 'svk', 'import', $args{source}, $self->repository;
+ $cmd = [
+ 'svk', 'import',
+ $args{source}, $self->repository,
+ '-m', q{'} . $args{comment} . q{'},
+ ];
}
else {
- my $name = $args{source};
- $name =~ s!^.*/(.+)/?$!$1.tar.gz!;
- $name = CPAN::DistnameInfo->new($name)->dist;
-
if ( my $script_dir = $args{build_script} ) {
- $cmd = join ' ', 'svk', 'import', $script_dir,
- $self->repository . "/scripts/$name/";
+ $cmd = [
+ 'svk', 'import',
+ $script_dir, $self->repository . "/scripts/$args{name}/",
+ '-m', q{'} . $args{comment} . q{'},
+ ];
}
else {
- $cmd = join ' ', 'svk', 'import', $args{source},
- $self->repository . "/dists/$name";
+ $cmd = [
+ 'svk', 'import',
+ $args{source}, $self->repository . "/dists/$args{name}",
+ '-m', q{'} . $args{comment} . q{'},
+ ];
}
}
}
elsif ( $type eq 'commit' ) {
- $cmd = join ' ', 'svk', 'commit', '-m', q{'} . $args{comment} . q{'},
- $args{path};
+ $cmd =
+ [ 'svk', 'commit', '-m', q{'} . $args{comment} . q{'}, $args{path} ];
}
elsif ( $type eq 'delete' ) {
- $cmd = join ' ', 'svk', 'delete', '-m',
- q{'} . 'delete repository' . q{'}, join '/', $self->repository,
- $args{path};
+ $cmd = [
+ 'svk', 'delete', '-m', q{'} . 'delete repository' . q{'},
+ join '/', $self->repository, $args{path},
+ ];
}
elsif ( $type eq 'info' ) {
- $cmd = join ' ', 'svk', 'info', $self->repository, $args{path};
+ $cmd = [ 'svk', 'info', join '/', $self->repository, $args{path} ];
}
else {
- croak "invalid command";
+ croak "invalid command: $type";
}
- return join ' ', $cmd, @{ $args{extra} };
+ return $cmd;
}
sub _add_to_order {
@@ -211,7 +220,6 @@
BPB::Config::DumpFile( $file, $order );
$self->commit( path => $file, comment => "set order" );
$self->checkout( detach => 1, target => $file );
-
}
else {
my $cmd = 'svk cat ' . $self->repository . '/bpb/order.yml';
@@ -220,26 +228,18 @@
}
}
-sub _run {
- my $self = shift;
- my $cmd = shift;
- system($cmd );
-}
-
sub delete {
my $self = shift;
my $path = shift;
- $self->_run( $self->_cmd( delete => path => $path ) )
+ BPB::Util->run( $self->_cmd( delete => path => $path ) )
if $self->info($path);
}
sub info {
my $self = shift;
my $path = shift;
- my $cmd = $self->_cmd( info => path => $path );
- my $info = `$cmd`;
- return $info unless $info =~ /does not exist/i;
- return;
+ my ($info) = BPB::Util->run( $self->_cmd( info => path => $path ), 1 );
+ return $info;
}
1;
Modified: bpsbuilder/BPB/lib/BPB/Backend/SVN.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVN.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVN.pm Wed Jan 2 16:12:04 2008
@@ -47,7 +47,11 @@
close $builder;
$self->delete; # clean repository in case it exists
- $self->import( source => $dir, _initialize => 1 );
+ $self->import(
+ source => $dir,
+ comment => 'create project',
+ _initialize => 1,
+ );
}
=head2 import
@@ -61,11 +65,13 @@
my $name = $args{source};
$name =~ s{^.*/(.+)/?$}{$1.tar.gz};
$name = CPAN::DistnameInfo->new($name)->dist;
- my $cmd = $self->_cmd( import => %args, name => $name );
- for (qw/dists scripts/) {
- $self->delete("$_/$name");
+ if ( $args{build_script} ) {
+ $self->delete("scripts/$name");
}
- $self->_run($cmd);
+ else {
+ $self->delete("dists/$name");
+ }
+ BPB::Util->run( $self->_cmd( import => %args, name => $name ) );
$self->_add_to_order( source => $args{source} ) unless $args{_initialize};
}
@@ -75,8 +81,7 @@
sub export {
my $self = shift;
- my $cmd = $self->_cmd( export => @_ );
- $self->_run($cmd);
+ BPB::Util->run( $self->_cmd( export => @_ ) );
}
=head2 checkout
@@ -85,22 +90,19 @@
sub checkout {
my $self = shift;
- my $cmd = $self->_cmd( checkout => @_ );
- $self->_run($cmd);
+ BPB::Util->run( $self->_cmd( checkout => @_ ) );
}
sub commit {
my $self = shift;
- my $cmd = $self->_cmd( commit => @_ );
- $self->_run($cmd);
+ BPB::Util->run( $self->_cmd( commit => @_ ) );
}
sub _cmd {
my $self = shift;
my $type = shift;
my %args = @_;
- $args{extra} ||= [];
- $args{path} ||= '';
+ $args{path} ||= '';
for ( @{ $REQUIRE_OPTIONS{$type} } ) {
croak "$type need option $_" unless $args{$_};
@@ -109,46 +111,56 @@
my $cmd;
if ( $type eq 'checkout' ) {
- $cmd = join ' ', 'svn', 'checkout', $self->repository . $args{path},
- $args{target};
+ $cmd =
+ [ 'svn', 'checkout', $self->repository . $args{path}, $args{target} ];
+ }
+ elsif ( $type eq 'export' ) {
+ $cmd =
+ [ 'svn', 'export', $self->repository . $args{path}, $args{target} ];
}
elsif ( $type eq 'import' ) {
- push @{ $args{extra} }, '-m',
- q{'} . ( $args{comment} || 'import' ) . q{'};
-
if ( $args{_initialize} ) {
- $cmd = join ' ', 'svn', 'import', $args{source}, $self->repository;
+ $cmd = [
+ 'svn', 'import',
+ $args{source}, $self->repository,
+ '-m', q{'} . $args{comment} . q{'}
+ ];
}
else {
-
if ( my $script_dir = $args{build_script} ) {
- $cmd = join ' ', 'svn', 'import', $script_dir,
- $self->repository . "/scripts/$args{name}/";
+ $cmd = [
+ 'svn', 'import',
+ $script_dir, $self->repository . "/scripts/$args{name}/",
+ '-m', q{'} . $args{comment} . q{'},
+ ];
}
else {
- $cmd = join ' ', 'svn', 'import', $args{source},
- $self->repository . "/dists/$args{name}";
+ $cmd = [
+ 'svn', 'import',
+ $args{source}, $self->repository . "/dists/$args{name}",
+ '-m', q{'} . $args{comment} . q{'},
+ ];
}
}
}
elsif ( $type eq 'commit' ) {
- $cmd = join ' ', 'svn', 'commit', '-m', q{'} . $args{comment} . q{'},
- $args{path};
+ $cmd =
+ [ 'svn', 'commit', '-m', q{'} . $args{comment} . q{'}, $args{path} ];
}
elsif ( $type eq 'delete' ) {
- $cmd = join ' ', 'svn', 'delete', '-m',
- q{'} . 'delete repository' . q{'}, join '/', $self->repository,
- $args{path};
+ $cmd = [
+ 'svn', 'delete', '-m', q{'} . 'delete' . $args{path} . q{'},
+ join '/', $self->repository, $args{path}
+ ];
}
elsif ( $type eq 'info' ) {
- $cmd = join ' ', 'svn', 'info', '2>/dev/null', $self->repository,
- $args{path};
+ $cmd = [ 'svn', 'info', join '/', $self->repository, $args{path} ];
}
else {
- croak "invalid command";
+ croak "invalid command: $type";
}
- return join ' ', $cmd, @{ $args{extra} };
+ return $cmd;
}
sub _add_to_order {
@@ -218,24 +230,19 @@
}
}
-sub _run {
- my $self = shift;
- my $cmd = shift;
- system($cmd );
-}
-
sub delete {
my $self = shift;
my $path = shift;
- $self->_run( $self->_cmd( delete => path => $path ) )
+ BPB::Util->run( $self->_cmd( delete => path => $path ) )
if $self->info($path);
}
sub info {
my $self = shift;
my $path = shift;
- my $cmd = $self->_cmd( info => path => $path );
- return `$cmd`;
+ my ( $info, $err ) = BPB::Util->run( $self->_cmd( info => path => $path ) );
+ return $info unless $err;
+ return;
}
1;
Modified: bpsbuilder/BPB/lib/BPB/Build.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Build.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Build.pm Wed Jan 2 16:12:04 2008
@@ -68,8 +68,7 @@
$self->_substitute('__build');
chmod 0755, '__build';
- system('./__build');
- unlink '__build';
+ BPB::Util->run(['./__build']);
}
sub _wrapper {
@@ -92,12 +91,11 @@
or die $!;
};
- for my $dir (qw(bin sbin libexec)) {
- find( $sub,
- grep { -d $_ }
- map { File::Spec->catfile( $self->install_base, $_ ) }
- qw/bin sbin libexec/ );
- }
+ my @dirs =
+ grep { -d $_ }
+ map { File::Spec->catfile( $self->install_base, $_ ) }
+ qw/bin sbin libexec/;
+ find( $sub, @dirs) if @dirs;
}
sub _substitute {
Modified: bpsbuilder/BPB/lib/BPB/Script/Import.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Script/Import.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Script/Import.pm Wed Jan 2 16:12:04 2008
@@ -68,9 +68,13 @@
File::Spec->catfile( $script_dir, 'require.yml' )
);
- $bpb->backend->import( map { $_, $self->$_ } qw/comment source/ );
+ $bpb->backend->import(
+ source => $self->source,
+ comment => $self->comment || 'import ' . $self->source,
+ );
$bpb->backend->import(
source => $self->source,
+ comment => 'import scripts for' . $self->source,
build_script => $script_dir,
);
}
@@ -124,6 +128,7 @@
);
$bpb->backend->import(
source => $s,
+ comment => 'import scripts for' . $s,
build_script => $script_dir,
);
}
Modified: bpsbuilder/BPB/lib/BPB/Source/Base.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Source/Base.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Source/Base.pm Wed Jan 2 16:12:04 2008
@@ -30,7 +30,7 @@
sub run {
my $self = shift;
for ( $self->_cmd ) {
- $self->_run($_);
+ BPB::Util->run( $_ );
}
$self->_copy(@_) if @_;
}
@@ -38,12 +38,6 @@
# you should subclass this method.
sub _cmd { }
-sub _run {
- my $self = shift;
- my $cmd = shift;
- system($cmd);
-}
-
sub _follow {
my $self = shift;
my $path = shift;
@@ -187,10 +181,10 @@
my %file = @_;
for ( keys %file ) {
if ( $file{$_} ) {
- my $cmd = join ' ', 'cp', $file{$_},
+ my $cmd = [ 'cp', $file{$_},
File::Spec->catfile( $self->directory, $self->name || $self->path,
- $_ );
- system($cmd);
+ $_ ) ];
+ BPB::Util->run( $cmd );
}
}
}
Modified: bpsbuilder/BPB/lib/BPB/Source/Compressed.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Source/Compressed.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Source/Compressed.pm Wed Jan 2 16:12:04 2008
@@ -57,12 +57,15 @@
}
my @cmds;
- push @cmds, join ' ', 'tar', $arg, $self->source, '-C', $self->directory;
+ push @cmds, [ 'tar', $arg, $self->source, '-C', $self->directory ];
if ( $self->name && $self->name ne $self->path ) {
- push @cmds, join ' ', 'mv',
- File::Spec->catfile( $self->directory, $self->path ),
- File::Spec->catfile( $self->directory, $self->name );
+ push @cmds,
+ [
+ 'mv',
+ File::Spec->catfile( $self->directory, $self->path ),
+ File::Spec->catfile( $self->directory, $self->name )
+ ];
}
return @cmds;
}
Modified: bpsbuilder/BPB/lib/BPB/Source/Directory.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Source/Directory.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Source/Directory.pm Wed Jan 2 16:12:04 2008
@@ -38,8 +38,8 @@
sub _cmd {
my $self = shift;
- return join ' ', 'cp', '-r', $self->source,
- File::Spec->catfile( $self->directory, $self->name || $self->path );
+ return ['cp', '-r', $self->source,
+ File::Spec->catfile( $self->directory, $self->name || $self->path )];
}
1;
Modified: bpsbuilder/BPB/lib/BPB/Source/SVK.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Source/SVK.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Source/SVK.pm Wed Jan 2 16:12:04 2008
@@ -43,20 +43,19 @@
my $self = shift;
my $source = $self->source;
my @cmds;
- push @cmds, join ' ', 'svk co ', $self->source,
+ push @cmds, ['svk', 'co', $self->source,
File::Spec->catfile( $self->download_directory,
- $self->name || $self->path );
- push @cmds, join ' ', 'svk co -d',
+ $self->name || $self->path )];
+ push @cmds, [ 'svk', 'co', '-d',
File::Spec->catfile( $self->download_directory,
- $self->name || $self->path );
+ $self->name || $self->path )];
$self->source(
File::Spec->catfile(
$self->download_directory, $self->name || $self->path
)
);
- system($_) for @cmds;
-
+ BPB::Util->run( $_ ) for @cmds;
}
sub path {
Modified: bpsbuilder/BPB/lib/BPB/Source/SVN.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Source/SVN.pm (original)
+++ bpsbuilder/BPB/lib/BPB/Source/SVN.pm Wed Jan 2 16:12:04 2008
@@ -42,14 +42,19 @@
sub _run {
my $self = shift;
my $source = $self->source;
- my $cmd = join ' ', 'svn export ', $self->source,
- File::Spec->catfile( $self->download_directory, $self->name || $self->path );
+ my $cmd = [
+ 'svn', 'export',
+ $self->source,
+ File::Spec->catfile(
+ $self->download_directory, $self->name || $self->path
+ )
+ ];
$self->source(
File::Spec->catfile(
$self->download_directory, $self->name || $self->path
)
);
- system($cmd );
+ BPB::Util->run( $cmd );
}
sub path {
@@ -65,14 +70,12 @@
}
}
-
sub _is_compressed {
my $self = shift;
return 1 if $self->source =~ m{.*/(.+)\.(tar.(gz|bz2)|tgz)$};
return;
}
-
1;
__END__
More information about the Bps-public-commit
mailing list