From a845140044510ef3fdc179b333301218d3faefe5 Mon Sep 17 00:00:00 2001 From: Guillaume Cottenceau Date: Fri, 18 Jan 2002 20:22:20 +0000 Subject: - write the 'common' part of the 'explanations' stuff, with nice help from Pixel for the tough Perl part - move 'use standalone' up in all standalone apps, to comply to 'explanations' --- perl-install/c/stuff.xs.pm | 6 +- perl-install/log.pm | 6 +- perl-install/standalone.pm | 130 ++++++++++++++++++++++++++++++++++ perl-install/standalone/XFdrake | 3 +- perl-install/standalone/adduserdrake | 3 +- perl-install/standalone/diskdrake | 4 +- perl-install/standalone/drakautoinst | 9 ++- perl-install/standalone/drakbackup | 4 +- perl-install/standalone/drakboot | 2 +- perl-install/standalone/drakfont | 4 +- perl-install/standalone/drakproxy | 9 ++- perl-install/standalone/draksec | 3 +- perl-install/standalone/drakxconf | 2 +- perl-install/standalone/drakxservices | 3 +- perl-install/standalone/keyboarddrake | 2 +- perl-install/standalone/livedrake | 3 +- perl-install/standalone/localedrake | 2 + perl-install/standalone/logdrake | 10 ++- perl-install/standalone/mousedrake | 3 +- perl-install/standalone/net_monitor | 4 +- perl-install/standalone/printerdrake | 3 +- perl-install/standalone/tinyfirewall | 4 +- 22 files changed, 195 insertions(+), 24 deletions(-) (limited to 'perl-install') diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm index 59d8fe232..3176e3515 100644 --- a/perl-install/c/stuff.xs.pm +++ b/perl-install/c/stuff.xs.pm @@ -310,10 +310,11 @@ void closelog() void -syslog(mesg) +syslog(priority, mesg) + int priority char *mesg CODE: - syslog(LOG_WARNING, mesg); + syslog(priority, mesg); void setsid() @@ -1013,6 +1014,7 @@ int rpmvercmp(char *a, char *b); HDIO_GETGEO BLKGETSIZE LOOP_GET_STATUS MS_MGC_VAL MS_RDONLY O_NONBLOCK F_SETFL F_GETFL O_CREAT SECTORSIZE WNOHANG VT_ACTIVATE VT_WAITACTIVE VT_GETSTATE CDROM_LOCKDOOR CDROMEJECT + LOG_WARNING LOG_INFO LOG_LOCAL1 ) ], ); push @macros, [ qw(int RPMTAG_NAME RPMTAG_GROUP RPMTAG_SIZE RPMTAG_VERSION RPMTAG_SUMMARY RPMTAG_DESCRIPTION RPMTAG_RELEASE RPMTAG_EPOCH RPMTAG_ARCH RPMTAG_OBSOLETES RPMTAG_REQUIRENAME RPMTAG_FILEFLAGS RPMFILE_CONFIG) ] diff --git a/perl-install/log.pm b/perl-install/log.pm index b049f5d49..59f3d4bbf 100644 --- a/perl-install/log.pm +++ b/perl-install/log.pm @@ -20,7 +20,7 @@ sub F() { *LOG } sub l { $logOpen or openLog(); if ($::isStandalone) { - c::syslog(join "", @_); + c::syslog(c::LOG_WARNING(), join("", @_)); } elsif ($::isInstall) { print LOG "* ", @_, "\n"; print LOG2 "* ", @_, "\n"; @@ -32,9 +32,7 @@ sub ld { $logDebugMessages and &l } sub w { &l } sub openLog(;$) { - if ($::isStandalone) { - c::openlog("DrakX"); - } elsif ($::isInstall) { + if ($::isInstall) { if ($_[0]) { #- useLocal open LOG, "> $_[0]";# or die "no log possible :("; } else { diff --git a/perl-install/standalone.pm b/perl-install/standalone.pm index eea2cf5ca..a9eeb9af0 100644 --- a/perl-install/standalone.pm +++ b/perl-install/standalone.pm @@ -23,6 +23,7 @@ sub install { my ($o, @l) = @_; $o->{in}->suspend; my $wait = $o->{in}->wait_message('', _("Installing packages...")); + standalone::explanations("installed packages @l"); my $ret = system('urpmi', '--allow-medium-change', '--auto', '--best-output', @l) == 0; undef $wait; $o->{in}->resume; @@ -37,6 +38,7 @@ sub is_installed { sub remove { my ($o, @l) = @_; $o->{in}->suspend; + standalone::explanations("removed packages @l"); my $ret = system('rpm', '-e', @l) == 0; $o->{in}->resume; $ret; @@ -45,12 +47,140 @@ sub remove { sub remove_nodeps { my ($o, @l) = @_; $o->{in}->suspend; + standalone::explanations("removed (with --nodeps) packages @l"); my $ret = system('rpm', '-e', '--nodeps', @l) == 0; $o->{in}->resume; $ret; } ################################################################################ + package standalone; +#- stuff will go to special /var/log/explanations file +my $standalone_name; +sub explanations { c::syslog(c::LOG_INFO()|c::LOG_LOCAL1(), "@_") } + +@common_functs = qw(renamef linkf symlinkf output substInFile mkdir_p rm_rf cp_af touch setVarsInSh setVarsInCsh update_gnomekderc); +@builtin_functs = qw(chmod chown unlink link symlink rename system); +@drakx_modules = qw(Xconfig Xconfigurator Xconfigurator_consts any bootloader bootlook c class_discard commands crypto detect_devices devices diskdrake diskdrake_interactive fs fsedit http keyboard lang log loopback lvm modparm modules mouse my_gtk network partition_table partition_table_bsd partition_table_dos partition_table_empty partition_table_gpt partition_table_mac partition_table_raw partition_table_sun printer printerdrake proxy raid run_program scanner services steps swap timezone tinyfirewall); + + +sub import { + ($standalone_name = $0) =~ s|.*/||; + c::openlog("$standalone_name"."[$$]"); + explanations('### Program is starting ###'); + + eval "*MDK::Common::$_ = *$_" foreach @common_functs; + + foreach my $f (@builtin_functs) { + eval "*$_"."::$f = *$f" foreach @drakx_modules; + eval "*".caller()."::$f = *$f"; + } +} + + +sub renamef { + explanations "moved file $_[0] to $_[1]"; + goto &MDK::Common::File::renamef; +} + +sub linkf { + explanations "hard linked file $_[0] to $_[1]"; + goto &MDK::Common::File::linkf; +} + +sub symlinkf { + explanations "symlinked file $_[0] to $_[1]"; + goto &MDK::Common::File::symlinkf; +} + +sub output { + explanations "created file $_[0]"; + goto &MDK::Common::File::output; +} + +sub substInFile(&@) { + explanations "modified file $_[1]"; + goto &MDK::Common::File::substInFile; +} + +sub mkdir_p { + explanations "created directory $_[0] (and parents if necessary)"; + goto &MDK::Common::File::mkdir_p; +} + +sub rm_rf { + explanations "removed files/directories (recursively) @_"; + goto &MDK::Common::File::rm_rf; +} + +sub cp_af { + my $retval = MDK::Common::File::cp_af @_; + my $dest = pop @_; + explanations "copied recursively @_ to $dest"; + return $retval; +} + +sub touch { + explanations "touched file @_"; + goto &MDK::Common::File::touch; +} + +sub setVarsInSh { + explanations "modified file $_[0]"; + goto &MDK::Common::System::setVarsInSh; +} + +sub setVarsInCsh { + explanations "modified file $_[0]"; + goto &MDK::Common::System::setVarsInCsh; +} + +sub update_gnomekderc { + explanations "updated file $_[0]"; + goto &MDK::Common::System::update_gnomekderc; +} + + +sub chmod { + my $retval = CORE::chmod @_; + my $mode = shift @_; + explanations sprintf("changed mode of %s to %o", $_, $mode) foreach @_; + return $retval; +} + +sub chown { + my $retval = CORE::chown @_; + my $uid = shift @_; + my $gid = shift @_; + explanations sprintf("changed owner of $_ to $uid.$gid") foreach @_; + return $retval; +} + +sub unlink { + explanations "removed files/directories @_"; + CORE::unlink @_; +} + +sub link { + explanations "hard linked file $_[0] to $_[1]"; + CORE::link $_[0], $_[1]; +} + +sub symlink { + explanations "symlinked file $_[0] to $_[1]"; + CORE::symlink $_[0], $_[1]; +} + +sub rename { + explanations "renamed file $_[0] to $_[1]"; + CORE::rename $_[0], $_[1]; +} + +sub system { + explanations "launched command: @_"; + CORE::system @_; +} + 1; diff --git a/perl-install/standalone/XFdrake b/perl-install/standalone/XFdrake index 891722d50..66b8746ea 100755 --- a/perl-install/standalone/XFdrake +++ b/perl-install/standalone/XFdrake @@ -19,8 +19,9 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use modules; use Xconfigurator; use Xconfig; diff --git a/perl-install/standalone/adduserdrake b/perl-install/standalone/adduserdrake index d2893c850..c176f5936 100755 --- a/perl-install/standalone/adduserdrake +++ b/perl-install/standalone/adduserdrake @@ -2,9 +2,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use common; use interactive; -use standalone; use any; local $_ = join '', @ARGV; diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake index be570dadb..d428e6955 100755 --- a/perl-install/standalone/diskdrake +++ b/perl-install/standalone/diskdrake @@ -23,9 +23,11 @@ use lib qw(/usr/lib/libDrakX); + +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use common; use diskdrake_interactive; -use standalone; use interactive; use detect_devices; use fsedit; diff --git a/perl-install/standalone/drakautoinst b/perl-install/standalone/drakautoinst index 1dc3fc2a3..04ff72cbc 100755 --- a/perl-install/standalone/drakautoinst +++ b/perl-install/standalone/drakautoinst @@ -15,9 +15,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use common; use interactive; -use standalone; use devices; use detect_devices; use steps; @@ -359,6 +360,12 @@ sub control_buttons { #------------------------------------------------- #- $Log$ +#- Revision 1.16 2002/01/18 20:22:20 gc +#- - write the 'common' part of the 'explanations' stuff, +#- with nice help from Pixel for the tough Perl part +#- - move 'use standalone' up in all standalone apps, +#- to comply to 'explanations' +#- #- Revision 1.15 2002/01/08 10:21:15 fpons #- removed stupid invocation of _("$_"), is it correct code to change it to $_ only ? #- diff --git a/perl-install/standalone/drakbackup b/perl-install/standalone/drakbackup index dbdfdee24..80bf7f8d6 100755 --- a/perl-install/standalone/drakbackup +++ b/perl-install/standalone/drakbackup @@ -112,8 +112,10 @@ use Gtk; use lib qw(/usr/lib/libDrakX ); + +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use my_gtk qw(:helpers :wrappers); use common; use strict; diff --git a/perl-install/standalone/drakboot b/perl-install/standalone/drakboot index 8a17b4813..dd0eb6403 100755 --- a/perl-install/standalone/drakboot +++ b/perl-install/standalone/drakboot @@ -2,10 +2,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' use common; use interactive; -use standalone; use any; use bootloader; use detect_devices; diff --git a/perl-install/standalone/drakfont b/perl-install/standalone/drakfont index 462d01fb2..ea04c6e96 100755 --- a/perl-install/standalone/drakfont +++ b/perl-install/standalone/drakfont @@ -81,8 +81,10 @@ use Gtk; use lib qw(/usr/lib/libDrakX ); + +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use my_gtk qw(:helpers :wrappers); use common; use strict; diff --git a/perl-install/standalone/drakproxy b/perl-install/standalone/drakproxy index acfc159ba..ec6d5cbfc 100755 --- a/perl-install/standalone/drakproxy +++ b/perl-install/standalone/drakproxy @@ -15,8 +15,9 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use proxy; use my_gtk qw(:helpers :wrappers); @@ -67,6 +68,12 @@ Gtk->exit(0); #------------------------------------------------- #- $Log$ +#- Revision 1.9 2002/01/18 20:22:20 gc +#- - write the 'common' part of the 'explanations' stuff, +#- with nice help from Pixel for the tough Perl part +#- - move 'use standalone' up in all standalone apps, +#- to comply to 'explanations' +#- #- Revision 1.8 2001/10/30 20:11:31 damien #- corrected ref($in) =~ /gtk/ #- diff --git a/perl-install/standalone/draksec b/perl-install/standalone/draksec index cf536104c..aef9cd80d 100755 --- a/perl-install/standalone/draksec +++ b/perl-install/standalone/draksec @@ -2,9 +2,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use common; use interactive; -use standalone; use mouse; use c; diff --git a/perl-install/standalone/drakxconf b/perl-install/standalone/drakxconf index 51530940d..a8d3158eb 100755 --- a/perl-install/standalone/drakxconf +++ b/perl-install/standalone/drakxconf @@ -2,9 +2,9 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' use interactive; -use standalone; use keyboard; use Xconfigurator_consts; use common; diff --git a/perl-install/standalone/drakxservices b/perl-install/standalone/drakxservices index 21e7baade..f5249475b 100755 --- a/perl-install/standalone/drakxservices +++ b/perl-install/standalone/drakxservices @@ -2,9 +2,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use common; use interactive; -use standalone; use services; use log; diff --git a/perl-install/standalone/keyboarddrake b/perl-install/standalone/keyboarddrake index a6c415c7e..0ac98cb49 100755 --- a/perl-install/standalone/keyboarddrake +++ b/perl-install/standalone/keyboarddrake @@ -2,10 +2,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' use interactive; use keyboard; -use standalone; use Xconfigurator_consts; use common; use c; diff --git a/perl-install/standalone/livedrake b/perl-install/standalone/livedrake index bb689996f..9c2af4c03 100755 --- a/perl-install/standalone/livedrake +++ b/perl-install/standalone/livedrake @@ -2,9 +2,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use common; use interactive; -use standalone; use run_program; use c; diff --git a/perl-install/standalone/localedrake b/perl-install/standalone/localedrake index cc9b68260..cc43ee653 100644 --- a/perl-install/standalone/localedrake +++ b/perl-install/standalone/localedrake @@ -2,6 +2,8 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; use lang; use any; diff --git a/perl-install/standalone/logdrake b/perl-install/standalone/logdrake index 72bedfc45..8fbc4ca2a 100755 --- a/perl-install/standalone/logdrake +++ b/perl-install/standalone/logdrake @@ -23,8 +23,10 @@ use POSIX; use Gtk; use lib qw(/usr/lib/libDrakX); + +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use any; use Config; use my_gtk qw(:helpers :wrappers); @@ -409,6 +411,12 @@ sub destroy_window { # log # $Log$ +# Revision 1.3 2002/01/18 20:22:20 gc +# - write the 'common' part of the 'explanations' stuff, +# with nice help from Pixel for the tough Perl part +# - move 'use standalone' up in all standalone apps, +# to comply to 'explanations' +# # Revision 1.2 2001/12/18 17:31:48 yduret # fix console mode : exit now # diff --git a/perl-install/standalone/mousedrake b/perl-install/standalone/mousedrake index f3609b936..64501a531 100755 --- a/perl-install/standalone/mousedrake +++ b/perl-install/standalone/mousedrake @@ -2,9 +2,10 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use common; use interactive; -use standalone; use modules; use detect_devices; use Xconfig; diff --git a/perl-install/standalone/net_monitor b/perl-install/standalone/net_monitor index 70504ed6e..2bd2120ca 100755 --- a/perl-install/standalone/net_monitor +++ b/perl-install/standalone/net_monitor @@ -20,8 +20,10 @@ use Gtk; use lib qw(/usr/lib/libDrakX); + +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use my_gtk qw(:helpers :wrappers); #-use Data::Dumper; use common; diff --git a/perl-install/standalone/printerdrake b/perl-install/standalone/printerdrake index 0a339adf6..87d44e252 100755 --- a/perl-install/standalone/printerdrake +++ b/perl-install/standalone/printerdrake @@ -20,8 +20,9 @@ use lib qw(/usr/lib/libDrakX); +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use printerdrake; use printer; use c; diff --git a/perl-install/standalone/tinyfirewall b/perl-install/standalone/tinyfirewall index df01e76e9..3f91a0027 100755 --- a/perl-install/standalone/tinyfirewall +++ b/perl-install/standalone/tinyfirewall @@ -19,8 +19,10 @@ # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. use lib qw(/usr/lib/libDrakX); + +use standalone; #- warning, standalone must be loaded very first, for 'explanations' + use interactive; -use standalone; use tinyfirewall; $::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -- cgit v1.2.1