first perl traduction

2 files changed, 176 insertions, 0 deletions

diff --git a/common/scripts/Vareqval.pm b/common/scripts/Vareqval.pm
new file mode 100755
index 00000000..f5f31929
--- /dev/null
+++ b/common/scripts/Vareqval.pm
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+
+# Author Philippe Hétroy, phetroy@mandrakesoft.com
+# $Id: Vareqval.pm,v 1.1 2002-07-26 09:19:56 adesmons Exp $
+
+# Module for loding and committing informations in a VAR = value file type
+
+package Vareqval;
+use lib('./');
+use strict;
+use Data::Dumper;
+
+
+# Get all useful content of the config file
+# Return a hash containg the key and the value
+# ATTENTION : in the conf file, an empty value is returnes as a spaced value (mandatory because of XML compatibility)
+sub get {
+    my $self = shift;
+    my $file = shift;
+    my %l;
+    local *F; open F, $file or return;
+    local $_;
+
+    while (<F>) {
+
+        my ($v, $val, $val2) =
+          /^\s*                 # leading space
+           (\w+) = \s*              # variable
+           (
+               "(.*)"        # double-quoted text
+             | '(.*)'        # single-quoted text
+	     | [^'"\s]*         # normal text
+           )
+           \s*$                 # end of line
+          /x;
+         no warnings;
+         $l{$v} = defined $val2 ? $val2 : $val;
+    }
+
+    %l;
+}
+
+# Commits changes in conf files and ifconfig
+sub commit {
+    my $self = shift;
+    my ($file, $hash) = @_;
+    local *F;
+
+    my $output = "";
+    if (open(F, $file)) {
+	local $_;
+
+	while (<F>) {
+	    my ($pre, $key, $eq, $val, $rest) = /(^\s*)(\w+)(\s*=\s*"*'*)([^'"\s]*)(.*)/x;
+
+            if (!defined $key) {
+                $output .= $_;
+                next;
+            };
+            next if (!exists $hash->{$key});    #Elt has been removed
+            no warnings;
+            $val = $hash->{$key};
+            delete $hash->{$key};
+            $output .= defined $val ? $pre . $key . $eq . $val .  $rest . "\n" : $pre . $key . $eq . $val .  $rest;
+#            $output .= $pre . $key . $eq . $val .  $rest . "\n";
+        }
+            #appending added parameters
+            foreach (keys %$hash) {
+                $output .= $_ . "=" . $hash->{$_} . "\n";
+            }
+
+    } else {    #the file does not exist
+	print STDERR "File $file will be created\n";
+	foreach (keys %$hash) {
+	    $output .= defined $hash->{$_} ? $_ . "=" . $hash->{$_} . "\n" : $_ . "=\n";
+	}
+    }
+
+#print $output;
+#print "\n------------------\n";
+
+     # outputing the new conf
+     open(F, "> $file") or return;
+     print F $output;
+     close(F);
+}
+
+1;
diff --git a/common/scripts/Varspaceval.pm b/common/scripts/Varspaceval.pm
new file mode 100644
index 00000000..7e385d8a
--- /dev/null
+++ b/common/scripts/Varspaceval.pm
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+
+# Author Philippe Hétroy, phetroy@mandrakesoft.com
+# $Id: Varspaceval.pm,v 1.1 2002-07-26 09:19:56 adesmons Exp $
+
+# Module for loding and committing informations in a VAR = value file type
+
+package Varspaceval;
+use lib('./');
+use strict;
+use Data::Dumper;
+
+
+# Get all useful content of the config file
+# Return a hash containg the key and the value
+# ATTENTION : in the conf file, an empty value is returnes as a spaced value (mandatory because of XML compatibility)
+sub get {
+    my $self = shift;
+    my $file = shift;
+    my %l;
+    local *F; open F, $file or return;
+    local $_;
+
+    while (<F>) {
+
+        my ($v, $val, $val2) =
+          /^\s*                 # leading space
+           (\w+)\s*              # variable
+           (
+               "(.*)"        # double-quoted text
+             | '(.*)'        # single-quoted text
+	     | [^'"\s]*         # normal text
+           )
+           \s*$                 # end of line
+          /x;
+         no warnings;
+         $l{$v} = defined $val2 ? $val2 : $val;
+    }
+
+    %l;
+}
+
+# Commits changes in conf files and ifconfig
+sub commit {
+    my $self = shift;
+    my ($file, $hash) = @_;
+    local *F;
+
+    my $output = "";
+    if (open(F, $file)) {
+	local $_;
+
+	while (<F>) {
+	    my ($pre, $key, $eq, $val, $rest) = /(^\s*)(\w+)(\s*"*'*)([^'"\s]*)(.*)/x;
+
+            if (!defined $key) {
+                $output .= $_;
+                next;
+            };
+            next if (!exists $hash->{$key});    #Elt has been removed
+            no warnings;
+            $val = $hash->{$key};
+            delete $hash->{$key};
+            $output .= defined $val ? $pre . $key . $eq . $val .  $rest . "\n" : $pre . $key . $eq . $val .  $rest;
+#            $output .= $pre . $key . $eq . $val .  $rest . "\n";
+        }
+            #appending added parameters
+            foreach (keys %$hash) {
+                $output .= $_ . " " . $hash->{$_} . "\n";
+            }
+
+    } else {    #the file does not exist
+	print STDERR "File $file will be created\n";
+	foreach (keys %$hash) {
+	    $output .= defined $hash->{$_} ? $_ . "=" . $hash->{$_} . "\n" : $_ . "=\n";
+	}
+    }
+
+#print $output;
+#print "\n------------------\n";
+
+     # outputing the new conf
+     open(F, "> $file") or return;
+     print F $output;
+     close(F);
+}
+
+1;