summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/commands.pm18
-rw-r--r--perl-install/common.pm47
-rw-r--r--perl-install/detect_devices.pm49
-rw-r--r--perl-install/fsedit.pm18
-rw-r--r--perl-install/install2.pm17
-rw-r--r--perl-install/install_any.pm7
-rw-r--r--perl-install/install_steps_interactive.pm65
-rw-r--r--perl-install/interactive.pm5
-rw-r--r--perl-install/interactive_gtk.pm1
-rw-r--r--perl-install/modparm.pm18
-rw-r--r--perl-install/printer.pm11
-rw-r--r--perl-install/run_program.pm19
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);
+ }
+
}
}
+
}
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 07:06:04 +0000