diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2007-09-28 10:00:27 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2007-09-28 10:00:27 +0000 |
commit | 0a394dc8a493fe78a09f0d73879f3be9b317b574 (patch) | |
tree | 71e7dca170b69c0804005026ef39b9221a2ba85b /URPM/Resolve.pm | |
parent | 113669c5e2093fd35676847f1a7b6224f579db08 (diff) | |
download | perl-URPM-0a394dc8a493fe78a09f0d73879f3be9b317b574.tar perl-URPM-0a394dc8a493fe78a09f0d73879f3be9b317b574.tar.gz perl-URPM-0a394dc8a493fe78a09f0d73879f3be9b317b574.tar.bz2 perl-URPM-0a394dc8a493fe78a09f0d73879f3be9b317b574.tar.xz perl-URPM-0a394dc8a493fe78a09f0d73879f3be9b317b574.zip |
- create _add_group() out of sort_graph() for future use
- cleanup
Diffstat (limited to 'URPM/Resolve.pm')
-rw-r--r-- | URPM/Resolve.pm | 51 |
1 files changed, 26 insertions, 25 deletions
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm index ebe27d2..82a1890 100644 --- a/URPM/Resolve.pm +++ b/URPM/Resolve.pm @@ -1525,6 +1525,29 @@ sub reverse_multi_hash { \%r; } +sub _merge_2_groups { + my ($groups, $l1, $l2) = @_; + my $l = [ @$l1, @$l2 ]; + $groups->{$_} = $l foreach @$l; + $l; +} +sub _add_group { + my ($groups, $group) = @_; + + my ($main, @other) = uniq(grep { $_ } map { $groups->{$_} } @$group); + $main ||= []; + if (@other) { + $main = _merge_2_groups($groups, $main, $_) foreach @other; + } + foreach (grep { !$groups->{$_} } @$group) { + $groups->{$_} ||= $main; + push @$main, $_; + my @l_ = uniq(@$main); + @l_ == @$main or die ''; + } + # warn "# groups: ", join(' ', map { join('+', @$_) } uniq(values %$groups)), "\n"; +} + #- nb: this handles $nodes list not containing all $nodes that can be seen in $edges #- #- side-effects: none @@ -1537,28 +1560,6 @@ sub sort_graph { my %nodes_h = map { $_ => 1 } @$nodes; my (%loops, %added, @sorted); - my $merge_loops = sub { - my ($l1, $l2) = @_; - my $l = [ @$l1, @$l2 ]; - $loops{$_} = $l foreach @$l; - $l; - }; - my $add_loop = sub { - my (@ids) = @_; - my ($main, @other) = uniq(grep { $_ } map { $loops{$_} } @ids); - $main ||= []; - if (@other) { - $main = $merge_loops->($main, $_) foreach @other; - } - foreach (grep { !$loops{$_} } @ids) { - $loops{$_} ||= $main; - push @$main, $_; - my @l_ = uniq(@$main); - @l_ == @$main or die ''; - } -# warn "# loops: ", join(' ', map { join('+', @$_) } uniq(values %loops)), "\n"; - }; - my $recurse; $recurse = sub { my ($id, @ids) = @_; # warn "# recurse $id @ids\n"; @@ -1573,13 +1574,13 @@ sub sort_graph { my $begin = 1; my @l = grep { $begin &&= $_ != $p_id } @ids; $loop_ahead = 1; - $add_loop->($p_id, $id, @l); + _add_group(\%loops, [ $p_id, $id, @l ]); } elsif ($loops{$p_id}) { my $take; if (my @l = grep { $take ||= $loops{$_} && $loops{$_} == $loops{$p_id} } reverse @ids) { $loop_ahead = 1; # warn "# loop to existing one $p_id, $id, @l\n"; - $add_loop->($p_id, $id, @l); + _add_group(\%loops, [ $p_id, $id, @l ]); } } else { $recurse->($p_id, $id, @ids); @@ -1643,7 +1644,7 @@ sub _sort_by_dependencies__add_obsolete_edges { my %fullnames = map { scalar($urpm->{depslist}[$_]->fullname) => $_ } @$l; foreach my $group (@groups) { - my @group = map { $fullnames{$_} } @$group; + my @group = grep { defined $_ } map { $fullnames{$_} } @$group; foreach (@group) { @{$requires->{$_}} = uniq(@{$requires->{$_}}, @group); } |