Better modules split

4 files changed, 17 insertions, 214 deletions

diff --git a/emi b/emi
index b9d93eb..790ec52 100755
--- a/emi
+++ b/emi
@@ -32,7 +32,7 @@ use File::Path qw(make_path);
 use Iurt::Config qw(config_usage config_init get_author_email get_mandatory_arch);
 use Iurt::Process qw(check_pid);
 use Iurt::Mail qw(sendmail);
-use Iurt::File qw(get_upload_tree_state);
+use Iurt::Queue qw(get_upload_tree_state);
 use Iurt::Util qw(plog_init plog);
 use Iurt::Emi qw(find_prefixes_ready_to_upload upload_prefix_in_media);
 use Data::Dumper;
diff --git a/lib/Iurt/File.pm b/lib/Iurt/File.pm
index 33be6a1..7f28628 100644
--- a/lib/Iurt/File.pm
+++ b/lib/Iurt/File.pm
@@ -9,208 +9,26 @@ use MDK::Common qw(cat_ find member partition);
 use strict;
 
 our @EXPORT = qw(
-    get_upload_tree_state
-    cleanup_failed_build
+    create_file
+    check_file_timeout
+    read_line
 );
 
-sub apply_to_upload_tree {
-    my ($tree_root, $func) = @_;
-
-    # Squash double slashes for cosmetics
-    $tree_root =~ s!/+!/!g;
-
-    opendir(my $dir, $tree_root);
-    plog('INFO', "check dir: $tree_root");
-
-    foreach my $f (readdir $dir) {
-	$f =~ /^\.{1,2}$/ and next;
-	if (-d "$tree_root/$f") {
-	    plog('DEBUG', "checking target $tree_root/$f");
-	    opendir my $target_dir, "$tree_root/$f";
-
-	    foreach my $m (readdir $target_dir) {
-		$m =~ /^\.{1,2}$/ and next;
-		if (-d "$tree_root/$f/$m") {
-		    plog('DEBUG', "checking media $tree_root/$f/$m");
-		    opendir my $media_dir, "$tree_root/$f/$m";
-
-		    foreach my $s (readdir $media_dir) {
-			$s =~ /^\.{1,2}$/ and next;
-			if (-d "$tree_root/$f/$m/$s") {
-			    if ($func) {
-				opendir my $submedia_dir, "$tree_root/$f/$m/$s";
-				foreach my $r (readdir $submedia_dir) {
-				    $r =~ /^\.{1,2}$/ and next;
-				    $func->($tree_root, $f, $m, $s, $r);
-				}
-			    }
-			}
-		    }
-		}
-	    }
-	}
-    }
-}
- 
-sub cleanup_failed_build {
-    my ($todo_dir, $done_dir, $fail_dir, $prefix, $ent, $arch, $config) = @_;
-
-    my $mandatory_arch = get_mandatory_arch($config, $ent->{target});
-    my $fatal_failure = member($arch, @$mandatory_arch) || $arch eq 'noarch';
-
-    my ($failed_rpms, $kept_rpms);
-    if ($fatal_failure) {
-	plog('DEBUG', "failure is for mandatory arch $arch, aborting build");
-	$failed_rpms = $ent->{rpms};
-    } else {
-	plog('DEBUG', "failure is for non-mandatory arch $arch, keeping other builds going");
-	($failed_rpms, $kept_rpms) = partition { /\.$arch\.rpm$/ } @{$ent->{rpms}};
-    }
-
-    foreach my $rpm (@$failed_rpms) {
-	my $file = "$done_dir/${prefix}_$rpm";
-	plog('DEBUG', "moving built rpm $file to $fail_dir/");
-	move($file, "$fail_dir/${prefix}_$rpm");
-    }
-
-    if (!$fatal_failure) {
-	# keep rpms for other architectures
-	$ent->{rpms} = $kept_rpms;
-	return;
-    }
-
-    # abort all remaining builds
-    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;
-	}
-    }
+sub create_file {
+    my $file = shift;
+    my @contents = @_;
 
-    if (-d "$done_dir/$prefix") {
-	make_path("$fail_dir/$prefix");
-	foreach my $file (glob "$done_dir/$prefix/*") {
-	    plog('DEBUG', "moving $file to $fail_dir/$prefix/");
-	    move($file, "$fail_dir/$prefix/");
-	}
-    }
+    open my $FILE, ">$file" or die "FATAL: can't open $file for writing";
+    print $FILE "@contents";
 }
 
