Changeset 63 for trunk

Timestamp:

Sep 4, 2009, 4:45:10 PM (15 years ago)

Author:

g7moreau

Message:

• Cancel last commit (error done before...)

File:

• trunk/klask (modified) (98 diffs)

trunk/klask

@@ -7 +7 @@
 use strict;
 use warnings;
-
+use version; our $VERSION = qv('0.5.5');
+
+use Readonly;
+use Filehandle;
 use Net::SNMP;
 #use YAML;
@@ -29 +32 @@
 my $KLASK_CFG = YAML::Syck::LoadFile("$KLASK_CFG_FILE");
 
-my %DEFAULT = %{$KLASK_CFG->{default}};
-my @SWITCH  = @{$KLASK_CFG->{switch}};
+my %DEFAULT = %{ $KLASK_CFG->{default} };
+my @SWITCH  = @{ $KLASK_CFG->{switch}  };
 
 my %switch_level = ();
-my %SWITCH_DB = ();
+my %SWITCH_DB    = ();
 LEVEL_OF_EACH_SWITCH:
 for my $sw (@SWITCH){
@@ -39 +42 @@
    $SWITCH_DB{$sw->{hostname}} = $sw;
    }
-@SWITCH = sort { $switch_level{$b->{hostname}} <=> $switch_level{$a->{hostname}} } @{$KLASK_CFG->{switch}};
+@SWITCH = reverse sort { $switch_level{$a->{hostname}} <=> $switch_level{$b->{hostname}} } @{$KLASK_CFG->{switch}};
 
 my %SWITCH_PORT_COUNT = ();
@@ -60 +63 @@
    );
 
