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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
package URPM;
use strict;
use vars qw($VERSION @ISA);
require DynaLoader;
@ISA = qw(DynaLoader);
$VERSION = '0.03';
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) {
$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;
}
#- resolve requires using requested tag, keep resolution state to speed process.
#- a requested package is marked to be installed, once done, a upgrade flag or
#- installed flag is set according to needs of package.
#- other required package will have required flag set along with upgrade flag or
#- installed flag.
#- base flag should always been installed or upgraded.
#- the following options are recognized :
#- check : check requires of installed packages.
sub resolve_requires {
my ($urpm, $db, $state, %options);
my (@packages);
#- get package that need to be evaluated.
foreach (0 .. $#{$urpm->{depslist}}) {
my $pkg = $urpm->{depslist}[$_];
$pkg->flag_requested && !($pkg->flag_installed || $pkg->flag_upgrade) and push @packages, $_;
}
#TODO
}
|
