re-sync after the big svn loss

1 files changed, 143 insertions, 50 deletions

diff --git a/perl-install/common.pm b/perl-install/common.pm
index 63c1d0980..9d8923096 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -10,7 +10,7 @@ use run_program;
 
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT = qw($SECTORSIZE N N_ check_for_xserver files_exist formatTime formatXiB makedev mandrake_release removeXiBSuffix require_root_capability salt setVirtual set_alternative set_l10n_sort set_permissions translate unmakedev);
+our @EXPORT = qw($SECTORSIZE N P N_ check_for_xserver files_exist formatTime formatXiB makedev mandrake_release removeXiBSuffix require_root_capability setVirtual set_alternative set_l10n_sort set_permissions translate unmakedev);
 
 # perl_checker: RE-EXPORT-ALL
 push @EXPORT, @MDK::Common::EXPORT;
@@ -27,47 +27,51 @@ our $SECTORSIZE  = 512;
 #- Functions
 #-#####################################################################################
 
+sub P {
+    my ($s_singular, $s_plural, $nb, @para) = @_; 
+    sprintf(translate($s_singular, $s_plural, $nb), @para);
+}
+
 sub N {
     my ($s, @para) = @_; 
-    $::one_message_has_been_translated ||= join(':', (caller(0))[1,2]); #- see mygtk2.pm
-    my $t = translate($s);
-    sprintf($t, @para);
+    sprintf(translate($s), @para);
 }
 sub N_ { $_[0] }
 
 
-sub salt {
-    my ($nb) = @_;
-    require devices;
-    open(my $F, devices::make("random")) or die "missing random";
-    my $s; read $F, $s, $nb;
-    $s = pack("b8" x $nb, unpack "b6" x $nb, $s);
-    $s =~ tr|\0-\x3f|0-9a-zA-Z./|;
-    $s;
-}
-
 sub makedev { ($_[0] << 8) | $_[1] }
 sub unmakedev { $_[0] >> 8, $_[0] & 0xff }
 
 sub translate_real {
-    my ($s) = @_;
+    my ($s, $o_plural, $o_nb) = @_;
     $s or return '';
     foreach (@::textdomains, 'libDrakX') {
-	my $s2 = Locale::gettext::dgettext($_, $s);
+	my $s2;
+     if ($o_nb) {
+         $s2 = Locale::gettext::dngettext($_, $s, $o_plural, $o_nb);
+     } else {
+         $s2 = Locale::gettext::dgettext($_, $s);
+     }
+	# when utf8 pragma is in use, Locale::gettext() returns an utf8 string not tagged as such:
+	c::set_tagged_utf8($s2) if !utf8::is_utf8($s2) && utf8::is_utf8($s);
 	return $s2 if $s ne $s2;
     }
     $s;
 }
 
