diff options
author | pad <pad@mandriva.com> | 1999-09-14 14:50:50 +0000 |
---|---|---|
committer | pad <pad@mandriva.com> | 1999-09-14 14:50:50 +0000 |
commit | 0aa7a9e98c3b51085c87aa13d61eef8e3f694626 (patch) | |
tree | 06c3462cb7af3adb37d3a4606dd43d2604b88eec /perl-install | |
parent | 951e65ef820631665dbeddf6cfb43afce034efb9 (diff) | |
download | drakx-0aa7a9e98c3b51085c87aa13d61eef8e3f694626.tar drakx-0aa7a9e98c3b51085c87aa13d61eef8e3f694626.tar.gz drakx-0aa7a9e98c3b51085c87aa13d61eef8e3f694626.tar.bz2 drakx-0aa7a9e98c3b51085c87aa13d61eef8e3f694626.tar.xz drakx-0aa7a9e98c3b51085c87aa13d61eef8e3f694626.zip |
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r-- | perl-install/commands.pm | 18 | ||||
-rw-r--r-- | perl-install/common.pm | 47 | ||||
-rw-r--r-- | perl-install/detect_devices.pm | 49 | ||||
-rw-r--r-- | perl-install/fsedit.pm | 18 | ||||
-rw-r--r-- | perl-install/install2.pm | 17 | ||||
-rw-r--r-- | perl-install/install_any.pm | 7 | ||||
-rw-r--r-- | perl-install/install_steps_interactive.pm | 65 | ||||
-rw-r--r-- | perl-install/interactive.pm | 5 | ||||
-rw-r--r-- | perl-install/interactive_gtk.pm | 1 | ||||
-rw-r--r-- | perl-install/modparm.pm | 18 | ||||
-rw-r--r-- | perl-install/printer.pm | 11 | ||||
-rw-r--r-- | perl-install/run_program.pm | 19 |
12 files changed, 213 insertions, 62 deletions
diff --git a/perl-install/commands.pm b/perl-install/commands.pm index 3909d4398..87862c19b 100644 --- a/perl-install/commands.pm +++ b/perl-install/commands.pm @@ -4,12 +4,20 @@ use diagnostics; use strict; use vars qw($printable_chars); +#-###################################################################################### +#- misc imports +#-###################################################################################### use common qw(:common :file :system :constant); +#-##################################################################################### +#- Globals +#-##################################################################################### my $BUFFER_SIZE = 1024; -1; +#-###################################################################################### +#- Functions +#-###################################################################################### sub getopts { my $o = shift; my @r = map { '' } (@_ = split //, $_[0]); @@ -384,7 +392,7 @@ sub insmod { require 'run_program.pm'; run_program::run("cd /tmp ; bzip2 -cd /lib/modules.cpio.bz2 | cpio -i $name.o"); -r $f or die "can't find module $name"; - run_program::run("insmod_", $f, @_) or die("insmod $name failed"); + run_program::run(["insmod_", "insmod"], $f, @_) or die("insmod $name failed"); unlink $f; } @@ -444,3 +452,9 @@ $dev, $size, $used, $free, $use, $mntpoint write DF if $size; } } + +#-###################################################################################### +#- Wonderful perl :( +#-###################################################################################### +1; # + diff --git a/perl-install/common.pm b/perl-install/common.pm index 5fa40e2b1..d30906a21 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -14,12 +14,18 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int ); @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; + +#-##################################################################################### +#- Globals +#-##################################################################################### $printable_chars = "\x20-\x7E"; $sizeof_int = psizeof("i"); $bitof_int = $sizeof_int * 8; $SECTORSIZE = 512; -1; +#-##################################################################################### +#- Functions +#-##################################################################################### sub fold_left(&@) { my $f = shift; @@ -264,7 +270,24 @@ sub setVarsInSh { $l->{$_} and print F "$_=$l->{$_}\n" foreach @fields; } + +sub best_match { + my ($str, @lis) = @_; + my @words = split /\W+/, $str; + my ($max, $res) = 0; + + foreach (@lis) { + my $count = 0; + foreach my $i (@words) { + $count++ if /$i/i; + } + $max = $count, $res = $_ if $count >= $max; + } + $res; +} + sub bestMatchSentence { + my $best = -1; my $bestSentence; my @s = split /\W+/, shift; @@ -277,3 +300,25 @@ sub bestMatchSentence { } $bestSentence; } + +# count the number of character that match +sub bestMatchSentence2 { + + my $best = -1; + my $bestSentence; + my @s = split /\W+/, shift; + foreach (@_) { + my $count = 0; + foreach my $e (@s) { + $count+= length ($e) if /$e/i; + } + $best = $count, $bestSentence = $_ if $count > $best; + } + $bestSentence; +} + + +#-###################################################################################### +#- Wonderful perl :( +#-###################################################################################### +1; # diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index 034fa48b9..9cc57b2fb 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -3,17 +3,24 @@ package detect_devices; use diagnostics; use strict; +#-###################################################################################### +#- misc imports +#-###################################################################################### use log; use common qw(:common :file); use devices; use c; +#-##################################################################################### +#- Globals +#-##################################################################################### my @netdevices = map { my $l = $_; map { "$l$_" } (0..3) } qw(eth tr plip fddi); my $scsiDeviceAvailable; my $CSADeviceAvailable; -1; - +#-###################################################################################### +#- Functions +#-###################################################################################### sub get { #- Detect the default BIOS boot harddrive is kind of tricky. We may have IDE, #- SCSI and RAID devices on the same machine. From what I see so far, the default @@ -162,6 +169,12 @@ sub tryOpen($) { local *F; sysopen F, devices::make($_[0]), c::O_NONBLOCK() and \*F; } + +sub tryWrite($) { + local *F; + sysopen F, devices::make($_[0]), 1 | c::O_NONBLOCK() and \*F; +} + sub syslog { -r "/tmp/syslog" and return map { /<\d+>(.*)/ } cat_("/tmp/syslog"); `dmesg` @@ -171,3 +184,35 @@ sub hasSMP { my $nb = grep { /^processor/ } cat_("/proc/cpuinfo"); $nb > 1; } + +sub whatParport() { + my @res =(); + foreach (0..3) { + local *F; + my $elem = {}; + open F, "/proc/parport/$_/autoprobe" or next; + foreach (<F>) { $elem->{$1} = $2 if /(.*):(.*);/ } + push @res, { port => "/dev/lp$_", val => $elem}; + } + @res; +} + +#-CLASS:PRINTER; +#-MODEL:HP LaserJet 1100; +#-MANUFACTURER:Hewlett-Packard; +#-DESCRIPTION:HP LaserJet 1100 Printer; +#-COMMAND SET:MLC,PCL,PJL; +sub whatPrinter() { + my @res = whatParport(); + grep { $_->{val}{CLASS} eq "PRINTER"} @res; +} + +sub whatPrinterPort() { + grep { tryWrite($_)} qw(/dev/lp0 /dev/lp1 /dev/lp2); +} + +#-###################################################################################### +#- Wonderful perl :( +#-###################################################################################### +1; # + diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm index 055a1d3b8..61a0f2dff 100644 --- a/perl-install/fsedit.pm +++ b/perl-install/fsedit.pm @@ -3,6 +3,9 @@ package fsedit; use diagnostics; use strict; +#-###################################################################################### +#- misc imports +#-###################################################################################### use common qw(:common :constant :functional); use partition_table qw(:types); use partition_table_raw; @@ -10,8 +13,9 @@ use Data::Dumper; use devices; use log; -1; - +#-##################################################################################### +#- Globals +#-##################################################################################### my @suggestions = ( { mntpoint => "/boot", minsize => 10 << 11, size => 16 << 11, type => 0x83 }, { mntpoint => "/", minsize => 50 << 11, size => 100 << 11, type => 0x83 }, @@ -25,8 +29,9 @@ my @suggestions = ( my @suggestions_mntpoints = qw(/mnt/dos); -1; - +#-###################################################################################### +#- Functions +#-###################################################################################### sub suggestions_mntpoint($) { my ($hds) = @_; sort grep { !/swap/ && !has_mntpoint($_, $hds) } @@ -281,3 +286,8 @@ sub move { &$f($v); } } + +#-###################################################################################### +#- Wonderful perl :( +#-###################################################################################### +1; # diff --git a/perl-install/install2.pm b/perl-install/install2.pm index e28c8a9a2..e5528c8ab 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -203,19 +203,6 @@ for (my $i = 0; $i < @installSteps; $i += 2) { push @orderedInstallSteps, $installSteps[$i]; } -#-TOSEE bug with -#-%installSteps = -#- map_tab_hash { -#- my ($i, $h) = @_; -#- $h->{help} = $stepsHelp{$installSteps[$i]} || __("Help"); -#- $h->{next} = $installSteps[$i + 2]; -#- $h->{onError} = $installSteps[$i + 2 * $h->{onError}]; -#-#- $h->{toBeDone} = []; SEMBLE FIXE les PBS -#-#- $h->{entered} = 0; -#- push @orderedInstallSteps, $installSteps[$i]; -#- } \@installStepsFields, @installSteps; -#-print Dumper(\%installSteps); - $installSteps{first} = $installSteps[0]; #-##################################################################################### @@ -297,7 +284,7 @@ $o = { PAPERSIZE => "legal", CRLF => 0, - DEVICE => "/dev/dev1", + DEVICE => "/dev/lp", REMOTEHOST => "", REMOTEQUEUE => "", @@ -546,7 +533,9 @@ sub main { eval { spawnShell() }; $o->{prefix} = $::testing ? "/tmp/test-perl-install" : "/mnt"; + $o->{root} = $::testing ? "/tmp/root-perl-install" : "/"; mkdir $o->{prefix}, 0755; + mkdir $o->{root}, 0755; #- make sure we don't pick up any gunk from the outside world $ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:/usr/X11R6/bin:$o->{prefix}/sbin:$o->{prefix}/bin:$o->{prefix}/usr/sbin:$o->{prefix}/usr/bin:$o->{prefix}/usr/X11R6/bin"; diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index f9b604bc6..79c41bfa6 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -10,14 +10,19 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); ); @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; +#-###################################################################################### +#- misc imports +#-###################################################################################### use common qw(:common :system); use run_program; use detect_devices; use pkgs; use log; -1; +#-###################################################################################### +#- Functions +#-###################################################################################### sub relGetFile($) { local $_ = member($_[0], qw(compss compssList depslist hdlist)) ? "base" : "RPMS"; $_ = "Mandrake/$_/$_[0]"; diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 6bff4e7ff..919257d51 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -26,7 +26,7 @@ use fs; use modparm; use log; use printer; - +use lilo; #-###################################################################################### #- In/Out Steps Functions #-###################################################################################### @@ -233,6 +233,14 @@ sub printerConfig($) { $o->{printer}{want}); return if !$o->{printer}{want}; + unless (($::testing)) { + printer::set_prefix($o->{prefix}); + pkgs::select($o->{packages}, $o->{packages}{'rhs-printfilters'}); + $o->installPackages($o->{packages}); + + } + printer::read_printer_db(); + $o->{printer}{complete} = 0; if ($::expert) { #std info @@ -262,21 +270,27 @@ name and directory should be used for this queue?"), if ($o->{printer}{TYPE} eq "LOCAL") { { my $w = $o->wait_message(_("Test ports"), _("Detecting devices...")); - eval { modules::load("lp"); }; + eval { modules::load("lp");modules::load("parport_probe"); }; } + my @port = (); - foreach ("lp0", "lp1", "lp2") { - local *LP; - push @port, "/dev/$_" if open LP, ">/dev/$_" + my @parport = detect_devices::whatPrinter(); + eval { modules::unload("parport_probe") }; + my $str; + if ($parport[0]) { + my $port = $parport[0]{port}; + $o->{printer}{DEVICE} = $port; + my $descr = common::bestMatchSentence2($parport[0]{val}{DESCRIPTION}, @printer::entry_db_description); + $o->{printer}{DBENTRY} = $printer::descr_to_db{$descr}; + $str = _("I have detected a %s on ", $parport[0]{val}{DESCRIPTION}) . $port; + @port = map { $_->{port}} @parport; + } else { + @port = detect_devices::whatPrinterPort(); } - eval { modules::unload("lp") }; - -#- @port =("lp0", "lp1", "lp2"); $o->{printer}{DEVICE} = $port[0] if $port[0]; - return if !$o->ask_from_entries_ref(_("Local Printer Device"), - _("What device is your printer connected to \n(note that /dev/lp0 is equivalent to LPT1:)?\n"), + _("What device is your printer connected to \n(note that /dev/lp0 is equivalent to LPT1:)?\n") . $str , [_("Printer Device:")], [{val => \$o->{printer}{DEVICE}, list => \@port }], ); @@ -328,25 +342,14 @@ wish to access and any applicable user name and password."), ); } - unless (($::testing)) { - printer::set_prefix($o->{prefix}); - pkgs::select($o->{packages}, $o->{packages}{'rhs-printfilters'}); - $o->installPackages($o->{packages}); - - } - printer::read_printer_db(); - my @entries_db_short = sort keys %printer::thedb; - my @entry_db_description = map { $printer::thedb{$_}{DESCR} } @entries_db_short; - my %descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short; - my %db_to_descr = reverse %descr_to_db; $o->{printer}{DBENTRY} = - $descr_to_db{ + $printer::descr_to_db{ $o->ask_from_list_(_("Configure Printer"), _("What type of printer do you have?"), - [@entry_db_description], - $db_to_descr{$o->{printer}{DBENTRY}}, + [@printer::entry_db_description], + $printer::db_to_descr{$o->{printer}{DBENTRY}}, ) }; @@ -515,6 +518,20 @@ sub setupBootloader($) { \@l, $l[!$o->{bootloader}{onmbr}] ) eq $l[0]; + + lilo::proposition($o->{hds}, $o->{fstab}); + + my @entries = grep { $_->{liloLabel} } @{$o->{fstab}}; + + $o->ask_from_entries_ref('', + _("The boot manager Mandrake uses can boot other + operating systems as well. You need to tell me + what partitions you would like to be able to boot + and what label you want to use for each of them."), + [map {"$_->{device}" . type2name($_->{type})} @entries], + [map {\$_->{liloLabel}} @entries], + ); + install_steps::setupBootloader($o); } diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index 9e3d8b6a3..3b296a982 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -107,7 +107,7 @@ sub ask_from_entry { my ($o, $title, $message, $label, $def, %callback) = @_; $message = ref $message ? $message : [ $message ]; - $o->ask_from_entries($title, $message, [ $label ], [ $def ], %callback); + first ($o->ask_from_entries($title, $message, [ $label ], [ $def ], %callback)); } sub ask_from_entries($$$$;$%) { @@ -126,11 +126,12 @@ sub ask_from_entries_ref($$$$;$%) { my ($o, $title, $message, $l, $val, %callback) = @_; $message = ref $message ? $message : [ $message ]; + my $val_hash = [ map { if ((ref $_) eq "SCALAR") { { val => $_ } } else { - ($_->{list} && @{$_->{list}}) ? + ($_->{list} && (@{$_->{list}} > 1)) ? { %$_, type => "list"} : $_; } } @$val ]; diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index ad4aa36ba..4f01fcbb7 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -88,6 +88,7 @@ sub ask_from_entries_refW { $depth_combo->entry->set_editable(!$_->{not_edit}); $depth_combo->set_popdown_strings(@{$_->{list}}); $depth_combo->disable_activate; + $_->{val} ||= $_->{list}[0]; $depth_combo; } else { new Gtk::Entry; diff --git a/perl-install/modparm.pm b/perl-install/modparm.pm index cc7b0efb4..438b79dcd 100644 --- a/perl-install/modparm.pm +++ b/perl-install/modparm.pm @@ -3,12 +3,21 @@ package modparm; use diagnostics; use strict; +#-###################################################################################### +#- misc imports +#-###################################################################################### use common qw(:common :functional); use log; +#-##################################################################################### +#- Globals +#-##################################################################################### my %modparm_hash; +#-###################################################################################### +#- Functions +#-###################################################################################### sub read_modparm_file($) { my ($file) = @_; my @line; @@ -50,8 +59,7 @@ sub get_options_name($) { @names; } -if ($::testing) { - read_modparm_file("/tmp/modparm.txt"); -} - -1; +#-###################################################################################### +#- Wonderful perl :( +#-###################################################################################### +1; # diff --git a/perl-install/printer.pm b/perl-install/printer.pm index 37f0d61c3..2724b6988 100644 --- a/perl-install/printer.pm +++ b/perl-install/printer.pm @@ -28,8 +28,7 @@ use strict; =cut #-##################################################################################### -use vars qw(%thedb %printer_type %printer_type_inv @papersize_type %fields $spooldir); - +use vars qw(%thedb %printer_type %printer_type_inv @papersize_type %fields $spooldir @entries_db_short @entry_db_description %descr_to_db %db_to_descr); #-##################################################################################### =head2 Imports @@ -230,6 +229,8 @@ my $PRINTER_DB_FILE = "/usr/lib/rhs/rhs-printfilters/printerdb"; my $PRINTER_FILTER_DIR = "/usr/lib/rhs/rhs-printfilters"; + + #-##################################################################################### =head2 Exported constant @@ -317,6 +318,12 @@ sub read_printer_db(;$) { $thedb{$entryname} = $entry; } } + + @entries_db_short = sort keys %printer::thedb; + @entry_db_description = map { $printer::thedb{$_}{DESCR} } @entries_db_short; + %descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short; + %db_to_descr = reverse %descr_to_db; + } diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm index 15394a1be..617c6ebd5 100644 --- a/perl-install/run_program.pm +++ b/perl-install/run_program.pm @@ -11,8 +11,8 @@ sub run($@) { rooted('', @_) } sub rooted { my ($root, $name, @args) = @_; - - log::l("running: $name @args" . ($root ? " with root $root" : "")); + my $str = ref $name ? $name->[0] : $name; + log::l("running: $str @args" . ($root ? " with root $root" : "")); $root ? $root .= '/' : ($root = ''); fork and wait, return $? == 0; @@ -25,9 +25,18 @@ sub rooted { $root and chroot $root; chdir "/"; - unless (exec $name, @args) { - log::l("exec of $name failed: $!"); - exec('false') or exit(1); + if (ref $name) { + unless (exec { $name->[0] } $name->[1], @args) { + log::l("exec of $name->[0] failed: $!"); + exec('false') or exit(1); + } + } else { + unless (exec $name, @args) { + log::l("exec of $name failed: $!"); + exec('false') or exit(1); + } + } } + } |