Use of uninitialized value in pattern match(m//)

Bonjour,

J'ai developpé un script un fait l'extraction des données via telnet pour les insérer par la suite dans une base de données ,le problème c'est que certaine données ne peuvent pas être exraites en affichant le message d'erreur suivant:

Code:

Use of uninitialized value in pattern match (m//) at D:\ projet\classe2.pl line 56.

Voici une partie du code que j'ai developpé:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
my $dbh = DBI->connect($url, $user, $password) or die "!\n";
 
 my $p = Net::Ping->new();
 
 my $t = new Net::Telnet (Timeout=>undef, Errmode=>"return");
 
 $p->hires();
 
       my $sql="select * from secteur";
 
        my $req=$dbh->prepare($sql);
 
        $req->execute || die " Pb de la selection : $DBI::errstr";
 
        while (my (@info)=$req->fetchrow_array) {;
 
            my $sect=$info[0];
 
            print $sect."\n";
 
            my $host=$info[2];
 
            my $username=$info[4];
 
            my $passwd=$info[5];
 
            my ($ret, $duration, $ip) = $p->ping($host, undef);
 
            if ($ret) {
 
              printf("$host is alive (packet return time: %.2f ms)\n", 1000 * $duration) ;
 
              $t->open($host);
 
              $t->login($username, $passwd);
 
                    my @class0 = $t->cmd("wmanIfBs classifier show");
                    my @match=amatch("instance:", @class0);
                    for(my $i=0; $i<=$#match; $i++){
 
                       my @ins=split(/[:]/,$match[$i]);
                       print $ins[0]."\t".$ins[$#ins];
                       my @info=split(/[.]/, $ins[$#ins]);
                       #print $info[$#info-1]."\t".$info[$#info]."\n";
                       my @class1 = $t->cmd("wmanIfBs classifier show instance 1.$info[$#info-1].$info[$#info]");
 
                       my @IpSource=amatch("IpSourceAddr:", @class1);
 
                       #my @ip1=split(/[a-zA-Z:.]/,$IpSource[0]);
 
                       my @ip1=$IpSource[0] =~ /(\d+.|\d+$)/g;
 
                       if (exists $IpSource[0] and $IpSource[0] =~ /(\d+.|\d+$)/g){
 
                       print @ip1;
                       print "\n";
 
                       }
 
}
              }
 
            $t->close();
            $p->close();
 
        }
 
        $req->finish;

Merci de m'aider à trouver une solution à ce problème.