I am sure this can be done with split(), but I am more interested in doing it with s// if possible. I want to compare a supplied IP address with an array of IP addresses and find a match if existing. I also want to consider a partial match successful only if the entire element (not a substring of the array element) is a match.
For example: Supplied IP: 10.12.13.14
If the current array element is 10.12. or 10. or 10.12.13. We can consider that a match, but not 10.12.11.
This is to find if a given IP exists in the hosts.allow TCP wrappers file on a Linux host. I will add functionality to append the address if it is not covered in the file. Since Partial subnet matches like 10.120. or 192.168. work, I need to test for those as well. That is the code I am missing below where the placeholder "OR SUBSTRING MATCHES" exists. I want to know if my $IP = "1.2.3.4"; how do I make substring variables so I can perform a string comparison on "1.2.3." and "1.2." ?
#PSEUDO CODE EXAMPLE
my #IPS = (10.12.13.14, 191.168.1.2, 10.8., 172.16. );
my $IP = "10.8.3.44";
foreach (#IPS) { if( $IP eq $_ || split(/\d+\./, 1-3, $IP) eq $_ ) { print $IP matches current IP: $_\n}
# That split is supposed to represent "10." "10.8." and "10.8.3." That is the logic I am trying to accomplish, but I would like to use s// if it fits the job, otherwise I am open to split() or other suggestions
#REAL CODE EXAMPLE
#!/usr/bin/perl
my $IP = $ARGV[0];
my $FILE = '/etc/hosts.allow';
# Make sure it is an IP with either 157. or 140. as first octet
unless ( $IP =~ qr/(140|157)\.(\d{1,3}\.){2}\d{1,3}/ ) {
die "Usage: $0 IP Address" } else {
open (FH, "<", "$FILE");
foreach $LINE (<FH>) {
if ( $LINE =~ qr/^sshd: (.*)/i ) {
#LIST = split(", ", $1);
foreach (#LIST) {
chomp $_;
if($IP eq $_) || (OR SUBSTRING MATCHES ) <-need code here {
print "IP ADDRESS: $IP found! \n";
} else { print "$_ is not a match\n"};
}
}
}
}
Why reinvent the wheel?
use strict;
use warnings;
use feature qw/say/;
use Net::Subnet;
my $allowed_hosts = subnet_matcher qw(
10.8.0.0/16
10.12.13.14/32
191.168.1.2/32
172.16.0.0/16
);
for my $ip (qw/10.8.3.44/) {
if ($allowed_hosts->($ip)) {
say "$ip is allowed!";
}
else {
say "$ip is disallowed!";
}
}
You can build a regular expression to match against your accepted list. As M42 already demonstrated, you need to use quotemeta so that your period's aren't treated as the any character. You also need to be careful about your boundary conditions as well:
my #ips = qw(10.12.13.14 191.168.1.2 10.8. 172.16.);
my $ips_list = join '|', map {/\d$/ ? "$_\$" : $_} map quotemeta, #ips;
my $ips_re = qr{^(?:$ips_list)};
while (<DATA>) {
chomp;
if ($_ =~ $ips_re) {
print "(pass) $_\n";
} else {
print "(fail) $_\n";
}
}
__DATA__
10.8.3.44
999.10.8.999
10.12.13.14999
10.12.13.14
172.16.99.99
191.168.1.2
191.168.1.29
Outputs:
(pass) 10.8.3.44
(fail) 999.10.8.999
(fail) 10.12.13.14999
(pass) 10.12.13.14
(pass) 172.16.99.99
(pass) 191.168.1.2
(fail) 191.168.1.29
How about:
if ( ($IP eq $_) || ($IP =~ /^\Q$_/) ) {
Related
I'm trying to dynamically catch regex matching in Perl. I've known that eval will help me do this but I may be doing something wrong.
Code:
use strict;
use warnings;
my %testHash = (
'(\d+)\/(\d+)\/(\d+)' => '$1$2$3'
);
my $str = '1/12/2016';
foreach my $pattern (keys (%testHash)) {
my $value = $testHash{$pattern};
my $result;
eval {
local $_ = $str;
/$pattern/;
print "\$1 - $1\n";
print "\$2 - $2\n";
print "\$3 - $3\n";
eval { print "$value\n"; }
}
}
Is it also possible to store captured regex patterns in an array?
I believe what you really want is a dynamic version of the following:
say $str =~ s/(\d+)\/(\d+)\/(\d+)/$1$2$3/gr;
String::Substitution provides what we need to achieve that.
use String::Substitution qw( gsub_copy );
for my $pattern (keys(%testHash)) {
my $replacement = $testHash{$pattern};
say gsub_copy($str, $pattern, $replacement);
}
Note that $replacement can also be a callback. This permits far more complicated substitutions. For example, if you wanted to convert 1/12/2016 into 2016-01-12, you could use the following:
'(\d+)/(\d+)/(\d+)' => sub { sprintf "%d-%02d-%02d", #_[3,1,2] },
To answer your actual question:
use String::Substitution qw( interpolate_match_vars last_match_vars );
for my $pattern (keys(%testHash)) {
my $template = $testHash{$pattern};
$str =~ $pattern # Or /$pattern/ if you prefer
or die("No match!\n");
say interpolate_match_vars($template, last_match_vars());
}
I am not completely sure what you want to do here, but I don't think your program does what you think it does.
You are useing eval with a BLOCK of code. That's like a try block. If it dies inside of that eval block, it will catch that error. It will not run your string like it was code. You need a string eval for that.
Instead of explaining that, here's an alternative.
This program uses sprintf and numbers the parameters. The %1$s syntax in the pattern says _take the first argument (1$) and format it as a string (%s). You don't need to localize or assign to $_ to do a match. The =~ operator does that on other variables for you. I also use qr{} to create a quoted regular expression (essentially a variable containing a precompiled pattern) that I can use directly. Because of the {} as delimiter, I don't need to escape the slashes.
use strict;
use warnings;
use feature 'say'; # like print ..., "\n"
my %testHash = (
qr{(\d+)/(\d+)/(\d+)} => '%1$s.%2$s.%3$s',
qr{(\d+)/(\d+)/(\d+) nomatch} => '%1$s.%2$s.%3$s',
qr{(\d+)/(\d+)/(\d\d\d\d)} => '%3$4d-%2$02d-%1$02d',
qr{\d} => '%s', # no capture group
);
my $str = '1/12/2016';
foreach my $pattern ( keys %testHash ) {
my #captures = ( $str =~ $pattern );
say "pattern: $pattern";
if ($#+ == 0) {
say " no capture groups";
next;
}
unless (#captures) {
say " no match";
next;
}
# debug-output
for my $i ( 1 .. $#- ) {
say sprintf " \$%d - %s", $i, $captures[ $i - 1 ];
}
say sprintf $testHash{$pattern}, #captures;
}
I included four examples:
The first pattern is the one you had. It uses %1$s and so on as explained above.
The second one does not match. We check the number of elements in #captured by looking at it in scalar context.
The third one shows that you can also reorder the result, or even use the sprintf formatting.
The last one has no capture group. We check by looking at the index of the last element ($# as the sigil for arrays that usually have an # sigil) in #+, which holds the offsets of the ends of the last successful submatches in the currently active dynamic scope. The first element is the end of the overall match, so if this only has one element, we don't have capture groups.
The output for me is this:
pattern: (?^:(\d+)/(\d+)/(\d\d\d\d))
$1 - 1
$2 - 12
$3 - 2016
2016-12-01
pattern: (?^:(\d+)/(\d+)/(\d+) nomatch)
no match
pattern: (?^:\d)
no capture groups
pattern: (?^:(\d+)/(\d+)/(\d+))
$1 - 1
$2 - 12
$3 - 2016
1.12.2016
Note that the order in the output is mixed up. That's because hashes are not ordered in Perl, and if you iterate over the keys in a hash without sort the order is random.
Apologies! I realized both my question and sample code were both vague. But after reading your suggestions I came of with the following code.
I haven't optimized this code yet and there is a limit to the replacement.
foreach my $key (keys %testHash) {
if ( $str =~ $key ) {
my #matchArr = ($str =~ $key); # Capture all matches
# Search and replace (limited from $1 to $9)
for ( my $i = 0; $i < #matchArr; $i++ ) {
my $num = $i+1;
$testHash{$key} =~ s/\$$num/$matchArr[$i]/;
}
$result = $testHash{$key};
last;
}
}
print "$result\n";
Evaluing the regexp in list context returns the matches. so in your example:
use Data::Dumper; # so we can see the result
foreach my $pattern (keys (%testHash)) {
my #a = ($str =~/$pattern/);
print Dumper(\#a);
}
would do the job.
HTH
Georg
Is it also possible to store captured regex patterns in an array?
Of course it is possible to store captured substrings in an array:
#!/usr/bin/env perl
use strict;
use warnings;
my #patterns = map qr{$_}, qw{
(\d+)/(\d+)/(\d+)
};
my $str = '1/12/2016';
foreach my $pattern ( #patterns ) {
my #captured = ($str =~ $pattern)
or next;
print "'$_'\n" for #captured;
}
Output:
'1'
'12'
'2016'
I do not quite understand what you are trying to do with combinations of local, eval EXPR and eval BLOCK in your code and the purpose of the following hash:
my %testHash = (
'(\d+)\/(\d+)\/(\d+)' => '$1$2$3'
);
If you are trying to codify that this pattern should result in three captures, you can do that like this:
my #tests = (
{
pattern => qr{(\d+)/(\d+)/(\d+)},
ncaptures => 3,
}
);
my $str = '1/12/2016';
foreach my $test ( #tests ) {
my #captured = ($str =~ $test->{pattern})
or next;
unless (#captured == $test->{ncaptures}) {
# handle failure
}
}
See this answer to find out how you can automate counting the number of capture groups in a pattern. Using the technique in that answer:
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
my #tests = map +{ pattern => qr{$_}, ncaptures => number_of_capturing_groups($_) }, qw(
(\d+)/(\d+)/(\d+)
);
my $str = '1/12/2016';
foreach my $test ( #tests ) {
my #captured = ($str =~ $test->{pattern});
ok #captured == $test->{ncaptures};
}
done_testing;
sub number_of_capturing_groups {
"" =~ /|$_[0]/;
return $#+;
}
Output:
ok 1
1..1
I need to grep a value from an array.
For example i have a values
#a=('branches/Soft/a.txt', 'branches/Soft/h.cpp', branches/Main/utils.pl');
#Array = ('branches/Soft/a.txt', 'branches/Soft/h.cpp', branches/Main/utils.pl','branches/Soft/B2/c.tct', 'branches/Docs/A1/b.txt');
Now, i need to loop #a and find each value matches to #Array. For Example
It works for me with grep. You'd do it the exact same way as in the More::ListUtils example below, except for having grep instead of any. You can also shorten it to
my $got_it = grep { /$str/ } #paths;
my #matches = grep { /$str/ } #paths;
This by default tests with /m against $_, each element of the list in turn. The $str and #paths are the same as below.
You can use the module More::ListUtils as well. Its function any returns true/false depending on whether the condition in the block is satisfied for any element in the list, ie. whether there was a match in this case.
use warnings;
use strict;
use Most::ListUtils;
my $str = 'branches/Soft/a.txt';
my #paths = ('branches/Soft/a.txt', 'branches/Soft/b.txt',
'branches/Docs/A1/b.txt', 'branches/Soft/B2/c.tct');
my $got_match = any { $_ =~ m/$str/ } #paths;
With the list above, containing the $str, the $got_match is 1.
Or you can roll it by hand and catch the match as well
foreach my $p (#paths) {
print "Found it: $1\n" if $p =~ m/($str)/;
}
This does print out the match.
Note that the strings you show in your example do not contain the one to match. I added it to my list for a test. Without it in the list no match is found in either of the examples.
To test for more than one string, with the added sample
my #strings = ('branches/Soft/a.txt', 'branches/Soft/h.cpp', 'branches/Main/utils.pl');
my #paths = ('branches/Soft/a.txt', 'branches/Soft/h.cpp', 'branches/Main/utils.pl',
'branches/Soft/B2/c.tct', 'branches/Docs/A1/b.txt');
foreach my $str (#strings) {
foreach my $p (#paths) {
print "Found it: $1\n" if $p =~ m/($str)/;
}
# Or, instead of the foreach loop above use
# my $match = grep { /$str/ } #paths;
# print "Matched for $str\n" if $match;
}
This prints
Found it: branches/Soft/a.txt
Found it: branches/Soft/h.cpp
Found it: branches/Main/utils.pl
When the lines with grep are uncommented and foreach ones commented out I get the corresponding prints for the same strings.
The slashes dot in $a will pose a problem so you either have to escape them it when doing regex match or use a simple eq to find the matches:
Regex match with $a escaped:
my #matches = grep { /\Q$a\E/ } #array;
Simple comparison with "equals":
my #matches = grep { $_ eq $a } #array;
With your sample data both will give an empty array #matches because there is no match.
This Solved My Question. Thanks to all especially #zdim for the valuable time and support
my #SVNFILES = ('branches/Soft/a.txt', 'branches/Soft/b.txt');
my #paths = ('branches/Soft/a.txt', 'branches/Soft/b.txt',
'branches/Docs/A1/b.txt', 'branches/Soft/B2/c.tct');
foreach my $svn (#SVNFILES)
{
chomp ($svn);
my $m = grep { /$svn/ } (#paths);
if ( $m eq '0' ) {
print "Files Mismatch\n";
exit 1;
}
}
You should escape characters like '/' and '.' in any regex when you need it as a character.
Likewise :
$a="branches\/Soft\/a\.txt"
Retry whatever you did with either grep or perl with that. If it still doesn't work, tell us precisely what you tried.
I have a list of names and I want to look for names containing two given letters asigned using variables.
$one = "A";
$two = "O";
Please note that I want those letters to be present anywhere in the checked names, so that I can get outputs like this:
Jason
Damon
Amo
Noma
Boam
...
But each letter must only be present once per name, meaning that this wouldn't work.
Alamo
I've tried this bit of code but it doesn't work.
foreach my $name (#list) {
if ($name =~ /$one/) {
if ($name =~ /$two/) {
print $name;
}}
else {next}; }
How about this?
for my $name (#list) {
my $ones = () = $name =~ /$one/gi;
my $twos = () = $name =~ /$two/gi;
if ($ones == 1 && $twos == 1) {
print $name;
}
}
#!/usr/bin/env perl
#
# test.pl is the name of this script
use warnings;
use strict;
my %char = map {$_ => 1} grep {/[a-z]/} map {lc($_)} split //, join '', #ARGV;
my #chars = sort keys %char; # the different characters appearing in the command line arguments
while (my $line = <STDIN>)
{
grep {$_ <=> 1} map {scalar(() = $line =~ /$_/ig )} #chars
or print $line;
}
Now:
echo hello world | test.pl fw will print nothing (w occurs exactly once in hello world, but f does not)
echo hello world | test.pl hw will print a line consisting of hello world (both h and w occur exactly once).
One way to get it all into a single regex is to use an expression within the regex pattern to search for the other letter (a or o) based on which one was found first:
#!/usr/bin/env perl
use 5.010; use strict; use warnings;
while(<DATA>){
chomp;
say if m/^
[^ao]* # anything but a or o
([ao]) # an 'a' or 'o'
[^ao]* # anything but a or o
(??{($1 and lc($1) eq 'a') ? 'o' : 'a'}) # the other 'a' or 'o'
[^ao]* $/xi; # anything but a or o
}
__DATA__
Abdi
Chelal
Jucal
Husham
Gallio
Pileser
Tekoa
Kenaz
Raphah
See the perlre section on Extended Expressions for more info.
This is my solution. You don't make it clear whether there will always be just two single-character strings to match but I have assumed that there may be more
Unfortunately the classical way of counting occurrences of a character -- tr/// -- doesn't interpolate variables into its searchlist and doesn't have a case-independent modifier /i. But the pattern-match operator m// does, so that is what I have used
I thoroughly dislike the so-called goatse operator, but there isn't a neater way that I know of that allows you to count the number of times a global regex pattern matches
I could have used a grep for the inner loop, but I went for a regular for loop and a next with a label as I believe it's more readable this way
use strict;
use warnings;
use v5.10.1;
use autodie;
my #list = do {
open my $fh, '<', 'names.txt';
<$fh>;
};
chomp #list;
my ($one, $two) = qw/ A O /;
NAME:
for my $name ( #list ) {
for ( $one, $two) {
my $count = () = $name =~ /$_/gi;
next NAME unless $count == 1;
}
say $name;
}
output
Gallio
Tekoa
Achbor
Clopas
This is the input that I used
Abdi
Chelal
Jucal
Husham
Gallio
Pileser
Tekoa
Kenaz
Raphah
Tiras
Jehudi
Bildad
Shemidah
Meshillemoth
Tabeel
Achbor
Jesus
Osee
Elnaam
Rephah
Asaiah
Er
Clopas
Penuel
Shema
Marsena
Jaare
Joseph
Shamariah
Levi
Aphses
The problem:
Find pieces of text in a file enclosed by # and replace the inside
Input:
#abc# abc #ABC#
cba #cba CBA#
Deisred output:
абц abc АБЦ
cba цба ЦБА
I have the following:
#!/usr/bin/perl
use strict;
use warnings;
use Encode;
my $output;
open FILE,"<", 'test.txt';
while (<FILE>) {
chomp(my #chars = split(//, $_));
for (#chars) {
my #char;
$_ =~ s/a/chr(0x430)/eg;
$_ =~ s/b/chr(0x431)/eg;
$_ =~ s/c/chr(0x446)/eg;
$_ =~ s/d/chr(0x434)/eg;
$_ =~ s/e/chr(0x435)/eg;
$_ =~ s/A/chr(0x410)/eg;
$_ =~ s/B/chr(0x411)/eg;
$_ =~ s/C/chr(0x426)/eg;
push #char, $_;
$output = join "", #char;
print encode("utf-8",$output);}
print "\n";
}
close FILE;
But I'm stuck on how to process further
Thanks for help in advance!
Kluther
Here my solution. (you will fixed it, yes. It is prototype)
for (my $data = <DATA>){
$data=~s/[#]([\s\w]+)[#]/func($1)/ge;
print $data;
# while($data=~m/[#]([\s\w]+)[#]/g){
# print "marked: ",$1,"\n";
# print "position:", pos();
# }
# print "not marked: ";
}
sub func{
#do your magic here ;)
return "<< #_ >>";
}
__DATA__
#abc# abc #ABC# cba #cba CBA#
What happens here?
First, I read data. You can do it yourself.
for (my $data = <DATA>){...}
Next, I need to search your pattern and replace it.
What should I do?
Use substition operator: s/pattern/replace/
But in interesting form:
s/pattern/func($1)/ge
Key g mean Global Search
Key e mean Evaluate
So, I think, that you need to write your own func function ;)
Maybe better to use transliteration operator: tr/listOfSymbolsToBeReplaced/listOfSymbolsThatBePlacedInstead/
With minimal changes to your algorithm you need to keep track of whether you are inside the #marks or not. so add something like this
my $bConvert = 0;
chomp(my #chars = split(//, $_));
for (#chars) {
my $char = $_;
if (/#/) {
$bConvert = ($bConvert + 1) % 2;
next;
}
elsif ($bConvert) {
$char =~ s/a/chr(0x430)/eg;
$char =~ s/b/chr(0x431)/eg;
$char =~ s/c/chr(0x446)/eg;
$char =~ s/d/chr(0x434)/eg;
$char =~ s/e/chr(0x435)/eg;
$char =~ s/A/chr(0x410)/eg;
$char =~ s/B/chr(0x411)/eg;
$char =~ s/C/chr(0x426)/eg;
}
print encode("utf-8",$char);
}
Try this after $output is processed.
$output =~ s/\#//g;
my #split_output = split(//, $output);
$output = "";
my $len = scalar(#split_output) ;
while ($len--) {
$output .= shift(#split_output);
}
print $output;
It can be done with a single regex and no splitting of the string:
use strict;
use warnings;
use Encode;
my %chars = (
a => chr(0x430),
b => chr(0x431),
c => chr(0x446),
d => chr(0x434),
e => chr(0x435),
A => chr(0x410),
B => chr(0x411),
C => chr(0x426),
);
my $regex = '(' . join ('|', keys %chars) . ')';
while (<DATA>) {
1 while ($_ =~ s|\#(?!\s)[^#]*?\K$regex(?=[^#]*(?!\s)\#)|$chars{$1}|eg);
print encode("utf-8",$_);
}
It does require repeated runs of the regex due to the overlapping nature of the matches.
I am trying to extract all of the IP Addresses off of this website: http://www.game-monitor.com/
I want to regex the IP's on that page, extract all of them and display them on the screen.
This is what I have so far, can you tell me what Is wrong and help me?
#!/usr/bin/perl
use HTTP::Request;
use LWP::UserAgent;
print 'Press [1] To Begin: ';
chomp ($begin = <STDIN>);
my $url = 'http://www.game-monitor.com/';
my #ips = ('\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}','\d{1,3}\.\d{1,2}\.\d{1,3}\.\d{1,2}','\d{1,2} \.\d{1,3}\.\d{1,2}\.\d{1,3}','\d{1,2}\.\d{1,2}\.\d{1,2}\.\d{1,3}','\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,2}','\d{1,3}\.\d{1,3}\.\d{1,2}\.\d{1,2}','\d{1,2}\.\d{1,2}\.\d{1,3}\.\d{1,3}','\d{1,2}\.\d{1,2}\.\d{1,2}\.\d{1,2}','\d{1,2}\.\d{1,3}\.\d{1,3}\.\d{1,2}','\d{1,3}\.\d{1,2}\.\d{1,2}\.\d{1,3}');
if ($begin eq 1)
{
my $request = HTTP::Request->new(GET => $url);
my $useragent = LWP::UserAgent->new();
my $response = $useragent->request($request);
my $result = $response->content;
foreach $ip (#ips)
{
if ($result =~ /($ips[0])/ ||
$result =~ /($ips[1])/ ||
$result =~ /($ips[2])/ ||
$result =~ /($ips[3])/ ||
$result =~ /($ips[4])/ ||
$result =~ /($ips[5])/ ||
$result =~ /($ips[6])/ ||
$result =~ /($ips[7])/ ||
$result =~ /($ips[8])/ ||
$result =~ /($ips[9])/
)
{
print "IP: $1 \n";
print "IP: $2 \n";
print "IP: $3 \n";
print "IP: $4 \n";
print "IP: $5 \n";
print "IP: $6 \n";
print "IP: $7 \n";
print "IP: $8 \n";
print "IP: $9 \n";
print "IP: $10 \n";
}
}
}
To simplify multi-line substitutions, use the /s modifier, which in effect tells Perl to pretend the string is a single line--even if it isn't.
see perlre for more detail.
It would be nice if you use module like Regexp::Common::net -- provide regexes for IPv4 addresses instead of writing your own regex for matching ip addresses.
for example try something like,
use Regexp::Common qw/net/;
while (<>) {
print $1, "\n" if /($RE{net}{ipv4})/;
}
Use the /g modifier to match all IPs.
Tip: use -w parameter and strict package to avoid "bad coding style".
#!/usr/bin/perl -w
use strict;
use HTTP::Request;
use LWP::UserAgent;
print 'Press [1] To Begin: ';
chomp (my $begin = <STDIN>);
my $url = 'http://www.game-monitor.com/';
my $ip_regex = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}';
if ($begin eq 1)
{
my $request = HTTP::Request->new(GET => $url);
my $useragent = LWP::UserAgent->new();
my $response = $useragent->request($request);
my $result = $response->content;
while ($result =~ /($ip_regex)/g)
{
print "IP: $1 \n";
}
}
#!/usr/bin/perl
use HTTP::Request;
use LWP::UserAgent;
my $url = 'http://www.game-monitor.com/';
my $request = HTTP::Request->new(GET => $url);
my $useragent = LWP::UserAgent->new();
my $response = $useragent->request($request);
my $result = $response->content;
#m = ($result =~ /\b(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\b/sg);
foreach (#m) {
print "IP: $_\n";
}
I don't really see what you're trying to do with your big array #ips. The first regex already matches all IP addresses (since \d{1,3} means "one to three digits", it already contains IP addresses that have two digits), so you don't need all those permutations with \d{1,2}.
One thing you could do is to surround your regex with \b word boundary anchors to ensure that you don't match 123.123.123.123 within 99123.123.123.12399 or something like it. Also, you're probably aware that your regex would also match something like 999.999.999.999. If that's not a problem because your input won't contain invalid IP addresses, then of course that's just fine.
Finally, you need the /g global modifier so your regex finds not just the first but all occurrences in the string.
In essence, how about doing it like this:
while ($result =~ m/\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b/g) {
print "IP: $&\n";
}