summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>1999-07-21 16:59:18 +0000
committerPascal Rigaux <pixel@mandriva.com>1999-07-21 16:59:18 +0000
commit5a5ec8d18c04f2077622bce50e7024e0749e4da8 (patch)
tree4449a44fc54d7f3e039045a476ecb14522ee5992 /perl-install
parentdd40621fa1311c9bce97902e2db57f8b15fab449 (diff)
downloaddrakx-5a5ec8d18c04f2077622bce50e7024e0749e4da8.tar
drakx-5a5ec8d18c04f2077622bce50e7024e0749e4da8.tar.gz
drakx-5a5ec8d18c04f2077622bce50e7024e0749e4da8.tar.bz2
drakx-5a5ec8d18c04f2077622bce50e7024e0749e4da8.tar.xz
drakx-5a5ec8d18c04f2077622bce50e7024e0749e4da8.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile18
-rw-r--r--perl-install/c/Makefile.PL2
-rw-r--r--perl-install/common.pm7
-rw-r--r--perl-install/fsedit.pm56
-rwxr-xr-xperl-install/getpkgs_deps10
-rwxr-xr-xperl-install/install23
-rw-r--r--perl-install/install2.pm12
-rw-r--r--perl-install/install_any.pm2
-rw-r--r--perl-install/lang.pm12
-rw-r--r--perl-install/my_gtk.pm18
-rw-r--r--perl-install/partition_table.pm3
-rw-r--r--perl-install/pkgs.pm125
12 files changed, 175 insertions, 93 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 3b401fa1e..d4aec1cdb 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,6 +1,7 @@
SO_FILES = c/blib/arch/auto/c/c.so
PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm commands install2 diskdrake
-DEST = /tmp/t/Mandrake/instimage
+ROOTDEST = /tmp/t
+DEST = $(ROOTDEST)/Mandrake/instimage
DESTREP4PMS = $(DEST)/usr/bin/perl-install
PERL = perl
LOCALFILES = $(PERL) mouseconfig
@@ -50,6 +51,9 @@ test_pms: verify_c
verify_c:
./verify_c $(PMS)
+depslist:
+ ./gendepslist > $(ROOTDEST)/Mandrake/base/depslist
+
install_pms: all
for i in `perl -ne 's/sub (\w+?)_? {.*/$$1/ and print' commands.pm`; do ln -sf commands $(DEST)/usr/bin/$$i; done
@@ -110,8 +114,9 @@ get_needed_files: $(SO_FILES)
cp -a keymaps $(DEST)/usr/share
cp -a consolefonts $(DEST)/usr/share
- echo -e "#!/usr/bin/perl\n\nsymlink '/tmp/rhimage/usr/lib/perl5', '/usr/lib/perl5';\nexec '/usr/bin/sh'" > $(DEST)/usr/bin/runinstall2
- chmod a+x $(DEST)/usr/bin/runinstall2
+ ln -s install2 $(DEST)/usr/bin/runinstall2
+# echo -e "#!/bin/sh\n\nexec '/usr/bin/sh'" > $(DEST)/usr/bin/runinstall2
+# chmod a+x $(DEST)/usr/bin/runinstall2
as_root:
/bin/dd if=/dev/zero of=/tmp/initrd bs=1k count=4000
@@ -128,17 +133,16 @@ full_stage2:
stage2:
$(MAKE) install_pms
- cd /tmp/t ; tar cfz /tmp/instimage-full.tgz Mandrake
- cd /tmp/t ; tar cfz /tmp/instimage-light.tgz Mandrake/instimage/usr/[bl]*
+ cd $(ROOTDEST) ; tar cfz /tmp/instimage-full.tgz Mandrake
+ cd $(ROOTDEST) ; tar cfz /tmp/instimage-light.tgz Mandrake/instimage/usr/[bl]*
@#rm -rf /mnt/initrd/*
@#cp -a $(DEST)/* /mnt/initrd
@#sync
@#dd if=/dev/loop0 | gzip -9 > /tmp/t/Mandrake/base/stage2.img
-
# function f() { grep "$*" /usr/include/*.h /usr/include/*/*.h; }
-# dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cp -a /tmp/disk/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
+# dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cd ~pixel/gi/perl-install ; install -s install/local-install install1/bin/install ; cp -a install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
# mount /tmp/initrd /mnt/disk/ -o loop ; ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
diff --git a/perl-install/c/Makefile.PL b/perl-install/c/Makefile.PL
index f9d2309f8..4ed352603 100644
--- a/perl-install/c/Makefile.PL
+++ b/perl-install/c/Makefile.PL
@@ -6,5 +6,5 @@ WriteMakefile(
'VERSION_FROM' => 'c.pm', # finds $VERSION
'LIBS' => ['-lrpm -ldb1 -lz -L/usr/X11R6/lib -lX11 -lgdk'], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
- 'INC' => '-Wall `gtk-config --cflags`', # e.g., '-I/usr/include/other'
+ 'INC' => '-I/usr/include/rpm -Wall `gtk-config --cflags`', # e.g., '-I/usr/include/other'
);
diff --git a/perl-install/common.pm b/perl-install/common.pm
index c15aafdae..feec2e844 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- common => [ qw(_ __ min max bool member divide is_empty_array_ref round_up round_down first top translate) ],
+ common => [ qw(_ __ min max bool member divide is_empty_array_ref set_new set_add round_up round_down first second top uniq translate) ],
file => [ qw(dirname basename all glob_ cat_ chop_ mode) ],
system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ],
constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
@@ -25,7 +25,9 @@ sub __ { $_[0] }
sub min { my $min = shift; grep { $_ < $min and $min = $_; } @_; $min }
sub max { my $max = shift; grep { $_ > $max and $max = $_; } @_; $max }
sub first { $_[0] }
+sub second { $_[1] }
sub top { $_[$#_] }
+sub uniq { my %l; @l{@_} = (); keys %l }
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
sub dirname { @_ == 1 or die "usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
sub basename { @_ == 1 or die "usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
@@ -38,6 +40,9 @@ sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
+sub set_new(@) { my %l; @l{@_} = undef; { list => [ @_ ], hash => \%l } }
+sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}->{$_} and next; push @{$o->{list}}, $_; $o->{hash}->{$_} = undef } }
+
sub sync { syscall_('sync') }
sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) }
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 8e511c8b9..7406211e7 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -25,6 +25,11 @@ my @suggestions = (
1;
+sub suggestions_mntpoint($) {
+ my ($hds) = @_;
+ grep { !/swap/ && !has_mntpoint($_, $hds) } map { $_->{mntpoint} } @suggestions;
+}
+
sub hds($$) {
my ($drives, $flags) = @_;
my @hds;
@@ -58,13 +63,11 @@ sub suggest_part($$$;$) {
$suggestions ||= \@suggestions;
foreach (@$suggestions) { $_->{minsize} ||= $_->{size} }
- my $has_swap;
- my @mntpoints = map { $has_swap ||= isSwap($_); $_->{mntpoint} } get_fstab(@$hds);
- my %mntpoints; @mntpoints{@mntpoints} = undef;
+ my $has_swap = grep { isSwap($_) } get_fstab(@$hds);
my ($best, $second) =
grep { $part->{size} >= $_->{minsize} }
- grep { !exists $mntpoints{$_->{mntpoint}} || isSwap($_) && !$has_swap }
+ grep { ! has_mntpoint($_->{mntpoint}, $hds) || isSwap($_) && !$has_swap }
@$suggestions or return;
$best = $second if
@@ -100,27 +103,31 @@ sub suggest_part($$$;$) {
#}
+sub has_mntpoint($$) {
+ my ($mntpoint, $hds) = @_;
+ scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds);
+}
-sub checkMountPoint($$) {
-# my $type = shift;
-# local $_ = shift;
-#
-# m|^/| or die "The mount point $_ is illegal.\nMount points must begin with a leading /";
+sub check_mntpoint($$) {
+ my ($mntpoint, $hds) = @_;
+
+ $mntpoint eq '' and return;
+
+ local $_ = $mntpoint;
+ m|^/| or die _("Mount points must begin with a leading /");
# m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /";
-# c::isprint($_) or die "The mount point $_ is illegal.\nMount points must be made of printable characters (no accents...)";
-#
-# foreach my $dev (qw(/dev /bin /sbin /etc /lib)) {
-# /^$dev/ and die "The $_ directory must be on the root filesystem.",
-# }
-#
-# if ($type eq 'linux_native') {
-# $_ eq '/'; and return 1;
-# foreach my $r (qw(/var /tmp /boot /root)) {
-# /^$r/ and return 1;
-# }
-# die "The mount point $_ is illegal.\nSystem partitions must be on Linux Native partitions";
-# }
-# 1;
+
+ has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
+}
+
+sub add($$$) {
+ my ($hd, $part, $hds) = @_;
+
+ isSwap($part) ?
+ ($part->{mntpoint} = 'swap') :
+ check_mntpoint($part->{mntpoint}, $hds);
+
+ partition_table::add($hd, $part);
}
sub removeFromList($$$) {
@@ -183,9 +190,8 @@ sub allocatePartitions($$) {
sub auto_allocate($;$) {
my ($hds, $suggestions) = @_;
- my %mntpoints; map { $mntpoints{$_->{mntpoint}} = 1 } get_fstab(@$hds);
allocatePartitions($hds, [
- grep { ! $mntpoints{$_->{mntpoint}} }
+ grep { ! has_mntpoint($_->{mntpoint}, $hds) }
@{ $suggestions || \@suggestions }
]);
map { partition_table::assign_device_numbers($_) } @$hds;
diff --git a/perl-install/getpkgs_deps b/perl-install/getpkgs_deps
new file mode 100755
index 000000000..bc2d5e0e8
--- /dev/null
+++ b/perl-install/getpkgs_deps
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use diagnostics;
+use strict;
+
+use lib qw(/usr/bin/perl-install . c c/blib/arch);
+use pkgs_deps;
+use pkgs;
+
+pkgs_deps::main(pkgs::psUsingDirectory());
diff --git a/perl-install/install2 b/perl-install/install2
index c8ae2ce9b..016bafabc 100755
--- a/perl-install/install2
+++ b/perl-install/install2
@@ -3,7 +3,8 @@
use diagnostics;
use strict;
-use lib qw(. c c/blib/arch);
+use lib qw(/usr/bin/perl-install . c c/blib/arch);
use install2;
install2::main(@ARGV);
+
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 442ad4cf0..049331533 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -24,7 +24,7 @@ $INSTALL_VERSION = 0;
my @installStepsFields = qw(text help skipOnCancel skipOnLocal prev next);
my @installSteps = (
- selectLanguage => [ "Choose your language", "help", 0, 0 ],
+ selectLanguage => [ __("Choose your language"), "help", 0, 0 ],
selectPath => [ __("Choose install or upgrade"), __("help"), 0, 0 ],
selectInstallClass => [ __("Select installation class"), __("help"), 0, 0 ],
setupSCSI => [ __("Setup SCSI"), __("help"), 0, 1 ],
@@ -98,10 +98,10 @@ my $default = {
installClass => 'Server',
bootloader => { onmbr => 1, linear => 0 },
mkbootdisk => 0,
- base => [ qw(basesystem mkbootdisk linuxconf anacron linux_logo rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup setuptool filesystem MAKEDEV SysVinit ash at authconfig bash bdflush binutils console-tools cpio crontabs dev diffutils e2fsprogs ed eject etcskel file fileutils findutils getty_ps gpm grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup mailcap mailx man mkinitrd mingetty modutils mount mouseconfig net-tools passwd kernel-pcmcia-cs procmail procps psmisc pump mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which) ],
+ base => [ qw(basesystem console-tools mkbootdisk linuxconf anacron linux_logo rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup setuptool filesystem MAKEDEV SysVinit ash at authconfig bash bdflush binutils console-tools crontabs dev e2fsprogs ed etcskel file fileutils findutils getty_ps gpm grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which) ],
comps => [
- [ 1, __('X Window System') => qw(XFree86 XFree86-xfs XFree86-75dpi-fonts) ],
- [ 1, __('KDE') => qw(kdeadmin kdebase kthememgr kdegames kjumpingcube kdegraphics kdelibs kdemultimedia kdenetwork kdesupport kdeutils kBeroFTPD kdesu kdetoys kpilot kcmlaptop kdpms kpppload kmpg) ],
+ [ 0, __('X Window System') => qw(XFree86 XFree86-xfs XFree86-75dpi-fonts) ],
+ [ 0, __('KDE') => qw(kdeadmin kdebase kthememgr kdegames kjumpingcube kdegraphics kdelibs kdemultimedia kdenetwork kdesupport kdeutils kBeroFTPD kdesu kdetoys kpilot kcmlaptop kdpms kpppload kmpg) ],
[ 0, __('Console Multimedia') => qw(aumix audiofile esound sndconfig awesfx rhsound cdp mpg123 svgalib playmidi sox mikmod) ],
[ 0, __('CD-R burning and utilities') => qw(mkisofs cdrecord cdrecord-cdda2wav cdparanoia xcdroast) ],
[ 0, __('Games') => qw(xbill xboard xboing xfishtank xgammon xjewel xpat2 xpilot xpuzzles xtrojka xkobo freeciv) ],
@@ -197,10 +197,12 @@ sub findInstallFiles {
c::rpmReadConfigFiles() or die "can't read rpm config files";
log::l("\tdone");
- $o->{packages} = pkgs::psFromHeaderListFile(install_any::imageGetFile("hdlist"));
+ $o->{packages} = pkgs::psUsingDirectory();
+ pkgs::getDeps($o->{packages});
}
sub choosePackages {
+ foreach (@{$o->{default}->{base}}) { pkgs::select($o->{packages}, $_) }
$o->choosePackages($o->{packages}, $o->{comps});
my @p = @{$o->{default}->{base}}, grep { $_->{selected} } @{$o->{comps}};
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index f7bac3580..74e6b2a01 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -15,7 +15,7 @@ use log;
1;
-sub fileInBase { member($_[0], qw(hdlist comps)); }
+sub fileInBase { member($_[0], qw(hdlist comps depslist)); }
sub imageGetFile {
fileInBase($_[0]) and return "/tmp/rhimage/Mandrake/base/$_[0]";
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index 54e75bcd8..3385248d6 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -8,6 +8,7 @@ use commands;
use cpio;
use log;
+my @fields =
my %languages = (
"en" => [ "English", undef, undef, "en_US" ],
"fr" => [ "French", "lat0-sun16", "iso15", "fr_FR" ],
@@ -60,14 +61,15 @@ sub write {
&$f("LANG", $lang);
&$f("LINGUAS", $lang);
if (my $l = $languages{$lang}) {
- &$f("LC_ALL", $l->{lc_all});
- &$f("SYSFONT", $l->{font});
- &$f("SYSFONTACM", $l->{map});
+ &$f("LC_ALL", $l->[3]);
+ $l->[1] or return;
+ &$f("SYSFONT", $l->[1]);
+ &$f("SYSFONTACM", $l->[2]);
my $p = "$prefix/usr/lib/kbd";
commands::cp("-f",
- "$p/consolefonts/$l->{font}.psf.gz",
- glob_("$p/consoletrans/$l->{map}*"),
+ "$p/consolefonts/$l->[1].psf.gz",
+ glob_("$p/consoletrans/$l->[2]*"),
"$prefix/etc/sysconfig/console");
}
}
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index b7a3405f5..c2f0166bf 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -127,8 +127,8 @@ sub create_okcancel($;$$) {
my ($w, $ok, $cancel) = @_;
gtkadd(create_hbox(),
- gtksignal_connect($w->{ok} = new Gtk::Button($ok || "Ok"), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }),
- gtksignal_connect(new Gtk::Button($cancel || "Cancel"), "clicked" => sub { $w->{retval} = 0; Gtk->main_quit }),
+ gtksignal_connect($w->{ok} = new Gtk::Button($ok || _("Ok")), "clicked" => $w->{ok_clicked} || sub { $w->{retval} = 1; Gtk->main_quit }),
+ gtksignal_connect(new Gtk::Button($cancel || _("Cancel")), "clicked" => $w->{cancel_clicked} || sub { $w->{retval} = 0; Gtk->main_quit }),
);
}
@@ -221,8 +221,8 @@ sub _create_window($$) {
################################################################################
sub ask_warn { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); }
-sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, "Yes", "No"); main($w); }
-sub ask_okcancel { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, "Is it ok?", "Ok", "Cancel"); main($w); }
+sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Yes"), _("No")); main($w); }
+sub ask_okcancel { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Is it ok?"), _("Ok"), _("Cancel")); main($w); }
sub ask_from_entry { my $w = my_gtk->new(shift @_); $w->_ask_from_entry(@_); main($w); }
sub ask_from_list { my $w = my_gtk->new(shift @_); $w->_ask_from_list(pop @_, @_); main($w); }
@@ -230,15 +230,13 @@ sub _ask_from_entry($$@) {
my ($o, @msgs) = @_;
my $entry = new Gtk::Entry;
my $f = sub { $o->{retval} = $entry->get_text; Gtk->main_quit };
+ $o->{ok_clicked} = $f;
+ $o->{cancel_clicked} = sub { $o->{retval} = undef; Gtk->main_quit };
gtkadd($o->{window},
gtkpack($o->create_box_with_title(@msgs),
gtksignal_connect($entry, 'activate' => $f),
- ($o->{hide_buttons} ? () : gtkpack(new Gtk::HBox(0,0),
- gtksignal_connect(new Gtk::Button('Ok'), 'clicked' => $f),
- gtksignal_connect(new Gtk::Button('Cancel'), 'clicked' => sub { $o->{retval} = undef; Gtk->main_quit }),
- )),
- ),
+ ($o->{hide_buttons} ? () : create_okcancel($o))),
);
$entry->grab_focus();
}
@@ -295,7 +293,7 @@ sub _ask_warn($@) {
my ($o, @msgs) = @_;
gtkadd($o->{window},
gtkpack($o->create_box_with_title(@msgs),
- gtksignal_connect(my $w = new Gtk::Button("Ok"), "clicked" => sub { Gtk->main_quit }),
+ gtksignal_connect(my $w = new Gtk::Button(_("Ok")), "clicked" => sub { Gtk->main_quit }),
),
);
$w->grab_focus();
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 3ebd47122..3f46e7ea7 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -286,6 +286,9 @@ sub add($$) {
raw_add($hd->{primary}->{raw}, $part);
@{$hd->{primary}->{normal}} = $part;
} else {
+ $hd->{primary}->{extended} && !verifyInside($part, $hd->{primary}->{extended})
+ and die "sorry, can't add outside the main extended partition";
+
foreach (@{$hd->{extended}}) {
$_->{normal} and next;
raw_add($_->{raw}, $part);
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 34a5774c9..9d9894031 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -19,59 +19,108 @@ my @skipThesesPackages = qw(XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach
sub skipThisPackage { member($_[0], @skipThesesPackages) }
-sub addInfosFromHeader($$) {
- my ($packages, $header) = @_;
+
+sub Package {
+ my ($packages, $name) = @_;
+ $packages->{$name} or die "unknown package $name";
+}
+sub select($$) {
+ my ($packages, $name) = @_;
+ my $p = Package($packages, $name);
+ $p->{selected} = -1; # selected by user
+ my @l = @{$p->{deps}};
+ while (@l) {
+ my $n = shift @l;
+ my $i = Package($packages, $n);
+ push @l, @{$i->{deps}} unless $i->{selected};
+ $i->{selected}++ unless $i->{selected} == -1;
+ }
+}
+sub unselect($$) {
+ my ($packages, $name) = @_;
+ my $p = Package($packages, $name);
+ my $set = set_new($name);
+ my $l = $set->{list};
+
+ # get the list of provided packages
+ foreach my $q (@$l) {
+ my $i = Package($packages, $q);
+ $i->{selected} or next;
+ $i->{selected} = 1; # that way, its counter will be zero the first time
+ set_add($set, @{$i->{provides} || []});
+ }
+
+ while (@$l) {
+ my $n = shift @$l;
+ my $i = Package($packages, $n);
+
+ $i->{selected} <= 0 and next;
+ if (--$i->{selected} == 0) {
+ push @$l, @{$i->{deps}};
+ }
+ }
+
+ # garbage collect for circular dependencies
+ my $changed = 1;
+ while ($changed) {
+ $changed = 0;
+ NEXT: foreach my $p (grep { $_->{selected} > 0 } values %$packages) {
+ my $set = set_new(@{$p->{provides}});
+ foreach (@{$set->{list}}) {
+ my $q = Package($packages, $_);
+ $q->{selected} == -1 and next NEXT;
+ set_add($set, @{$q->{provides}}) if $q->{selected};
+ }
+ $p->{selected} = 0;
+ $changed = 1;
+ }
+ }
+}
+sub toggle($$) {
+ my ($packages, $name) = @_;
+ Package($packages, $name)->{selected} ? unselect($packages, $name) : &select($packages, $name);
+}
+sub set($$$) {
+ my ($packages, $name, $val) = @_;
+ $val ? &select($packages, $name) : unselect($packages, $name);
+}
+
+sub addInfosFromHeader($$;$) {
+ my ($packages, $header, $file) = @_;
my $name = c::headerGetEntry($header, 'name');
$packages->{$name} = {
- name => $name,
+ name => $name, file => $file, selected => 0, deps => [],
header => $header, size => c::headerGetEntry($header, 'size'),
- group => c::headerGetEntry($header, 'group') || "(unknown group)",
};
}
-sub psUsingDirectory {
+sub psUsingDirectory(;$) {
my ($dirname) = @_;
my %packages;
+ $dirname ||= install_any::imageGetFile('');
log::l("scanning $dirname for packages");
foreach (glob_("$dirname/*.rpm")) {
- my $basename = basename($_);
local *F;
open F, $_ or log::l("failed to open package $_: $!");
- my $header = c::rpmReadPackageHeader($_) or log::l("failed to rpmReadPackageHeader $basename: $!");
+ my $header = c::rpmReadPackageHeader(fileno F) or log::l("failed to rpmReadPackageHeader $_: $!");
my $name = c::headerGetEntry($header, 'name');
- addInfosFromHeader(\%packages, $header);
+ addInfosFromHeader(\%packages, $header, $_);
}
\%packages;
}
-sub psVerifyDependencies {
-# my ($packages, $fixup) = @_;
-#
-# -r "/mnt/var/lib/rpm/packages.rpm" or die "can't find packages.rpm";
-#
-# my $db = rpmdbOpenRWCreate("/mnt");
-# my $rpmdeps = rpmtransCreateSet($db, undef);
-#
-# foreach (values %$packages) {
-# $_->{selected} ?
-# c::rpmtransAddPackage($rpmdeps, $_->{header}, undef, $_, 0, undef) :
-# c::rpmtransAvailablePackage($rpmdeps, $_->{header}, $_);
-# }
-# my @conflicts = c::rpmdepCheck($rpmdeps);
-#
-# rpmtransFree($rpmdeps);
-# rpmdbClose($db);
-#
-# if ($fixup) {
-# foreach (@conflicts) {
-# $_->{suggestedPackage}->{selected} = 1;
-# }
-# rpmdepFreeConflicts(@conflicts);
-# }
-#
-# 1;
+sub getDeps($) {
+ my ($packages) = @_;
+
+ local *F;
+ open F, install_any::imageGetFile("depslist"); # or die "can't find dependencies list";
+ foreach (<F>) {
+ my ($name, @deps) = split;
+ Package($packages, $name)->{deps} = \@deps;
+ map { push @{Package($packages, $_)->{provides}}, $name } @deps;
+ }
}
sub psFromHeaderListDesc {
@@ -130,9 +179,11 @@ sub install {
my ($total, $nb);
foreach my $p (@$toInstall) {
- my $fullname = sprintf "%s-%s-%s.%s.rpm",
- map { c::headerGetEntry($p->{header}, $_) } qw(name version release arch);
- c::rpmtransAddPackage($trans, $p->{header}, install_any::imageGetFile($fullname) , $isUpgrade);
+ $p->{file} ||=
+ install_any::imageGetFile(sprintf "%s-%s-%s.%s.rpm",
+ map { c::headerGetEntry($p->{header}, $_) }
+ qw(name version release arch));
+ c::rpmtransAddPackage($trans, $p->{header}, $p->{file}, $isUpgrade);
$nb++;
$total += $p->{size};
}