Changeset 51 for devel/dploy-common/lib/Dploy/Base.pm

Timestamp:

05/02/08 16:00:33 (4 years ago)

Author:

bruno

Message:

• Use pb functions in scripts
• Update of concept doc
• Check errors in dploy-add2dhcp

File:

• devel/dploy-common/lib/Dploy/Base.pm (modified) (2 diffs)

devel/dploy-common/lib/Dploy/Base.pm

@@ -12 +12 @@
 use Pod::Usage;
 use English;
+use ProjectBuilder::Base;
 
 #use File::Basename;
@@ -30 +31 @@
 # any code which uses this module.
  
-our $debug = 0;
-our $LOG = \*STDOUT;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(dploy_check_mac dploy_check_ip);
 
-our @ISA = qw(Exporter);
-our @EXPORT = qw(dploy_syntax $debug $LOG);
+sub dploy_check_mac {
 
-sub dploy_syntax {
+my $mac = shift;
 
-# Internal mkdir -p function
-sub dploy_mkdir_p {
-my @dir = @_;
-my $ret = mkpath(@dir, 0, 0755);
-return($ret);
+pb_syntax(-1,0) if (not defined $mac);
+if ($mac !~ /^(?:[[:xdigit:]]{1,2}[-:]){5}[[:xdigit:]]{1,2}$/) {
+    print "Wrong MAC address\n";
+    pb_syntax(-1,0);
+}
+# only lowercase for homogeneity in mac address
+$mac =~ tr/A-Z/a-z/;
+
+# newmac replaces : separator with - and only lowercase for dhcpd
+my $newmac = $mac;
+$newmac =~ s/:/-/g;
+
+return($newmac);
 }
 
-# Internal rm -rf function
-sub dploy_rm_rf {
-my @dir = @_;
-my $ret = rmtree(@dir, 0, 0);
-return($ret);
+sub dploy_check_ip {
+
+my $ip = shift;
+my $cmt = shift;
+
+pb_syntax(-1,0) if (not defined $ip);
+if ($ip !~ /^([1-9]?\d|1\d\d|2[0-4]\d|25[0-5])\.([1-9]?\d|1\d\d|2[0-4]\d|25[0-5])\.([1-9]?\d|1\d\d|2[0-4]\d|25[0-5])\.([1-9]?\d|1\d\d|2[0-4]\d|25[0-5])$/) {
+        print "$cmt\n";
+        pb_syntax(-1,0);
+    }
 }
 
-# Internal system function
-sub dploy_system {
-
-my $cmd=shift;
-my $cmt=shift || $cmd;
-
-dploy_log(0,"$cmt... ");
-#system("$cmd 2>&1 > $ENV{'PBTMP'}/system.log");
-system($cmd);
-dploy_log(1,"Executing $cmd\n");
-my $res = $?;
-if ($res == -1) {
-    dploy_log(0,"failed to execute ($cmd) : $!\n");
-    dploy_display_file("$ENV{'PBTMP'}/system.log");
-} elsif ($res & 127) {
-    dploy_log(0, "child ($cmd) died with signal ".($? & 127).", ".($? & 128) ? 'with' : 'without'." coredump\n");
-    dploy_display_file("$ENV{'PBTMP'}/system.log");
-} elsif ($res == 0) {
-    dploy_log(0,"OK\n");
-} else {
-    dploy_log(0, "child ($cmd) exited with value ".($? >> 8)."\n");
-    dploy_display_file("$ENV{'PBTMP'}/system.log");
-}
-return($res);
-}
-
-sub dploy_display_file {
-
-my $file=shift;
-
-return if (not -f $file);
-open(FILE,"$file");
-while (<FILE>) {
-    print $_;
-}
-close(FILE);
-}
-
-# Function which returns a pointer on a table
-# corresponding to a set of values queried in the conf file
-# and test the returned vaue as they need to exist in that case
-sub dploy_conf_get {
-
-my @param = @_;
-my @return = dploy_conf_get_if(@param);
-
-die "No params found for $ENV{'PBPROJ'}" if (not @return);
-
-foreach my $i (0..$#param) {
-    die "No $param[$i] defined for $ENV{'PBPROJ'}" if (not defined $return[$i]);
-}
-return(@return);
-}
-
-# Function which returns a pointer on a table
-# corresponding to a set of values queried in the conf file
-# Those value may be undef if they do not exist
-sub dploy_conf_get_if {
-
-my @param = @_;
-
-# Everything is returned via ptr1
-my @ptr1 = ();
-my @ptr2 = ();
-@ptr1 = dploy_conf_read_if("$ENV{'PBETC'}", @param) if (defined $ENV{'PBETC'});
-@ptr2 = dploy_conf_read_if("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb", @param) if ((defined $ENV{'PBROOTDIR'}) and (defined $ENV{'PBPROJ'}));
-
-my $p1;
-my $p2;
-
-dploy_log(2,"DEBUG: dploy_conf_get param1: ".Dumper(@ptr1)."\n");
-dploy_log(2,"DEBUG: dploy_conf_get param2: ".Dumper(@ptr2)."\n");
-
-foreach my $i (0..$#param) {
-    $p1 = $ptr1[$i];
-    $p2 = $ptr2[$i];
-    # Always try to take the param from the home dir conf file in priority
-    # in order to mask what could be defined under the CMS to allow for overloading
-    if (not defined $p2) {
-        # No ref in CMS project conf file so use the home dir one.
-        $p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if ((not defined $p1->{$ENV{'PBPROJ'}}) && (defined $p1->{'default'}));
-    } else {
-        # Ref found in CMS project conf file
-        if (not defined $p1) {
-            # No ref in home dir project conf file so use the CMS one.
-            $p2->{$ENV{'PBPROJ'}} = $p2->{'default'} if ((not defined $p2->{$ENV{'PBPROJ'}}) && (defined $p2->{'default'}));
-            $p1 = $p2;
-        } else {
-            # Both are defined - handling the overloading
-            if (not defined $p1->{'default'}) {
-                if (defined $p2->{'default'}) {
-                    $p1->{'default'} = $p2->{'default'};
-                }
-            }
-
-            if (not defined $p1->{$ENV{'PBPROJ'}}) {
-                if (defined $p2->{$ENV{'PBPROJ'}}) {
-                    $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}} if (defined $p2->{$ENV{'PBPROJ'}});
-                } else {
-                    $p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if (defined $p1->{'default'});
-                }
-            }
-            # Now copy back into p1 all p2 content which doesn't exist in p1
-            # p1 content (local) always has priority over p2 (project)
-            foreach my $k (keys %$p2) {
-                $p1->{$k} = $p2->{$k} if (not defined $p1->{$k});
-            }
-        }
-    }
-    $ptr1[$i] = $p1;
-}
-dploy_log(2,"DEBUG: dploy_conf_get param ptr1: ".Dumper(@ptr1)."\n");
-return(@ptr1);
-}
-
-# Function which returns a pointer on a hash
-# corresponding to a declaration (arg2) in a conf file (arg1)
-# if that conf file doesn't exist returns undef 
-sub dploy_conf_read_if {
-
-my $conffile = shift;
-my @param = @_;
-
-open(CONF,$conffile) || return((undef));
-close(CONF);
-return(dploy_conf_read($conffile,@param));
-}
-
-# Function which returns a pointer on a hash
-# corresponding to a declaration (arg2) in a conf file (arg1)
-sub dploy_conf_read {
-
-my $conffile = shift;
-my @param = @_;
-my $trace;
-my @ptr;
-my %h;
-
-open(CONF,$conffile) || die "Unable to open $conffile";
-while(<CONF>) {
-    if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) {
-        dploy_log(3,"DEBUG: 1:$1 2:$2 3:$3\n");
-        $h{$1}{$2}=$3;
-    }
-}
-close(CONF);
-
-for my $param (@param) {
-    push @ptr,$h{$param};
-}
-return(@ptr);
-}
-
-# Analyze a url passed and return protocol, account, password, server, port, path
-sub dploy_get_uri {
-
-my $uri = shift || undef;
-
-dploy_log(2,"DEBUG: uri:$uri\n");
-# A URL has the format protocol://[ac@]host[:port][path[?query][#fragment]].
-# Cf man URI
-my ($scheme, $authority, $path, $query, $fragment) =
-         $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?| if (defined $uri);
-my ($account,$host,$port) = $authority =~ m|(?:([^\@]+)\@)?([^:]+)(:(?:[0-9]+))?| if (defined $authority);
-
-$scheme = "" if (not defined $scheme);
-$authority = "" if (not defined $authority);
-$path = "" if (not defined $path);
-$account = "" if (not defined $account);
-$host = "" if (not defined $host);
-$port = "" if (not defined $port);
-
-dploy_log(2,"DEBUG: scheme:$scheme ac:$account host:$host port:$port path:$path\n");
-return($scheme, $account, $host, $port, $path);
-}
-
-
-sub dploy_get_date {
-    
-return(localtime->sec(), localtime->min(), localtime->hour(), localtime->mday(), localtime->mon(), localtime->year(), localtime->wday(), localtime->yday(), localtime->isdst());
-}
-
-sub dploy_log {
-
-my $dlevel = shift;
-my $msg = shift;
-
-print $LOG "$msg" if ($dlevel <= $debug);
-}
-
-sub dploy_syntax {
-
-my $exit_status = shift || -1;
-my $verbose_level = shift || 0;
-
-my $filehandle = \*STDERR;
-
-$filehandle = \*STDOUT if ($exit_status == 0);
-
-pod2usage( { -message => "Dploy.org Version PBVER-PBREV\n",
-             -exitval => $exit_status  ,
-             -verbose => $verbose_level,
-             -output  => $filehandle } );
-}
-
-
 1;