-sub translate {
-    my $s = translate_real(@_);
-    $::need_utf8_i18n and c::set_tagged_utf8($s);
-
+sub remove_translate_context {
+    my ($s) = @_;
     #- translation with context, kde-like 
     $s =~ s/^_:.*\n//;
     $s;
 }
 
+sub translate {
+    my $s = translate_real(@_);
+    $::one_message_has_been_translated ||= join(':', (caller(1))[1,2]); #- see mygtk2.pm
+    remove_translate_context($s);
+}
+
 sub from_utf8 {
     my ($s) = @_;
     Locale::gettext::iconv($s, "utf-8", undef); #- undef = locale charmap = nl_langinfo(CODESET)
@@ -90,15 +94,6 @@ sub set_l10n_sort() {
 }
 
 
-BEGIN { undef *availableRamMB }
-sub availableRamMB()  { 
-    my $s = MDK::Common::System::availableRamMB();
-    #- HACK HACK: if i810 and memsize
-    require detect_devices;
-    return $s - 1 if $s == 128 && detect_devices::matching_driver__regexp('^Card:Intel 810$');
-    $s;
-}
-
 sub setVirtual {
     my ($vt_number) = @_;
     my $vt = '';
@@ -111,7 +106,7 @@ sub setVirtual {
 
 sub nonblock {
     my ($F) = @_;
-    fcntl($F, c::F_SETFL(), fcntl($F, c::F_GETFL(), 0) | c::O_NONBLOCK());
+    fcntl($F, c::F_SETFL(), fcntl($F, c::F_GETFL(), 0) | c::O_NONBLOCK()) or die "can not fcntl F_SETFL: $!";
 }
 
 sub removeXiBSuffix {
@@ -131,7 +126,7 @@ sub formatXiB {
 	($nb, $base) = ($newnb, $newbase);
 	$base >= 1024 ? ($newbase = $base / 1024) : ($newnb = $nb / 1024);
     };
-    foreach ('', N("KB"), N("MB"), N("GB")) {
+    foreach (N("B"), N("KB"), N("MB"), N("GB")) {
 	$decr->(); 
 	if ($newnb < 1 && $newnb * $newbase < 1) {
 	    my $v = $nb * $base;
@@ -176,6 +171,22 @@ sub formatError {
     &MDK::Common::String::formatError($err);
 }
 
+sub group_by(&@) {
+    my $f = shift;
+    @_ or return;
+    my $e = shift;
+    my @l = my $last_l = [$e];
+    foreach (@_) {
+	if ($f->($e, $_)) {
+	    push @$last_l, $_;
+	} else {
+	    push @l, $last_l = [$_];
+	    $e = $_;
+	}
+    }
+    @l;
+}
+
 # Group the list by n. Returns a reference of lists of length n
 sub group_n_lm {
     my $n = shift;
@@ -212,30 +223,46 @@ sub set_alternative {
 
 sub files_exist { and_(map { -f "$::prefix$_" } @_) }
 
+sub open_file {
+    my ($file) = @_;
+    my $F;
+    open($F, $file) ? $F : do { log::l("Can not open $file: $!"); undef };
+}
+
+
 sub secured_file {
     my ($f) = @_;
     c::is_secure_file($f) or die "can not ensure a safe $f";
     $f;
 }
 
+sub chown_ {
+    my ($b_recursive, $name, $group, @files) = @_;
+
+    my ($uid, $gid) = (getpwnam($name) || $name, getgrnam($group) || $group);
+      
+    require POSIX;
+    my $chown; $chown = sub {
+	foreach (@_) {
+	    POSIX::lchown($uid, $gid, $_) or die "chown of file $_ failed: $!\n";
+	    ! -l $_ && -d $_ && $b_recursive and &$chown(glob_($_));
+	}
+    };
+    $chown->(@files);
+}
+
+
 sub set_permissions {
     my ($file, $perms, $o_owner, $o_group) = @_;
     # We only need to set the permissions during installation to be able to
-    # print test pages. After installation the devfsd daemon does the business
-    # automatically.
+    # print test pages. After installation udev does the business automatically.
     return 1 unless $::isInstall;
-    if ($o_owner && $o_group) {
-        run_program::rooted($::prefix, "/bin/chown", "$o_owner.$o_group", $file)
-	    or die "Could not start chown!";
-    } elsif ($o_owner) {
-        run_program::rooted($::prefix, "/bin/chown", $o_owner, $file)
-	    or die "Could not start chown!";
-    } elsif ($o_group) {
-        run_program::rooted($::prefix, "/bin/chgrp", $o_group, $file)
-	    or die "Could not start chgrp!";
+    if ($o_owner || $o_group) {
+	$o_owner ||= (lstat($file))[4];
+	$o_group ||= (lstat($file))[5];
+	chown_(0, $o_owner, $o_group, $file);
     }
-    run_program::rooted($::prefix, "/bin/chmod", $perms, $file)
-	or die "Could not start chmod!";
+    chmod(oct($perms), $file) or die "chmod of file $file failed: $!\n";
 }
 
 sub release_file {
@@ -247,20 +274,28 @@ sub release_file {
     );
 }
 
+sub parse_LDAP_namespace_structure {
+    my ($s) = @_;
+    my %h = map { if_(/(.*?)=(.*)/, $1 => $2) } split(',', $s);
+    \%h;
+}
+
 sub mandrake_release {
     my ($o_dir) = @_;
     my $f = release_file($o_dir);
     $f && chomp_(cat_("$o_dir$f"));
 }
 
+sub wrap_command_for_root {
+    my ($name, @args) = @_;
+    ([ 'consolehelper', $name ], @args);
+}
+
 sub require_root_capability() {
     return if $::testing || !$>; # we're already root
-    if (check_for_xserver()) {
-	if (fuzzy_pidofs(qr/\bkwin\b/) > 0) {
-	    exec("kdesu", "--ignorebutton", "-c", "$0 @ARGV") or die N("kdesu missing");
-	}
-    }
-    exec { 'consolehelper' } $0, @ARGV or die N("consolehelper missing");
+
+    my ($command, @args) = wrap_command_for_root($0, @ARGV);
+    exec { $command->[0] } $command->[1], @args or die N("command %s missing", $command->[0]);
 
     # still not root ?
     die "you must be root to run this program" if $>;
@@ -299,6 +334,7 @@ sub unpack_with_refs {
     @r;
 }
 
+#- used in userdrake and mdkonline
 sub md5file {
     require Digest::MD5;
     my @md5 = map {
@@ -313,4 +349,61 @@ sub md5file {
     return wantarray() ? @md5 : $md5[0];
 }
 
+sub load_modules_from_base {
+    my ($base) = @_;
+    $base =~ s|::|/|g;
+    my $base_file = $base . ".pm";
+    require $base_file;
+    my ($inc_path) = substr($INC{$base_file}, 0, -length($base_file));
+    my @files = map { substr($_, length($inc_path)) } glob_($inc_path . $base . '/*.pm');
+    require $_ foreach @files;
+    #- return the matching modules list
+    map { local $_ = $_; s|/|::|g; s|\.pm$||g; $_ } @files;
+}
+
+sub get_alternatives {
+    my ($name) = @_;
+
+    my $dir = '/var/lib/rpm/alternatives';
+    my ($state, $main_link, @l) = chomp_(cat_("$dir/$name")) or return;
+    my @slaves;
+    while (@l && $l[0] ne '') {
+	my ($name, $link) = splice(@l, 0, 2);
+	push @slaves, { name => $name, link => $link };
+    }
+    shift @l; #- empty line
+    my @alternatives;
+    while (@l && $l[0] ne '') {
+	my ($file, $weight, @slave_files) = splice(@l, 0, 2 + @slaves);
+	
+	push @alternatives, { file => $file, weight => $weight, slave_files => \@slave_files };
+    }
+    { name => $name, link => $main_link, state => $state, slaves => \@slaves, alternatives => \@alternatives };
+}
+
+sub symlinkf_update_alternatives {
+    my ($name, $wanted_file) = @_;
+    my $conf = get_alternatives($name);
+    my $chosen = find { $_->{file} eq $wanted_file } @{$conf->{alternatives}} or return;
+    symlinkf("/etc/alternatives/$name", $::prefix . $conf->{link});
+    symlinkf($wanted_file, "$::prefix/etc/alternatives/$name");
+    mapn {
+	my ($slave, $file) = @_;
+	if ($file) {
+	    symlinkf("/etc/alternatives/$slave->{name}", $::prefix . $slave->{link});
+	    symlinkf($file, "$::prefix/etc/alternatives/$slave->{name}");
+	} else {
+	    unlink $::prefix . $slave->{link};
+	    unlink "$::prefix/etc/alternatives/$slave->{name}";
+	}
+    } $conf->{slaves}, $chosen->{slave_files};
+}
+
+sub update_gnomekderc_no_create {
+    my ($file, $category, %subst_) = @_;
+    if (-e $file) {
+	update_gnomekderc($file, $category, %subst_);
+    }
+}
+
 1;