summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>1999-11-19 11:38:45 +0000
committerFrancois Pons <fpons@mandriva.com>1999-11-19 11:38:45 +0000
commitbfe37c13141bc718a42c0d8b8c3bbff03bfc5ff2 (patch)
treed485b3c253e2a1b2cc3c32b6243eb426f695d3ea /perl-install
parenta672385d6e1ae6b19e7181aaa5767e31f7e669ef (diff)
downloaddrakx-bfe37c13141bc718a42c0d8b8c3bbff03bfc5ff2.tar
drakx-bfe37c13141bc718a42c0d8b8c3bbff03bfc5ff2.tar.gz
drakx-bfe37c13141bc718a42c0d8b8c3bbff03bfc5ff2.tar.bz2
drakx-bfe37c13141bc718a42c0d8b8c3bbff03bfc5ff2.tar.xz
drakx-bfe37c13141bc718a42c0d8b8c3bbff03bfc5ff2.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/c/stuff.xs.pm77
-rw-r--r--perl-install/install_steps_gtk.pm20
-rw-r--r--perl-install/install_steps_interactive.pm10
-rw-r--r--perl-install/pkgs.pm26
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/) {