diff options
| -rw-r--r-- | perl-install/c/stuff.xs.pm | 77 | ||||
| -rw-r--r-- | perl-install/install_steps_gtk.pm | 20 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 10 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 26 |
4 files changed, 93 insertions, 40 deletions
diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm index 32ca98ff6..784afa807 100644 --- a/perl-install/c/stuff.xs.pm +++ b/perl-install/c/stuff.xs.pm @@ -431,18 +431,21 @@ rpmtransSetScriptFd(trans, fd) rpmtransSetScriptFd(trans, fdDup(fd)); void -rpmRunTransactions(trans, callbackOpen, callbackClose, callbackStart, callbackProgress, force) +rpmRunTransactions(trans, callbackOpen, callbackClose, callbackMessage, force) void *trans SV *callbackOpen SV *callbackClose - SV *callbackStart - SV *callbackProgress + SV *callbackMessage int force PPCODE: rpmProblemSet probs; void *rpmRunTransactions_callback(const Header h, const rpmCallbackType what, const unsigned long amount, const unsigned long total, const void * pkgKey, void * data) { static FD_t fd; static int last_amount; + char *msg = NULL; + char *param_s = NULL; + const unsigned long *param_ul1 = NULL; + const unsigned long *param_ul2 = NULL; char *n = (char *) pkgKey; switch (what) { @@ -470,27 +473,73 @@ rpmRunTransactions(trans, callbackOpen, callbackClose, callbackStart, callbackPr break; } + case RPMCALLBACK_TRANS_START: { + switch (amount) { + case 1: msg = "Examining packages to install..."; break; + case 5: msg = "Examining files to install..."; break; + case 6: msg = "Finding overlapping files..."; break; + } + if (msg) param_ul1 = &total; + } break; + + case RPMCALLBACK_UNINST_START: { + msg = "Removing old files..."; + param_ul1 = &total; + } break; + + case RPMCALLBACK_TRANS_PROGRESS: { + msg = "Progressing transaction"; + param_ul1 = &amount; + } break; + + case RPMCALLBACK_UNINST_PROGRESS: { + msg = "Progressing removing old files"; + param_ul1 = &amount; + } break; + + case RPMCALLBACK_TRANS_STOP: { + msg = "Done transaction"; + } break; + + case RPMCALLBACK_UNINST_STOP: { + msg = "Done removing old files"; + } break; + case RPMCALLBACK_INST_START: { - dSP ; - PUSHMARK(sp) ; - XPUSHs(sv_2mortal(newSVpv(n, 0))); - PUTBACK ; - perl_call_sv(callbackStart, G_DISCARD); + msg = "Starting installing package"; + param_s = n; + last_amount = 0; } break; case RPMCALLBACK_INST_PROGRESS: if ((amount - last_amount) * 4 / total) { - dSP; - PUSHMARK(sp); - XPUSHs(sv_2mortal(newSViv(amount))); - XPUSHs(sv_2mortal(newSViv(total))); - PUTBACK ; - perl_call_sv(callbackProgress, G_DISCARD); + msg = "Progressing installing package"; + param_s = n; + param_ul1 = &amount; + param_ul2 = &total; + last_amount = amount; } break; default: break; } + + if (msg) { + dSP ; + PUSHMARK(sp) ; + XPUSHs(sv_2mortal(newSVpv(msg, 0))); + if (param_s) { + XPUSHs(sv_2mortal(newSVpv(param_s, 0))); + } + if (param_ul1) { + XPUSHs(sv_2mortal(newSViv(*param_ul1))); + } + if (param_ul2) { + XPUSHs(sv_2mortal(newSViv(*param_ul2))); + } + PUTBACK ; + perl_call_sv(callbackMessage, G_DISCARD); + } return NULL; } if (rpmRunTransactions(trans, rpmRunTransactions_callback, NULL, NULL, &probs, 0, force ? ~0 : ~RPMPROB_FILTER_DISKSPACE)) { diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index a958d1553..fda1686cb 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -507,16 +507,16 @@ sub installPackages { $msg->set(_("Preparing installation")); $w->sync; - my $old = \&log::ld; - local *log::ld = sub { + my $old = \&pkgs::installCallback; + local *pkgs::installCallback = sub { my $m = shift; - if ($m =~ /^starting installation:/) { + if ($m =~ /^Starting installation/) { $nb = $_[0]; - $total_size = $_[2]; $current_total_size = 0; + $total_size = $_[1]; $current_total_size = 0; $start_time = time(); - $msg->set(join '', @_); + $msg->set(_("%d packages", $nb) . _(", %U bytes", $total_size)); $w->flush; - } elsif ($m =~ /^starting installing/) { + } elsif ($m =~ /^Starting installing package/) { $progress->update(0); my $name = $_[0]; $msg->set(_("Installing package %s", $name)); @@ -524,11 +524,11 @@ sub installPackages { $last_size = c::headerGetEntry($o->{packages}{$name}{header}, 'size'); $text->set((split /\n/, c::headerGetEntry($o->{packages}{$name}{header}, 'summary'))[0] || ''); $w->flush; - } elsif ($m =~ /^progressing installation/) { - $progress->update($_[2] ? $_[0] / $_[2] : 0); + } elsif ($m =~ /^Progressing installing package/) { + $progress->update($_[2] ? $_[1] / $_[2] : 0); my $dtime = time() - $start_time; - my $ratio = $total_size ? ($_[0] + $current_total_size) / $total_size : 0; + my $ratio = $total_size ? ($_[1] + $current_total_size) / $total_size : 0; my $total_time = $ratio ? $dtime / $ratio : time(); $progress_total->update($ratio); @@ -538,7 +538,7 @@ sub installPackages { $last_dtime = $dtime; } $w->flush; - } else { goto $old } + } else { unshift @_, $m; goto $old } }; catch_cdie { $o->install_steps::installPackages($packages); } sub { diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index a0567d5f1..803638f5f 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -250,16 +250,16 @@ sub installPackages { my $w = $o->wait_message(_("Installing"), _("Preparing installation")); - my $old = \&log::ld; - local *log::ld = sub { + my $old = \&pkgs::installCallback; + local *pkgs::installCallback = sub { my $m = shift; - if ($m =~ /^starting installation:/) { + if ($m =~ /^Starting installation/) { $total = $_[2]; - } elsif ($m =~ /^starting installing/) { + } elsif ($m =~ /^Starting installing package/) { my $name = $_[0]; $w->set(_("Installing package %s\n%d%%", $name, 100 * $current / $total)); $current += c::headerGetEntry($o->{packages}{$name}{header}, 'size'); - } else { goto $old } + } else { unshift @_, $m; goto $old } }; $o->SUPER::installPackages($packages); } diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 0c56f6a11..ac8717f42 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -454,6 +454,12 @@ sub selectPackagesToUpgrade($$$) { log::l("done selecting packages to upgrade"); } +sub installCallback { + my $msg = shift; + + log::l($msg .": ". join(',', @_)); +} + sub install($$) { my ($prefix, $toInstall) = @_; my %packages; @@ -476,7 +482,6 @@ sub install($$) { c::headerGetEntry(getHeader($p), 'arch'); $packages{$p->{name}} = $p; c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel' -# c::rpmtransAddPackage($trans, getHeader($p), $p->{file}, 1); #- TODO: replace `named kernel' by `provides kernel' $nb++; $total += $p->{size}; } @@ -491,12 +496,6 @@ sub install($$) { eval { fs::mount("/proc", "$prefix/proc", "proc", 0) }; - #- if someone try to change the function log::ld or the parameters used, - #- DON TRY THAT unless you have modified accordingly install_steps_gtk. - #- because log::ld is catched, furthermore do not translate the messages used. - log::l("starting installation: ", $nb, " packages, ", $total, " bytes"); - log::ld("starting installation: ", $nb, " packages, ", $total, " bytes"); - my $callbackOpen = sub { my $f = (my $p = $packages{$_[0]})->{file}; print LOG "$f\n"; @@ -504,11 +503,16 @@ sub install($$) { $fd ? fileno $fd : -1; }; my $callbackClose = sub { $packages{$_[0]}{installed} = 1; }; - my $callbackStart = sub { log::ld("starting installing package ", $_[0]) }; - my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) }; + my $callbackMessage = \&pkgs::installCallback; +# my $callbackStart = sub { log::ld("starting installing package ", $_[0]) }; +# my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) }; + + #- 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,...). + &$callbackMessage("Starting installation", $nb, $total); - if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, - $callbackStart, $callbackProgress, 0)) { + if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) { my %parts; @probs = reverse grep { if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) { |