-sub get_upload_tree_state {
-    our ($config) = @_;
-
-    our %pkg_tree;
-    my $todo = "$config->{queue}/todo";
-    my $done = "$config->{queue}/done";
-
-    sub todo_func {
-	my ($todo, $f, $m, $s, $r) = @_;
-
-	my $media = "$m/$s";
-
-	if ($r =~ /(\d{14}\.(\w+)\.\w+\.\d+)_(.*\.src\.rpm)$/) {
-	    my ($prefix, $user, $srpm) = ($1, $2, $3);
-
-	    plog('DEBUG', "found srpm $srpm ($prefix)");
-	    $pkg_tree{$prefix}{media}{$media}{path} = "/$f/$m/$s";
-	    $pkg_tree{$prefix}{target} = $f;
-	    $pkg_tree{$prefix}{user} = $user;
-	    push @{$pkg_tree{$prefix}{srpms}} , $srpm;
-	    my ($name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/;
-
-	    $pkg_tree{$prefix}{srpm_name}{$name} = $srpm;
-	}
-
-	if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_([\w-]+)\.(\w+)\.(\w+)\.(\d{14})\.(\d+)\.lock$/) {
-	    my ($prefix, $arch, $bot, $host, $date, $pid) = ($1, $2, $3, $4, $5, $6);
-
-	    # Set path here too has we may have a lock without the src.rpm
-	    $pkg_tree{$prefix}{media}{$media}{path} = "/$f/$m/$s";
-
-	    $arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
-	    plog('DEBUG', "found lock on $host/$arch for $prefix");
-
-	    if ($arch =~ /noarch/) {
-		plog('DEBUG', "... and $prefix is noarch");
-		$pkg_tree{$prefix}{media}{$media}{arch}{noarch} = 1;
-		$arch =~ s/-.*//;
-	    }
-
-	    $pkg_tree{$prefix}{media}{$media}{arch}{$arch} = 1;
-
-	    my $time = read_line("$todo/$f/$m/$s/$r");
-	    $time = (split ' ', $time)[2];
-	    push @{$pkg_tree{$prefix}{media}{$media}{bot}}, {
-		bot => $bot,
-		host => $host,
-		date => $date,
-		pid => $pid,
-		'arch' => $arch,
-		'time' => $time
-	    };
-	}
-
-	if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_.*\.deps$/) {
-	    my $prefix = $1;
-	    my @deps = map { chomp(); $_ } cat_("$todo/$f/$m/$s/$r");
-	    plog('DEBUG', "Adding dependency $_ ($prefix)") foreach @deps;
-
-	    $pkg_tree{$prefix}{deps} = \@deps;
-	}
-    }
-
-    sub done_func {
-	my ($_todo, $f, $m, $s, $r) = @_;
-
-	my $media = "$m/$s";
-
-	if ($r =~ /^(\d{14}\.\w+\.\w+\.\d+)([_.].+)$/) {
-	    my ($prefix, $suffix) = ($1, $2);
-	    $pkg_tree{$prefix}{media}{$media}{path} = "/$f/$m/$s";
-	    if ($suffix =~ /^_(.*\.([^.]+)\.rpm)$/) {
-		my ($rpm, $arch) = ($1, $2);
-		$arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
-		plog('DEBUG', "found already built rpm $rpm ($prefix) for media $media");
-		$pkg_tree{$prefix}{target} = $f;
-		if ($arch eq 'src') {
-		    $pkg_tree{$prefix}{media}{$media}{arch}{src} = 1;
-		}
-		push @{$pkg_tree{$prefix}{media}{$media}{rpms}} , $rpm;
-		push @{$pkg_tree{$prefix}{rpms}} , $rpm;
-	    } elsif ($suffix =~ /^_(\w+)\.(\w+)$/) {
-		my ($arch, $result) = ($1, $2);
-		plog('DEBUG', "found .$result ($prefix) for $arch");
-		if ($result eq 'done') {
-		    $pkg_tree{$prefix}{media}{$media}{arch}{$arch} = 1;
-		} elsif ($result eq 'excluded') {
-		    $arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
-		    $pkg_tree{$prefix}{media}{$media}{excluded_arch}{$arch} = 1;
-		} elsif ($result eq 'fail') {
-		    $pkg_tree{$prefix}{media}{$media}{failed_arch}{$arch} = 1;
-		} else {
-		    plog('WARNING', "unknown state $arch.$result for $prefix");
-		}
-	    } elsif ($suffix =~ /^\.(\w+)$/) {
-		my $action = $1;
-		if ($action eq 'upload') {
-		    plog('DEBUG', "found already uploaded ($prefix)");
-		    $pkg_tree{$prefix}{media}{$media}{uploaded} = 1;
-		}
-	    }
-	}
-    }
+sub check_file_timeout {
+    my ($file, $time) = @_;
 
-    apply_to_upload_tree($done, \&done_func);
-    apply_to_upload_tree($todo, \&todo_func);
+    my $i = 0;
+    while ($i < $time && (!-f $file || -z $file)) { sleep 1; $i++ }
 
-    return %pkg_tree;
+    $i == $time;
 }
 
 sub read_line {
diff --git a/lib/Iurt/Ulri.pm b/lib/Iurt/Ulri.pm
index 4140678..0f83897 100755
--- a/lib/Iurt/Ulri.pm
+++ b/lib/Iurt/Ulri.pm
@@ -4,6 +4,7 @@ use base qw(Exporter);
 use File::Path qw(make_path);
 use File::Temp qw(mktemp);
 use Iurt::Config qw(get_author_email);
+use Iurt::File qw(check_file_timeout);
 use Iurt::Util qw(plog ssh_setup ssh sput);
 use strict;
 
@@ -122,15 +123,6 @@ sub build_package {
     return $pid;
 }
 
-sub check_file_timeout {
-    my ($file, $time) = @_;
-
-    my $i = 0;
-    while ($i < $time && (!-f $file || -z $file)) { sleep 1; $i++ }
-
-    $i == $time;
-}
-
 sub exclude_machine {
     my ($config, $host) = @_;
     plog('INFO', "Excluding build host $host");
diff --git a/ulri b/ulri
index e373419..5cd8f1e 100755
--- a/ulri
+++ b/ulri
@@ -34,8 +34,9 @@
 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::File qw(create_file);
 use Iurt::Process qw(check_pid);
-use Iurt::File qw(cleanup_failed_build get_upload_tree_state);
+use Iurt::Queue qw(cleanup_failed_build get_upload_tree_state);
 use Iurt::Mail qw(sendmail);
 use Iurt::Util qw(plog_init plog ssh_setup ssh sout sget sput);
 use Iurt::Ulri qw(build_package warn_about_failure);
@@ -577,14 +578,6 @@ plog('INFO', "jobs in queue:", %to_compile ?
 unlink $pidfile;
 exec "emi" if $something_finished;
 
-sub create_file {
-    my $file = shift;
-    my @contents = @_;
-
-    open my $FILE, ">$file" or die "FATAL: can't open $file for writing";
-    print $FILE "@contents";
-}
-
 __END__
 
 # ulri ends here