Try to improve cleanup (and not forget a build when another arch fails)

2 files changed, 43 insertions, 49 deletions

diff --git a/lib/Iurt/File.pm b/lib/Iurt/File.pm
index 42943de..9eb00f7 100644
--- a/lib/Iurt/File.pm
+++ b/lib/Iurt/File.pm
@@ -1,22 +1,15 @@
 package Iurt::File;
 
 use base qw(Exporter);
+use File::Copy 'move';
 use Iurt::Util qw(plog);
 use strict;
 
 our @EXPORT = qw(
     check_upload_tree 
+    cleanup_failed_build
 );
 
-=head2 config_usage($config_usage, $config)
-
-Create an instance of a class at runtime.
-I<$config_usage> is the configuration help,
-I<%config> is the current configuration values
-Return true.
-
-=cut
-
 sub check_upload_tree {
     my ($todo, $func, $o_post) = @_;
 
@@ -66,3 +59,35 @@ sub check_upload_tree {
     }
 }
  
+sub cleanup_failed_build {
+    my ($todo_dir, $done_dir, $fail_dir, $prefix, $ent) = @_;
+
+    foreach my $rpm (@{$ent->{rpms}}) {
+	my $file = "$done_dir/${prefix}_$rpm";
+	plog('DEBUG', "moving built rpm $file to $fail_dir/");
+	move($file, "$fail_dir/${prefix}_$rpm");
+    }
+    delete $ent->{rpms};
+
+    foreach my $srpm (@{$ent->{srpms}}) {
+	my $file = "$todo_dir/${prefix}_$srpm";
+	plog('DEBUG', "moving $file to $fail_dir/");
+	move($file, "$fail_dir/${prefix}_$srpm");
+	# If one arch has been generated, we also have a src.rpm in done
+	$file = "$done_dir/${prefix}_$srpm";
+	if (-f $file) {
+	    plog('DEBUG', "deleting $file");
+	    unlink $file;
+	}
+    }
+    delete $ent->{srpms};
+
+    if (-d "$done_dir/$prefix") {
+	make_path("$fail_dir/$prefix");
+	for my $file (glob "$done_dir/$prefix/*") {
+	    plog('DEBUG', "moving $file to $fail_dir/$prefix/");
+	    move($file, "$fail_dir/$prefix/");
+	}
+    }
+}
+
diff --git a/ulri b/ulri
index fef4f06..b83b6c7 100755
--- a/ulri
+++ b/ulri
@@ -35,7 +35,7 @@ use strict;
 use MDK::Common qw(any cat_ if_ find);
 use Iurt::Config qw(config_usage get_date config_init get_author_email check_arch check_noarch);
 use Iurt::Process qw(check_pid);
-use Iurt::File qw(check_upload_tree);
+use Iurt::File qw(check_upload_tree cleanup_failed_build);
 use Iurt::Mail qw(sendmail);
 use Iurt::Util qw(plog_init plog ssh_setup ssh sout sget sput);
 use File::Copy 'move';
@@ -259,17 +259,6 @@ sub todo_func {
     }
 }
 
-sub todo_post {
-    my ($todo, $f, $m, $s, $r) = @_;
-
-    if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_([\w-]+)\.(\w+)\.(\w+)\.(\d{14})\.(\d+)\.lock$/) {
-	if (!$pkg_tree{$1}{srpms}) {
-	    plog('INFO', "cleaning orphan $r");
-	    unlink "$todo/$f/$m/$s/$r";
-	}
-    }
-}
-
 sub done_func {
     my ($_todo, $_f, $m, $s, $r) = @_;
 
@@ -286,8 +275,7 @@ sub done_func {
     }
 }
 
-
-check_upload_tree($todo, \&todo_func, \&todo_post);
+check_upload_tree($todo, \&todo_func);
 
 # getting already compiled packages
 # The cache should not be needed if the .done file are removed as the same
@@ -409,7 +397,11 @@ foreach my $prefix (keys %pkg_tree) {
 			make_path("$done_dir/$prefix");
 			sget($remote, "$prefix_dir/log/*", "$done_dir/$prefix");
 			ssh($remote, "rm -rf $prefix_dir");
-			$something_finished = 1;
+			if (!$ent->{srpms}) {
+			    cleanup_failed_build($todo_dir, $done_dir, $fail_dir, $prefix, $ent);
+			} else {
+			    $something_finished = 1;
+			}
 		    }
 		}
 	    } # if ($status)
@@ -467,32 +459,9 @@ foreach my $prefix (keys %pkg_tree) {
 		     "to $fail_dir/ failed ($!)");
 		$compildone->{$prefix}{$media}{$arch} = 0;
 	    }
-	    
-	    # Move built packages to failures if one arch failed
-	    foreach my $rpm (@{$ent->{rpms}}) {
-		my $file = "$done_dir/${prefix}_$rpm";
-		plog('DEBUG', "moving built rpm $file to $fail_dir/${prefix}_$rpm");
-		link $file, "$fail_dir/${prefix}_$rpm";
-		unlink $file;
-	    }
 
-	    # Should clean the queue 
-	    # Must remove the SRPM and the lock 
-	    foreach my $srpm (@{$ent->{srpms}}) {                                
-		my $file = "$todo_dir/${prefix}_$srpm";
-		plog('DEBUG', "moving $file to $fail_dir/${prefix}_$srpm");
-		link $file, "$fail_dir/${prefix}_$srpm";
-		# FIXME If another arch is currently building, we will not clean its logs (Bug #4343)
-		delete $pkg_tree{$prefix};
-		unlink $file;
-		# If one arch has been generated, we also have a src.rpm in done
-		$file = "$done_dir/${prefix}_$srpm";
-		if (-f $file) {
-		    plog('DEBUG', "deleting $file");
-		    unlink $file;
-		}
-	    }
-	    
+	    cleanup_failed_build($todo_dir, $done_dir, $fail_dir, $prefix, $ent);
+
 	    # Notify user if build failed
 	    #
 	    if ($user) {