| 1 |
package urpm; |
| 2 |
|
| 3 |
# $Id: urpm.pm 271301 2010-11-22 00:50:49Z eugeni $ |
| 4 |
|
| 5 |
no warnings 'utf8'; |
| 6 |
use strict; |
| 7 |
use File::Find (); |
| 8 |
use urpm::msg; |
| 9 |
use urpm::download; |
| 10 |
use urpm::util qw(basename begins_with cat_ cat_utf8 dirname file2absolute_file member); |
| 11 |
use urpm::sys; |
| 12 |
use urpm::cfg; |
| 13 |
use urpm::md5sum; |
| 14 |
# perl_checker: require urpm::args |
| 15 |
# perl_checker: require urpm::media |
| 16 |
# perl_checker: require urpm::parallel |
| 17 |
|
| 18 |
our $VERSION = '7.21'; |
| 19 |
our @ISA = qw(URPM Exporter); |
| 20 |
our @EXPORT_OK = ('file_from_local_url', 'file_from_local_medium', 'is_local_medium'); |
| 21 |
|
| 22 |
# Prepare exit code. If you change this, the exiting with a failure and the message given will be postponed to the end of the overall processing. |
| 23 |
our $postponed_msg = N("While some packages may have been installed, there were failures.\n"); |
| 24 |
our $postponed_code = 0; |
| 25 |
|
| 26 |
use URPM; |
| 27 |
use URPM::Resolve; |
| 28 |
|
| 29 |
|
| 30 |
=head1 NAME |
| 31 |
|
| 32 |
urpm - Mageia perl tools to handle the urpmi database |
| 33 |
|
| 34 |
=head1 DESCRIPTION |
| 35 |
|
| 36 |
C<urpm> is used by urpmi executables to manipulate packages and media |
| 37 |
on a Mageia Linux distribution. |
| 38 |
|
| 39 |
=head2 The urpm class |
| 40 |
|
| 41 |
=over 4 |
| 42 |
|
| 43 |
=cut |
| 44 |
|
| 45 |
#- this violently overrides is_arch_compat() to always return true. |
| 46 |
sub shunt_ignorearch { |
| 47 |
eval q( sub URPM::Package::is_arch_compat { 1 } ); |
| 48 |
} |
| 49 |
|
| 50 |
sub xml_info_policies() { qw(never on-demand update-only always) } |
| 51 |
|
| 52 |
sub default_options { |
| 53 |
{ |
| 54 |
'split-level' => 1, |
| 55 |
'split-length' => 8, |
| 56 |
'verify-rpm' => 1, |
| 57 |
'post-clean' => 1, |
| 58 |
'xml-info' => 'on-demand', |
| 59 |
'max-round-robin-tries' => 5, |
| 60 |
'max-round-robin-probes' => 2, |
| 61 |
'days-between-mirrorlist-update' => 5, |
| 62 |
'nb-of-new-unrequested-pkgs-between-auto-select-orphans-check' => 10, |
| 63 |
}; |
| 64 |
} |
| 65 |
|
| 66 |
=item urpm->new() |
| 67 |
|
| 68 |
The constructor creates a new urpm object. It's a blessed hash that |
| 69 |
contains fields from L<URPM>, and also the following fields: |
| 70 |
|
| 71 |
B<source>: { id => src_rpm_file|spec_file } |
| 72 |
|
| 73 |
B<media>: [ { |
| 74 |
start => int, end => int, name => string, url => string, |
| 75 |
virtual => bool, media_info_dir => string, with_synthesis => string, |
| 76 |
no-media-info => bool, |
| 77 |
iso => string, downloader => string, |
| 78 |
ignore => bool, update => bool, modified => bool, really_modified => bool, |
| 79 |
unknown_media_info => bool, |
| 80 |
} ], |
| 81 |
|
| 82 |
B<options>: hashref of urpm options |
| 83 |
|
| 84 |
several paths: |
| 85 |
|
| 86 |
=over |
| 87 |
|
| 88 |
B<config>: path of urpmi.cfg (/etc/urpmi/urpmi.cfg) |
| 89 |
|
| 90 |
B<mediacfgdir>: path of mediacfg.d (/etc/urpmi/mediacfg.d) |
| 91 |
|
| 92 |
B<skiplist>: path of skip.list (/etc/urpmi/skip.list), |
| 93 |
|
| 94 |
B<instlist>: path of inst.list (/etc/urpmi/inst.list), |
| 95 |
|
| 96 |
B<prefer_list>: path of prefer.list (/etc/urpmi/prefer.list), |
| 97 |
|
| 98 |
B<prefer_vendor_list>: path of prefer.vendor.list (/etc/urpmi/prefer.vendor.list), |
| 99 |
|
| 100 |
B<private_netrc>: path of netrc (/etc/urpmi/netrc), |
| 101 |
|
| 102 |
B<statedir>: state directory (/var/lib/urpmi), |
| 103 |
|
| 104 |
B<cachedir>: cache directory (/var/cache/urpmi), |
| 105 |
|
| 106 |
B<root>: path of the rooted system (when using global urpmi config), |
| 107 |
|
| 108 |
B<urpmi_root>: path of the rooted system (when both urpmi & rpmdb are chrooted) |
| 109 |
|
| 110 |
=back |
| 111 |
|
| 112 |
Several subs: |
| 113 |
|
| 114 |
=over |
| 115 |
|
| 116 |
B<fatal>: sub for relaying fatal errors (should popup in GUIes) |
| 117 |
|
| 118 |
B<error>: sub for relaying other errors |
| 119 |
|
| 120 |
B<log>: sub for relaying messages if --verbose |
| 121 |
|
| 122 |
B<print>: sub for always displayed messages, enable to redirect output for eg: installer |
| 123 |
|
| 124 |
B<info>: sub for messages displayed unless --quiet |
| 125 |
|
| 126 |
=back |
| 127 |
|
| 128 |
All C<URPM> methods are available on an urpm object. |
| 129 |
|
| 130 |
=cut |
| 131 |
|
| 132 |
sub new { |
| 133 |
my ($class) = @_; |
| 134 |
my $self; |
| 135 |
$self = bless { |
| 136 |
# from URPM |
| 137 |
depslist => [], |
| 138 |
provides => {}, |
| 139 |
obsoletes => {}, |
| 140 |
|
| 141 |
media => undef, |
| 142 |
options => {}, |
| 143 |
|
| 144 |
fatal => sub { printf STDERR "%s\n", $_[1]; exit($_[0]) }, |
| 145 |
error => sub { printf STDERR "%s\n", $_[0] }, |
| 146 |
info => sub { printf "%s\n", $_[0] }, #- displayed unless --quiet |
| 147 |
log => sub { printf "%s\n", $_[0] }, #- displayed if --verbose |
| 148 |
print => sub { printf "%s\n", $_[0] }, #- always displayed, enable to redirect output for eg: installer |
| 149 |
}, $class; |
| 150 |
|
| 151 |
set_files($self, ''); |
| 152 |
$self->set_nofatal(1); |
| 153 |
$self; |
| 154 |
} |
| 155 |
|
| 156 |
=item urpm->new_parse_cmdline() |
| 157 |
|
| 158 |
Like urpm->new but also parse the command line and parse the configuration file. |
| 159 |
|
| 160 |
=cut |
| 161 |
|
| 162 |
sub new_parse_cmdline { |
| 163 |
my ($class) = @_; |
| 164 |
my $urpm = $class->new; |
| 165 |
urpm::args::parse_cmdline(urpm => $urpm); |
| 166 |
get_global_options($urpm); |
| 167 |
$urpm; |
| 168 |
} |
| 169 |
|
| 170 |
sub _add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { defined $a->{$k} or $a->{$k} = $v } $a } |
| 171 |
|
| 172 |
sub get_global_options { |
| 173 |
my ($urpm) = @_; |
| 174 |
|
| 175 |
my $config = urpm::cfg::load_config($urpm->{config}) |
| 176 |
or $urpm->{fatal}(6, $urpm::cfg::err); |
| 177 |
|
| 178 |
if (my $global = $config->{global}) { |
| 179 |
_add2hash($urpm->{options}, $global); |
| 180 |
} |
| 181 |
#- remember global options for write_config |
| 182 |
$urpm->{global_config} = $config->{global}; |
| 183 |
|
| 184 |
_add2hash($urpm->{options}, default_options()); |
| 185 |
} |
| 186 |
|
| 187 |
sub prefer_rooted { |
| 188 |
my ($root, $file) = @_; |
| 189 |
-e "$root$file" ? "$root$file" : $file; |
| 190 |
} |
| 191 |
|
| 192 |
sub check_dir { |
| 193 |
my ($urpm, $dir) = @_; |
| 194 |
-d $dir && ! -l $dir or $urpm->{fatal}(1, N("fail to create directory %s", $dir)); |
| 195 |
-o $dir && -w $dir or $urpm->{fatal}(1, N("invalid owner for directory %s", $dir)); |
| 196 |
} |
| 197 |
|
| 198 |
sub init_dir { |
| 199 |
my ($urpm, $dir) = @_; |
| 200 |
|
| 201 |
mkdir $dir, 0755; # try to create it |
| 202 |
|
| 203 |
check_dir($urpm, $dir); |
| 204 |
|
| 205 |
mkdir "$dir/partial"; |
| 206 |
mkdir "$dir/rpms"; |
| 207 |
|
| 208 |
$dir; |
| 209 |
} |
| 210 |
|
| 211 |
sub userdir_prefix { |
| 212 |
my ($_urpm) = @_; |
| 213 |
'/tmp/.urpmi-'; |
| 214 |
} |
| 215 |
|
| 216 |
sub valid_statedir { |
| 217 |
my ($urpm) = @_; |
| 218 |
$< or return; |
| 219 |
|
| 220 |
my $dir = ($urpm->{urpmi_root} || '') . userdir_prefix($urpm) . $< . "/lib"; |
| 221 |
init_dir($urpm, $dir); |
| 222 |
} |
| 223 |
|
| 224 |
sub userdir { |
| 225 |
#mdkonline uses userdir because it runs as user |
| 226 |
my ($urpm) = @_; |
| 227 |
$< or return; |
| 228 |
|
| 229 |
my $dir = ($urpm->{urpmi_root} || '') . userdir_prefix($urpm) . $<; |
| 230 |
init_dir($urpm, $dir); |
| 231 |
} |
| 232 |
|
| 233 |
sub ensure_valid_cachedir { |
| 234 |
my ($urpm) = @_; |
| 235 |
if (my $dir = userdir($urpm)) { |
| 236 |
$urpm->{cachedir} = $dir; |
| 237 |
} |
| 238 |
-w "$urpm->{cachedir}/partial" or $urpm->{fatal}(1, N("Can not download packages into %s", "$urpm->{cachedir}/partial")); |
| 239 |
} |
| 240 |
|
| 241 |
sub valid_cachedir { |
| 242 |
my ($urpm) = @_; |
| 243 |
userdir($urpm) || $urpm->{cachedir}; |
| 244 |
} |
| 245 |
|
| 246 |
sub is_temporary_file { |
| 247 |
my ($urpm, $f) = @_; |
| 248 |
|
| 249 |
begins_with($f, $urpm->{cachedir}); |
| 250 |
} |
| 251 |
|
| 252 |
sub set_env { |
| 253 |
my ($urpm, $env) = @_; |
| 254 |
-d $env or $urpm->{fatal}(8, N("Environment directory %s does not exist", $env)); |
| 255 |
print N("using specific environment on %s\n", $env); |
| 256 |
#- setting new environment. |
| 257 |
$urpm->{config} = "$env/urpmi.cfg"; |
| 258 |
if (cat_($urpm->{config}) =~ /^\s*virtual\s*$/m) { |
| 259 |
print "dropping virtual from $urpm->{config}\n"; |
| 260 |
system(q(perl -pi -e 's/^\s*virtual\s*$//' ) . $urpm->{config}); |
| 261 |
} |
| 262 |
$urpm->{mediacfgdir} = "$env/mediacfg.d"; |
| 263 |
$urpm->{skiplist} = "$env/skip.list"; |
| 264 |
$urpm->{instlist} = "$env/inst.list"; |
| 265 |
$urpm->{prefer_list} = "$env/prefer.list"; |
| 266 |
$urpm->{prefer_vendor_list} = "$env/prefer.vendor.list"; |
| 267 |
$urpm->{statedir} = $env; |
| 268 |
$urpm->{env_rpmdb} = "$env/rpmdb.cz"; |
| 269 |
$urpm->{env_dir} = $env; |
| 270 |
} |
| 271 |
|
| 272 |
sub set_files { |
| 273 |
my ($urpm, $urpmi_root) = @_; |
| 274 |
|
| 275 |
$urpmi_root and $urpmi_root = file2absolute_file($urpmi_root); |
| 276 |
|
| 277 |
my %h = ( |
| 278 |
config => "$urpmi_root/etc/urpmi/urpmi.cfg", |
| 279 |
mediacfgdir => "$urpmi_root/etc/urpmi/mediacfg.d", |
| 280 |
skiplist => prefer_rooted($urpmi_root, '/etc/urpmi/skip.list'), |
| 281 |
instlist => prefer_rooted($urpmi_root, '/etc/urpmi/inst.list'), |
| 282 |
prefer_list => prefer_rooted($urpmi_root, '/etc/urpmi/prefer.list'), |
| 283 |
prefer_vendor_list => |
| 284 |
prefer_rooted($urpmi_root, '/etc/urpmi/prefer.vendor.list'), |
| 285 |
private_netrc => "$urpmi_root/etc/urpmi/netrc", |
| 286 |
statedir => "$urpmi_root/var/lib/urpmi", |
| 287 |
cachedir => "$urpmi_root/var/cache/urpmi", |
| 288 |
root => $urpmi_root, |
| 289 |
$urpmi_root ? (urpmi_root => $urpmi_root) : @{[]}, |
| 290 |
); |
| 291 |
$urpm->{$_} = $h{$_} foreach keys %h; |
| 292 |
|
| 293 |
create_var_lib_rpm($urpm, %h); |
| 294 |
|
| 295 |
# policy is too use chroot environment only for --urpmi-root, not for --root: |
| 296 |
if ($urpmi_root && -e "$urpmi_root/etc/rpm/macros") { |
| 297 |
URPM::loadmacrosfile("$urpmi_root/etc/rpm/macros"); |
| 298 |
} |
| 299 |
} |
| 300 |
|
| 301 |
sub create_var_lib_rpm { |
| 302 |
my ($urpm, %h) = @_; |
| 303 |
require File::Path; |
| 304 |
File::Path::mkpath([ $h{statedir}, |
| 305 |
(map { "$h{cachedir}/$_" } qw(partial rpms)), |
| 306 |
dirname($h{config}), |
| 307 |
"$urpm->{root}/var/lib/rpm", |
| 308 |
"$urpm->{root}/var/tmp", |
| 309 |
]); |
| 310 |
} |
| 311 |
|
| 312 |
sub modify_rpm_macro { |
| 313 |
my ($name, $to_remove, $to_add) = @_; |
| 314 |
|
| 315 |
my $val = URPM::expand('%' . $name); |
| 316 |
$val =~ s/$to_remove/$to_add/ or $val = join(' ', grep { $_ } $val, $to_add); |
| 317 |
URPM::add_macro("$name $val"); |
| 318 |
} |
| 319 |
|
| 320 |
sub set_tune_rpm { |
| 321 |
my ($urpm, $para) = @_; |
| 322 |
|
| 323 |
my %h = map { $_ => 1 } map { |
| 324 |
if ($_ eq 'all') { |
| 325 |
('nofsync', 'private'); |
| 326 |
} else { |
| 327 |
$_; |
| 328 |
} |
| 329 |
} split(',', $para); |
| 330 |
|
| 331 |
$urpm->{tune_rpm} = \%h; |
| 332 |
} |
| 333 |
|
| 334 |
sub tune_rpm { |
| 335 |
my ($urpm) = @_; |
| 336 |
|
| 337 |
if ($urpm->{tune_rpm}{nofsync}) { |
| 338 |
modify_rpm_macro('__dbi_other', 'fsync', 'nofsync'); |
| 339 |
} |
| 340 |
if ($urpm->{tune_rpm}{private}) { |
| 341 |
urpm::sys::clean_rpmdb_shared_regions($urpm->{root}); |
| 342 |
modify_rpm_macro('__dbi_other', 'usedbenv', 'private'); |
| 343 |
} |
| 344 |
} |
| 345 |
|
| 346 |
sub _blist_pkg_to_urls { |
| 347 |
my ($blist, @pkgs) = @_; |
| 348 |
my $base_url = $blist->{medium}{url} . '/'; |
| 349 |
map { $base_url . $_->filename } @pkgs; |
| 350 |
} |
| 351 |
sub blist_pkg_to_url { |
| 352 |
my ($blist, $pkg) = @_; |
| 353 |
my ($url) = _blist_pkg_to_urls($blist, $pkg); |
| 354 |
$url; |
| 355 |
} |
| 356 |
sub blist_to_urls { |
| 357 |
my ($blist) = @_; |
| 358 |
_blist_pkg_to_urls($blist, values %{$blist->{pkgs}}); |
| 359 |
} |
| 360 |
sub blist_to_filenames { |
| 361 |
my ($blist) = @_; |
| 362 |
map { $_->filename } values %{$blist->{pkgs}}; |
| 363 |
} |
| 364 |
|
| 365 |
sub protocol_from_url { |
| 366 |
my ($url) = @_; |
| 367 |
$url =~ m!^(\w+)(_[^:]*)?:! && $1; |
| 368 |
} |
| 369 |
sub file_from_local_url { |
| 370 |
my ($url) = @_; |
| 371 |
$url =~ m!^(?:removable[^:]*:/|file:/)?(/.*)! && $1; |
| 372 |
} |
| 373 |
sub file_from_local_medium { |
| 374 |
my ($medium, $o_url) = @_; |
| 375 |
my $url = $o_url || $medium->{url}; |
| 376 |
if ($url =~ m!^cdrom://(.*)!) { |
| 377 |
my $rel = $1; |
| 378 |
$medium->{mntpoint} or do { require Carp; Carp::confess("cdrom is not mounted yet!\n") }; |
| 379 |
"$medium->{mntpoint}/$rel"; |
| 380 |
} else { |
| 381 |
file_from_local_url($url); |
| 382 |
} |
| 383 |
} |
| 384 |
sub is_local_url { |
| 385 |
my ($url) = @_; |
| 386 |
file_from_local_url($url) || is_cdrom_url($url); |
| 387 |
} |
| 388 |
sub is_local_medium { |
| 389 |
my ($medium) = @_; |
| 390 |
is_local_url($medium->{url}); |
| 391 |
} |
| 392 |
sub is_cdrom_url { |
| 393 |
my ($url) = @_; |
| 394 |
protocol_from_url($url) eq 'cdrom'; |
| 395 |
} |
| 396 |
|
| 397 |
=item db_open_or_die($urpm, $b_write_perm) |
| 398 |
|
| 399 |
Open RPM database (RW or not) and die if it fails |
| 400 |
|
| 401 |
=cut |
| 402 |
|
| 403 |
sub db_open_or_die_ { |
| 404 |
my ($urpm, $b_write_perm) = @_; |
| 405 |
my $db; |
| 406 |
if ($urpm->{env_rpmdb}) { |
| 407 |
#- URPM has same methods as URPM::DB and empty URPM will be seen as empty URPM::DB. |
| 408 |
$db = URPM->new; |
| 409 |
$db->parse_synthesis($urpm->{env_rpmdb}); |
| 410 |
} else { |
| 411 |
$db = db_open_or_die($urpm, $urpm->{root}, $b_write_perm); |
| 412 |
} |
| 413 |
$db; |
| 414 |
} |
| 415 |
|
| 416 |
# please use higher level function db_open_or_die_() |
| 417 |
sub db_open_or_die { |
| 418 |
my ($urpm, $root, $b_write_perm) = @_; |
| 419 |
|
| 420 |
$urpm->{debug} and $urpm->{debug}("opening rpmdb (root=$root, write=$b_write_perm)"); |
| 421 |
|
| 422 |
my $db = URPM::DB::open($root, $b_write_perm || 0) |
| 423 |
or $urpm->{fatal}(9, N("unable to open rpmdb")); |
| 424 |
|
| 425 |
$db; |
| 426 |
} |
| 427 |
|
| 428 |
=item register_rpms($urpm, @files) |
| 429 |
|
| 430 |
Register local packages for being installed, keep track of source. |
| 431 |
|
| 432 |
=cut |
| 433 |
|
| 434 |
sub register_rpms { |
| 435 |
my ($urpm, @files) = @_; |
| 436 |
my ($start, $id, $error, %requested); |
| 437 |
|
| 438 |
#- examine each rpm and build the depslist for them using current |
| 439 |
#- depslist and provides environment. |
| 440 |
$start = @{$urpm->{depslist}}; |
| 441 |
foreach (@files) { |
| 442 |
/\.(?:rpm|spec)$/ or $error = 1, $urpm->{error}(N("invalid rpm file name [%s]", $_)), next; |
| 443 |
|
| 444 |
#- if that's an URL, download. |
| 445 |
if (protocol_from_url($_)) { |
| 446 |
my $basename = basename($_); |
| 447 |
unlink "$urpm->{cachedir}/partial/$basename"; |
| 448 |
$urpm->{log}(N("retrieving rpm file [%s] ...", $_)); |
| 449 |
if (urpm::download::sync_url($urpm, $_, quiet => 1)) { |
| 450 |
$urpm->{log}(N("...retrieving done")); |
| 451 |
$_ = "$urpm->{cachedir}/partial/$basename"; |
| 452 |
} else { |
| 453 |
$urpm->{error}(N("...retrieving failed: %s", $@)); |
| 454 |
unlink "$urpm->{cachedir}/partial/$basename"; |
| 455 |
next; |
| 456 |
} |
| 457 |
} else { |
| 458 |
-r $_ or $error = 1, $urpm->{error}(N("unable to access rpm file [%s]", $_)), next; |
| 459 |
} |
| 460 |
|
| 461 |
if (/\.spec$/) { |
| 462 |
my $pkg = URPM::spec2srcheader($_) |
| 463 |
or $error = 1, $urpm->{error}(N("unable to parse spec file %s [%s]", $_, $!)), next; |
| 464 |
$id = @{$urpm->{depslist}}; |
| 465 |
$urpm->{depslist}[$id] = $pkg; |
| 466 |
$pkg->set_id($id); #- sets internal id to the depslist id. |
| 467 |
$urpm->{source}{$id} = $_; |
| 468 |
} else { |
| 469 |
($id) = $urpm->parse_rpm($_); |
| 470 |
my $pkg = defined $id && $urpm->{depslist}[$id]; |
| 471 |
$pkg or $error = 1, $urpm->{error}(N("unable to register rpm file")), next; |
| 472 |
$pkg->arch eq 'src' || $pkg->is_arch_compat |
| 473 |
or $error = 1, $urpm->{error}(N("Incompatible architecture for rpm [%s]", $_)), next; |
| 474 |
$urpm->{source}{$id} = $_; |
| 475 |
} |
| 476 |
} |
| 477 |
$error and $urpm->{fatal}(2, N("error registering local packages")); |
| 478 |
defined $id && $start <= $id and @requested{($start .. $id)} = (1) x ($id-$start+1); |
| 479 |
|
| 480 |
#- distribute local packages to distant nodes directly in cache of each machine. |
| 481 |
if (@files && $urpm->{parallel_handler}) { |
| 482 |
$urpm->{parallel_handler}->parallel_register_rpms($urpm, @files); |
| 483 |
} |
| 484 |
|
| 485 |
%requested; |
| 486 |
} |
| 487 |
|
| 488 |
=item is_delta_installable($urpm, $pkg, $root) |
| 489 |
|
| 490 |
checks whether the delta RPM represented by $pkg is installable wrt the |
| 491 |
RPM DB on $root. For this, it extracts the rpm version to which the |
| 492 |
delta applies from the delta rpm filename itself. So naming conventions |
| 493 |
do matter :) |
| 494 |
|
| 495 |
=cut |
| 496 |
|
| 497 |
sub is_delta_installable { |
| 498 |
my ($urpm, $pkg, $root) = @_; |
| 499 |
$pkg->flag_installed or return 0; |
| 500 |
my $f = $pkg->filename; |
| 501 |
my $n = $pkg->name; |
| 502 |
my ($v_match) = $f =~ /^\Q$n\E-(.*)_.+\.delta\.rpm$/; |
| 503 |
my $db = db_open_or_die($urpm, $root); |
| 504 |
my $v_installed; |
| 505 |
$db->traverse(sub { |
| 506 |
my ($p) = @_; |
| 507 |
$p->name eq $n and $v_installed = $p->version . '-' . $p->release; |
| 508 |
}); |
| 509 |
$v_match eq $v_installed; |
| 510 |
} |
| 511 |
|
| 512 |
|
| 513 |
=item extract_packages_to_install($urpm, $sources) |
| 514 |
|
| 515 |
Extract package that should be installed instead of upgraded, |
| 516 |
installing instead of upgrading is useful |
| 517 |
- for inst.list (cf flag disable_obsolete) |
| 518 |
|
| 519 |
Sources is a hash of id -> source rpm filename. |
| 520 |
|
| 521 |
=cut |
| 522 |
|
| 523 |
sub extract_packages_to_install { |
| 524 |
my ($urpm, $sources) = @_; |
| 525 |
my %inst; |
| 526 |
|
| 527 |
foreach (keys %$sources) { |
| 528 |
my $pkg = $urpm->{depslist}[$_] or next; |
| 529 |
$pkg->flag_disable_obsolete |
| 530 |
and $inst{$pkg->id} = delete $sources->{$pkg->id}; |
| 531 |
} |
| 532 |
|
| 533 |
\%inst; |
| 534 |
} |
| 535 |
|
| 536 |
#- deprecated, use find_candidate_packages_() directly |
| 537 |
#- |
| 538 |
#- side-effects: none |
| 539 |
sub find_candidate_packages_ { |
| 540 |
my ($urpm, $id_prop) = @_; |
| 541 |
|
| 542 |
my %packages; |
| 543 |
foreach ($urpm->find_candidate_packages($id_prop)) { |
| 544 |
push @{$packages{$_->name}}, $_; |
| 545 |
} |
| 546 |
values %packages; |
| 547 |
} |
| 548 |
|
| 549 |
=item get_updates_description($urpm, @update_medias) |
| 550 |
|
| 551 |
Get reason of update for packages to be updated. |
| 552 |
Use all update medias if none given. |
| 553 |
|
| 554 |
=cut |
| 555 |
|
| 556 |
sub get_updates_description { |
| 557 |
my ($urpm, @update_medias) = @_; |
| 558 |
my %update_descr; |
| 559 |
my ($cur, $section); |
| 560 |
|
| 561 |
@update_medias or @update_medias = urpm::media::non_ignored_media($urpm, 'update'); |
| 562 |
|
| 563 |
foreach my $medium (@update_medias) { |
| 564 |
# fix not taking into account the last %package token of each descrptions file: '%package dummy' |
| 565 |
foreach (cat_utf8(urpm::media::statedir_descriptions($urpm, $medium)), |
| 566 |
($::env ? cat_utf8("$::env/descriptions") : ()), '%package dummy') { |
| 567 |
/^%package +(.+)/ and do { |
| 568 |
# fixes not parsing descriptions file when MU adds itself the security source: |
| 569 |
if (exists $cur->{importance} && !member($cur->{importance}, qw(security bugfix))) { |
| 570 |
$cur->{importance} = 'normal'; |
| 571 |
} |
| 572 |
$update_descr{$medium->{name}}{$_} = $cur foreach @{$cur->{pkgs} || []}; |
| 573 |
$cur = { pkgs => [ split /\s/, $1 ] }; |
| 574 |
$section = 'pkg'; |
| 575 |
next; |
| 576 |
}; |
| 577 |
/^Updated?: +(.+)/ && $section eq 'pkg' and do { $cur->{updated} = $1; next }; |
| 578 |
/^Importance: +(.+)/ && $section eq 'pkg' and do { $cur->{importance} = $1; next }; |
| 579 |
/^(ID|URL): +(.+)/ && $section eq 'pkg' and do { $cur->{$1} = $2; next }; |
| 580 |
/^%(pre|description)/ and do { $section = $1; next }; |
| 581 |
$section =~ /^(pre|description)\z/ and $cur->{$1} .= $_; |
| 582 |
} |
| 583 |
} |
| 584 |
\%update_descr; |
| 585 |
} |
| 586 |
|
| 587 |
sub error_restricted ($) { |
| 588 |
my ($urpm) = @_; |
| 589 |
$urpm->{fatal}(2, N("This operation is forbidden while running in restricted mode")); |
| 590 |
} |
| 591 |
|
| 592 |
sub DESTROY {} |
| 593 |
|
| 594 |
1; |
| 595 |
|
| 596 |
__END__ |
| 597 |
|
| 598 |
=back |
| 599 |
|
| 600 |
=head1 SEE ALSO |
| 601 |
|
| 602 |
The L<URPM> package is used to manipulate at a lower level synthesis and rpm |
| 603 |
files. |
| 604 |
|
| 605 |
See also submodules: L<gurpmi>, L<urpm::args>, L<urpm::bug_report>, |
| 606 |
L<urpm::cdrom>, L<urpm::cfg>, L<urpm::download>, L<urpm::get_pkgs>, |
| 607 |
L<urpm::install>, L<urpm::ldap>, L<urpm::lock>, L<urpm::main_loop>, |
| 608 |
L<urpm::md5sum>, L<urpm::media>, L<urpm::mirrors>, L<urpm::msg>, |
| 609 |
L<urpm::orphans>, L<urpm::parallel_ka_run>, L<urpm::parallel>, |
| 610 |
L<urpm::parallel_ssh>, L<urpm::prompt>, L<urpm::removable>, |
| 611 |
L<urpm::select>, L<urpm::signature>, L<urpm::sys>, L<urpm::util>, |
| 612 |
L<urpm::xml_info_pkg>, L<urpm::xml_info> |
| 613 |
|
| 614 |
=head1 COPYRIGHT |
| 615 |
|
| 616 |
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA |
| 617 |
|
| 618 |
Copyright (C) 2005-2010 Mandriva SA |
| 619 |
|
| 620 |
Copyright (C) 2011-2013 Mageia SA |
| 621 |
|
| 622 |
This program is free software; you can redistribute it and/or modify |
| 623 |
it under the terms of the GNU General Public License as published by |
| 624 |
the Free Software Foundation; either version 2, or (at your option) |
| 625 |
any later version. |
| 626 |
|
| 627 |
This program is distributed in the hope that it will be useful, |
| 628 |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 629 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 630 |
GNU General Public License for more details. |
| 631 |
|
| 632 |
You should have received a copy of the GNU General Public License |
| 633 |
along with this program; if not, write to the Free Software |
| 634 |
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
| 635 |
|
| 636 |
=cut |
| 637 |
|
| 638 |
# ex: set ts=8 sts=4 sw=4 noet: |
Parent Directory
| 
Revision Log