-my %INTERNAL_PORT_MAP = (
+Readonly my %INTERNAL_PORT_MAP => (
    0 => 'A',
    1 => 'B',
@@ -70 +73 @@
    7 => 'H',
    );
-my %INTERNAL_PORT_MAP_REV = reverse %INTERNAL_PORT_MAP;
-
-my %SWITCH_KIND = (
+Readonly my %INTERNAL_PORT_MAP_REV => reverse %INTERNAL_PORT_MAP;
+
+Readonly my %SWITCH_KIND => (
    J3299A => { model => 'HP224M',     match => 'HP J3299A ProCurve Switch 224M'  },
    J4120A => { model => 'HP1600M',    match => 'HP J4120A ProCurve Switch 1600M' },
@@ -87 +90 @@
    BS350T => { model => 'BS350T',     match => 'BayStack 350T HW'                },
    );
- 
-my %OID_NUMBER = (
-   sysDescr    => '1.3.6.1.2.1.1.1.0',
-   sysName     => '1.3.6.1.2.1.1.5.0',
-   sysContact  => '1.3.6.1.2.1.1.4.0',
-   sysLocation => '1.3.6.1.2.1.1.6.0',
+
+Readonly my %OID_NUMBER => (
+   sysDescription  => '1.3.6.1.2.1.1.1.0',
+   sysName         => '1.3.6.1.2.1.1.5.0',
+   sysContact      => '1.3.6.1.2.1.1.4.0',
+   sysLocation     => '1.3.6.1.2.1.1.6.0',
    );
+
+Readonly my $RE_MAC_ADDRESS  => qr{ [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} }xms;
+Readonly my $RE_IPv4_ADDRESS => qr{ [0-9]{1,3} \. [0-9]{1,3} \. [0-9]{1,3} \. [0-9]{1,3} }xms;
+
 
 ################
@@ -104 +111 @@
    }
 else {
-   print STDERR "klask: command $cmd not found\n\n";
+   print {*STDERR} "klask: command $cmd not found\n\n";
    $CMD_DB{help}->();
    exit 1;
@@ -114 +121 @@
    die "Configuration file $KLASK_CFG_FILE does not exists. Klask need it !\n" if not -e "$KLASK_CFG_FILE";
    die "Var folder $KLASK_VAR does not exists. Klask need it !\n"              if not -d "$KLASK_VAR";
+   return;
    }
 
 sub test_switchdb_environnement {
    die "Switch database $KLASK_SW_FILE does not exists. Launch updatesw before this command !\n" if not -e "$KLASK_SW_FILE";
+   return;
    }
 
 sub test_maindb_environnement {
    die "Main database $KLASK_DB_FILE does not exists. Launch updatedb before this command !\n" if not -e "$KLASK_DB_FILE";
+   return;
    }
 
@@ -128 +138 @@
 sub fastping {
    system "fping -c 1 @_ >/dev/null 2>&1";
+   return;
+   }
+
+sub shell_command {
+   my $cmd = shift;
+
+   my $fh = new Filehandle;
+   open $fh, q{-|}, "$cmd" or die "Can't exec $cmd\n";
+   my $result = <$fh>;
+   close $fh;
+   chomp $result;
+   return $result;
    }
 
@@ -134 +156 @@
 sub resolve_ip_arp_host {
    my $param_ip_or_host = shift;
-   my $interface = shift || '*';
-   my $type      = shift || 'fast';
+   my $interface = shift || q{*};
+   my $type      = shift || q{fast};
 
    my %ret = (
@@ -144 +166 @@
 
 #   my $cmdarping  = `arping -c 1 -w 1 -rR $param 2>/dev/null`;
-   if (not $param_ip_or_host =~ m/^\d+\.\d+\.\d+\.\d+$/) {
-      $param_ip_or_host =~ s/\..*//;
+   if ( not $param_ip_or_host =~ m/^\d+ \. \d+ \. \d+ \. \d+$/xms ) {
+      $param_ip_or_host =~ s/ \. .* //xms;
       }
 
@@ -154 +176 @@
    # my $cmd = "grep  -e '".'\b'."$param_ip_or_host".'\b'."' /var/lib/arpwatch/arp.dat | sort +2rn | head -1";
    # my $cmd = "grep  -he '".'\b'."$param_ip_or_host".'\b'."' /var/lib/arpwatch/*.dat | sort +2rn | head -1";
-   my $cmd = "grep  -he '" . '\b' . "$param_ip_or_host" . '\b' . "' /var/lib/arpwatch/$interface.dat | sort -rn -k 3,3 | head -1";
+   my $cmd = q{grep  -he '\b} . $param_ip_or_host . q{\b' } . "/var/lib/arpwatch/$interface.dat | sort -rn -k 3,3 | head -1";
    my $cmd_arpwatch = shell_command $cmd;
    my ($arp, $ip, $timestamp, $host) = split m/ \s+ /xms, $cmd_arpwatch;
-
-#print "OOO $cmd\n";
-#print "TTT arp $arp -> $ip pour host $host\n";
 
    $ret{ipv4_address} = $ip        if $ip;
@@ -165 +184 @@
    $ret{timestamp}    = $timestamp if $timestamp;
 
-   my $nowtimestamp = time();
+   my $nowtimestamp = time;
 
    if ( $type eq 'fast' and ( not defined $timestamp or $timestamp < ( $nowtimestamp - 3 * 3600 ) ) ) {
@@ -172 +191 @@
       }
 
-  # resultat de la commande arp
+   # resultat de la commande arp
    # tech7meylan.hmg.inpg.fr (194.254.66.240) at 00:14:22:45:28:A9 [ether] on eth0
    # sw2-batF0-legi.hmg.priv (192.168.22.112) at 00:30:c1:76:9c:01 [ether] on eth0.37
-   my $cmd_arp  = `arp -a $param_ip_or_host 2>/dev/null`;
-   chomp $cmd_arp;
-   $cmd_arp =~ /(\S*)\s\(([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})\)\sat\s([0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2})/;
-   $ret{hostname_fq}  = $1 if(defined($1));
-   $ret{ipv4_address} = $2 if(defined($2));
-   $ret{mac_address}  = $3 if(defined($3));
-#print "RET1 $ret{ipv4_address} -> $ret{mac_address} : $ret{hostname_fq}\n";
-
-#   if ($ret{ipv4_address} eq '0.0.0.0' and $ret{mac_address} eq 'unknow'and $ret{hostname_fq} eq 'unknow') {
-      # resultat de la commande host si le parametre est ip
-      # 250.66.254.194.in-addr.arpa domain name pointer legihp2100.hmg.inpg.fr.
-      my $cmd_host = `host $param_ip_or_host 2>/dev/null`;
-      chomp $cmd_host;
-      $cmd_host =~ m/domain\sname\spointer\s(\S+)\.$/;
-      $ret{hostname_fq} = $1 if defined $1;
-
-      # resultat de la commande host si parametre est hostname
-      # tech7meylan.hmg.inpg.fr has address 194.254.66.240
-      $cmd_host =~ m/(\S*)\shas\saddress\s([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})$/;
-      $ret{hostname_fq}  = $1 if defined $1;
-      $ret{ipv4_address} = $2 if defined $2;
-
-      $cmd_host =~ m/\b([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.in-addr\.arpa\s/;
-      $ret{ipv4_address} = "$4.$3.$2.$1"     if defined $1 and  defined $2 and  defined $3 and  defined $4;
-      $ret{hostname_fq}  = $param_ip_or_host if not defined $1 and $ret{hostname_fq} eq 'unknow';
-#      }
-
-#print "RET2 $ret{ipv4_address} -> $ret{mac_address} : $ret{hostname_fq}\n";
-   unless ($ret{mac_address} eq 'unknow') {
+   my $cmd_arp  = shell_command "arp -a $param_ip_or_host";
+   if ( $cmd_arp =~ m{ (\S*) \s \( ( $RE_IPv4_ADDRESS ) \) \s at \s ( $RE_MAC_ADDRESS ) }xms ) {
+      ( $ret{hostname_fq}, $ret{ipv4_address}, $ret{mac_address} )  = ($1, $2, $3);
+      }
+
+   # resultat de la commande host si le parametre est ip
+   # 250.66.254.194.in-addr.arpa domain name pointer legihp2100.hmg.inpg.fr.
+   my $cmd_host = shell_command "host $param_ip_or_host";
+   if ( $cmd_host =~ m/domain \s name \s pointer \s (\S+) \.$/xms ) {
+      $ret{hostname_fq} = $1;
+      }
+
+   # resultat de la commande host si parametre est hostname
+   # tech7meylan.hmg.inpg.fr has address 194.254.66.240
+   if ( $cmd_host =~ m/(\S*) \s has \s address \s ( $RE_IPv4_ADDRESS )$/xms ) {
+      ( $ret{hostname_fq}, $ret{ipv4_address} ) = ($1, $2);
+      }
+
+   if ( $cmd_host =~ m/ \b ( $RE_IPv4_ADDRESS ) \. in-addr \. arpa \s/xms ) {
+      $ret{ipv4_address} = $1;
+      }
+   #$ret{hostname_fq}  = $param_ip_or_host if not defined $1 and $ret{hostname_fq} eq 'unknow';
+
+   if ($ret{mac_address} ne 'unknow') {
       my @paquets = ();
-      foreach ( split(/:/, $ret{mac_address}) ) {
-         my @chars = split //, uc("00$_");
+      foreach ( split m/ : /xms, $ret{mac_address} ) {
+         my @chars = split m//xms, uc "00$_";
          push @paquets, "$chars[-2]$chars[-1]";
          }
-      $ret{mac_address} = join ':', @paquets;
-      }
-
-#print "RET3 $ret{ipv4_address} -> $ret{mac_address} : $ret{hostname_fq}\n";
+      $ret{mac_address} = join q{:}, @paquets;
+      }
+
    return %ret;
    }
@@ -219 +232 @@
 sub get_switch_model {
    my $sw_snmp_description = shift || 'unknow';
-   
+
    for my $sw_kind (keys %SWITCH_KIND) {
-      next if not $sw_snmp_description =~ m/$SWITCH_KIND{$sw_kind}->{match}/;
-      
+      next if not $sw_snmp_description =~ m/$SWITCH_KIND{$sw_kind}->{match}/xms;
+
       return $SWITCH_KIND{$sw_kind}->{model};
       }
-      
+
    return $sw_snmp_description;
    }
@@ -233 +246 @@
 sub init_switch_names {
    my $verbose = shift;
-   
+
    printf "%-25s                %-25s %s\n",'Switch','Description','Type';
-#   print "Switch description\n" if $verbose;
    print "-------------------------------------------------------------------------\n" if $verbose;
 
@@ -243 +255 @@
          $session{-version} = $sw->{version}   || 1;
          $session{-port}    = $sw->{snmpport}  || $DEFAULT{snmpport}  || 161;
-         if (exists $sw->{version} and $sw->{version} eq 3) {
+         if (exists $sw->{version} and $sw->{version} eq '3') {
             $session{-username} = $sw->{username} || 'snmpadmin';
             }
@@ -257 +269 @@
       my $result = $session->get_request(
          -varbindlist => [
-            $OID_NUMBER{sysDescr},
+            $OID_NUMBER{sysDescription},
             $OID_NUMBER{sysName},
             $OID_NUMBER{sysContact},
@@ -264 +276 @@
          );
       $sw->{description} = $result->{$OID_NUMBER{sysName}} || $sw->{hostname};
-      $sw->{model} = get_switch_model( $result->{$OID_NUMBER{sysDescr}});
+      $sw->{model} = get_switch_model( $result->{$OID_NUMBER{sysDescription}});
       #$sw->{location} = $result->{"1.3.6.1.2.1.1.6.0"} || $sw->{hostname};
       #$sw->{contact} = $result->{"1.3.6.1.2.1.1.4.0"} || $sw->{hostname};
       $session->close;
 
-      # Ligne à virer car on récupère maintenant le modèle du switch 
-      my ($desc, $type) = split ':', $sw->{description}, 2;
-#      printf "%-25s 0--------->>>> %-25s %s\n", $sw->{hostname}, $desc, uc($type)."**" if $verbose;
+      # Ligne à virer car on récupère maintenant le modèle du switch
+      my ($desc, $type) = split m/ : /xms, $sw->{description}, 2;
       printf "%-25s 0--------->>>> %-25s %s\n", $sw->{hostname}, $desc, $sw->{model} if $verbose;
       }
 
    print "\n" if $verbose;
+   return;
    }
 
@@ -282 +294 @@
 sub hex_to_dec {
    #00:0F:1F:43:E4:2B
-   my $car = '00' . uc(shift);
+   my $car = '00' . uc shift;
 
    return '00' if $car eq '00UNKNOW';
@@ -288 +300 @@
       '0'=>'0',  '1'=>'1',  '2'=>'2',  '3'=>'3',  '4'=>'4',
       '5'=>'5',  '6'=>'6',  '7'=>'7',  '8'=>'8',  '9'=>'9',
-      'A'=>'10', 'B'=>'11', 'C'=>'12', 'D'=>'13', 'E'=>'14', 'F'=>'15'
+      'A'=>'10', 'B'=>'11', 'C'=>'12', 'D'=>'13', 'E'=>'14', 'F'=>'15',
       );
-   my @chars = split(//, $car);
+   my @chars = split m//xms, $car;
    return $table{$chars[-2]}*16 + $table{$chars[-1]};
    }
@@ -300 +312 @@
    my $arp = shift;
 
-   my @paquets = split /:/, $arp;
-   my $return = '';
+   my @paquets = split m/ : /xms, $arp;
+   my $return = q{};
    foreach(@paquets) {
-      $return .= ".".hex_to_dec($_);
+      $return .= q{.} . hex_to_dec($_);
       }
    return $return;
@@ -311 +323 @@
 # va rechercher le port et le switch sur lequel est la machine
 sub find_switch_port {
-   my $arp = shift;
-   my $switch_proposal = shift || '';
-   
+   my $arp             = shift;
+   my $switch_proposal = shift || q{};
+
    my %ret;
-   $ret{switch_description} = "unknow";
-   $ret{switch_port} = "0";
+   $ret{switch_description} = 'unknow';
+   $ret{switch_port} = '0';
 
    return %ret if $arp eq 'unknow';;
 
    my @switch_search = @SWITCH;
-   if ($switch_proposal ne '') {
+   if ($switch_proposal ne q{}) {
       for my $sw (@SWITCH) {
          next if $sw->{hostname} ne $switch_proposal;
@@ -329 +341 @@
       }
 
-   my $research = "1.3.6.1.2.1.17.4.3.1.2".arp_hex_to_dec($arp);
-   
+   my $research = '1.3.6.1.2.1.17.4.3.1.2' . arp_hex_to_dec($arp);
+
    LOOP_ON_SWITCH:
    for my $sw (@switch_search) {
@@ -339 +351 @@
          -varbindlist => [$research]
          );
-      if (not defined($result) or $result->{$research} eq 'noSuchInstance') {
+      if (not defined $result or $result->{$research} eq 'noSuchInstance') {
          $session->close;
          next LOOP_ON_SWITCH;
@@ -348 +360 @@
 
          # IMPORTANT !!
-         # ceci empeche la detection sur certains port ... 
+         # ceci empeche la detection sur certains port ...
          # en effet les switch sont relies entre eux par un cable reseau et du coup
          # tous les arp de toutes les machines sont presentes sur ces ports (ceux choisis ici sont les miens)
@@ -364 +376 @@
             $ret{switch_description} = $sw->{description};
             $ret{switch_port}        = get_human_readable_port($sw->{model}, $swport); # $swport;
-            
+
             last LOOP_ON_SWITCH;
 #            }
@@ -386 +398 @@
       }
 
-   my $research = "1.3.6.1.2.1.17.4.3.1.2".arp_hex_to_dec($arp);
+   my $research = '1.3.6.1.2.1.17.4.3.1.2' . arp_hex_to_dec($arp);
    LOOP_ON_ALL_SWITCH:
    for my $sw (@SWITCH) {
@@ -396 +408 @@
          );
 
-      if(defined($result) and $result->{$research} ne 'noSuchInstance'){
+      if(defined $result and $result->{$research} ne 'noSuchInstance'){
          my $swport = $result->{$research};
 
@@ -422 +434 @@
    return $KLASK_CFG->{network}{$network}{interface};
    }
-  
+
 ###
 # liste l'ensemble des adresses ip d'un réseau
@@ -433 +445 @@
       my @line  = @{$KLASK_CFG->{network}{$net}{'ip-subnet'}};
       for my $cmd (@line) {
-         for my $method (keys %$cmd){
+         for my $method (keys %{$cmd}){
             $cidrlist->add_any($cmd->{$method}) if $method eq 'add';
             }
@@ -443 +455 @@
    for my $cidr ($cidrlist->list()) {
       my $net = new NetAddr::IP $cidr;
-      for my $ip (@$net) {
-         $ip =~ s#/32##;
+      for my $ip (@{$net}) {
+         $ip =~ s{ /32 }{}xms;
          push @res,  $ip;
          }
@@ -468 +480 @@
    my $sw_model = shift;
    my $sw_port  = shift;
-   
+
    return $sw_port if not $sw_model eq 'HP8000M';
-   
+
    my $reste = (($sw_port - 1) % 8) + 1;
-   my $major = int( ($sw_port - 1) / 8 );
+   my $major = int (($sw_port - 1) / 8);
 
    return "$INTERNAL_PORT_MAP{$major}$reste";
@@ -480 +492 @@
    my $sw_model = shift;
    my $sw_port  = shift;
-   
+
    return $sw_port if not $sw_model eq 'HP8000';
 
-   my $letter = substr($sw_port, 0, 1);
-   
+   my $letter = substr $sw_port, 0, 1;
+
 #   return $port if $letter =~ m/\d/;
-   
-   my $reste =  substr($sw_port, 1);
-   
+
+   my $reste =  substr $sw_port, 1;
+
    return $INTERNAL_PORT_MAP_REV{$letter} * 8 + $reste;
    }
@@ -498 +510 @@
 sub cmd_help {
 
-print <<END;
+print <<'END';
 klask - ports manager and finder for switch
 
@@ -514 +526 @@
  klask status  switch port
 END
+   return;
    }
 
 sub cmd_version {
 
-print <<END;
+print <<'END';
 Klask - ports manager and finder for switch
 Copyright (C) 2005-2008 Gabriel Moreau
@@ -526 +539 @@
    print ' $Date$'."\n";
    print ' $Id$'."\n";
+   return;
    }
 
 sub cmd_search {
    my @computer = @_;
-   
+
    init_switch_names();    #nomme les switchs
    fastping(@computer);
@@ -536 +550 @@
       my %resol_arp = resolve_ip_arp_host($clientname);          #resolution arp
       my %where     = find_switch_port($resol_arp{mac_address}); #retrouve l'emplacement
-      printf "%-22s %2i %-30s %-15s %18s", $where{switch_description}, $where{switch_port}, $resol_arp{hostname_fq}, $resol_arp{ipv4_address}, $resol_arp{mac_address}."\n"
+      printf '%-22s %2i %-30s %-15s %18s', $where{switch_description}, $where{switch_port}, $resol_arp{hostname_fq}, $resol_arp{ipv4_address}, $resol_arp{mac_address}."\n"
          unless $where{switch_description} eq 'unknow' and $resol_arp{hostname_fq} eq 'unknow' and $resol_arp{mac_address} eq 'unknow';
       }
+   return;
    }
 
@@ -546 +561 @@
    fastping(@computer);
    my $computerdb = YAML::Syck::LoadFile("$KLASK_DB_FILE");
-   
+
    LOOP_ON_COMPUTER:
    for my $clientname (@computer) {
       my %resol_arp = resolve_ip_arp_host($clientname);      #resolution arp
       my $ip = $resol_arp{ipv4_address};
-      
+
       next LOOP_ON_COMPUTER unless exists $computerdb->{$ip};
-      
-      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($computerdb->{$ip}{timestamp});
+
+      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $computerdb->{$ip}{timestamp};
       $year += 1900;
       $mon++;
-      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
+      my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
 
       printf "%-22s %2s %-30s %-15s %-18s %s\n",
@@ -567 +582 @@
          $date;
       }
+   return;
    }
 
@@ -583 +599 @@
 
    my $number_of_computer = get_list_ip(@network); # + 1;
-   my $size_of_database   = keys %$computerdb;
+   my $size_of_database   = keys %{$computerdb};
       $size_of_database   = 1 if $size_of_database == 0;
    my $i = 0;
@@ -595 +611 @@
    my %db_switch_connected_on_port = %{$switch_connection->{connected_on_port}};
    my %db_switch_chained_port = ();
-   for my $swport (keys %db_switch_connected_on_port) {        
-      my ($sw_connect,$port_connect) = split ':', $swport;
+   for my $swport (keys %db_switch_connected_on_port) {
+      my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
       $db_switch_chained_port{$sw_connect} .= "$port_connect:";
       }
@@ -603 +619 @@
       if ( exists $db_switch_chained_port{$sw->{hostname}} ) {
          chop $db_switch_chained_port{$sw->{hostname}};
-         push @{$sw->{portignore}}, split(':',$db_switch_chained_port{$sw->{hostname}});
+         push @{$sw->{portignore}}, split m/ : /xms, $db_switch_chained_port{$sw->{hostname}};
          }
 #      print "$sw->{hostname} ++ @{$sw->{portignore}}\n";
@@ -628 +644 @@
       for my $one_computer (@computer) {
          $i++;
-         
-         my $total_percent = int(($i*100)/$number_of_computer);
+
+         my $total_percent = int (($i*100)/$number_of_computer);
 
          my $localtime = time - $timestamp;
-         my ($sec,$min) = localtime($localtime);
+         my ($sec,$min) = localtime $localtime;
 
          my $time_elapse = 0;
             $time_elapse = $localtime * ( 100 - $total_percent) / $total_percent if $total_percent != 0;
-         my ($sec_elapse,$min_elapse) = localtime($time_elapse);
+         my ($sec_elapse,$min_elapse) = localtime $time_elapse;
 
          printf "\rComputer scanned: %4i/%i (%2i%%)",  $i,                 $number_of_computer, $total_percent;
 #         printf ", Computer detected: %4i/%i (%2i%%)", $detected_computer, $size_of_database,   int(($detected_computer*100)/$size_of_database);
-         printf ", detected: %4i/%i (%2i%%)", $detected_computer, $size_of_database,   int(($detected_computer*100)/$size_of_database);
-         printf " [Time: %02i:%02i / %02i:%02i]", int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
-#         printf "  [%02i:%02i/%02i:%02i]", int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
-         printf " %-14s", $one_computer;
+         printf ', detected: %4i/%i (%2i%%)', $detected_computer, $size_of_database,   int(($detected_computer*100)/$size_of_database);
+         printf ' [Time: %02i:%02i / %02i:%02i]', int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
+#         printf '  [%02i:%02i/%02i:%02i]', int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
+         printf ' %-14s', $one_computer;
 
          my %resol_arp = resolve_ip_arp_host($one_computer,$current_interface);
-         
+
          # do not search on router connection (why ?)
          if ( exists $router_mac_ip{$resol_arp{mac_address}}) {
@@ -659 +675 @@
             }
 
-         my $switch_proposal = '';
+         my $switch_proposal = q{};
          if (exists $computerdb->{$resol_arp{ipv4_address}} and exists $computerdb->{$resol_arp{ipv4_address}}{switch_hostname}) {
             $switch_proposal = $computerdb->{$resol_arp{ipv4_address}}{switch_hostname};
@@ -716 +732 @@
          # mise a jour du nom de la machine si modification dans le dns
          $computerdb->{$resol_arp{ipv4_address}}{hostname_fq} = $resol_arp{hostname_fq};
-       
+
          # mise à jour de la date de détection si détection plus récente par arpwatch
          $computerdb->{$resol_arp{ipv4_address}}{timestamp}   = $resol_arp{timestamp} if exists $resol_arp{timestamp} and $computerdb->{$resol_arp{ipv4_address}}{timestamp} < $resol_arp{timestamp};
 
-         # provisoire car changement de nom des attributs
-#         $computerdb->{$resol_arp{ipv4_address}}{mac_address}        = $computerdb->{$resol_arp{ipv4_address}}{arp};
-#         $computerdb->{$resol_arp{ipv4_address}}{switch_description} = $computerdb->{$resol_arp{ipv4_address}}{switch};
-#         $computerdb->{$resol_arp{ipv4_address}}{switch_port}        = $computerdb->{$resol_arp{ipv4_address}}{port};
-       
          # relance un arping sur la machine si celle-ci n'a pas été détectée depuis plus d'une semaine
 #         push @computer_not_detected, $resol_arp{ipv4_address} if $computerdb->{$resol_arp{ipv4_address}}{timestamp} < $timestamp_last_week;
          $computer_not_detected{$resol_arp{ipv4_address}} = $current_interface if $computerdb->{$resol_arp{ipv4_address}}{timestamp} < $timestamp_last_week;
-       
+
          }
       }
@@ -736 +747 @@
 
    my $dirdb = $KLASK_DB_FILE;
-      $dirdb =~ s#/[^/]*$##;
+      $dirdb =~ s{ / [^/]* $}{}xms;
    mkdir "$dirdb", 0755 unless -d "$dirdb";
    YAML::Syck::DumpFile("$KLASK_DB_FILE", $computerdb);
@@ -745 +756 @@
 #      print  "arping -c 1 -w 1 -rR -i $interface $one_computer 2>/dev/null\n";
       }
+   return;
    }
 
@@ -763 +775 @@
 
    my $dirdb = $KLASK_DB_FILE;
-      $dirdb =~ s#/[^/]*$##;
+      $dirdb =~ s{ / [^/]* $}{}xms;
    mkdir "$dirdb", 0755 unless -d "$dirdb";
    YAML::Syck::DumpFile("$KLASK_DB_FILE", $computerdb);
+   return;
    }
 
@@ -783 +796 @@
 
    $format = 'txt' if not defined $possible_format{$format};
-   
+
    $possible_format{$format}->(@ARGV);
+   return;
    }
 
@@ -796 +810 @@
 
    LOOP_ON_IP_ADDRESS:
-   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %$computerdb)) {
-   
+   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %{$computerdb})) {
+
 #      next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq 'unknow';
 
@@ -805 +819 @@
 # dans le futur
 #      next if $computerdb->{$ip}{hostname_fq} eq 'unknow';
-      
-      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($computerdb->{$ip}{timestamp});
+
+      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $computerdb->{$ip}{timestamp};
       $year += 1900;
       $mon++;
-      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
+      my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
 
       printf "%-25s  %2s  <-------  %-30s %-15s %-18s %s\n",
@@ -819 +833 @@
          $date;
       }
+   return;
    }
 
@@ -829 +844 @@
 #<script src="sorttable-klask.js"></script>
 
-   print <<END;
+   print <<'END_HTML';
 <table class="sortable" summary="Klask export database">
  <caption>Klask database</caption>
@@ -855 +870 @@
  </tfoot>
  <tbody>
-END
+END_HTML
 
    my %mac_count = ();
    LOOP_ON_IP_ADDRESS:
-   foreach my $ip (keys %$computerdb) {
-   
+   foreach my $ip (keys %{$computerdb}) {
+
       # to be improve in the future
       next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq ($computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description}); # switch on himself !
-      
+
       $mac_count{$computerdb->{$ip}{mac_address}}++;
       }
@@ -870 +885 @@
 
    LOOP_ON_IP_ADDRESS:
-   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %$computerdb)) {
-   
+   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %{$computerdb})) {
+
       # to be improve in the future
       next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq ($computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description}); # switch on himself !
 
-      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($computerdb->{$ip}{timestamp});
+      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $computerdb->{$ip}{timestamp};
       $year += 1900;
       $mon++;
-      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
+      my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
 
 #      $odd_or_even++;
 #      my $typerow = $odd_or_even % 2 ? 'odd' : 'even';
-      $typerow = $typerow eq 'even' ? 'odd' : 'even'; 
+      $typerow = $typerow eq 'even' ? 'odd' : 'even';
 
       my $switch_hostname = $computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description} || 'unkown';
       chomp $switch_hostname;
-      my $switch_hostname_sort = sprintf "%s %3s" ,$switch_hostname, $computerdb->{$ip}{switch_port};
-
-      my $ip_sort = sprintf "%03i%03i%03i%03i", split( /\./, $ip);
-
-      my $mac_sort = sprintf "%04i-%s", 9999 - $mac_count{$computerdb->{$ip}{mac_address}}, $computerdb->{$ip}{mac_address};
-
-      $computerdb->{$ip}{hostname_fq} = 'unknow' if $computerdb->{$ip}{hostname_fq} =~ m/^\d+\.\d+\.\d+\.\d+$/;
-      my ( $host_short ) = split /\./, $computerdb->{$ip}{hostname_fq};
-
-      print <<END;
+      my $switch_hostname_sort = sprintf '%s %3s' ,$switch_hostname, $computerdb->{$ip}{switch_port};
+
+      my $ip_sort = sprintf '%03i%03i%03i%03i', split m/ \. /xms, $ip;
+
+      my $mac_sort = sprintf '%04i-%s', 9999 - $mac_count{$computerdb->{$ip}{mac_address}}, $computerdb->{$ip}{mac_address};
+
+      $computerdb->{$ip}{hostname_fq} = 'unknow' if $computerdb->{$ip}{hostname_fq} =~ m/^ \d+ \. \d+ \. \d+ \. \d+ $/xms;
+      my ( $host_short ) = split m/ \. /xms, $computerdb->{$ip}{hostname_fq};
+
+      print <<"END_HTML";
   <tr class="$typerow">
    <td sorttable_customkey="$switch_hostname_sort">$switch_hostname</td>
@@ -905 +920 @@
    <td>$date</td>
   </tr>
-END
+END_HTML
       }
 
@@ -917 +932 @@
    for my $sw (sort keys %db_switch_output_port) {
 
-      my $switch_hostname_sort = sprintf "%s %3s" ,$sw, $db_switch_output_port{$sw};
-
-      $typerow = $typerow eq 'even' ? 'odd' : 'even'; 
+      my $switch_hostname_sort = sprintf '%s %3s' ,$sw, $db_switch_output_port{$sw};
+
+      $typerow = $typerow eq 'even' ? 'odd' : 'even';
 
       if (exists $db_switch_parent{$sw}) {
@@ -930 +945 @@
       $year += 1900;
       $mon++;
-      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
-
-      my $ip_sort = sprintf "%03i%03i%03i%03i", split( /\./, $ipv4_address);
-
-      my $mac_sort = sprintf "%04i-%s", 9999, $mac_address;
-
-
-         my ( $host_short ) = sprintf "%s %3s" , split(/\./, $db_switch_parent{$sw}->{switch}, 1), $db_switch_parent{$sw}->{port};
-
-print <<END;
+      my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
+
+      my $ip_sort = sprintf '%03i%03i%03i%03i', split m/ \. /xms, $ipv4_address;
+
+      my $mac_sort = sprintf '%04i-%s', 9999, $mac_address;
+
+      my ( $host_short ) = sprintf '%s %3s' , split(m/ \. /xms, $db_switch_parent{$sw}->{switch}, 1), $db_switch_parent{$sw}->{port};
+
+      print <<"END_HTML";
   <tr class="$typerow">
    <td sorttable_customkey="$switch_hostname_sort">$sw</td>
@@ -949 +963 @@
    <td>$date</td>
   </tr>
-END
+END_HTML
          }
       else {
-#         printf "%-25s  %2s  +-->  router\n", $sw, $db_switch_output_port{$sw};
-print <<END;
+         print <<"END_HTML";
   <tr class="$typerow">
    <td sorttable_customkey="$switch_hostname_sort">$sw</td>
@@ -963 +976 @@
    <td></td>
   </tr>
-END
+END_HTML
          }
       }
 
    for my $swport (sort keys %db_switch_connected_on_port) {
-      my ($sw_connect,$port_connect) = split ':', $swport;
+      my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
       for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
 
-         my $switch_hostname_sort = sprintf "%s %3s" ,$sw_connect, $port_connect;
+         my $switch_hostname_sort = sprintf '%s %3s' ,$sw_connect, $port_connect;
 
       my $mac_address = $db_switch{$sw}->{mac_address};
@@ -980 +993 @@
       $year += 1900;
       $mon++;
-      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
-
-      my $ip_sort = sprintf "%03i%03i%03i%03i", split( /\./, $ipv4_address);
-
-      my $mac_sort = sprintf "%04i-%s", 9999, $mac_address;
-
-      $typerow = $typerow eq 'even' ? 'odd' : 'even'; 
+      my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year,$mon,$mday,$hour,$min;
+
+      my $ip_sort = sprintf '%03i%03i%03i%03i', split m/ \. /xms, $ipv4_address;
+
+      my $mac_sort = sprintf '%04i-%s', 9999, $mac_address;
+
+      $typerow = $typerow eq 'even' ? 'odd' : 'even';
 
          if (exists $db_switch_output_port{$sw}) {
 
-             my ( $host_short ) = sprintf "%s %3s" , split(/\./, $sw, 1), $db_switch_output_port{$sw};
-
-print <<END;
+            my ( $host_short ) = sprintf '%s %3s' , split( m/\./xms, $sw, 1), $db_switch_output_port{$sw};
+
+            print <<"END_HTML";
   <tr class="$typerow">
    <td sorttable_customkey="$switch_hostname_sort">$sw_connect</td>
@@ -1002 +1015 @@
    <td>$date</td>
   </tr>
-END
+END_HTML
             }
          else {
-print <<END;
+            print <<"END_HTML";
   <tr class="$typerow">
    <td sorttable_customkey="$switch_hostname_sort">$sw_connect</td>
@@ -1015 +1028 @@
    <td>$date</td>
   </tr>
-END
-            }
-         }
-      }
-
-
-   print <<END;
+END_HTML
+            }
+         }
+      }
+
+   print <<'END_HTML';
  </tbody>
 </table>
