diff options
| -rw-r--r-- | urpm.pm | 42 | ||||
| -rwxr-xr-x | urpmi | 36 | ||||
| -rw-r--r-- | urpmi.spec | 6 | ||||
| -rwxr-xr-x | urpmq | 33 |
4 files changed, 62 insertions, 55 deletions
@@ -1429,23 +1429,9 @@ sub search_packages { #- version, try to upgrade to minimize upgrade errors. #- all additional package selected have a true value. sub filter_packages_to_upgrade { - my ($urpm, $packages, $select_choices, %options) = @_; + my ($urpm, $db, $packages, $select_choices, %options) = @_; my ($id, %track, %track_requires, %installed, %selected, %conflicts); - my ($db, @packages) = (URPM::DB::open($options{root}), keys %$packages); - my $sig_handler = sub { undef $db; exit 3 }; - local $SIG{INT} = $sig_handler; - local $SIG{QUIT} = $sig_handler; - - #- common routines that are called at different points. - my $check_installed = sub { - my ($pkg) = @_; - $pkg->arch eq 'src' and return; - $options{keep_alldeps} || exists $installed{$pkg->id} and return 0; - $db->traverse_tag('name', [ $pkg->name ], sub { - my ($p) = @_; - $installed{$pkg->id} ||= $pkg->compare_pkg($p) <= 0; - }); - }; + my @packages = keys %$packages; #- at this level, compute global closure of what is requested, regardless of #- choices for which all package in the choices are taken and their dependencies. @@ -1463,7 +1449,13 @@ sub filter_packages_to_upgrade { #- are installed). foreach (@$id) { my $pkg = $urpm->{depslist}[$_]; - if (exists $packages->{$_} || $check_installed->($pkg) > 0) { + $pkg->arch eq 'src' and return; + $options{keep_alldeps} || exists $installed{$pkg->id} and return 0; + my $count = $db->traverse_tag('name', [ $pkg->name ], sub { + my ($p) = @_; + $installed{$pkg->id} ||= $pkg->compare_pkg($p) <= 0; + }); + if (exists $packages->{$_} || $count > 0) { $installed{$pkg->id} or push @forced_selection, $_; } else { push @selection, $_; @@ -1662,7 +1654,12 @@ sub filter_packages_to_upgrade { foreach my $pkg (@pre_choices) { push @choices, $pkg; - $check_installed->($pkg); + $pkg->arch eq 'src' and return; + $options{keep_alldeps} || exists $installed{$pkg->id} and return 0; + $db->traverse_tag('name', [ $pkg->name ], sub { + my ($p) = @_; + $installed{$pkg->id} ||= $pkg->compare_pkg($p) <= 0; + }); $installed{$pkg->id} and delete $packages->{$pkg->id}; exists $installed{$pkg->id} and push @upgradable_choices, $pkg; } @@ -1698,8 +1695,6 @@ sub filter_packages_to_upgrade { } } - undef $db; - #- rpm db will be closed automatically on destruction of $db. \%track; } @@ -1977,11 +1972,7 @@ sub extract_packages_to_install { } sub select_packages_to_upgrade { - my ($urpm, $prefix, $packages, $remove_packages, $keep_files, %options) = @_; - my $db = URPM::DB::open($prefix); - my $sig_handler = sub { undef $db; exit 3 }; - local $SIG{INT} = $sig_handler; - local $SIG{QUIT} = $sig_handler; + my ($urpm, $db, $packages, $remove_packages, $keep_files, %options) = @_; #- used for package that are not correctly updated. #- should only be used when nothing else can be done correctly. @@ -2151,7 +2142,6 @@ sub select_packages_to_upgrade { } }); } - undef $db; } 1; @@ -27,7 +27,6 @@ my $update = 0; my $media = 0; my $auto = 0; my $allow_medium_change = 0; -my $complete = 0; my $auto_select = 0; my $force = 0; my $sync = undef; @@ -68,7 +67,6 @@ usage: ") . _(" --fuzzy - impose fuzzy search (same as -y). ") . _(" --src - next package is a source package (same as -s). ") . _(" --noclean - keep rpm not used in cache. -") . _(" --complete - use parsehdlist server to complete selection. ") . _(" --force - force invocation even if some packages do not exist. ") . _(" --wget - use wget to retrieve distant files. ") . _(" --curl - use curl to retrieve distant files. @@ -100,7 +98,6 @@ for (@ARGV) { /^--fuzzy$/ and do { $fuzzy = 1; next }; /^--src$/ and do { $src = 1; next }; /^--noclean$/ and do { $noclean = 1; next }; - /^--complete$/ and do { $complete = 1; next }; /^--force$/ and do { $force = 1; next }; /^--wget$/ and do { $sync = \&urpm::sync_wget; next }; /^--curl$/ and do { $sync = \&urpm::sync_curl; next }; @@ -246,21 +243,30 @@ my $ask_choice = sub { $choices_id[$n - 1]; }; -#- auto select package for upgrading the distribution. -if ($auto_select) { - my (%to_remove, %keep_files); +#- open/close of database should be moved here, in order to allow testing +#- some bogus case and check for integrity. +{ + my $db = URPM::DB::open($root); + my $sig_handler = sub { undef $db; exit 3 }; + local $SIG{INT} = $sig_handler; + local $SIG{QUIT} = $sig_handler; - $urpm->select_packages_to_upgrade($root, \%packages, \%to_remove, \%keep_files, use_parsehdlist => $complete); + #- auto select package for upgrading the distribution. + if ($auto_select) { + my (%to_remove, %keep_files); -#- if (keys(%to_remove) > 0) { -#- print STDERR "some packages have to be removed for being upgraded, this is not supported yet\n"; -#- } -} + $urpm->select_packages_to_upgrade($db, \%packages, \%to_remove, \%keep_files); -$urpm->filter_packages_to_upgrade(\%packages, $ask_choice, root => $root); -#- my $track = $urpm->filter_packages_to_upgrade(\%packages, $ask_choice, track => 1); -#- require Data::Dumper; -#- print STDERR Data::Dumper->Dump([$track], ['$track']); + if (keys(%to_remove) > 0) { + $urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n")); + } + } + + $urpm->filter_packages_to_upgrade($db, \%packages, $ask_choice); + #- my $track = $urpm->filter_packages_to_upgrade(\%packages, $ask_choice, track => 1); + #- require Data::Dumper; + #- print STDERR Data::Dumper->Dump([$track], ['$track']); +} #- get out of package that should not be upgraded. $urpm->deselect_unwanted_packages(\%packages); @@ -2,7 +2,7 @@ Name: urpmi Version: 3.4 -Release: 2mdk +Release: 3mdk License: GPL Source0: %{name}.tar.bz2 Source1: %{name}.logrotate @@ -144,6 +144,10 @@ fi %changelog +* Wed Jun 5 2002 François Pons <fpons@mandrakesoft.com> 3.4-3mdk +- avoid sub of sub with different level of variable closure in perl, + this cause the interpreter to lose its memory usage. + * Wed Jun 5 2002 François Pons <fpons@mandrakesoft.com> 3.4-2mdk - fix rpmdb non closed when traversing it. - fix ftp and http medium with bad list generation. @@ -137,21 +137,28 @@ if (@src_names) { or $query->{force} or exit 1; } -#- auto select package for upgrading the distribution. -if ($query->{auto_select}) { - my (%to_remove, %keep_files); - - $urpm->select_packages_to_upgrade($query->{root}, \%packages, \%to_remove, \%keep_files); - - if (keys(%to_remove) > 0) { - $urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n")); +#- open/close of database should be moved here, in order to allow testing +#- some bogus case and check for integrity. +if ($query->{auto_select} || $query->{deps}) { + my $db = URPM::DB::open($root); + my $sig_handler = sub { undef $db; exit 3 }; + local $SIG{INT} = $sig_handler; + local $SIG{QUIT} = $sig_handler; + + #- auto select package for upgrading the distribution. + if ($query->{auto_select}) { + my (%to_remove, %keep_files); + + $urpm->select_packages_to_upgrade($db, \%packages, \%to_remove, \%keep_files); + + if (keys(%to_remove) > 0) { + $urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n")); + } } -} -#- filter to add in packages selected required packages. -$query->{deps} and $urpm->filter_packages_to_upgrade(\%packages, undef, - keep_alldeps => !$query->{upgrade}, - root => $query->{root}); + #- filter to add in packages selected required packages. + $query->{deps} and $urpm->filter_packages_to_upgrade($db, \%packages, undef, keep_alldeps => !$query->{upgrade}); +} #- get out of package that should not be upgraded. $urpm->deselect_unwanted_packages(\%packages); |