diff options
| -rw-r--r-- | perl-install/install_steps.pm | 9 | ||||
| -rw-r--r-- | perl-install/install_steps_gtk.pm | 5 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 5 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 18 |
4 files changed, 20 insertions, 17 deletions
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 3bb6d8644..606df646e 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -432,18 +432,23 @@ sub pkg_install { } } +sub installCallback { +# my (undef, $msg, @para) = @_; +# log::l("$msg: " . join(',', @para)); +} + sub installPackages { #- complete REWORK, TODO and TOCHECK! my ($o) = @_; my $packages = $o->{packages}; - pkgs::remove_marked_ask_remove($packages); + pkgs::remove_marked_ask_remove($packages, \&installCallback); #- small transaction will be built based on this selection and depslist. my @toInstall = pkgs::packagesToInstall($packages); my $time = time(); $ENV{DURING_INSTALL} = 1; - pkgs::install($o->{isUpgrade}, \@toInstall, $packages); + pkgs::install($o->{isUpgrade}, \@toInstall, $packages, \&installCallback); any::writeandclean_ldsoconf($o->{prefix}); delete $ENV{DURING_INSTALL}; diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index 1c336421c..a195455b8 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -510,8 +510,7 @@ sub installPackages { $advertize->(0); - my $oldInstallCallback = \&pkgs::installCallback; - local *pkgs::installCallback = sub { + local *install_steps::installCallback = sub { my ($data, $type, $id, $subtype, $amount, $total) = @_; if ($type eq 'user' && $subtype eq 'install') { #- $amount and $total are used to return number of package and total size. @@ -545,7 +544,7 @@ sub installPackages { $last_dtime = $dtime; } $w->flush; - } else { goto $oldInstallCallback } + } }; #- the modification is not local as the box should be living for other package installation. undef *install_any::changeMedium; diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 49fbcdca9..2fcddce05 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -712,8 +712,7 @@ sub installPackages { my $w = $o->wait_message(N("Installing"), N("Preparing installation")); - my $old = \&pkgs::installCallback; - local *pkgs::installCallback = sub { + local *install_steps::installCallback = sub { my ($data, $type, $id, $subtype, $_amount, $total_) = @_; if ($type eq 'user' && $subtype eq 'install') { $total = $total_; @@ -721,7 +720,7 @@ sub installPackages { my $p = $data->{depslist}[$id]; $w->set(N("Installing package %s\n%d%%", $p->name, $total && 100 * $current / $total)); $current += $p->size; - } else { goto $old } + } }; #- the modification is not local as the box should be living for other package installation. diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index fcb0f8bfd..96953417e 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -1038,7 +1038,7 @@ sub installCallback { } sub install { - my ($isUpgrade, $toInstall, $packages) = @_; + my ($isUpgrade, $toInstall, $packages, $callback) = @_; my %packages; delete $packages->{rpmdb}; #- make sure rpmdb is closed before. @@ -1070,7 +1070,7 @@ sub install { #- do not modify/translate the message used with installCallback since #- these are keys during progressing installation, or change in other #- place (install_steps_gtk.pm,...). - installCallback($packages, user => undef, install => $nb, $total); + $callback->($packages, user => undef, install => $nb, $total); do { my @transToInstall = installTransactionClosure($packages, \%packages); @@ -1109,8 +1109,8 @@ sub install { foreach (@transToInstall) { log::l("i would install ", $_->name, " now"); my $id = $_->id; - installCallback($packages, inst => $id, start => 0, $size_typical); - installCallback($packages, inst => $id, progress => 0, $size_typical); + $callback->($packages, inst => $id, start => 0, $size_typical); + $callback->($packages, inst => $id, progress => 0, $size_typical); $close->($_); } } else { @@ -1155,7 +1155,7 @@ sub install { }); $check_installed or log::l($pkg->name . " not installed, " . URPM::rpmErrorString()); $check_installed and $close->($pkg); - }, callback_inst => \&installCallback, + }, callback_inst => $callback, ); log::l("transactions done, now trying to close still opened fd"); install_any::getFile('XXX'); #- close still opened fd. @@ -1219,7 +1219,7 @@ sub install { } sub remove_marked_ask_remove { - my ($packages) = @_; + my ($packages, $callback) = @_; my @to_remove = keys %{$packages->{state}{ask_remove}} or return; @@ -1228,13 +1228,13 @@ sub remove_marked_ask_remove { #- we are not checking depends since it should come when #- upgrading a system. although we may remove some functionalities ? - remove(\@to_remove); + remove(\@to_remove, $callback); delete $packages->{state}{ask_remove}{$_} foreach @to_remove; } sub remove { - my ($to_remove) = @_; + my ($to_remove, $callback) = @_; log::l("removing: " . join(' ', @$to_remove)); @@ -1244,7 +1244,7 @@ sub remove { #- stuff remove all packages that matches $p, not a problem since $p has name-version-release format. $trans->remove($_) foreach @$to_remove; - installCallback($db, user => undef, remove => scalar @$to_remove); + $callback->($db, user => undef, remove => scalar @$to_remove); if (my @pbs = $trans->run(undef, force => 1)) { die "removing of old rpms failed:\n ", join("\n ", @pbs); |