summaryrefslogtreecommitdiffstats
path: root/perl-install/common.pm
diff options
context:
space:
mode:
authorThierry Vignaud <tvignaud@mandriva.org>2002-11-12 12:05:40 +0000
committerThierry Vignaud <tvignaud@mandriva.org>2002-11-12 12:05:40 +0000
commit046406ab6b13659f4be843d3d2d5639efaf425fe (patch)
tree2304d9911b495ea5262815f2b3cca305f53d83f4 /perl-install/common.pm
parent57582cf77904240eee6c29874866b9d62e4a9951 (diff)
downloaddrakx-backup-do-not-use-046406ab6b13659f4be843d3d2d5639efaf425fe.tar
drakx-backup-do-not-use-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.gz
drakx-backup-do-not-use-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.bz2
drakx-backup-do-not-use-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.xz
drakx-backup-do-not-use-046406ab6b13659f4be843d3d2d5639efaf425fe.zip
printer related modules cleaning :
- create the printer/ hierarchy - split services related stuff into services.pm & printer::services, - move things that've nothing to do with printers into common.pm (alternatives, permissions, ...) - move eveything related to cups, gimp-print, detection, {star,open}office to the corresponding splited printer:: module - big consolidation of printer::office (it was obvious there were tons of duplication between staroffice and openoffice managment) - move other stuff into printer::main, printer::common, status : print.pm has been heavily splited (now one can begin to understand the little bits). printerdrake still needs to be splited/cleaned and eventually removed since printer/printerdrake modules separation is not understandable by other people till, in printer::gimp, $lprcommand is neither declared nor setted nowhere. idem in mdk9.0 ...
Diffstat (limited to 'perl-install/common.pm')
-rw-r--r--perl-install/common.pm59
1 files changed, 58 insertions, 1 deletions
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 3e46d89aa..4093c1b02 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -4,11 +4,12 @@ use MDK::Common;
use MDK::Common::System;
use diagnostics;
use strict;
+use run_program;
use vars qw(@ISA @EXPORT $SECTORSIZE);
@ISA = qw(Exporter);
# no need to export ``_''
-@EXPORT = qw($SECTORSIZE N N_ translate untranslate formatXiB removeXiBSuffix formatTime setVirtual makedev unmakedev salt);
+@EXPORT = qw($SECTORSIZE N N_ translate untranslate formatXiB removeXiBSuffix formatTime setVirtual makedev unmakedev salt set_permissions files_exist set_alternative);
# perl_checker: RE-EXPORT-ALL
push @EXPORT, @MDK::Common::EXPORT;
@@ -185,4 +186,60 @@ sub join_lines {
@l, if_($s, $s);
}
+
+sub set_alternative {
+ my ($command, $executable) = @_;
+ local *F;
+ # Read the list of executables for the given command to find the number
+ # of the desired executable
+ open F, ($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; /bin/echo | update-alternatives --config $command \" |" or
+ die "Could not run \"update-alternatives\"!";
+ my $choice = 0;
+ while (my $line = <F>) {
+ chomp $line;
+ if ($line =~ m/^[\* ][\+ ]\s*([0-9]+)\s+(\S+)\s*$/) { # list entry?
+ if ($2 eq $executable) {
+ $choice = $1;
+ last;
+ }
+ }
+ }
+ close F;
+ # If the executable was found, assign the command to it
+ if ($choice > 0) {
+ system(($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "/bin/sh -c \"/bin/echo $choice | update-alternatives --config $command > /dev/null 2>&1\"");
+ }
+ return 1;
+}
+
+sub files_exist {
+ my @files = @_;
+ foreach my $file (@files) {
+ return 0 unless -f "$::prefix$file"
+ }
+ return 1;
+}
+
+sub set_permissions {
+ my ($file, $perms, $owner, $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.
+ return 1 unless $::isInstall;
+ if ($owner && $group) {
+ run_program::rooted($::prefix, "/bin/chown", "$owner.$group", $file)
+ or die "Could not start chown!";
+ } elsif ($owner) {
+ run_program::rooted($::prefix, "/bin/chown", $owner, $file)
+ or die "Could not start chown!";
+ } elsif ($group) {
+ run_program::rooted($::prefix, "/bin/chgrp", $group, $file)
+ or die "Could not start chgrp!";
+ }
+ run_program::rooted($::prefix, "/bin/chmod", $perms, $file)
+ or die "Could not start chmod!";
+}
+
1;