[Bps-public-commit] r10587 - bpsbuilder/Shipwright/lib/Shipwright

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Wed Jan 30 09:30:49 2008
New Revision: 10587

Modified:
   bpsbuilder/Shipwright/lib/Shipwright/Backend.pm

Log:
updated builder script, independent log files for build, test and clean

Modified: bpsbuilder/Shipwright/lib/Shipwright/Backend.pm
==============================================================================
--- bpsbuilder/Shipwright/lib/Shipwright/Backend.pm	(original)
+++ bpsbuilder/Shipwright/lib/Shipwright/Backend.pm	Wed Jan 30 09:30:49 2008
@@ -230,7 +230,7 @@
 
 only-test: test for the installed dists.
     it's used to be sure everything is ok after we install with success. 
-    need to specify --install-base.
+    need to specify --install-base if nothing find in __install_base.
 
 clean: clean the source
 
@@ -242,17 +242,33 @@
     exit 0;
 }
 
-unlink 'build.log' if -e 'build.log';
-open my $log, '>', 'build.log' or die $!;
 
 $args{skip} = [ split /,\s*/, $args{skip} || '' ];
 
 my $order = parse_order( File::Spec->catfile( 'shipwright', 'order.yml' ) );
 
+my $log;
+
 if ( $args{'only-test'} ) {
+    open $log, '>', 'test.log' or die $!;
+
+    $args{'install-base'} = get_install_base() unless $args{'install-base'}; 
     test();
 }
 elsif ( $args{'clean'} ) {
+    open $log, '>', 'clean.log' or die $!;
+
+    $args{'install-base'} = get_install_base() unless $args{'install-base'};
+    unless ( $args{perl} ) {
+        if ( -e File::Spec->catfile( $args{'install-base'}, 'bin', 'perl' ) ) {
+            $args{perl} =
+              File::Spec->catfile( $args{'install-base'}, 'bin', 'perl' );
+        }
+        else {
+            $args{perl} = $^X;
+        }
+    }
+
     for my $dist (@$order) {
         unless ( grep { $dist eq $_ } @{ $args{skip} } ) {
             clean($dist);
@@ -263,6 +279,7 @@
 else {
 
     # for install
+    open $log, '>', 'build.log' or die $!;
 
     my ($project_name) = $build_base =~ /([-\w]+)$/;
     unless ( $args{'install-base'} ) {
@@ -273,6 +290,11 @@
           "no default install-base, will set it to $args{'install-base'}\n";
     }
 
+    open my $fh, '>', '__install_base'
+      or die "can't write to __install_base: $!";
+    print $fh $args{'install-base'};
+    close $fh;
+
     unless ( $args{perl} ) {
         if ( ( grep { $_ eq 'perl' } @$order )
             && !( grep { $_ eq 'perl' } @{ $args{skip} } ) )
@@ -334,7 +356,7 @@
 sub install {
     my $dir = shift;
 
-    my $cmds = cmds($dir);
+    my $cmds = cmds(File::Spec->catfile( 'scripts', $dir, 'build' ));
 
     chdir File::Spec->catfile( 'dists', $dir );
 
@@ -351,15 +373,17 @@
 
         print "we'll run the cmd: $cmd\n";
         if ( system($cmd) ) {
-            print $log "build $dir with failure when run $type: $!\n";
+            print $log "build $dir $type part with failure: $!\n";
             if ( $args{force} && $type eq 'test' ) {
                 print $log
 "although tests failed, will install anyway since we have force arg\n";
             }
             else {
-                die "build $dir with failure when run $type: $!\n";
+                die "build $dir $type part with failure: $!\n";
             }
-
+        }
+        else {
+            print $log "build $dir $type part with success!\n";
         }
     }
 
@@ -428,7 +452,7 @@
     my $text = shift;
     return unless $text;
 
-    my $perl         = $args{'perl'};
+    my $perl         = $args{'perl'} || $^X;
     my $install_base = $args{'install-base'};
     $text =~ s/%%PERL%%/$perl/g;
     $text =~ s/%%INSTALL_BASE%%/$install_base/g;
@@ -449,42 +473,29 @@
 
 sub test {
 
-    my @cmds;
-    {
-        open my $fh, '<', File::Spec->catfile( 't', 'test' )
-          or die $!;
-        @cmds = <$fh>;
-        close $fh;
-        chomp @cmds;
-        @cmds = map { substitute($_) } @cmds;
-    }
+    my $cmds = cmds(File::Spec->catfile( 't', 'test' ));
 
-    for (@cmds) {
-        my ( $type, $cmd );
-        next unless /\S/;
-
-        if (/^(\S+):\s*(.*)/) {
-            $type = $1;
-            $cmd  = $2;
+    for (@$cmds) {
+        my ( $type, $cmd ) = @$_;
+        print $log "run tests $type part with cmd: $cmd\n";
+        if ( system($cmd ) ) {
+            die "something wrong when execute $cmd: $?";
         }
         else {
-            $type = '';
-            $cmd  = $_;
+            print $log "run test $type part with success\n";
         }
-
-        print "run tests $type with cmd: $cmd\n";
-        system($cmd) && die "something wrong when execute $cmd: $?";
     }
-
+    print $log "run tests with success\n";
 }
 
 sub cmds {
-    my $dir = shift;
+    my $file = shift;
 
     my @cmds;
+
+
     {
-        open my $fh, '<', File::Spec->catfile( 'scripts', $dir, 'build' )
-          or die $!;
+        open my $fh, '<', $file or die $!;
         @cmds = <$fh>;
         close $fh;
         chomp @cmds;
@@ -513,7 +524,7 @@
 sub clean {
     my $dir = shift;
 
-    my $cmds = cmds($dir);
+    my $cmds = cmds(File::Spec->catfile( 'scripts', $dir, 'build' ));
 
     chdir File::Spec->catfile( 'dists', $dir );
 
@@ -521,13 +532,28 @@
         my ( $type, $cmd ) = @$_;
         next unless $type eq 'clean';
 
-        print "we'll run the cmd: $cmd\n";
         if ( system($cmd) ) {
             print $log "clean $dir with failure: $!\n";
         }
+        else {
+            print $log "clean $dir with success $!\n";
+        }
     }
 }
 
+sub get_install_base {
+    if ( open my $fh, '<', '__install_base' ) {
+        my $install_base = <$fh>;
+        close $fh;
+        chomp $install_base;
+        return $install_base;
+    }
+    else {
+        warn
+"can't find install-base automatically, you need to specify it manually.\n";
+    }
+
+}
 EOF
 , 
 null => '',