From 5999898cb22f35cfadbea9df40ee82e622be4519 Mon Sep 17 00:00:00 2001 From: Francois Pons Date: Fri, 31 Mar 2000 11:52:06 +0000 Subject: *** empty log message *** --- perl-install/ChangeLog | 15 ++++ perl-install/Xconfigurator.pm | 2 +- perl-install/devices.pm | 1 + perl-install/install2.pm | 5 +- perl-install/install_any.pm | 89 +++++++++++++++----- perl-install/install_steps.pm | 10 +-- perl-install/install_steps_gtk.pm | 27 ++++-- perl-install/install_steps_interactive.pm | 31 +++++-- perl-install/pkgs.pm | 132 +++++++++++++++--------------- perl-install/printer.pm | 2 +- perl-install/printerdrake.pm | 6 +- 11 files changed, 206 insertions(+), 114 deletions(-) (limited to 'perl-install') diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog index d482b0c96..4519221e1 100644 --- a/perl-install/ChangeLog +++ b/perl-install/ChangeLog @@ -1,3 +1,18 @@ +2000-03-30 François Pons + + * install2pm: added eval around loading af_packet and postinstall + copy of RPMS. + * devices.pm: added /dev/kdb for SPARC. + * install_any.pm: modified multi CD management, postinstall copy + of RPMS. + * install_steps_gtk.pm: added support for Xsun server for SPARC. + * install_steps_interactive.pm: added multi CD dialog box for + selecting CD available. Serialized ethernet configuration and ppp + configuration. + * pkgs.pm: added check for infinite recursion for bad depslist. + * printer.pm: better test for reparse of printerdb. + * Xconfigurator.pm: added support for Xsun server for SPARC. + 2000-03-30 Pixel * install_steps_gtk.pm (choosePackagesTree): enhance tree selection diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm index 0ca3fe1f3..bbebb1cba 100644 --- a/perl-install/Xconfigurator.pm +++ b/perl-install/Xconfigurator.pm @@ -332,7 +332,7 @@ sub testFinalConfig($;$$) { open STDERR, ">$f_err"; chroot $prefix if $prefix; exec $o->{card}{prog}, - "-xf86config", ($::testing ? $tmpconfig : $f) . ($::xf4 && "-4"), + ($o->{card}{prog} !~ /Xsun/ ? ("-xf86config", ($::testing ? $tmpconfig : $f) . ($::xf4 && "-4")) : ()), ":9" or c::_exit(0); } diff --git a/perl-install/devices.pm b/perl-install/devices.pm index 29c89a1d5..c48bd3636 100644 --- a/perl-install/devices.pm +++ b/perl-install/devices.pm @@ -112,6 +112,7 @@ sub make($) { "mcdx" => [ c::S_IFBLK(), 20, 0 ], "mem" => [ c::S_IFCHR(), 1, 1 ], "optcd" => [ c::S_IFBLK(), 17, 0 ], + "kbd" => [ c::S_IFCHR(), 11, 0 ], "psaux" => [ c::S_IFCHR(), 10, 1 ], "random" => [ c::S_IFCHR(), 1, 8 ], "sbpcd" => [ c::S_IFBLK(), 25, 0 ], diff --git a/perl-install/install2.pm b/perl-install/install2.pm index 6d028ebd2..4e5fb566f 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -366,7 +366,7 @@ sub doInstallStep { $o->beforeInstallPackages; $o->installPackages($o->{packages}); - $o->afterInstallPackages; + $o->afterInstallPackages; } #------------------------------------------------------------------------------ sub miscellaneous { @@ -639,7 +639,7 @@ sub main { modules::read_stage1_conf("/tmp/conf.modules"); modules::read_already_loaded(); - modules::load("af_packet"); + eval { modules::load("af_packet") }; install_any::lnx4win_preinstall() if $o->{lnx4win}; #-the main cycle @@ -670,6 +670,7 @@ sub main { last if $o->{step} eq 'exitInstall'; } + install_any::clean_postinstall_rpms(); install_any::ejectCdrom(); fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount}); diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 663efb171..da40d7b6a 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -4,7 +4,7 @@ use diagnostics; use strict; use Config; -use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $current_medium $asked_medium %refused_media); +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @needToCopy); @ISA = qw(Exporter); %EXPORT_TAGS = ( @@ -28,14 +28,27 @@ use detect_devices; use fs; use log; +#- package that have to be copied for proper installation (just to avoid changing cdrom) +#- here XFree86 is copied entirey if not already installed, maybe better to copy only server. +@needToCopy = qw( +XFree86 dhcpcd pump ppp ypbind rhs-printfilters samba ncpfs kernel-fb +); #-###################################################################################### #- Media change variables&functions #-###################################################################################### -$current_medium = ''; -$asked_medium = ''; -%refused_media = (); -sub useMedium($) { $asked_medium eq $_[0] or log::l("selecting new medium $_[0]"); $asked_medium = $_[0] } +my $postinstall_rpms = ''; +my $current_medium = ''; +my $asked_medium = ''; +my %refused_media = (); +sub useMedium($) { + #- before ejecting the first CD, there are some files to copy! + #- does nothing if the function has already been called. + $_[0] and $::o->{method} eq 'cdrom' and setup_postinstall_rpms($::o->{prefix}, $::o->{packages}); + + $asked_medium eq $_[0] or log::l("selecting new medium $_[0]"); + $asked_medium = $_[0]; +} sub changeMedium($$) { my ($method, $medium) = @_; log::l("change to medium $medium for method $method (refused by default)"); @@ -48,23 +61,23 @@ sub relGetFile($) { my $dir = m|/| ? "mdkinst" : /^(?:compss|compssList|compssUsers|depslist.*|hdlist.*)$/ ? "base/": "RPMS$asked_medium/"; "Mandrake/$dir$_"; } -sub errorOpeningFile($;$) { - my ($file, $absent) = @_; +sub errorOpeningFile($) { + my ($file) = @_; $file eq 'XXX' and return; #- special case to force closing file after rpmlib transaction. - $current_medium eq $asked_medium && !$absent and return; #- nothing to do in such case. + $current_medium eq $asked_medium and return; #- nothing to do in such case. $refused_media{$asked_medium} and return; #- refused forever... my $max = 32; #- always refuse after $max tries. if ($::o->{method} eq "cdrom") { - cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/rhimage| or return; + cat_("/proc/mounts") =~ m|(/tmp/\S+)\s+/tmp/rhimage| or return; my $cdrom = $1; - ejectCdrom(); + ejectCdrom($cdrom); while ($max > 0 && changeMedium($::o->{method}, $asked_medium)) { $current_medium = $asked_medium; eval { fs::mount($cdrom, "/tmp/rhimage", "iso9660", 'readonly') }; my $getFile = getFile($file); $getFile and return $getFile; $current_medium = 'unknown'; #- don't know what CD is inserted now. - ejectCdrom(); + ejectCdrom($cdrom); --$max; } } else { @@ -95,7 +108,7 @@ sub getFile { #- handling changing a media when some of the file on the first CD has been copied #- to other to avoid media change... open getFile, "/tmp/rhimage/" . relGetFile($_[0]) or - return errorOpeningFile($_[0], !(-e "/tmp/rhimage/" . relGetFile($_[0]))); + $postinstall_rpms and open getFile, "$postinstall_rpms/$_[0]" or return errorOpeningFile($_[0]); *getFile; }; } @@ -108,6 +121,40 @@ sub rewindGetFile() { } } +#-###################################################################################### +#- Post installation RPMS from cdrom only, functions +#-###################################################################################### +sub setup_postinstall_rpms($$) { + my ($prefix, $packages) = @_; + + $postinstall_rpms and return; + $postinstall_rpms = "$prefix/usr/postinstall-rpm"; + + log::l("postinstall rpms directory set to $postinstall_rpms"); + commands::mkdir_('-p', $postinstall_rpms); + + require pkgs; + + #- compute closure of unselected package that may be copied. + my %toCopy; + foreach (@needToCopy) { + my $pkg = pkgs::packageByName($packages, $_); + pkgs::selectPackage($packages, $pkg, 0, \%toCopy); + } + + my @toCopy; push @toCopy, map { pkgs::packageByName($packages, $_) } keys %toCopy; + + #- extract headers of package, this is necessary for getting + #- the complete filename of each package. + #- copy the package files in the postinstall RPMS directory. + #- last arg is default medium '' known as the CD#1. + pkgs::extractHeaders($prefix, \@toCopy, $packages->[2]{''}); + commands::cp((map { "/tmp/rhimage/" . relGetFile(pkgs::packageFile($_)) } @toCopy), $postinstall_rpms); +} +sub clean_postinstall_rpms() { + $postinstall_rpms and commands::rm('-rf', $postinstall_rpms); +} + #-###################################################################################### #- Functions #-###################################################################################### @@ -423,13 +470,15 @@ sub hdInstallPath() { $part->{mntpoint} . first(readlink("/tmp/rhimage") =~ m|^/tmp/hdimage/(.*)|); } -sub unlockCdrom() { - cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/rhimage| or return; - eval { ioctl detect_devices::tryOpen($1), c::CDROM_LOCKDOOR(), 0 }; +sub unlockCdrom(;$) { + my ($cdrom) = @_; + $cdrom or cat_("/proc/mounts") =~ m|(/tmp/\S+)\s+/tmp/rhimage| and $cdrom = $1; + eval { $cdrom and ioctl detect_devices::tryOpen($1), c::CDROM_LOCKDOOR(), 0 }; } -sub ejectCdrom() { - cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/rhimage| or return; - my $f = eval { detect_devices::tryOpen($1) } or return; +sub ejectCdrom(;$) { + my ($cdrom) = @_; + $cdrom or cat_("/proc/mounts") =~ m|(/tmp/\S+)\s+/tmp/rhimage| and $cdrom = $1; + my $f = eval { $cdrom && detect_devices::tryOpen($cdrom) } or return; getFile("XXX"); #- close still opened filehandle eval { fs::umount("/tmp/rhimage") }; ioctl $f, c::CDROMEJECT(), 1; @@ -541,8 +590,11 @@ sub pkg_install { my ($o, $name) = @_; require pkgs; require install_steps; + print "trying to pkg_install $name\n"; pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $name) || die "$name rpm not found"); + print "trying to pkg_install $name : done selection\n"; install_steps::installPackages($o, $o->{packages}); + print "trying to pkg_install $name : done installed\n"; } sub fsck_option() { @@ -552,7 +604,6 @@ sub fsck_option() { sub install_urpmi { my ($prefix, $method, $mediums) = @_; - { local *F = getFile("depslist"); output("$prefix/var/lib/urpmi/depslist", ); diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index b22e8869a..df04546d5 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -2,6 +2,7 @@ package install_steps; use diagnostics; use strict; +use vars qw(@filesToSaveForUpgrade); #-###################################################################################### #- misc imports @@ -23,7 +24,7 @@ use network; use any; use fs; -my @filesToSaveForUpgrade = qw( +@filesToSaveForUpgrade = qw( /etc/ld.so.conf /etc/fstab /etc/hosts /etc/conf.modules ); @@ -209,6 +210,7 @@ sub beforeInstallPackages { fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount}); network::add2hosts("$o->{prefix}/etc/hosts", "localhost.localdomain", "127.0.0.1"); + require pkgs; pkgs::init_db($o->{prefix}, $o->{isUpgrade}); } @@ -344,13 +346,11 @@ GridHeight=70 } #- move some file after an upgrade that may be seriously annoying. + #- and rename saved files to .mdkgiorig. if ($o->{isUpgrade}) { log::l("moving previous desktop files that have been updated to Trash of each user"); install_any::move_desktop_file($o->{prefix}); - } - #- rename saved files to .mdkgiorig. - if ($o->{isUpgrade}) { foreach (@filesToSaveForUpgrade) { if (-e "$o->{prefix}$_.mdkgisave") { unlink "$o->{prefix}$_.mdkgiorig"; rename "$o->{prefix}/$_.mdkgisave", "$o->{prefix}/$_.mdkgiorig"; @@ -461,7 +461,7 @@ sub installCrypto { # } # } } - pkgs::install($o->{prefix}, $o->{isUpgrade}, [ values %$packages ]); + pkgs::install($o->{prefix}, $o->{isUpgrade}, [ values %$packages ]); #- TODO } #------------------------------------------------------------------------------ diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index 8aa06986e..5d04915ea 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -177,7 +177,9 @@ sub new($$) { my $ok = 1; local $SIG{CHLD} = sub { $ok = 0 if waitpid(-1, c::WNOHANG()) > 0 }; unless (fork) { - exec $_[0], "-dpms","-s" ,"240", "-allowMouseOpenFail", "-xf86config", $f or exit 1; + exec $_[0], (arch() =~ /^sparc/ ? () : ("-kb")), "-dpms","-s" ,"240", + ($_[0] =~ /Xsun/ ? ("-fp", "/usr/X11R6/lib/X11/fonts:unscaled") : + ("-allowMouseOpenFail", "-xf86config", $f)) or exit 1; } foreach (1..60) { sleep 1; @@ -194,29 +196,33 @@ sub new($$) { add2hash($card, Xconfigurator::cardName2card($card->{type})) if $card && $card->{type}; @servers = $card->{server} || "TGA"; #-@servers = qw(SVGA 3DLabs TGA) + } elsif (arch() =~ /^sparc/) { + local $_ = cat_("/proc/fb"); + if (/Mach64/) { @servers = qw(Mach64) } + else { @servers = qw(Xsun24) } } - @servers = qw(Mach64) if arch() =~ /^sparc/; @servers = qw(PPCDummy) if arch() eq "ppc"; foreach (@servers) { log::l("Trying with server $_"); my $dir = "/usr/X11R6/bin"; + my $prog = /Xsun/ ? $_ : "XF86_$_"; unless (-x "$dir/XF86_$_") { - unlink $_ foreach glob_("$dir/XF86_*"); - local *F; open F, ">$dir/XF86_$_" or die "failed to write server: $!"; + unlink $_ foreach glob_("$dir/X*"); + local *F; open F, ">$dir/$prog" or die "failed to write server: $!"; local $/ = \ (16 * 1024); - my $f = install_any::getFile("$dir/XF86_$_") or next; + my $f = install_any::getFile("$dir/$prog") or next; syswrite F, $_ foreach <$f>; - chmod 0755, "$dir/XF86_$_"; + chmod 0755, "$dir/$prog"; } if (/FB/) { !$o->{vga16} && $o->{allowFB} or next; - $o->{allowFB} = &$launchX("XF86_$_") #- keep in mind FB is used. + $o->{allowFB} = &$launchX($prog) #- keep in mind FB is used. and goto OK; } else { $o->{vga16} = 1 if /VGA16/; - &$launchX("XF86_$_") and goto OK; + &$launchX($prog) and goto OK; } } return undef; @@ -800,8 +806,13 @@ sub init_sizes() { sub createXconf($$$) { my ($file, $mouse_type, $mouse_dev, $wacom_dev) = @_; + devices::make("/dev/kdb") if arch() =~ /^sparc/; #- used by Xsun style server. symlinkf($mouse_dev, "/dev/mouse"); + #- needed for imlib to start on 8-bit depth visual. + symlink("/tmp/stage2/etc/imrc", "/etc/imrc"); + symlink("/tmp/stage2/etc/im_palette.pal", "etc/im_palette.pal"); + my $wacom; if ($wacom_dev) { $wacom_dev = devices::make($wacom_dev); diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 9ec17e7eb..a87ab9ea3 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -267,6 +267,7 @@ sub choosePackages { pkgs::setSelectedFromCompssList($o->{compssListLevels}, $packages, $::expert ? 90 : 80, $available, $o->{installClass}); my $min_size = pkgs::selectedSize($packages); + $o->chooseCD($packages); $o->chooseGroups($packages, $compssUsers, $compssUsersSorted); my $max_size = int (sum map { pkgs::packageSize($_) } values %{$packages->[0]}); @@ -317,6 +318,20 @@ sub chooseGroups { } } +sub chooseCD { + my ($o, $packages) = @_; + + #- get default values according to method, always skip empty medium + #- which is the default (or current) CD which is always available... + map { $packages->[2]{$_}{selected} = $o->{method} ne 'cdrom' } grep { $_ } keys %{$packages->[2]}; + + $o->ask_many_from_list_ref('', + _("Choose other CD to install"), + [ map { $packages->[2]{$_}{descr} || _("Cd-Rom #%s", $_) } grep { $_ } keys %{$packages->[2]} ], + [ map { \$packages->[2]{$_}{selected} } grep { $_ } keys %{$packages->[2]} ] + ) or goto &chooseCD unless $::beginner; +} + #------------------------------------------------------------------------------ sub installPackages { my ($o, $packages) = @_; @@ -360,13 +375,10 @@ sub configureNetwork($) { [ @l ]) || "Do not"; } else { $_ = $::beginner ? "Do not" : - $o->ask_from_list_([ _("Network Configuration") ], - _("Do you want to configure networking for your system?"), - [ __("Local LAN"), __("Dialup with modem"), __("Do not set up networking") ]); + ($o->ask_yesorno([ _("Network Configuration") ], + _("Do you want to configure Local LAN networking for your system?"), 0) ? "Local LAN" : "Do not"); } - if (/^Dialup/) { - $o->pppConfig; - } elsif (/^Do not/) { + if (/^Do not/) { $o->{netc}{NETWORKING} = "false"; } elsif (!/^Keep/) { $o->setup_thiskind('net', !$::expert, 1); @@ -391,6 +403,12 @@ sub configureNetwork($) { $o->configureNetworkNet($o->{netc}, $last ||= {}, @l) or return; } install_steps::configureNetwork($o); + + #- added ppp configuration after ethernet one. + if ($o->ask_yesorno([ _("Modem Configuration") ], + _("Do you want to configure Dialup with modem networking for your system?"), 0)) { + $o->pppConfig; + } } sub configureNetworkIntf { @@ -697,7 +715,6 @@ failures. Would you like to create a bootdisk for your system?"), #------------------------------------------------------------------------------ sub setupLILO { my ($o, $more) = @_; - any::setupBootloader($o, $o->{bootloader}, $o->{hds}, $o->{fstab}, $o->{security}, $o->{prefix}, $more); eval { $o->SUPER::setupBootloader }; diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 54045d30e..870904ff4 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -174,13 +174,16 @@ sub allPackages { } #- selection, unselection of package. -sub selectPackage($$;$$) { - my ($packages, $pkg, $base, $otherOnly) = @_; +sub selectPackage($$;$$$) { + my ($packages, $pkg, $base, $otherOnly, $check_recursion) = @_; #- check if the same or better version is installed, #- do not select in such case. packageFlagInstalled($pkg) and return; + #- avoid infinite recursion (mainly against badly generated depslist.ordered). + $check_recursion ||= {}; exists $check_recursion->{$pkg->{file}} and return; $check_recursion->{$pkg->{file}} = undef; + #- make sure base package are set even if already selected. $base and packageSetFlagBase($pkg, 1); @@ -202,12 +205,11 @@ sub selectPackage($$;$$) { packageFlagSelected($dep) and $preferred = $dep, last; exists $preferred{packageName($dep)} and $preferred = $dep; } - selectPackage($packages, $preferred, $base, $otherOnly) if $preferred; + selectPackage($packages, $preferred, $base, $otherOnly, $check_recursion) if $preferred; } else { #- deps have been closed except for choices, so no need to #- recursively apply selection, expand base on it. my $dep = packageById($packages, $_); -# printf ">>> $dep->{file}: %x\n", $dep->{flags}; $base and packageSetFlagBase($dep, 1); $otherOnly and !packageFlagSelected($dep) and $otherOnly->{packageName($dep)} = 1; $otherOnly or packageSetFlagSelected($dep, 1+packageFlagSelected($dep)); @@ -281,17 +283,18 @@ sub psUsingHdlists { chomp; s/\s*#.*$//; /^\s*$/ and next; - m/^hdlist(.*)\.cz.*$/ or die "invalid hdlist filename $_"; - push @hdlists, [ $_, $1 ]; + m/^hdlist(.*)\.cz\s*(.*)$/ or die "invalid hdlist filename $_"; + push @hdlists, [ $_, $1, $2 ]; } foreach (@hdlists) { - my ($hdlist, $medium) = @$_; + my ($hdlist, $medium, $descr) = @$_; my $f = install_any::getFile($hdlist) or die "no $hdlist found"; my $fakemedium = $method . ($medium || 1); $packages[2]{$medium} = { hdlist => $hdlist, medium => $medium, #- default medium is ''. + descr => $descr, #- default value is '' too. fakemedium => $fakemedium, min => scalar keys %{$packages[0]}, max => -1, #- will be updated after reading current hdlist. @@ -533,7 +536,7 @@ sub versionCompare($$) { } } -sub selectPackagesToUpgrade($$$;$$) { +sub selectPackagesToUpgrade($$$;$$) { #- TODO my ($packages, $prefix, $base, $toRemove, $toSave) = @_; log::l("reading /usr/lib/rpm/rpmrc"); @@ -566,20 +569,17 @@ sub selectPackagesToUpgrade($$$;$$) { c::headerGetEntry($header, 'version'). '-' . c::headerGetEntry($header, 'release'))); if ($p) { - eval { getHeader ($p) }; $@ && log::l("cannot get the header for package $p->{name}"); - my $version_cmp = versionCompare(c::headerGetEntry($header, 'version'), $p->{version}); - my $version_rel_test = $p->{header} ? c::rpmVersionCompare($header, $p->{header}) >= 0 : - ($version_cmp > 0 || - $version_cmp == 0 && - versionCompare(c::headerGetEntry($header, 'release'), $p->{release}) >= 0); - if ($version_rel_test) { + my $version_cmp = versionCompare(c::headerGetEntry($header, 'version'), packageVersion($p)); + my $version_rel_test = $version_cmp > 0 || $version_cmp == 0 && + versionCompare(c::headerGetEntry($header, 'release'), packageRelease($p)) >= 0; + if ($version_rel_test) { #- use FORCE TODO ? if ($otherPackage && $version_cmp <= 0) { log::l("removing $otherPackage since it will not be updated otherwise"); $toRemove{$otherPackage} = 1; #- force removing for theses other packages, select our. } else { - $p->{installed} = 1; + packageSetFlagInstalled($p, 1); } - } elsif ($upgradeNeedRemove{$p->{name}}) { + } elsif ($upgradeNeedRemove{packageName($p)}) { my $otherPackage = (c::headerGetEntry($header, 'name'). '-' . c::headerGetEntry($header, 'version'). '-' . c::headerGetEntry($header, 'release')); @@ -587,19 +587,19 @@ sub selectPackagesToUpgrade($$$;$$) { $toRemove{$otherPackage} = 1; #- force removing for theses other packages, select our. } } else { - my @files = c::headerGetEntry($header, 'filenames'); - @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && - ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = (); +# my @files = c::headerGetEntry($header, 'filenames'); +# @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && +# ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = (); } }); #- find new packages to upgrade. - foreach (values %$packages) { + foreach (values %{$packages->[0]}) { my $p = $_; my $skipThis = 0; - my $count = c::rpmdbNameTraverse($db, $p->{name}, sub { + my $count = c::rpmdbNameTraverse($db, packageName($p), sub { my ($header) = @_; - $skipThis ||= $p->{installed}; + $skipThis ||= packageFlagInstalled($p); }); #- skip if not installed (package not found in current install). @@ -609,25 +609,21 @@ sub selectPackagesToUpgrade($$$;$$) { unless ($skipThis) { my $cumulSize; - selectPackage($packages, $p) unless $p->{selected}; + selectPackage($packages, $p) unless packageFlagSelected($p); #- keep in mind installed files which are not being updated. doing this costs in #- execution time but use less memory, else hash all installed files and unhash #- all file for package marked for upgrade. - c::rpmdbNameTraverse($db, $p->{name}, sub { + c::rpmdbNameTraverse($db, packageName($p), sub { my ($header) = @_; - my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ && - (c::headerGetEntry($header, 'name'). '-' . - c::headerGetEntry($header, 'version'). '-' . - c::headerGetEntry($header, 'release'))); $cumulSize += c::headerGetEntry($header, 'size'); #- all these will be deleted on upgrade. - my @files = c::headerGetEntry($header, 'filenames'); - @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && - ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = (); +# my @files = c::headerGetEntry($header, 'filenames'); +# @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && +# ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = (); }); - eval { getHeader ($p) }; - my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : (); - map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles; +# eval { getHeader ($p) }; +# my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : (); +# map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles; #- keep in mind the cumul size of installed package since they will be deleted #- on upgrade. @@ -637,47 +633,47 @@ sub selectPackagesToUpgrade($$$;$$) { #- unmark all files for all packages marked for upgrade. it may not have been done above #- since some packages may have been selected by depsList. - foreach (values %$packages) { - my $p = $_; - - if ($p->{selected}) { - eval { getHeader ($p) }; - my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : (); - map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles; - } - } +# foreach (values %{$packages->[0]}) { +# my $p = $_; +# +# if (packageFlagSelected($p)) { +# eval { getHeader ($p) }; +# my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : (); +# map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles; +# } +# } #- select packages which contains marked files, then unmark on selection. - foreach (values %$packages) { - my $p = $_; - - unless ($p->{selected}) { - eval { getHeader ($p) }; - my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : (); - my $toSelect = 0; - map { if (exists $installedFilesForUpgrade{$_}) { - $toSelect ||= ! -d "$prefix/$_" && ! -l "$prefix/$_"; delete $installedFilesForUpgrade{$_} } - } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles; - selectPackage($packages, $p) if ($toSelect); - } - } +# foreach (values %$packages) { +# my $p = $_; +# +# unless ($p->{selected}) { +# eval { getHeader ($p) }; +# my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : (); +# my $toSelect = 0; +# map { if (exists $installedFilesForUpgrade{$_}) { +# $toSelect ||= ! -d "$prefix/$_" && ! -l "$prefix/$_"; delete $installedFilesForUpgrade{$_} } +# } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles; +# selectPackage($packages, $p) if ($toSelect); +# } +# } #- select packages which obseletes other package, obselete package are not removed, #- should we remove them ? this could be dangerous ! - foreach (values %$packages) { - my $p = $_; +# foreach (values %$packages) { +# my $p = $_; - eval { getHeader ($p) }; - my @obsoletes = $p->{header} ? c::headerGetEntry(getHeader ($p), 'obsoletes'): (); - map { selectPackage($packages, $p) if c::rpmdbNameTraverse($db, $_) > 0 } @obsoletes; - } +# eval { getHeader ($p) }; +# my @obsoletes = $p->{header} ? c::headerGetEntry(getHeader ($p), 'obsoletes'): (); +# map { selectPackage($packages, $p) if c::rpmdbNameTraverse($db, $_) > 0 } @obsoletes; +# } #- select all base packages which are not installed and not selected. - foreach (@$base) { - my $p = $packages->[0]{$_} or log::l("missing base package $_"), next; - log::l("base package $_ is not installed") unless $p->{installed} || $p->{selected}; #- installed not set on upgrade. - selectPackage($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected. - } +# foreach (@$base) { +# my $p = $packages->[0]{$_} or log::l("missing base package $_"), next; +# log::l("base package $_ is not installed") unless $p->{installed} || $p->{selected}; #- installed not set on upgrade. +# selectPackage($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected. +# } #- clean false value on toRemove. delete $toRemove{''}; diff --git a/perl-install/printer.pm b/perl-install/printer.pm index 34a20336d..f7e847b9f 100644 --- a/perl-install/printer.pm +++ b/perl-install/printer.pm @@ -328,7 +328,7 @@ sub getinfo($) { sub read_printer_db(;$) { my $dbpath = $prefix . ($_[0] || $PRINTER_DB_FILE); - %thedb and return; + scalar(keys %thedb) > 3 and return; #- try reparse if using only ppa, POSTSCRIPT, TEXT. my %available_devices; #- keep only available devices in our database. local *AVAIL; open AVAIL, ($::testing ? "$prefix" : "chroot $prefix ") . "/usr/bin/gs --help |"; diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm index 50b0fb4e4..8901e1f0d 100644 --- a/perl-install/printerdrake.pm +++ b/perl-install/printerdrake.pm @@ -38,7 +38,7 @@ sub setup_local($$$) { return if !$in->ask_from_entries_refH(_("Local Printer Device"), _("What device is your printer connected to (note that /dev/lp0 is equivalent to LPT1:)?\n") . (join "\n", @str), [ -_("Printer Device:") => {val => \$printer->{DEVICE}, list => \@port } ], +_("Printer Device") => {val => \$printer->{DEVICE}, list => \@port } ], ); #- select right DBENTRY according to device selected. @@ -261,8 +261,8 @@ You can add some more or change the existing ones."), _("Every print queue (which print jobs are directed to) needs a name (often lp) and a spool directory associated with it. What name and directory should be used for this queue and how is the printer connected?"), [ -_("Name of queue:") => { val => \$printer->{QUEUE} }, -_("Spool directory:") => { val => \$printer->{SPOOLDIR} }, +_("Name of queue") => { val => \$printer->{QUEUE} }, +_("Spool directory") => { val => \$printer->{SPOOLDIR} }, _("Printer Connection") => { val => \$printer->{str_type}, not_edit => 1, list => [ keys %printer::printer_type ] }, ], changed => sub { -- cgit v1.2.1