-END
+END_HTML
+   return;
    }
 
@@ -1031 +1044 @@
 
    LOOP_ON_IP_ADDRESS:
-   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %$computerdb)) {
+   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %{$computerdb})) {
 
       next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq ($computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description}); # switch on himself !
 
-      my $sw_hostname = $computerdb->{$ip}{switch_hostname} || '';
+      my $sw_hostname = $computerdb->{$ip}{switch_hostname} || q{};
       next if $sw_hostname eq 'unknow';
-  
-      my $sw_location = '';
+
+      my $sw_location = q{};
       for my $sw (@SWITCH) {
          next if $sw_hostname ne $sw->{hostname};
@@ -1045 +1058 @@
          }
 
-      printf "%s: \"%s\"\n", $ip, $sw_location if not $sw_location eq '';
-      }
+      printf "%s: \"%s\"\n", $ip, $sw_location if not $sw_location eq q{};
+      }
+   return;
    }
 
@@ -1052 +1066 @@
    my $switch = shift;
    my $port   = shift;
-   
-   #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 1 (up) 
-   #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 2 (down) 
+
+   #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 1 (up)
+   #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 2 (down)
    system "snmpset -v 1 -c public $switch 1.3.6.1.2.1.2.2.1.7.$port = 1";
+   return;
    }
 
