Move most of emi code to library functions

2 files changed, 178 insertions, 156 deletions

diff --git a/emi b/emi
index d6f1b6d..fa5035e 100755
--- a/emi
+++ b/emi
@@ -34,6 +34,7 @@ use Iurt::Process qw(check_pid);
 use Iurt::Mail qw(sendmail);
 use Iurt::File 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;
 use MDK::Common qw(cat_ if_ find touch);
 use MDK::Common::DataStructure qw(difference2);
@@ -119,162 +120,7 @@ my $done = "$config->{queue}/done";
 my $reject = "$config->{queue}/rejected";
 
 my %pkg_tree = get_upload_tree_state($config);
-
-#
-# Decide what should be uploaded
-#
-
-# $targets{$target}{$media}{arch_finisher}{$arch}: prefix on which we need to actions to get this arch updated
-# $targets{$target}{$media}{to_upload}: list of prefixes to upload
-my %targets;
-
-foreach my $prefix (sort keys %pkg_tree) {
-    my $target = $pkg_tree{$prefix}{target};
-    my $mandatory_arch = get_mandatory_arch($config, $target);
-
-    plog('NOTIFY', "processing $prefix");
-
-    my $ok = 1;
-
-    foreach my $media (keys %{$pkg_tree{$prefix}{media}}) {
-	my @wanted_archs = defined($pkg_tree{$prefix}{media}{$media}{arch}{noarch}) ? 'noarch' : @$mandatory_arch;
-	my $path = $pkg_tree{$prefix}{media}{$media}{path};
-	my %missing;
-
-	plog('DEBUG', "... in $path");
-
-	if ($pkg_tree{$prefix}{media}{$media}{uploaded}) {
-	    plog('INFO', "package already uploaded for mandatory arches, proceeding");
-	    next;
-	}
-
-	foreach my $m (@wanted_archs, 'src') {
-	    $pkg_tree{$prefix}{media}{$media}{excluded_arch}{$m} and next;
-	    my $x = "yes";
-	    if (!$pkg_tree{$prefix}{media}{$media}{arch}{$m}) {
-		$missing{$m} = 1;
-		$x = "no";
-		$ok = 0;
-	    }
-	    plog('INFO', " mandatory architecture $m present: $x");
-	}
-	
-	unless ($ok) {
-	    plog('INFO', "mandatory arch", join(' ', keys %missing),
-				"missing for $media, waiting");
-	    next;
-	}
-    }
-    next unless $ok;
-    
-    #
-    # All mandatory archs found, mark for upload
-    #
-    foreach my $media (keys %{$pkg_tree{$prefix}{media}}) {
-	$targets{$target}{$media} ||= { 'arch_finisher' => {}, 'is_finisher' => {}, 'to_upload' => [] };
-
-	push @{$targets{$target}{$media}{to_upload}}, $prefix;
-
-	# We already have found universal finisher in that media, we're fine
-	next if exists $targets{$target}{$media}{arch_finisher}{noarch};
-
-	if ($pkg_tree{$prefix}{media}{$media}{arch}{noarch}) {
-	    # This package is noarch, genhdlist for it will touch all archs
-	    $targets{$target}{$media}{arch_finisher} = { 'noarch' => $prefix };
-	} else {
-	    my $has_new_arch = scalar(difference2([ keys %{$pkg_tree{$prefix}{media}{$media}{arch}} ], [ keys %{$targets{$target}{$media}{arch_finisher}} ]));
-	    if ($has_new_arch) {
-		# We need this package to cover the new arch
-		# Set it for all, it may allow getting rid of some others
-		foreach (keys %{$pkg_tree{$prefix}{media}{$media}{arch}}) {
-		    $targets{$target}{$media}{arch_finisher}{$_} = $prefix;
-		}
-	    }
-	}
-    }
-}
-
-sub upload_prefix_in_media {
-    my ($prefix, $media, $o_finish) = @_;
-    my (@packages, @duplicate_packages);
-    my ($user) = $prefix =~ /\d{14}\.(\w+)\.\w+\.\d+$/;
-    my $target = $pkg_tree{$prefix}{target};
-    my $youri_file = "$prefix.youri";
-    if ($pkg_tree{$prefix}{media}{$media}{uploaded})  {
-        $youri_file .= "." . time();
-    }
-
-    my $path = $pkg_tree{$prefix}{media}{$media}{path};
-    
-    plog('OK', "all mandatory archs done: $prefix");
-    foreach my $rpm (@{$pkg_tree{$prefix}{media}{$media}{rpms}}) {
-	my $rpmpath = "$done/$path/${prefix}_$rpm";
-	if ($pkg_tree{$prefix}{media}{$media}{uploaded})  {
-	    # if already uploaded for mandatory arches, do not try to upload again src or noarch packages
-	    # but still remember these duplicate files for removal
-	    if (my ($type) = $rpm =~ /\.(noarch|src)\.rpm$/) {
-		plog('DEBUG', "$prefix already uploaded for mandatory arches, not re-uploading $type $rpm");
-		push @duplicate_packages, $rpmpath;
-		next;
-	    }
-	}
-	push @packages, $rpmpath;
-	plog('OK', " uploading $rpm in $done/$path");
-    }
-    
-    $user ||= $config->{upload_user};
-    # FIXME we want to skip all post, we should not hardcode them here
-    my $skip = $o_finish ? "" : "--skip-post genhdlist2 --skip-post mirror --skip-post clean_rpmsrate";
-    my $command = "/usr/bin/perl -I/usr/share/mga-youri-submit/lib /usr/share/mga-youri-submit/bin/youri-submit --verbose --config /etc/youri/submit-upload.conf --define user=$user --define prefix=$prefix --define section=$media $skip $target @packages &> $done/$path/$youri_file";
-    
-    plog('DEBUG', "running $command");
-    if (!system($command)) {
-	plog('INFO', "upload succeeded");
-    } else {
-	# should send a mail or something
-	plog('ERROR', "upload failed ($!), rejecting files in $reject/$path/");
-	make_path("$reject/$path");
-	foreach my $rpm (@{$pkg_tree{$prefix}{media}{$media}{rpms}}) {
-	    link("$done/$path/${prefix}_$rpm", "$reject/$path/${prefix}_$rpm") or plog('ERROR', "ERROR: link of $rpm failed ($!)");
-	}
-	link("$done/$path/$youri_file", "$reject/$path/$youri_file");
-	
-	my ($user) = $prefix =~ /\d{14}\.(\w+)\.\w+\.\d+/;
-	if ($user) {
-	    my @pkgs = grep { !/src\.rpm$/ } @{$pkg_tree{$prefix}{media}{$media}{rpms}};
-	    my $text = join("\n", qq(The upload of the following packages failed:\n), map { "- $_" } @pkgs) . "\n";
-	    my $rpms = join(' ', @pkgs, undef);
-	    my $to =  get_author_email($user) || "Unknown <$config->{admin}>";
-	    $text .= "\nUpload log available in $config->{http_queue}/rejected/$path/$youri_file\n";
-	    
-	    sendmail($to, undef, "Upload failed for $rpms", $text, "Emi the upload bot <$config->{admin}>", 0, $config);
-	}
-	
-	# should delete the files
-    }
-
-    # delete the files which should have heen either put in queue or rejected
-    unlink(@packages, @duplicate_packages);
-    
-    # unlink the sources rpm unless some non mandatory arch still need to be done
-    my $all_done = 1;
-    if (!defined($pkg_tree{$prefix}{media}{$media}{arch}{noarch})) {
-	my $arch_list = find { ref($_) eq 'ARRAY' } $config->{arch}, (ref($config->{arch}) eq 'HASH' ? ($config->{arch}{$target}, $config->{arch}{default}) : ());
-	my @arch_list = $arch_list ? @$arch_list : keys %{$config->{bot}};
-	# If we are here, mandatory arches are done, no need to check them
-	my $mandatory_arch = get_mandatory_arch($config, $target);
-	foreach my $arch (difference2(\@arch_list, $mandatory_arch)) {
-	    next if $pkg_tree{$prefix}{media}{$media}{arch}{$arch};
-	    $all_done = 0;
-	}
-    }
-    if ($all_done) {
-	foreach (@{$pkg_tree{$prefix}{srpms}}) {
-	    plog('DEBUG', "unlink $todo/$path/${prefix}_$_");
-	    unlink("$todo/$path/${prefix}_$_");
-	}
-    }
-}
+my %targets = find_prefixes_ready_to_upload($config, %pkg_tree);
 
 foreach my $target (keys %targets) {
     foreach my $media (keys %{$targets{$target}}) {
diff --git a/lib/Iurt/Emi.pm b/lib/Iurt/Emi.pm
new file mode 100644
index 0000000..cce3aed
--- /dev/null
+++ b/lib/Iurt/Emi.pm
@@ -0,0 +1,176 @@
+package Iurt::Emi;
+
+use base qw(Exporter);
+use File::Path qw(make_path);
+use Iurt::Config qw(get_author_email get_mandatory_arch);
+use Iurt::Mail qw(sendmail);
+use Iurt::Util qw(plog);
+use MDK::Common::Func qw(find);
+use MDK::Common::DataStructure qw(difference2);
+use strict;
+
+our @EXPORT = qw(
+    find_prefixes_ready_to_upload
+    upload_prefix_in_media
+);
+
+sub find_prefixes_ready_to_upload {
+    my ($config, %pkg_tree) = @_;
+
+    # $targets{$target}{$media}{arch_finisher}{$arch}: prefix on which we need to actions to get this arch updated
+    # $targets{$target}{$media}{to_upload}: list of prefixes to upload
+    my %targets;
+
+    foreach my $prefix (sort keys %pkg_tree) {
+	my $target = $pkg_tree{$prefix}{target};
+	my $mandatory_arch = get_mandatory_arch($config, $target);
+
+	plog('NOTIFY', "processing $prefix");
+
+	my $ok = 1;
+
+	foreach my $media (keys %{$pkg_tree{$prefix}{media}}) {
+	    my @wanted_archs = defined($pkg_tree{$prefix}{media}{$media}{arch}{noarch}) ? 'noarch' : @$mandatory_arch;
+	    my $path = $pkg_tree{$prefix}{media}{$media}{path};
+	    my %missing;
+
+	    plog('DEBUG', "... in $path");
+
+	    if ($pkg_tree{$prefix}{media}{$media}{uploaded}) {
+		plog('INFO', "package already uploaded for mandatory arches, proceeding");
+		next;
+	    }
+
+	    foreach my $m (@wanted_archs, 'src') {
+		$pkg_tree{$prefix}{media}{$media}{excluded_arch}{$m} and next;
+		my $x = "yes";
+		if (!$pkg_tree{$prefix}{media}{$media}{arch}{$m}) {
+		    $missing{$m} = 1;
+		    $x = "no";
+		    $ok = 0;
+		}
+		plog('INFO', " mandatory architecture $m present: $x");
+	    }
+
+	    unless ($ok) {
+		plog('INFO', "mandatory arch", join(' ', keys %missing),
+		     "missing for $media, waiting");
+		next;
+	    }
+	}
+	next unless $ok;
+
+	#
+	# All mandatory archs found, mark for upload
+	#
+	foreach my $media (keys %{$pkg_tree{$prefix}{media}}) {
+	    $targets{$target}{$media} ||= { 'arch_finisher' => {}, 'is_finisher' => {}, 'to_upload' => [] };
+
+	    push @{$targets{$target}{$media}{to_upload}}, $prefix;
+
+	    # We already have found universal finisher in that media, we're fine
+	    next if exists $targets{$target}{$media}{arch_finisher}{noarch};
+
+	    if ($pkg_tree{$prefix}{media}{$media}{arch}{noarch}) {
+		# This package is noarch, genhdlist for it will touch all archs
+		$targets{$target}{$media}{arch_finisher} = { 'noarch' => $prefix };
+	    } else {
+		my $has_new_arch = scalar(difference2([ keys %{$pkg_tree{$prefix}{media}{$media}{arch}} ], [ keys %{$targets{$target}{$media}{arch_finisher}} ]));
+		if ($has_new_arch) {
+		    # We need this package to cover the new arch
+		    # Set it for all, it may allow getting rid of some others
+		    foreach (keys %{$pkg_tree{$prefix}{media}{$media}{arch}}) {
+			$targets{$target}{$media}{arch_finisher}{$_} = $prefix;
+		    }
+		}
+	    }
+	}
+    }
+
+    return %targets;
+}
+
+sub upload_prefix_in_media {
+    my ($config, %pkg_tree, $prefix, $media, $o_finish) = @_;
+    my $todo = "$config->{queue}/todo";
+    my $done = "$config->{queue}/done";
+    my $reject = "$config->{queue}/rejected";
+    my (@packages, @duplicate_packages);
+    my ($user) = $prefix =~ /\d{14}\.(\w+)\.\w+\.\d+$/;
+    my $target = $pkg_tree{$prefix}{target};
+    my $youri_file = "$prefix.youri";
+    if ($pkg_tree{$prefix}{media}{$media}{uploaded})  {
+        $youri_file .= "." . time();
+    }
+
+    my $path = $pkg_tree{$prefix}{media}{$media}{path};
+
+    plog('OK', "all mandatory archs done: $prefix");
+    foreach my $rpm (@{$pkg_tree{$prefix}{media}{$media}{rpms}}) {
+	my $rpmpath = "$done/$path/${prefix}_$rpm";
+	if ($pkg_tree{$prefix}{media}{$media}{uploaded})  {
+	    # if already uploaded for mandatory arches, do not try to upload again src or noarch packages
+	    # but still remember these duplicate files for removal
+	    if (my ($type) = $rpm =~ /\.(noarch|src)\.rpm$/) {
+		plog('DEBUG', "$prefix already uploaded for mandatory arches, not re-uploading $type $rpm");
+		push @duplicate_packages, $rpmpath;
+		next;
+	    }
+	}
+	push @packages, $rpmpath;
+	plog('OK', " uploading $rpm in $done/$path");
+    }
+
+    $user ||= $config->{upload_user};
+    # FIXME we want to skip all post, we should not hardcode them here
+    my $skip = $o_finish ? "" : "--skip-post genhdlist2 --skip-post mirror --skip-post clean_rpmsrate";
+    my $command = "/usr/bin/perl -I/usr/share/mga-youri-submit/lib /usr/share/mga-youri-submit/bin/youri-submit --verbose --config /etc/youri/submit-upload.conf --define user=$user --define prefix=$prefix --define section=$media $skip $target @packages &> $done/$path/$youri_file";
+
+    plog('DEBUG', "running $command");
+    if (!system($command)) {
+	plog('INFO', "upload succeeded");
+    } else {
+	# should send a mail or something
+	plog('ERROR', "upload failed ($!), rejecting files in $reject/$path/");
+	make_path("$reject/$path");
+	foreach my $rpm (@{$pkg_tree{$prefix}{media}{$media}{rpms}}) {
+	    link("$done/$path/${prefix}_$rpm", "$reject/$path/${prefix}_$rpm") or plog('ERROR', "ERROR: link of $rpm failed ($!)");
+	}
+	link("$done/$path/$youri_file", "$reject/$path/$youri_file");
+
+	my ($user) = $prefix =~ /\d{14}\.(\w+)\.\w+\.\d+/;
+	if ($user) {
+	    my @pkgs = grep { !/src\.rpm$/ } @{$pkg_tree{$prefix}{media}{$media}{rpms}};
+	    my $text = join("\n", qq(The upload of the following packages failed:\n), map { "- $_" } @pkgs) . "\n";
+	    my $rpms = join(' ', @pkgs, undef);
+	    my $to =  get_author_email($user) || "Unknown <$config->{admin}>";
+	    $text .= "\nUpload log available in $config->{http_queue}/rejected/$path/$youri_file\n";
+
+	    sendmail($to, undef, "Upload failed for $rpms", $text, "Emi the upload bot <$config->{admin}>", 0, $config);
+	}
+
+	# should delete the files
+    }
+
+    # delete the files which should have heen either put in queue or rejected
+    unlink(@packages, @duplicate_packages);
+
+    # unlink the sources rpm unless some non mandatory arch still need to be done
+    my $all_done = 1;
+    if (!defined($pkg_tree{$prefix}{media}{$media}{arch}{noarch})) {
+	my $arch_list = find { ref($_) eq 'ARRAY' } $config->{arch}, (ref($config->{arch}) eq 'HASH' ? ($config->{arch}{$target}, $config->{arch}{default}) : ());
+	my @arch_list = $arch_list ? @$arch_list : keys %{$config->{bot}};
+	# If we are here, mandatory arches are done, no need to check them
+	my $mandatory_arch = get_mandatory_arch($config, $target);
+	foreach my $arch (difference2(\@arch_list, $mandatory_arch)) {
+	    next if $pkg_tree{$prefix}{media}{$media}{arch}{$arch};
+	    $all_done = 0;
+	}
+    }
+    if ($all_done) {
+	foreach (@{$pkg_tree{$prefix}{srpms}}) {
+	    plog('DEBUG', "unlink $todo/$path/${prefix}_$_");
+	    unlink("$todo/$path/${prefix}_$_");
+	}
+    }
+}