From fac50755655f574662ac8766fb29e0211116c096 Mon Sep 17 00:00:00 2001 From: Andreas Guldstrand Date: Sat, 14 Nov 2015 07:25:37 +0100 Subject: Change the way the build queue is made This fixes #2 --- SBO-Lib/lib/SBO/Lib.pm | 68 +++++++++++++++++++------------------------------- 1 file changed, 25 insertions(+), 43 deletions(-) (limited to 'SBO-Lib/lib/SBO/Lib.pm') diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 56bca0c..6a67820 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -941,59 +941,41 @@ sub get_requires { return $$info[0] ne '' ? $info : undef; } -# used by get_build_queue. -sub add_to_queue { - my $args = shift; - my $sbo = \${$args}{NAME}; - return unless $$sbo; - push @{ $args->{QUEUE} }, $$sbo; - my $requires = get_requires($$sbo); - FIRST: for my $req (@$requires) { - next FIRST if $req eq $$sbo; - if ($req eq "%README%") { - ${$args}{WARNINGS}{$$sbo}="%README%"; - } else { - $$sbo = $req; - add_to_queue($args); - } - } +sub _uniq { + my %seen; + return grep { !$seen{$_}++ } @_; +} + +sub _build_queue { + my ($sbos, $warnings) = @_; + my @queue = @$sbos; + my @result; + + while (my $sbo = shift @queue) { + next if $sbo eq "%README%"; + my $reqs = get_requires($sbo); + if (defined $reqs) { + push @result, _build_queue($reqs, $warnings); + foreach my $req (@$reqs) { + $warnings->{$sbo}="%README%" if $req eq "%README%"; + } + } + push @result, $sbo; + } + + return _uniq @result; } -# recursively add a sbo's requirements to the build queue. sub get_build_queue { - exists $_[1] or script_error('get_build_queue requires two arguments.'); - my ($sbos, $warnings) = @_; - my $temp_queue = []; - for my $sbo (@$sbos) { - my %args = ( - QUEUE => $temp_queue, - NAME => $sbo, - WARNINGS => $warnings - ); - add_to_queue(\%args); - } - # Remove duplicate entries (leaving last occurrence) - my @build_queue = reverse @$temp_queue; - my %seen; - @build_queue = grep {!$seen{$_}++} @build_queue; - @build_queue = reverse @build_queue; - return \@build_queue; + return [ _build_queue(@_) ]; } sub merge_queues { # Usage: merge_queues(\@queue_a, \@queue_b); # Results in queue_b being merged into queue_a (without duplicates) exists $_[1] or script_error('merge_queues requires two arguments.'); - my $queue_a = $_[0]; - my $queue_b = $_[1]; - - my %queue_a; - $queue_a{$_} = 1 for @$queue_a; - for my $item (reverse @$queue_b) { - push @$queue_a, $item unless $queue_a{$item}; - } - return $queue_a; + return [ _uniq @{$_[0]}, @{$_[1]} ]; } sub get_readme_contents { -- cgit v1.2.3