@@ -1061 +1076 @@
    my $switch = shift;
    my $port   = shift;
-   
+
    system "snmpset -v 1 -c public $switch 1.3.6.1.2.1.2.2.1.7.$port = 2";
+   return;
    }
 
@@ -1068 +1084 @@
    my $switch = shift;
    my $port   = shift;
-   
+
    system "snmpget -v 1 -c public $switch 1.3.6.1.2.1.2.2.1.7.$port";
+   return;
    }
 
 sub cmd_search_mac_on_switch {
-   my $switch_name = shift || '';
-   my $mac_address = shift || '';
-   
-   if ($switch_name eq '' or $mac_address eq '') {
+   my $switch_name = shift || q{};
+   my $mac_address = shift || q{};
+
+   if ($switch_name eq q{} or $mac_address eq q{}) {
       die "Usage: klask search-mac-on-switch SWITCH_NAME MAC_ADDRESS\n";
       }
 
    if (not defined $SWITCH_DB{$switch_name}) {
-      die "Switch $switch_name must be defined in klask configuration file\n"; 
+      die "Switch $switch_name must be defined in klask configuration file\n";
       }
 
@@ -1088 +1105 @@
       $session{-version} = $sw->{version}   || 1;
       $session{-port}    = $sw->{snmpport}  || $DEFAULT{snmpport}  || 161;
-   if (exists $sw->{version} and $sw->{version} eq 3) {
+   if (exists $sw->{version} and $sw->{version} eq '3') {
       $session{-username} = $sw->{username} || 'snmpadmin';
       }
@@ -1095 +1112 @@
       }
 
-   my $research = "1.3.6.1.2.1.17.4.3.1.2".arp_hex_to_dec($mac_address);
+   my $research = '1.3.6.1.2.1.17.4.3.1.2' . arp_hex_to_dec($mac_address);
    print "Klask search OID $research on switch $switch_name\n";
 
@@ -1104 +1121 @@
       -varbindlist => [$research]
       );
-   
-   if (not defined($result) or $result->{$research} eq 'noSuchInstance') {
+
+   if (not defined $result or $result->{$research} eq 'noSuchInstance') {
       print "Klask do not find MAC $mac_address on switch $switch_name\n";
       $session->close;
@@ -1114 +1131 @@
 
    print "Klask find MAC $mac_address on switch $switch_name port $swport\n";
+   return;
    }
 
@@ -1128 +1146 @@
 #   for my $one_computer ('194.254.66.254') {
    for my $one_router ( get_list_main_router(get_list_network()) ) {
-#print "TT$one_router\n";      
-      my %resol_arp = resolve_ip_arp_host($one_router,'*','low');            # resolution arp
+      my %resol_arp = resolve_ip_arp_host($one_router, q{*}, q{low}); # resolution arp
       next DETECT_ALL_ROUTER if $resol_arp{mac_address} eq 'unknow';
-#print "$one_router\n";      
       $where{$resol_arp{ipv4_address}} = find_all_switch_port($resol_arp{mac_address}); # retrouve les emplacements des routeurs
       }
@@ -1137 +1153 @@
    ALL_ROUTER_IP_ADDRESS:
    for my $ip (Net::Netmask::sort_by_ip_address(keys %where)) { # '194.254.66.254')) {
-   
+
       next ALL_ROUTER_IP_ADDRESS if not exists $where{$ip}; # /a priori/ idiot car ne sers à rien...
 
@@ -1146 +1162 @@
 
          next ALL_SWITCH_CONNECTED if $switch->{port} eq '0';
-         
+
          $db_switch_output_port{$switch->{hostname}} = $switch->{port};
          }
-      }   
-
-#   print "Switch output port\n";  
-#   print "------------------\n";
-#   for my $sw (sort keys %db_switch_output_port) {
-#      printf "%-25s %2s\n", $sw, $db_switch_output_port{$sw};
-#      }
-#   print "\n";
-
+      }
 
    my %db_switch_link_with = ();
