diff options
Diffstat (limited to 'perl-install')
78 files changed, 125 insertions, 600 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile index 9ce41430e..84f41baa6 100644 --- a/perl-install/Makefile +++ b/perl-install/Makefile @@ -25,7 +25,7 @@ $(DIRS): $(MAKE) -C $@ test_pms: verify_c - for i in install2 standalone/keyboarddrake standalone/XFdrake standalone/drakboot; do ./perl2fcalls -excludec -excluderesize_fat::c_rewritten $$i; done + for i in install2 standalone/keyboarddrake standalone/XFdrake standalone/drakboot; do perl_checker -I. -no_cw -excludec -excluderesize_fat::c_rewritten $$i; done for i in install2 install_steps_*.pm; do perl -cw -I. $$i; done verify_c: diff --git a/perl-install/Xconfig.pm b/perl-install/Xconfig.pm index 0797d6c8b..4bf6b112a 100644 --- a/perl-install/Xconfig.pm +++ b/perl-install/Xconfig.pm @@ -3,7 +3,7 @@ package Xconfig; # $Id$ use diagnostics; use strict; -use common qw(:common :file :system); +use common; use mouse; use devices; use Xconfigurator; diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm index a39adb6f1..f55a1bc03 100644 --- a/perl-install/Xconfigurator.pm +++ b/perl-install/Xconfigurator.pm @@ -4,7 +4,7 @@ use diagnostics; use strict; use vars qw($in $install @window_managers @depths @monitorSize2resolution @hsyncranges %min_hsync4wres @vsyncranges %depths @resolutions @resolutions_laptop %serversdriver @svgaservers @accelservers @allbutfbservers @allservers %vgamodes %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate %standard_monitors $XF86firstchunk_text $keyboardsection_start $keyboardsection_start_v4 $keyboardsection_part2 $keyboardsection_part3 $keyboardsection_part3_v4 $keyboardsection_end $pointersection_text $monitorsection_text1 $monitorsection_text2 $monitorsection_text3 $monitorsection_text4 $modelines_text_Trident_TG_96xx $modelines_text_ext $modelines_text $devicesection_text $devicesection_text_v4 $screensection_text1 %lines @options %xkb_options $good_default_monitor $low_default_monitor $layoutsection_v4 $modelines_text_apple); -use common qw(:common :file :functional :system); +use common; use log; use detect_devices; use run_program; diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm index c8b100f46..4116b4205 100644 --- a/perl-install/Xconfigurator_consts.pm +++ b/perl-install/Xconfigurator_consts.pm @@ -1,6 +1,6 @@ package Xconfigurator; # $Id$ -use common qw(:common); +use common; %depths = ( 8 => __("256 colors (8 bits)"), diff --git a/perl-install/any.pm b/perl-install/any.pm index 444fed381..86bdd4b8d 100644 --- a/perl-install/any.pm +++ b/perl-install/any.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :system :file :functional); +use common; use commands; use detect_devices; use partition_table qw(:types); diff --git a/perl-install/bootloader.pm b/perl-install/bootloader.pm index 73db24299..d1f82a1dd 100644 --- a/perl-install/bootloader.pm +++ b/perl-install/bootloader.pm @@ -7,7 +7,7 @@ use vars qw(%vga_modes); #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :file :functional :system); +use common; use partition_table qw(:types); use log; use any; @@ -377,11 +377,11 @@ wait %d seconds for default boot. } } my %l = ( - yaboot => bool(arch() =~ /ppc/), - silo => bool(arch() =~ /sparc/), - lilo => bool(arch() !~ /sparc|ppc/) && !isLoopback(fsedit::get_root($fstab)), - grub => bool(arch() !~ /sparc|ppc/ && availableRamMB() < 800), #- don't use grub if more than 800MB - loadlin => bool(arch() !~ /sparc|ppc/) && -e "/initrd/loopfs/lnx4win", + yaboot => to_bool(arch() =~ /ppc/), + silo => to_bool(arch() =~ /sparc/), + lilo => to_bool(arch() !~ /sparc|ppc/) && !isLoopback(fsedit::get_root($fstab)), + grub => to_bool(arch() !~ /sparc|ppc/ && availableRamMB() < 800), #- don't use grub if more than 800MB + loadlin => to_bool(arch() !~ /sparc|ppc/) && -e "/initrd/loopfs/lnx4win", ); unless ($lilo->{methods}) { $lilo->{methods} ||= { map { $_ => 1 } grep { $l{$_} } keys %l }; @@ -417,7 +417,7 @@ sub keytable($$) { $f && -r "$prefix/$f" && $f; } -sub has_profiles { bool(get_label("office", $b)) } +sub has_profiles { to_bool(get_label("office", $b)) } sub set_profiles { my ($b, $want_profiles) = @_; diff --git a/perl-install/bootlook.pm b/perl-install/bootlook.pm index 4a75f24db..d74159630 100644 --- a/perl-install/bootlook.pm +++ b/perl-install/bootlook.pm @@ -27,7 +27,7 @@ use POSIX; use lib qw(/usr/lib/libDrakX); use interactive; use standalone; -use common qw(:common :file :functional :system); +use common; use my_gtk qw(:helpers :wrappers); use any; use bootloader; diff --git a/perl-install/commands.pm b/perl-install/commands.pm index 11155f593..2c9324fd5 100644 --- a/perl-install/commands.pm +++ b/perl-install/commands.pm @@ -14,7 +14,8 @@ use vars qw($printable_chars); #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :file :system :constant); +use MDK::Common::System; +use common; #-##################################################################################### #- Globals @@ -325,7 +326,7 @@ sub dd { sub head_tail { my ($h, $n) = getopts(\@_, qw(hn)); - $h || @_ < bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n"; + $h || @_ < to_bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n"; $n = $n ? shift : 10; local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = *STDIN); @@ -497,7 +498,7 @@ $dev, $size, $used, $free, $use, $mntpoint $h{$dev} = $mntpoint; } foreach $dev (sort keys %h) { - ($size, $free) = common::df($mntpoint = $h{$dev}); + ($size, $free) = MDK::Common::System::df($mntpoint = $h{$dev}); $size or next; $use = int (100 * ($size - $free) / $size); @@ -544,7 +545,7 @@ sub du { my $f; $f = sub { my ($e) = @_; my $s = (lstat($e))[12]; - $s += sum map { &$f($_) } glob_("$e/*") if !-l $e && -d $e; + $s += sum(map { &$f($_) } glob_("$e/*")) if !-l $e && -d $e; $s; }; print &$f($_) >> 1, "\t$_\n" foreach @_ ? @_ : glob_("*"); @@ -576,9 +577,9 @@ sub bug { mount devices::make(detect_devices::floppy()), "/fd0"; require install_any; - output "/fd0/report.bug", install_any::report_bug("/mnt"); #- no other way :-( + output("/fd0/report.bug", install_any::report_bug("/mnt")); #- no other way :-( umount "/fd0"; - sync; + sync(); } sub loadkeys { diff --git a/perl-install/common.pm b/perl-install/common.pm index aaf0075a9..c33b59878 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -1,160 +1,35 @@ package common; # $Id$ +use MDK::Common; +use MDK::Common::System; use diagnostics; use strict; -use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $SECTORSIZE %compat_arch); +use vars qw(@ISA @EXPORT $SECTORSIZE); @ISA = qw(Exporter); -%EXPORT_TAGS = ( - common => [ qw(__ may_apply even odd arch better_arch compat_arch min max sqr sum and_ or_ if_ if__ chomp_ sign product bool invbool listlength bool2text bool2yesno text2bool to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ put_in_hash set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX formatLines deref next_val_in_array) ], - functional => [ qw(fold_left compose map_index grep_index find_index map_each grep_each list2kv mapn mapn_ difference2 before_leaving catch_cdie cdie) ], - file => [ qw(dirname basename touch all glob_ cat_ cat__ catMaybeCompressed output symlinkf renamef mode typeFromMagic expand_symlinks) ], - system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ salt getVarsFromSh setVarsInSh setVarsInShMode setVarsInCsh substInFile availableMemory availableRamMB removeXiBSuffix formatXiB template2file template2userfile update_userkderc list_skels formatTime formatTimeRaw unix2dos setVirtual isCdNotEjectable) ], - constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE %compat_arch) ], -); -@EXPORT_OK = map { @$_ } values %EXPORT_TAGS; +# no need to export ``_'' +@EXPORT = qw(arch sync $SECTORSIZE __ translate untranslate formatXiB removeXiBSuffix formatTime setVirtual makedev unmakedev salt isCdNotEjectable compat_arch better_arch); + +# perl_checker: RE-EXPORT-ALL +push @EXPORT, @MDK::Common::EXPORT; #-##################################################################################### #- Globals #-##################################################################################### -$printable_chars = "\x20-\x7E"; -$sizeof_int = psizeof("i"); -$bitof_int = $sizeof_int * 8; $SECTORSIZE = 512; -%compat_arch = ( #- compatibilty arch mapping. - 'noarch' => undef, - 'i386' => 'noarch', - 'i486' => 'i386', - 'i586' => 'i486', - 'i686' => 'i586', - 'i786' => 'i686', - 'k6' => 'i586', - 'k7' => 'k6', - 'k8' => 'k7', - 'ppc' => 'noarch', - 'alpha' => 'noarch', - 'sparc' => 'noarch', - 'sparc32' => 'sparc', - 'sparc64' => 'sparc32', - 'ia64' => 'noarch', - ); #-##################################################################################### #- Functions #-##################################################################################### -sub fold_left(&@) { - my $f = shift; - local $a = shift; - foreach $b (@_) { $a = &$f() } - $a -} sub _ { my $s = shift @_; my $t = translate($s); sprintf $t, @_; } -#-delete $main::{'_'}; sub __ { $_[0] } -sub even { $_[0] % 2 == 0 } -sub odd { $_[0] % 2 == 1 } -sub min { fold_left { $a < $b ? $a : $b } @_ } -sub max { fold_left { $a > $b ? $a : $b } @_ } -sub sum { fold_left { $a + $b } @_ } -sub and_{ fold_left { $a && $b } @_ } -sub or_ { fold_left { $a || $b } @_ } -sub sqr { $_[0] * $_[0] } -sub sign { $_[0] <=> 0 } -sub product { fold_left { $a * $b } @_ } -sub first { $_[0] } -sub second { $_[1] } -sub top { $_[-1] } -sub uniq { my %l; @l{@_} = (); keys %l } -sub to_int { $_[0] =~ /(\d*)/; $1 } -sub to_float { $_[0] =~ /(\d*(\.\d*)?)/; $1 } -sub ikeys { my %l = @_; sort { $a <=> $b } keys %l } -sub add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} ||= $v } $a } -sub add2hash_ { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { exists $a->{$k} or $a->{$k} = $v } $a } -sub put_in_hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} = $v } $a } -sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 } -sub dirname { @_ == 1 or die "usage: dirname <name>\n" . backtrace(); local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } -sub basename { @_ == 1 or die "usage: basename <name>\n" . backtrace(); local $_ = shift; s|/*\s*$||; s|.*/||; $_ } -sub bool { @_ == 1 or die "usage: bool(<scalar>)\n" . backtrace(); $_[0] ? 1 : 0 } -sub invbool { my $a = shift; $$a = !$$a; $$a } -sub listlength { scalar @_ } -sub bool2text { $_[0] ? "true" : "false" } -sub bool2yesno { $_[0] ? "yes" : "no" } -sub text2bool { my $t = lc($_[0]); $t eq "true" || $t eq "yes" ? 1 : 0 } -sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] } -sub cat_ { local *F; open F, $_[0] or $_[1] ? die "cat of file $_[0] failed: $!\n" : return; my @l = <F>; wantarray ? @l : join '', @l } -sub cat__ { my ($f) = @_; my @l = <$f>; wantarray ? @l : join '', @l } -sub output { my $f = shift; local *F; open F, ">$f" or die "output in file $f failed: $!\n"; print F foreach @_; } -sub deref { ref $_[0] eq "ARRAY" ? @{$_[0]} : ref $_[0] eq "HASH" ? %{$_[0]} : $_[0] } -sub linkf { unlink $_[1]; link $_[0], $_[1] } -sub symlinkf { unlink $_[1]; symlink $_[0], $_[1] } -sub renamef { unlink $_[1]; rename $_[0], $_[1] } -sub chomp_ { my @l = map { my $l = $_; chomp $l; $l } @_; wantarray ? @l : $l[0] } -sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d } -sub round { int ($_[0] + 0.5) } -sub round_up { my ($i, $r) = @_; $i = int $i; $i += $r - ($i + $r - 1) % $r - 1; } -sub round_down { my ($i, $r) = @_; $i = int $i; $i -= $i % $r; } -sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 } -sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 } -sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} } -sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = (); } keys %l } - -sub sync { syscall_('sync') } -sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) } -sub unix2dos { local $_ = $_[0]; s/\015$//mg; s/$/\015/mg; $_ } - -sub openFileMaybeCompressed { - my ($f) = @_; - -e $f || -e "$f.gz" or die "file $f not found"; - local *F; - open F, -e $f ? $f : "gzip -dc $f.gz|" or die "file $f is not readable"; - *F; -} -sub catMaybeCompressed { cat__(openFileMaybeCompressed($_[0])) } - -sub psizeof { length pack $_[0] } -sub concat_symlink { - my ($f, $l) = @_; - $l =~ m|^\.\./(/.*)| and return $1; - - $f =~ s|/$||; - while ($l =~ s|^\.\./||) { - $f =~ s|/[^/]+$|| or die "concat_symlink: $f $l\n"; - } - "$f/$l"; -} - -sub expand_symlinks { - my ($first, @l) = split '/', $_[0]; - $first eq '' or die "expand_symlinks: $_[0] is relative\n"; - my ($f, $l); - foreach (@l) { - $f .= "/$_"; - $f = concat_symlink($f, "../$l") while $l = readlink $f; - } - $f; -} - -sub may_apply { $_[0] ? $_[0]->($_[1]) : (@_ > 2 ? $_[2] : $_[1]) } - -sub if_ { - my $b = shift; - $b or return (); - wantarray || @_ <= 1 or die("if_ called in scalar context with more than one argument " . join(":", caller())); - wantarray ? @_ : $_[0]; -} -sub if__ { - my $b = shift; - defined $b or return (); - wantarray || @_ <= 1 or die("if_ called in scalar context with more than one argument " . join(":", caller())); - wantarray ? @_ : $_[0]; -} sub arch() { require c; c::kernel_arch(); @@ -166,140 +41,7 @@ sub better_arch { } sub compat_arch { better_arch(arch(), $_[0]) } -sub touch { - my ($f) = @_; - unless (-e $f) { - local *F; - open F, ">$f"; - } - my $now = time; - utime $now, $now, $f; -} - -sub map_index(&@) { - my $f = shift; - my @v; local $::i = 0; - map { @v = &$f($::i); $::i++; @v } @_; -} -sub grep_index(&@) { - my $f = shift; - my $v; local $::i = 0; - grep { $v = &$f($::i); $::i++; $v } @_; -} -sub find_index(&@) { - my $f = shift; - local $_; - for (my $i = 0; $i < @_; $i++) { - $_ = $_[$i]; - &$f and return $i; - } - die "find_index failed in @_"; -} - -sub map_each(&%) { - my ($f, %h) = @_; - my @l; - local ($::a, $::b); - while (($::a, $::b) = each %h) { push @l, &$f($::a, $::b) } - @l; -} -sub grep_each(&%) { - my ($f, %h) = @_; - my %l; - local ($::a, $::b); - while (($::a, $::b) = each %h) { $l{$::a} = $::b if &$f($::a, $::b) } - %l; -} -sub list2kv(@) { [ grep_index { even($::i) } @_ ], [ grep_index { odd($::i) } @_ ] } - -sub smapn { - my $f = shift; - my $n = shift; - my @r = (); - for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_); } - @r -} -sub mapn(&@) { - my $f = shift; - smapn($f, min(map { scalar @$_ } @_), @_); -} -sub mapn_(&@) { - my $f = shift; - smapn($f, max(map { scalar @$_ } @_), @_); -} - -sub add_f4before_leaving { - my ($f, $b, $name) = @_; - - unless ($common::before_leaving::{$name}) { - no strict 'refs'; - ${"common::before_leaving::$name"} = 1; - ${"common::before_leaving::list"} = 1; - } - local *N = *{$common::before_leaving::{$name}}; - my $list = *common::before_leaving::list; - $list->{$b}{$name} = $f; - *N = sub { - my $f = $list->{$_[0]}{$name} or die ''; - $name eq 'DESTROY' and delete $list->{$_[0]}; - goto $f; - } unless defined &{*N}; - -} - -#- ! the functions are not called in the order wanted, in case of multiple before_leaving :( -sub before_leaving(&) { - my ($f) = @_; - my $b = bless {}, 'common::before_leaving'; - add_f4before_leaving($f, $b, 'DESTROY'); - $b; -} - -sub catch_cdie(&&) { - my ($f, $catch) = @_; - - local @common::cdie_catches; - unshift @common::cdie_catches, $catch; - &$f(); -} - -sub cdie { - my ($err, $f) = @_; - foreach (@common::cdie_catches) { - $@ = $err; - &{$_}(\$err) and return; - } - die $err; -} - -sub all { - my $d = shift; - local *F; - opendir F, $d or return; - my @l = grep { $_ ne '.' && $_ ne '..' } readdir F; - closedir F; - - @l; -} - -sub glob_ { - my ($d, $f) = ($_[0] =~ /\*/) ? (dirname($_[0]), basename($_[0])) : ($_[0], '*'); - - $d =~ /\*/ and die "glob_: wildcard in directory not handled ($_[0])\n"; - ($f = quotemeta $f) =~ s/\\\*/.*/g; - - $d =~ m|/$| or $d .= '/'; - map { $d eq './' ? $_ : "$d$_" } grep { /^$f$/ } all($d); -} - - -sub syscall_ { - my $f = shift; - - require 'syscall.ph'; - syscall(&{$common::{"SYS_$f"}}, @_) == 0; -} sub salt { my ($nb) = @_; @@ -314,20 +56,6 @@ sub salt { sub makedev { ($_[0] << 8) | $_[1] } sub unmakedev { $_[0] >> 8, $_[0] & 0xff } -sub list_passwd() { - my (@l, @e); - setpwent(); - while (@e = getpwent()) { push @l, [ @e ] } - endpwent(); - @l; -} -sub list_home() { - map { $_->[7] } grep { $_->[2] >= 500 } list_passwd(); -} -sub list_skels { - my ($prefix, $suffix) = @_; - grep { -d $_ && -w $_ } map { "$prefix$_/$suffix" } '/etc/skel', '/root', list_home() } - sub translate { my ($s) = @_; c::dgettext('libDrakX', $s); @@ -339,190 +67,9 @@ sub untranslate { die "untranslate failed"; } -sub warp_text { - my ($text, $width) = @_; - $width ||= 80; - - my @l; - foreach (split "\n", $text) { - my $t = ''; - foreach (split /\s+/, $_) { - if (length "$t $_" > $width) { - push @l, $t; - $t = $_; - } else { - $t = "$t $_"; - } - } - push @l, $t; - } - @l; -} - -sub formatAlaTeX { - my ($t, $tmp); - foreach (split "\n", $_[0]) { - if (/^$/) { - $t .= ($t && "\n") . $tmp; - $tmp = ''; - } else { - $tmp = ($tmp && "$tmp ") . first(/^\s*(.*?)\s*$/); - } - } - $t . ($t && $tmp && "\n") . $tmp; -} - -sub formatLines { - my ($t, $tmp); - foreach (split "\n", $_[0]) { - if (/^\s/) { - $t .= "$tmp\n"; - $tmp = $_; - } else { - $tmp = ($tmp ? "$tmp " : ($t && "\n") . $tmp) . $_; - } - } - "$t$tmp\n"; -} - -sub getVarsFromSh { - my %l; - local *F; open F, $_[0] or return; - local $_; - while (<F>) { - s/#.*//; # remove comments - my ($v, $val, $val2) = - /^\s* # leading space - (\w+) = # variable - ( - "([^"]*)" # double-quoted text - | '([^']*)' # single-quoted text - | [^'"\s]+ # normal text - ) - \s*$ # end of line - /x or next; - $l{$v} = defined $val2 ? $val2 : $val; - } - %l; -} - -sub setVarsInSh { - my ($file, $l, @fields) = @_; - setVarsInShMode($file, 0777 ^ umask(), $l, @fields); -} - -sub setVarsInShMode { - my ($file, $mod, $l, @fields) = @_; - @fields = keys %$l unless @fields; - - local *F; - open F, "> $file" or die "cannot create config file $file"; - chmod $mod, $file; - $l->{$_} and print F "$_=$l->{$_}\n" foreach @fields; -} - -sub setVarsInCsh { - my ($file, $l, @fields) = @_; - @fields = keys %$l unless @fields; - - local *F; - open F, "> $_[0]" or die "cannot create config file $file"; - $l->{$_} and print F "setenv $_ $l->{$_}\n" foreach @fields; -} - -sub template2file { - my ($in, $out, %toreplace) = @_; - output $out, map { s/@@@(.*?)@@@/$toreplace{$1}/g; $_ } cat_($in); -} -sub template2userfile { - my ($prefix, $in, $out_rel, $force, %toreplace) = @_; - - foreach (list_skels($prefix, $out_rel)) { - -d dirname($_) or !-e $_ or $force or next; - - template2file($in, $_, %toreplace); - m|/home/(.+?)/| and chown(getpwnam($1), getgrnam($1), $_); - } -} -sub update_userkderc { - my ($file, $category, %subst) = @_; - - output $file, - (map { - my $l = $_; - s/^\s*//; - if (my $i = /^\[$category\]/i ... /^\[/) { - if ($i =~ /E/) { #- for last line of category - $l = join('', map_each { "$::a=$::b\n" } %subst) . $l; - %subst = (); - } elsif (/^(\w*?)=/) { - if (my $e = delete $subst{lc($1)}) { - $l = "$1=$e\n"; - } - } - } - $l; - } cat_($file)), - (%subst && "[$category]\n", map_each { "$::a=$::b\n" } %subst); #- if category has not been found above. -} - -sub substInFile(&@) { - my $f = shift; - foreach my $file (@_) { - if (-e $file) { - local @ARGV = $file; - local ($^I, $_) = ''; - while (<>) { &$f($_); print } - } else { - local *F; my $old = select F; # that way eof return true - local $_ = ''; - &$f($_); - select $old; - eval { output($file, $_) }; - } - } -} - -# count the number of character that match -sub bestMatchSentence { - - my $best = -1; - my $bestSentence; - my @s = split /\W+/, shift; - foreach (@_) { - my $count = 0; - foreach my $e (@s) { - $count+= length ($e) if /^$e$/; - $count+= length ($e) if /^$e$/i; - $count+= length ($e) if /$e/; - $count+= length ($e) if /$e/i; - } - $best = $count, $bestSentence = $_ if $count > $best; - } - wantarray ? ($bestSentence, $best) : $bestSentence; -} - -sub typeFromMagic { - my $f = shift; - local *F; sysopen F, $f, 0 or return; - - my $tmp; - M: foreach (@_) { - my ($name, @l) = @$_; - while (@l) { - my ($offset, $signature) = splice(@l, 0, 2); - sysseek(F, $offset, 0) or next M; - sysread(F, $tmp, length $signature); - $tmp eq $signature or next M; - } - return $name; - } - undef; -} - -sub availableMemory() { sum map { /(\d+)/ } grep { /^(MemTotal|SwapTotal):/ } cat_("/proc/meminfo"); } +BEGIN { undef *availableRamMB } sub availableRamMB() { - my $s = 4 * round((-s '/proc/kcore') / 1024 / 1024 / 4); + my $s = MDK::Common::System::availableRamMB(); #- HACK HACK: if i810 and memsize require detect_devices; return $s - 1 if $s == 128 && grep { $_->{driver} =~ /i810/ } detect_devices::probeall(); @@ -566,11 +113,6 @@ sub formatXiB { int($newnb * $newbase) . _("TB"); } -sub formatList { - my $nb = shift; - join(", ", @_ <= $nb ? @_ : (@_[0..$nb-1], '...')); -} - sub formatTime { my ($s, $m, $h) = gmtime($_[0]); if ($h) { @@ -583,43 +125,10 @@ sub formatTime { _("%d seconds", $s); } } -sub formatTimeRaw { - my ($s, $m, $h) = gmtime($_[0]); - sprintf "%d:%02d:%02d", $h, $m, $s; -} - -#- return the size of the partition and its free space in KiB -sub df { - my ($mntpoint) = @_; - my ($blocksize, $size, $free); - my $buf = ' ' x 20000; - syscall_('statfs', $mntpoint, $buf) or return; - (undef, $blocksize, $size, $free, undef, undef) = unpack "L!6", $buf; - map { $_ * ($blocksize / 1024) } $size, $free; -} - -sub next_val_in_array { - my ($v, $l) = @_; - my %l = mapn { @_ } $l, [ @$l[1..$#$l], $l->[0] ]; - $l{$v}; -} sub isCdNotEjectable { scalar(grep { /ram3/ } cat_("/proc/mounts")) == 0 } -sub formatError { - my ($err) = @_; - $err =~ s/ at .*?$/\./ if !$::testing; - $err; -} - -sub backtrace { - my $s; - for (my $i = 1; caller($i); $i++) { - my ($package, $file, $line, $func) = caller($i); - $s .= "$func() called from $file:$line\n"; - } - $s; -} +sub sync { &MDK::Common::System::sync } #-###################################################################################### #- Wonderful perl :( diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm index 0832d5073..74200ddeb 100644 --- a/perl-install/crypto.pm +++ b/perl-install/crypto.pm @@ -3,7 +3,7 @@ package crypto; # $Id$ use diagnostics; use strict; -use common qw(:common); +use common; use log; use ftp; diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index 6bc394744..36a171072 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -7,7 +7,7 @@ use strict; #- misc imports #-###################################################################################### use log; -use common qw(:common :file :functional); +use common; use devices; use c; diff --git a/perl-install/devices.pm b/perl-install/devices.pm index d14f3c397..cd5e6ffe9 100644 --- a/perl-install/devices.pm +++ b/perl-install/devices.pm @@ -3,7 +3,7 @@ package devices; # $Id$ use diagnostics; use strict; -use common qw(:system :file); +use common; use run_program; use log; use c; diff --git a/perl-install/fs.pm b/perl-install/fs.pm index 79929f699..36e9f6381 100644 --- a/perl-install/fs.pm +++ b/perl-install/fs.pm @@ -3,7 +3,8 @@ package fs; # $Id$ use diagnostics; use strict; -use common qw(:common :file :system :functional); +use MDK::Common::System; +use common; use log; use devices; use partition_table qw(:types); @@ -340,7 +341,7 @@ sub df { return; } } - my (undef, $free) = common::df($dir); + my (undef, $free) = MDK::Common::System::df($dir); if (!$part->{isMounted}) { umount($dir); diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm index f7808dbf2..504d643dd 100644 --- a/perl-install/fsedit.pm +++ b/perl-install/fsedit.pm @@ -7,7 +7,7 @@ use vars qw(%suggestions); #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :constant :functional :file); +use common; use partition_table qw(:types); use partition_table_raw; use detect_devices; diff --git a/perl-install/help.pm b/perl-install/help.pm index 30c4e230e..9a7553b11 100644 --- a/perl-install/help.pm +++ b/perl-install/help.pm @@ -1,6 +1,6 @@ package help; # $Id$ -use common qw(:common); +use common; %steps = ( empty => '', diff --git a/perl-install/install2.pm b/perl-install/install2.pm index d8009c523..327df4f87 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -8,7 +8,7 @@ use vars qw($o $version); #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :file :system :functional); +use common; use install_any qw(:all); use install_steps; use commands; diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 979216b8f..9ea9ee746 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -14,7 +14,8 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @needToCopy @needToCopyIfRequiresSatisf #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :system :functional :file); +use MDK::Common::System; +use common; use run_program; use partition_table qw(:types); use partition_table_raw; @@ -283,7 +284,7 @@ sub getAvailableSpace { sub getAvailableSpace_mounted { my ($prefix) = @_; my $dir = -d "$prefix/usr" ? "$prefix/usr" : "$prefix"; - my (undef, $free) = common::df($dir) or return; + my (undef, $free) = MDK::Common::System::df($dir) or return; log::l("getAvailableSpace_mounted $free KB"); $free * 1024 || 1; } @@ -865,7 +866,7 @@ sub getHds { sub log_sizes { my ($o) = @_; - my @df = common::df($o->{prefix}); + my @df = MDK::Common::System::df($o->{prefix}); log::l(sprintf "Installed: %s(df), %s(rpm)", formatXiB($df[0] - $df[1], 1024), formatXiB(sum(`$ENV{LD_LOADER} rpm --root $o->{prefix}/ -qa --queryformat "%{size}\n"`))) if -x "$o->{prefix}/bin/rpm"; diff --git a/perl-install/install_gtk.pm b/perl-install/install_gtk.pm index 4b247a81b..880c09e6b 100644 --- a/perl-install/install_gtk.pm +++ b/perl-install/install_gtk.pm @@ -4,7 +4,7 @@ use diagnostics; use strict; use my_gtk qw(:helpers :wrappers); -use common qw(:common :file :functional); +use common; use lang; use devices; diff --git a/perl-install/install_interactive.pm b/perl-install/install_interactive.pm index 79423eeb8..ae65f6dae 100644 --- a/perl-install/install_interactive.pm +++ b/perl-install/install_interactive.pm @@ -5,7 +5,7 @@ use strict; use vars; -use common qw(:common :functional); +use common; use partition_table qw(:types); use partition_table_raw; use detect_devices; diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 3ee069165..d637e54c6 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -7,7 +7,7 @@ use vars qw(@filesToSaveForUpgrade); #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:file :system :common :functional); +use common; use install_any qw(:all); use partition_table qw(:types); use detect_devices; diff --git a/perl-install/install_steps_auto_install.pm b/perl-install/install_steps_auto_install.pm index 3b46e6c02..28802b2ba 100644 --- a/perl-install/install_steps_auto_install.pm +++ b/perl-install/install_steps_auto_install.pm @@ -13,7 +13,7 @@ use modules; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :functional); +use common; use install_steps; use log; diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index ca455247a..8843f18b6 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -11,7 +11,7 @@ use vars qw(@ISA); #-###################################################################################### use install_steps_interactive; use interactive_gtk; -use common qw(:common :file :functional :system); +use common; use my_gtk qw(:helpers :wrappers); use Gtk; use devices; @@ -626,7 +626,7 @@ _("There was an error installing packages:"), $1, _("Go on anyway?") ], 1) and r sub set_help { my ($o, @l) = @_; - $o->{current_help} = formatAlaTeX(join "\n", map { _ deref($help::steps{$_}) } @l); + $o->{current_help} = formatAlaTeX(join "\n", map { _(deref($help::steps{$_})) } @l); gtktext_insert($o->{help_window_text}, $o->{current_help}); 1; } diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 779bfd474..5b5fb804f 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -10,7 +10,7 @@ use vars qw(@ISA $new_bootstrap); #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :file :functional :system); +use common; use partition_table qw(:types); use partition_table_raw; use install_steps; @@ -809,7 +809,7 @@ sub configureTimezone { $o->{timezone}{timezone} = $o->ask_from_treelist('', _("Which is your timezone?"), '/', [ timezone::getTimeZones($::g_auto_install ? '' : $o->{prefix}) ], $o->{timezone}{timezone}); $o->set_help('configureTimezoneGMT'); - my $ntp = bool($o->{timezone}{ntp}); + my $ntp = to_bool($o->{timezone}{ntp}); $o->ask_from_entries_refH('', '', [ { text => _("Hardware clock set to GMT"), val => \$o->{timezone}{UTC}, type => 'bool' }, { text => _("Automatic time synchronization (using NTP)"), val => \$ntp, type => 'bool' }, diff --git a/perl-install/install_steps_newt.pm b/perl-install/install_steps_newt.pm index 34710782e..2292094b0 100644 --- a/perl-install/install_steps_newt.pm +++ b/perl-install/install_steps_newt.pm @@ -14,7 +14,7 @@ use interactive_newt; use install_any; use devices; use lang; -use common qw(:common); +use common; my $banner = __(); diff --git a/perl-install/install_steps_stdio.pm b/perl-install/install_steps_stdio.pm index 1ef8b83fa..4b0771c55 100644 --- a/perl-install/install_steps_stdio.pm +++ b/perl-install/install_steps_stdio.pm @@ -6,7 +6,7 @@ use vars qw(@ISA); @ISA = qw(install_steps_interactive interactive_stdio); -use common qw(:common); +use common; use interactive_stdio; use install_steps_interactive; use lang; diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index ad1d4a380..1815ab21e 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -6,7 +6,8 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :functional); +use MDK::Common::Func; +use common; #- ask_from_entries takes: #- val => reference to the value @@ -328,7 +329,7 @@ sub wait_message { my $b = before_leaving { $o->wait_message_endW($w) }; #- enable access through set - common::add_f4before_leaving(sub { $o->wait_message_nextW([ deref($_[1]) ], $w) }, $b, 'set'); + MDK::Common::Func::add_f4before_leaving(sub { $o->wait_message_nextW([ deref($_[1]) ], $w) }, $b, 'set'); $b; } diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index 77923070e..033e882c8 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -7,7 +7,7 @@ use vars qw(@ISA); @ISA = qw(interactive); use interactive; -use common qw(:common :functional); +use common; use my_gtk qw(:helpers :wrappers); my $forgetTime = 1000; #- in milli-seconds diff --git a/perl-install/interactive_newt.pm b/perl-install/interactive_newt.pm index 1f1f1157f..0662d9a4d 100644 --- a/perl-install/interactive_newt.pm +++ b/perl-install/interactive_newt.pm @@ -7,7 +7,7 @@ use vars qw(@ISA); @ISA = qw(interactive); use interactive; -use common qw(:common :functional); +use common; use log; use Newt::Newt; #- !! provides Newt and not Newt::Newt diff --git a/perl-install/interactive_stdio.pm b/perl-install/interactive_stdio.pm index 284194a11..e9e23cfb7 100644 --- a/perl-install/interactive_stdio.pm +++ b/perl-install/interactive_stdio.pm @@ -7,7 +7,7 @@ use vars qw(@ISA); @ISA = qw(interactive); use interactive; -use common qw(:common); +use common; $| = 1; diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm index f57acfbee..0e14b7a71 100644 --- a/perl-install/keyboard.pm +++ b/perl-install/keyboard.pm @@ -7,7 +7,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :system :file); +use common; use detect_devices; use run_program; use commands; diff --git a/perl-install/lang.pm b/perl-install/lang.pm index 5f316aaac..f3edfe2d6 100644 --- a/perl-install/lang.pm +++ b/perl-install/lang.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :file :system); +use common; use commands; use log; diff --git a/perl-install/loopback.pm b/perl-install/loopback.pm index 955019748..04c320ca3 100644 --- a/perl-install/loopback.pm +++ b/perl-install/loopback.pm @@ -6,7 +6,8 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :system :file :functional); +use MDK::Common::System; +use common; use partition_table qw(:types); use commands; use fs; @@ -75,7 +76,7 @@ sub create { sub getFree { my ($dir, $part) = @_; my $freespace = $dir ? - 2 * (common::df($dir))[1] : #- df in KiB + 2 * (MDK::Common::System::df($dir))[1] : #- df in KiB $part->{size}; $freespace - sum map { $_->{size} } @{$part->{loopback} || []}; diff --git a/perl-install/lvm.pm b/perl-install/lvm.pm index 8d7207723..72e1b4bb2 100644 --- a/perl-install/lvm.pm +++ b/perl-install/lvm.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :functional :system :file); +use common; use modules; use fsedit; use devices; diff --git a/perl-install/modparm.pm b/perl-install/modparm.pm index 6d20a2178..f1c81b0dd 100644 --- a/perl-install/modparm.pm +++ b/perl-install/modparm.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :functional); +use common; use log; diff --git a/perl-install/modules.pm b/perl-install/modules.pm index 5892fca1b..fe2f31b04 100644 --- a/perl-install/modules.pm +++ b/perl-install/modules.pm @@ -3,7 +3,7 @@ package modules; # $Id$ use strict; use vars qw(%drivers); -use common qw(:common :file :system :functional); +use common; use detect_devices; use run_program; use log; diff --git a/perl-install/mouse.pm b/perl-install/mouse.pm index 00c1e6b73..19d6bb9c6 100644 --- a/perl-install/mouse.pm +++ b/perl-install/mouse.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :system :functional :file); +use common; use modules; use detect_devices; use run_program; @@ -185,7 +185,7 @@ sub write { if (arch() =~ /ppc/) { my $s = join('', - "dev.mac_hid.mouse_button_emulation = " . bool($mouse->{button2_key} || $mouse->{button3_key}) . "\n", + "dev.mac_hid.mouse_button_emulation = " . to_bool($mouse->{button2_key} || $mouse->{button3_key}) . "\n", if_($mouse->{button2_key}, "dev.mac_hid.mouse_button2_keycode = $mouse->{button2_key}\n"), if_($mouse->{button3_key}, "dev.mac_hid.mouse_button3_keycode = $mouse->{button3_key}\n"), ); diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm index 8c74624ad..9a7327eb7 100644 --- a/perl-install/my_gtk.pm +++ b/perl-install/my_gtk.pm @@ -20,7 +20,7 @@ use Gtk; use Gtk::Gdk::ImlibImage; use c; use log; -use common qw(:common :functional :file); +use common; my $forgetTime = 1000; #- in milli-seconds $border = 5; @@ -136,7 +136,7 @@ sub destroy($) { flush(); } sub DESTROY { goto &destroy } -sub sync($) { +sub sync { my ($o) = @_; show($o); flush(); diff --git a/perl-install/network/adsl.pm b/perl-install/network/adsl.pm index 12daed505..65108f288 100644 --- a/perl-install/network/adsl.pm +++ b/perl-install/network/adsl.pm @@ -1,6 +1,6 @@ package network::adsl; -use common qw(:common :file); +use common; use run_program; use network::tools; use network::ethernet; diff --git a/perl-install/network/ethernet.pm b/perl-install/network/ethernet.pm index a6e6b0b64..df257637b 100644 --- a/perl-install/network/ethernet.pm +++ b/perl-install/network/ethernet.pm @@ -4,7 +4,7 @@ use network::network; use modules; use any; use detect_devices; -use common qw(:file :common); +use common; use run_program; use vars qw(@ISA @EXPORT); use globals "network", qw($in $prefix $install $connect_file $disconnect_file); diff --git a/perl-install/network/isdn.pm b/perl-install/network/isdn.pm index e8992b4ce..500339810 100644 --- a/perl-install/network/isdn.pm +++ b/perl-install/network/isdn.pm @@ -1,7 +1,7 @@ package network::isdn; use network::isdn_consts; -use common qw(:common :file :system); +use common; use any; use modules; use log; diff --git a/perl-install/network/modem.pm b/perl-install/network/modem.pm index 66faab9ec..5ff94d014 100644 --- a/perl-install/network/modem.pm +++ b/perl-install/network/modem.pm @@ -1,6 +1,6 @@ package network::modem; -use common qw(:common :file); +use common; use any; use modules; use detect_devices; diff --git a/perl-install/network/netconnect.pm b/perl-install/network/netconnect.pm index 6fa750929..308f90577 100644 --- a/perl-install/network/netconnect.pm +++ b/perl-install/network/netconnect.pm @@ -5,7 +5,7 @@ use diagnostics; use strict; use vars qw($isdn_init @isdndata); -use common qw(:common :file :functional :system); +use common; use log; use detect_devices; use run_program; diff --git a/perl-install/network/network.pm b/perl-install/network/network.pm index ecfadfb8d..ecf7823c2 100644 --- a/perl-install/network/network.pm +++ b/perl-install/network/network.pm @@ -8,7 +8,7 @@ use strict; #-###################################################################################### use Socket; -use common qw(:common :file :system :functional); +use common; use detect_devices; use run_program; use any; diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm index 60dc94104..daf2c0a02 100644 --- a/perl-install/network/tools.pm +++ b/perl-install/network/tools.pm @@ -1,6 +1,6 @@ package network::tools; -use common qw(:common :file :system); +use common; use run_program; use vars qw(@ISA @EXPORT); use globals "network", qw($in $prefix $install $disconnect_file $connect_prog); diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm index 69ec7f105..249cfbd90 100644 --- a/perl-install/partition_table.pm +++ b/perl-install/partition_table.pm @@ -11,7 +11,7 @@ package partition_table; # $Id$ @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; -use common qw(:common :system :functional); +use common; use partition_table_raw; use log; diff --git a/perl-install/partition_table_bsd.pm b/perl-install/partition_table_bsd.pm index c6cd71394..e9f51b455 100644 --- a/perl-install/partition_table_bsd.pm +++ b/perl-install/partition_table_bsd.pm @@ -6,7 +6,7 @@ use vars qw(@ISA); @ISA = qw(partition_table_raw); -use common qw(:common :system :file :functional); +use common; use partition_table_raw; use partition_table; use c; diff --git a/perl-install/partition_table_dos.pm b/perl-install/partition_table_dos.pm index e8ef57851..2c76a40e5 100644 --- a/perl-install/partition_table_dos.pm +++ b/perl-install/partition_table_dos.pm @@ -6,7 +6,7 @@ use vars qw(@ISA); @ISA = qw(partition_table_raw); -use common qw(:common :system :file); +use common; use partition_table_raw; use partition_table; use c; diff --git a/perl-install/partition_table_empty.pm b/perl-install/partition_table_empty.pm index a33798faf..d460317f5 100644 --- a/perl-install/partition_table_empty.pm +++ b/perl-install/partition_table_empty.pm @@ -11,7 +11,7 @@ use vars qw(@ISA); @ISA = qw(partition_table_raw); -use common qw(:common :system :file); +use common; use partition_table_raw; use partition_table; use c; diff --git a/perl-install/partition_table_mac.pm b/perl-install/partition_table_mac.pm index cf8678f9c..f14668949 100644 --- a/perl-install/partition_table_mac.pm +++ b/perl-install/partition_table_mac.pm @@ -6,7 +6,7 @@ use vars qw(@ISA $freepart_device $bootstrap_part $freepart_start $freepart_size @ISA = qw(partition_table_raw); -use common qw(:common :system :file :functional); +use common; use partition_table_raw; use partition_table; use c; diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm index c245301b6..0323eddf9 100644 --- a/perl-install/partition_table_raw.pm +++ b/perl-install/partition_table_raw.pm @@ -3,7 +3,7 @@ package partition_table_raw; # $Id$ use diagnostics; use strict; -use common qw(:common :system :file :constant); +use common; use devices; use log; use c; diff --git a/perl-install/partition_table_sun.pm b/perl-install/partition_table_sun.pm index 2eec591b3..2337c6860 100644 --- a/perl-install/partition_table_sun.pm +++ b/perl-install/partition_table_sun.pm @@ -6,7 +6,7 @@ use vars qw(@ISA); @ISA = qw(partition_table_raw); -use common qw(:common :system :file :functional); +use common; use partition_table_raw; use partition_table; use c; diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index c5fdb8a40..606726413 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -4,7 +4,7 @@ use diagnostics; use strict; use vars qw(*LOG %preferred $limitMinTrans %compssListDesc); -use common qw(:common :file :functional :system); +use common; use install_any; use commands; use run_program; diff --git a/perl-install/printer.pm b/perl-install/printer.pm index 8eea04aa8..0df3639ac 100644 --- a/perl-install/printer.pm +++ b/perl-install/printer.pm @@ -5,7 +5,7 @@ use strict; use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv @papersize_type %fields @entries_db_short @entry_db_description %descr_to_help %descr_to_db %db_to_descr %descr_to_ppd); -use common qw(:common :system :file); +use common; use commands; use run_program; diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm index 968254a40..21df546a2 100644 --- a/perl-install/printerdrake.pm +++ b/perl-install/printerdrake.pm @@ -3,7 +3,7 @@ package printerdrake; # $Id$ use diagnostics; use strict; -use common qw(:common :file :functional :system); +use common; use detect_devices; use commands; use modules; diff --git a/perl-install/proxy.pm b/perl-install/proxy.pm index b2cde4586..22d34d371 100644 --- a/perl-install/proxy.pm +++ b/perl-install/proxy.pm @@ -3,7 +3,7 @@ package proxy; use diagnostics; use strict; use run_program; -use common qw(:common :system :file); +use common; use log; use c; diff --git a/perl-install/raid.pm b/perl-install/raid.pm index b74c53e25..356a69ecb 100644 --- a/perl-install/raid.pm +++ b/perl-install/raid.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :functional); +use common; use partition_table qw(:types); use run_program; use devices; diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm index 3844e1c16..f811e7159 100644 --- a/perl-install/resize_fat/any.pm +++ b/perl-install/resize_fat/any.pm @@ -4,7 +4,7 @@ use diagnostics; use strict; use vars qw($FREE $FILE $DIRECTORY $UNMOVEABLE); -use common qw(:common :constant); +use common; use resize_fat::fat; use resize_fat::directory; use resize_fat::dir_entry; diff --git a/perl-install/resize_fat/boot_sector.pm b/perl-install/resize_fat/boot_sector.pm index 4ed4a73f7..c87328637 100644 --- a/perl-install/resize_fat/boot_sector.pm +++ b/perl-install/resize_fat/boot_sector.pm @@ -3,7 +3,7 @@ package resize_fat::boot_sector; # $Id$ use diagnostics; use strict; -use common qw(:common :system :constant :functional); +use common; use resize_fat::io; use resize_fat::any; use resize_fat::directory; diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm index beb780bcf..1f2b1ede6 100644 --- a/perl-install/resize_fat/directory.pm +++ b/perl-install/resize_fat/directory.pm @@ -3,7 +3,7 @@ package resize_fat::directory; # $Id$ use diagnostics; use strict; -use common qw(:system); +use common; use resize_fat::dir_entry; use resize_fat::io; diff --git a/perl-install/resize_fat/info_sector.pm b/perl-install/resize_fat/info_sector.pm index 1d9c1690a..35449cedc 100644 --- a/perl-install/resize_fat/info_sector.pm +++ b/perl-install/resize_fat/info_sector.pm @@ -3,7 +3,7 @@ package resize_fat::info_sector; # $Id$ use diagnostics; use strict; -use common qw(:system); +use common; use resize_fat::io; #- Oops, this will be unresizable on big-endian machine. trapped by signature. diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm index 897e2ed95..3b18241a2 100644 --- a/perl-install/resize_fat/main.pm +++ b/perl-install/resize_fat/main.pm @@ -25,7 +25,7 @@ use diagnostics; use strict; use log; -use common qw(:common :system :constant); +use common; use resize_fat::boot_sector; use resize_fat::info_sector; use resize_fat::directory; diff --git a/perl-install/sbus_probing/main.pm b/perl-install/sbus_probing/main.pm index f3269e671..4aed43459 100644 --- a/perl-install/sbus_probing/main.pm +++ b/perl-install/sbus_probing/main.pm @@ -2,7 +2,7 @@ package sbus_probing::main; # $Id$ use c; use log; -use common qw(:common); +use common; use modules; my %sbus_table_network = ( diff --git a/perl-install/services.pm b/perl-install/services.pm index 9b05474f8..d69812a38 100644 --- a/perl-install/services.pm +++ b/perl-install/services.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :functional :system :file); +use common; use commands; use run_program; use my_gtk qw(:helpers :wrappers); diff --git a/perl-install/share/list b/perl-install/share/list index 5e55ba71d..808c4bd07 100644 --- a/perl-install/share/list +++ b/perl-install/share/list @@ -98,6 +98,14 @@ /usr/lib/perl5/PERL_VERSION/overload.pm /usr/lib/perl5/PERL_VERSION/strict.pm /usr/lib/perl5/PERL_VERSION/vars.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common/DataStructure.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common/File.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common/Func.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common/Math.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common/String.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common/System.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common/Various.pm +/usr/lib/perl5/site_perl/PERL_VERSION/MDK/Common.pm /usr/lib/perl5/site_perl/PERL_VERSION/Net/Cmd.pm /usr/lib/perl5/site_perl/PERL_VERSION/Net/Config.pm /usr/lib/perl5/site_perl/PERL_VERSION/Net/FTP.pm diff --git a/perl-install/standalone/adduserdrake b/perl-install/standalone/adduserdrake index b7d06dc93..8584aa4ae 100755 --- a/perl-install/standalone/adduserdrake +++ b/perl-install/standalone/adduserdrake @@ -2,7 +2,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:common :functional :system :file); +use common; use interactive; use standalone; use any; diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake index 7bf80d398..01c0ed294 100755 --- a/perl-install/standalone/diskdrake +++ b/perl-install/standalone/diskdrake @@ -23,7 +23,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:common :functional); +use common; use diskdrake; use standalone; use interactive_gtk; diff --git a/perl-install/standalone/drakboot b/perl-install/standalone/drakboot index d55cad90d..d0c718ded 100755 --- a/perl-install/standalone/drakboot +++ b/perl-install/standalone/drakboot @@ -3,7 +3,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:common :file :functional); +use common; use interactive; use standalone; use any; diff --git a/perl-install/standalone/drakgw b/perl-install/standalone/drakgw index ce8a2da10..7e09755b6 100755 --- a/perl-install/standalone/drakgw +++ b/perl-install/standalone/drakgw @@ -15,7 +15,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:common :system :file); +use common; use interactive; use standalone; use log; @@ -656,6 +656,9 @@ Click on Configure to launch the setup wizard.", $setup_state)); #------------------------------------------------- #- $Log$ +#- Revision 1.45 2001/07/24 22:39:28 prigaux +#- move to MDK::Common, bool->to_bool +#- #- Revision 1.44 2001/05/16 11:13:21 damien #- added icon management #- diff --git a/perl-install/standalone/draksec b/perl-install/standalone/draksec index da5aac5ea..c3b325d1e 100755 --- a/perl-install/standalone/draksec +++ b/perl-install/standalone/draksec @@ -2,7 +2,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:system :file); +use common; use interactive; use standalone; use mouse; diff --git a/perl-install/standalone/drakxconf b/perl-install/standalone/drakxconf index 30a8468b0..f7a4fb794 100755 --- a/perl-install/standalone/drakxconf +++ b/perl-install/standalone/drakxconf @@ -7,7 +7,7 @@ use interactive; use standalone; use keyboard; use Xconfigurator_consts; -use common qw(:system); +use common; use c; local $_ = join '', @ARGV; diff --git a/perl-install/standalone/drakxservices b/perl-install/standalone/drakxservices index b2e961436..a7f750944 100755 --- a/perl-install/standalone/drakxservices +++ b/perl-install/standalone/drakxservices @@ -2,7 +2,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:common :functional :file); +use common; use interactive; use standalone; use services; diff --git a/perl-install/standalone/keyboarddrake b/perl-install/standalone/keyboarddrake index 631193d34..d43ff7e02 100755 --- a/perl-install/standalone/keyboarddrake +++ b/perl-install/standalone/keyboarddrake @@ -7,7 +7,7 @@ use interactive; use keyboard; use standalone; use Xconfigurator_consts; -use common qw(:system); +use common; use c; $::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; diff --git a/perl-install/standalone/livedrake b/perl-install/standalone/livedrake index 664f7b897..839339754 100755 --- a/perl-install/standalone/livedrake +++ b/perl-install/standalone/livedrake @@ -2,7 +2,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:common :system :file); +use common; use interactive; use standalone; use run_program; diff --git a/perl-install/standalone/mousedrake b/perl-install/standalone/mousedrake index 439b24d56..bc99d6ede 100755 --- a/perl-install/standalone/mousedrake +++ b/perl-install/standalone/mousedrake @@ -2,7 +2,7 @@ use lib qw(/usr/lib/libDrakX); -use common qw(:common :system); +use common; use interactive; use standalone; use modules; diff --git a/perl-install/standalone/net_monitor b/perl-install/standalone/net_monitor index 294265eb9..02c400211 100755 --- a/perl-install/standalone/net_monitor +++ b/perl-install/standalone/net_monitor @@ -24,7 +24,7 @@ use interactive; use standalone; use my_gtk qw(:helpers :wrappers); #-use Data::Dumper; -use common qw(:common :file :functional :system); +use common; use strict; use network::netconnect; diff --git a/perl-install/swap.pm b/perl-install/swap.pm index ed0669f8e..2c26485ea 100644 --- a/perl-install/swap.pm +++ b/perl-install/swap.pm @@ -3,7 +3,7 @@ package swap; # $Id$ use diagnostics; use strict; -use common qw(:common :system :constant); +use common; use log; use devices; use c; @@ -22,7 +22,7 @@ my $signature_page = "\0" x $pagesize; my $V0_MAX_PAGES = 8 * $pagesize - 10; my $V1_OLD_MAX_PAGES = int 0x7fffffff / $pagesize - 1; my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; #- (1 << 24) - 1; -my $MAX_BADPAGES = int ($pagesize - 1024 - 128 * $common::sizeof_int - 10) / $common::sizeof_int; +my $MAX_BADPAGES = int ($pagesize - 1024 - 128 * $sizeof_int - 10) / $sizeof_int; my $signature_format_v1 = "x1024 I I I I125"; #- bootbits, version, last_page, nr_badpages, padding 1; @@ -49,7 +49,7 @@ sub check_blocks { } $badpages++; } - vec($signature_page, $i, 1) = bool($last_read_ok) if $version == 0; + vec($signature_page, $i, 1) = to_bool($last_read_ok) if $version == 0; } #- TODO: add interface diff --git a/perl-install/timezone.pm b/perl-install/timezone.pm index 1b45d243a..e6dd49953 100644 --- a/perl-install/timezone.pm +++ b/perl-install/timezone.pm @@ -4,7 +4,7 @@ use diagnostics; use strict; use vars qw($ntp_servers); -use common qw(:common :system :file); +use common; use commands; use log; diff --git a/perl-install/tinyfirewall.pm b/perl-install/tinyfirewall.pm index 37c6e8d5a..0c4e5bb11 100644 --- a/perl-install/tinyfirewall.pm +++ b/perl-install/tinyfirewall.pm @@ -1,7 +1,7 @@ package tinyfirewall; use diagnostics; use strict; -use common qw(:common :functional :system :file); +use common; use commands; use run_program; use netconnect; |