构造Linux的图形化安装程序（4）[9]

　　#- 下面的c::*方式调用的函数是对rpmlib.a中的库函数进行封装之后生成的函数，它的封装保存在#- perl语言的存根文件stuff.xs中。
　　sub install($$$;$$) {
　　　　my ($prefix, $isUpgrade, $toInstall, $depOrder, $media) = @_;
　　　　my %packages;
　　
　　　　return if $::g_auto_install || !scalar(@$toInstall);
　　
　　　　my $loop_boot = loopback::prepare_boot($prefix);
　　
　　my ($total, $nb);
　　#- 根据数组toInstall中的内容，选择安装包，同时计算安装的大小。
　　　　foreach my $pkg (@$toInstall) {
　　　　$packages{packageName($pkg)} = $pkg;
　　　　$nb++;
　　　　$total += packageSize($pkg);
　　　　}
　　
　　　　#- 将安装信息写入日志文件，在成功安装系统之后，会形成安装日志文件install.log
　　　　log::l("pkgs::install $prefix");
　　　　log::l("pkgs::install the following: ", join(" ", keys %packages));
　　　　eval { fs::mount("/proc", "$prefix/proc", "proc", 0) } unless -e "$prefix/proc/cpuinfo";
　　
　　log::l("reading /usr/lib/rpm/rpmrc");
　　#- 读入rpm包的配置文件rpmrc
　　　　c::rpmReadConfigFiles() or die "can't read rpm config files";
　　　　log::l("\tdone");
　　
　　　　#- 打开包所在文件的回调函数。
　　　　my $callbackOpen = sub {
　　　　my $p = $packages{$_[0]};
　　　　my $f = packageFile($p);
　　　　print LOG "$f $p->[$MEDIUM]{descr}\n";
　　　　my $fd = install_any::getFile($f, $p->[$MEDIUM]{descr});
　　　　$fd ? fileno $fd : -1;
　　};
　　#- 删除包所在的描述结构，并设置包的安装标志
　　　　my $callbackClose = sub { packageSetFlagInstalled(delete $packages{$_[0]}, 1) };
　　　　installCallback("Starting installation", $nb, $total);
　　
　　　　my ($i, $min, $medium) = (0, 0, 1);
　　　　do {
　　　　my @transToInstall;
　　
　　　　if (!$depOrder || !$media) {
　　　　　　@transToInstall = values %packages;
　　　　　　$nb = 0;
　　　　} else {
　　　　　　do {
　　　　　　#- 如果需要，改变安装介质（光盘、硬盘）
　　　　　　if ($i > $media->{$medium}{max}) {
　　　　　　　　#- 寻找包含指定安装包的介质
　　　　　　　　foreach (keys %$media) {
　　　　　　　　$i >= $media->{$_}{min} && $i <= $media->{$_}{max} and $medium = $_, last;
　　　　　　　　}
　　　　　　}
　　　　　　$i >= $media->{$medium}{min} && $i <= $media->{$medium}{max} or die "unable to find right medium";
　　　　　　#- 检查使用的安装介质，比如是光盘安装还是别的方式
　　　　　　install_any::useMedium($medium);
　　
　　　　　　while ($i <= $media->{$medium}{max} && ($i < $min || scalar @transToInstall < $limitMinTrans)) {
　　　　　　　　my $dep = $packages{packageName($depOrder->[$i++])} or next;
　　　　　　　　if ($dep->[$MEDIUM]{selected}) {
　　　　　　　　push @transToInstall, $dep;
　　　　　　　　foreach (map { split '\|' } packageDepsId($dep)) {
　　　　　　　　　　$min < $_ and $min = $_;
　　　　　　　　}
　　　　　　　　} else {
　　　　　　　　log::l("ignoring package $dep->[$FILE] as its medium is not selected");
　　　　　　　　}
　　　　　　　　--$nb;
　　　　　　}
　　　　　　} while ($nb > 0 && scalar(@transToInstall) == 0);
　　　　}
　　　　#- 在任何介质都没有选择的包时，退出安装。
　　　　if ($nb == 0 && scalar(@transToInstall) == 0) {
　　　　　　cleanHeaders($prefix);
　　
　　　　　　loopback::save_boot($loop_boot);
　　　　　　return;
　　　　}
　　
　　　　extractHeaders($prefix, \@transToInstall, $media->{$medium});
　　　　#- 重设文件描述符
　　　　if ($media->{$medium}{method} eq 'cdrom') {
　　　　　　install_any::getFile(packageFile($transToInstall[0]), $transToInstall[0][$MEDIUM]{descr});
　　　　}
　　
　　　　install_any::getFile('XXX');
　　
　　　　my $retry = 3;
　　　　#- 为了保证安装过程具有更好的并发性和健壮性，在启动安装时，创建了一个子进程进行安装。
　　　　#- 同时，在父进程中对整个输出过程进行了改向。
　　　　while (@transToInstall) {
　　　　　　local (*INPUT, *OUTPUT); pipe INPUT, OUTPUT;
　　　　　　if (my $pid = fork()) {
　　　　　　close OUTPUT;
　　　　　　my $error_msg = ';
　　　　　　local $_;
　　　　　　while () {
　　　　　　　　if (/^die:(.*)/) {
　　　　　　　　$error_msg = $1;
　　　　　　　　last;
　　　　　　　　} else {
　　　　　　　　chomp;
　　　　　　　　my @params = split ":";
　　　　　　　　if ($params[0] eq 'close') {
　　　　　　　　　　&$callbackClose($params[1]);
　　　　　　　　} else {
　　　　　　　　　　installCallback(@params);
　　　　　　　　}
　　　　　　　　}
　　　　　　}
　　　　　　$error_msg and $error_msg .= join(', );
　　　　　　waitpid $pid, 0;
　　　　　　close INPUT;
　　　　　　$error_msg and die $error_msg;
　　　　　　} else {
　　　　　　#- 子进程执行所有的安装操作
　　　　　　$SIG{SEGV} = sub { log::l("segmentation fault on transactions"); c::_exit(0) };
　　　　　　my $db;
　　　　　　eval {
　　　　　　　　close INPUT;
　　　　　　　　select((select(OUTPUT),　$| = 1)[0]);