@@ -1171 +1179 @@
    ALL_SWITCH:
    for my $one_computer (@list_switch_ip) {
-      my %resol_arp = resolve_ip_arp_host($one_computer,'*','low'); # arp resolution
+      my %resol_arp = resolve_ip_arp_host($one_computer, q{*}, q{low}); # arp resolution
       next ALL_SWITCH if $resol_arp{mac_address} eq 'unknow';
-      
+
       push @list_switch_ipv4,$resol_arp{ipv4_address};
-      
+
       $where{$resol_arp{ipv4_address}} = find_all_switch_port($resol_arp{mac_address}); # find port on all switch
 
@@ -1184 +1192 @@
       $SWITCH_DB{$one_computer}->{timestamp}    = $timestamp;
       }
-      
+
    ALL_SWITCH_IP_ADDRESS:
    for my $ip (Net::Netmask::sort_by_ip_address(@list_switch_ipv4)) {
-   
+
       next ALL_SWITCH_IP_ADDRESS if not exists $where{$ip};
 
@@ -1206 +1214 @@
 
       }
-   
+
    my %db_switch_connected_on_port = ();
    my $maybe_more_than_one_switch_connected = 'yes';
-   
+
    while ($maybe_more_than_one_switch_connected eq 'yes') {
       for my $sw (keys %db_switch_link_with) {
          for my $connect (keys %{$db_switch_link_with{$sw}}) {
-         
+
             my $port = $db_switch_link_with{$sw}->{$connect};
-         
+
             $db_switch_connected_on_port{"$connect:$port"} ||= {};
             $db_switch_connected_on_port{"$connect:$port"}->{$sw}++; # Just to define the key
@@ -1225 +1233 @@
       SWITCH_AND_PORT:
       for my $swport (keys %db_switch_connected_on_port) {
-         
+
          next if keys %{$db_switch_connected_on_port{$swport}} == 1;
-         
+
          $maybe_more_than_one_switch_connected = 'yes';
 
-         my ($sw_connect,$port_connect) = split ':', $swport;
+         my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
          my @sw_on_same_port = keys %{$db_switch_connected_on_port{$swport}};
 
          CONNECTED:
          for my $sw_connected (@sw_on_same_port) {
-            
+
             next CONNECTED if not keys %{$db_switch_link_with{$sw_connected}} == 1;
-            
+
             $db_switch_connected_on_port{$swport} = {$sw_connected => 1};
-            
+
             for my $other_sw (@sw_on_same_port) {
                next if $other_sw eq $sw_connected;
-               
+
                delete $db_switch_link_with{$other_sw}->{$sw_connect};
                }
-            
+
             # We can not do better for this switch for this loop
             next SWITCH_AND_PORT;
@@ -1256 +1264 @@
    for my $sw (keys %db_switch_link_with) {
       for my $connect (keys %{$db_switch_link_with{$sw}}) {
-      
+
          my $port = $db_switch_link_with{$sw}->{$connect};
-      
+
          $db_switch_connected_on_port{"$connect:$port"} ||= {};
          $db_switch_connected_on_port{"$connect:$port"}->{$sw} = $port;
-        
+
          $db_switch_parent{$sw} = {switch => $connect, port => $port};
          }
       }
 
-   print "Switch output port and parent port connection\n";  
+   print "Switch output port and parent port connection\n";
    print "---------------------------------------------\n";
    for my $sw (sort keys %db_switch_output_port) {
@@ -1280 +1288 @@
    print "Switch parent and children port inter-connection\n";
    print "------------------------------------------------\n";
-   for my $swport (sort keys %db_switch_connected_on_port) {        
-      my ($sw_connect,$port_connect) = split ':', $swport;
+   for my $swport (sort keys %db_switch_connected_on_port) {
+      my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
       for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
          if (exists $db_switch_output_port{$sw}) {
@@ -1299 +1307 @@
       switch_db         => \%SWITCH_DB,
       };
-      
+
    YAML::Syck::DumpFile("$KLASK_SW_FILE", $switch_connection);
+   return;
    }
 
@@ -1320 +1329 @@
 
    $format = 'txt' if not defined $possible_format{$format};
-   
+
    $possible_format{$format}->(@ARGV);
+   return;
    }
 
@@ -1332 +1342 @@
    my %db_switch_connected_on_port = %{$switch_connection->{connected_on_port}};
 
-   print "Switch output port and parent port connection\n";  
+   print "Switch output port and parent port connection\n";
    print "---------------------------------------------\n";
    for my $sw (sort keys %db_switch_output_port) {
@@ -1346 +1356 @@
    print "Switch parent and children port inter-connection\n";
    print "------------------------------------------------\n";
-   for my $swport (sort keys %db_switch_connected_on_port) {        
-      my ($sw_connect,$port_connect) = split ':', $swport;
+   for my $swport (sort keys %db_switch_connected_on_port) {
+      my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
       for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
          if (exists $db_switch_output_port{$sw}) {
@@ -1357 +1367 @@
          }
       }
+   return;
    }
 
@@ -1362 +1373 @@
 
    my $switch_connection = YAML::Syck::LoadFile("$KLASK_SW_FILE");
-   
+
    my %db_switch_output_port       = %{$switch_connection->{output_port}};
    my %db_switch_parent            = %{$switch_connection->{parent}};
@@ -1371 +1382 @@
    my %db_building= ();
    for my $sw (@SWITCH) {
-      my ($building, $location) = split /\//, $sw->{location}, 2;
+      my ($building, $location) = split m/ \/ /xms, $sw->{location}, 2;
       $db_building{$building} ||= {};
       $db_building{$building}->{$location} ||= {};
       $db_building{$building}->{$location}{ $sw->{hostname} } = 'y';
       }
- 
- 
+
+
    print "digraph G {\n";
 
@@ -1386 +1397 @@
    for my $building (keys %db_building) {
       $b++;
-      
+
       print "\"building$b\" [label = \"$building\", color = black, fillcolor = gold, style = filled];\n";
       print "site -> \"building$b\" [len = 2, color = firebrick];\n";
@@ -1393 +1404 @@
       for my $loc (keys %{$db_building{$building}}) {
          $l++;
- 
-         print "\"location$b-$l\" [label = \"$building".'/'.join('\n',split("/",$loc))."\", color = black, fillcolor = orange, style = filled];\n";
+
+         print "\"location$b-$l\" [label = \"$building" . q{/} . join(q{\n}, split(m{ / }xms, $loc)) . "\", color = black, fillcolor = orange, style = filled];\n";
 #         print "\"location$b-$l\" [label = \"$building / $loc\", color = black, fillcolor = orange, style = filled];\n";
          print "\"building$b\" -> \"location$b-$l\" [len = 2, color = firebrick]\n";
@@ -1403 +1414 @@
 
             my $swname  = $sw;
-               $swname .= '\n-\n'."$db_switch_global{$sw}->{model}" if exists $db_switch_global{$sw} and exists $db_switch_global{$sw}->{model};
+               $swname .= q{\n-\n} . "$db_switch_global{$sw}->{model}" if exists $db_switch_global{$sw} and exists $db_switch_global{$sw}->{model};
             print "\"$sw\" [label = \"$swname\", color = black, fillcolor = palegreen, shape = rect, style = filled];\n";
             print "\"location$b-$l\" -> \"$sw\" [len = 2, color = firebrick, arrowtail = dot]\n";
@@ -1410 +1421 @@
 
             for my $swport (keys %db_switch_connected_on_port) {
-               my ($sw_connect,$port_connect) = split ':', $swport;
+               my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
                next if not $sw_connect eq $sw;
                next if $port_connect eq $db_switch_output_port{$sw};
@@ -1420 +1431 @@
       }
 
-#   print "Switch output port and parent port connection\n";  
+#   print "Switch output port and parent port connection\n";
 #   print "---------------------------------------------\n";
    for my $sw (sort keys %db_switch_output_port) {
@@ -1434 +1445 @@
 #   print "Switch parent and children port inter-connection\n";
 #   print "------------------------------------------------\n";
-   for my $swport (sort keys %db_switch_connected_on_port) {        
-      my ($sw_connect,$port_connect) = split ':', $swport;
+   for my $swport (sort keys %db_switch_connected_on_port) {
+      my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
       for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
          if (exists $db_switch_output_port{$sw}) {
@@ -1447 +1458 @@
 
 print "}\n";
+   return;
    }
 
@@ -1457 +1469 @@
 
 
-=head1 SYNOPSIS
+=head1 USAGE
 
  klask updatedb
@@ -1591 +1603 @@
 
 
-=head1 COPYRIGHT
-       
-Copyright (C) 2005-2008 Gabriel Moreau.
-
-
-=head1 LICENCE
+=head1 LICENSE AND COPYRIGHT
 
 GPL version 2 or later and Perl equivalent
 
+Copyright (C) 2005-2009 Gabriel Moreau.