1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
package URPM;
use strict;
use vars qw($VERSION @ISA);
require DynaLoader;
@ISA = qw(DynaLoader);
$VERSION = '0.04';
bootstrap URPM $VERSION;
sub new {
my ($class) = @_;
bless {
depslist => [],
provides => {},
}, $class;
}
sub traverse {
my ($urpm, $callback) = @_;
if ($callback) {
foreach (@{$urpm->{depslist} || []}) {
$callback->($_);
}
}
scalar @{$urpm->{depslist} || []};
}
sub traverse_tag {
my ($urpm, $tag, $names, $callback) = @_;
my ($count, %names) = (0);
if (@{$names || []}) {
@names{@$names} = ();
if ($tag eq 'name') {
foreach (@{$urpm->{depslist} || []}) {
if (exists $names{$_->name}) {
$callback and $callback->($_);
++$count;
}
}
} elsif ($tag eq 'whatprovides') {
foreach (@$names) {
foreach (keys %{$urpm->{provides}{$_} || {}}) {
$callback and $callback->($urpm->{depslist}[$_]);
++$count;
}
}
} elsif ($tag eq 'whatrequires') {
foreach (@{$urpm->{depslist} || []}) {
if (grep { /^([^ \[]*)/ && exists $names{$1} } $_->requires) {
$callback and $callback->($_);
++$count;
}
}
} elsif ($tag eq 'group') {
foreach (@{$urpm->{depslist} || []}) {
if (exists $names{$_->group}) {
$callback and $callback->($_);
++$count;
}
}
} elsif ($tag eq 'triggeredby' || $tag eq 'path') {
foreach (@{$urpm->{depslist} || []}) {
if (grep { exists $names{$_} } $_->files, grep { /^\// } $_->provides_nosense) {
$callback and $callback->($_);
++$count;
}
}
} else {
die "unknown tag";
}
}
$count;
}
#- relocate depslist array id to use only the most recent packages,
#- reorder info hashes to give only access to best packages.
sub relocate_depslist {
my ($urpm, %options) = @_;
my $relocated_entries = 0;
#- reset names hash now, will be filled after.
$urpm->{names} = {};
foreach (@{$urpm->{depslist} || []}) {
#- remove access to info if arch is incompatible and only
#- take into account compatible arch to examine.
#- set names hash by prefering first better version,
#- then better release, then better arch.
if ($_->is_arch_compat) {
my $p = $urpm->{names}{$_->name};
if ($p) {
if ($_->compare_pkg($p) > 0) {
$urpm->{names}{$_->name} = $_;
++$relocated_entries;
}
} else {
$urpm->{names}{$_->name} = $_;
}
} elsif ($_->arch ne 'src') {
#- the package is removed, make it invisible (remove id).
my $id = $_->set_id;
#- the architecture is not compatible, this means the package is dropped.
#- we have to remove its reference in provides.
foreach ($_->provides) {
delete $urpm->{provides}{$_}{$id};
}
}
}
#- relocate id used in depslist array, delete id if the package
#- should NOT be used.
#- if no entries have been relocated, we can safely avoid this computation.
if ($relocated_entries) {
foreach (@{$urpm->{depslist}}) {
my $p = $urpm->{names}{$_->name} or next;
$_->set_id($p->id);
}
}
$relocated_entries;
}
|
