use strict;
use warnings;

my @ips = qw(
 1.1.1.1 1.1.1.2
 4.2.4.5 4.2.4.6
);

# Keep this many blocks
my $n = 3;
my $re = join "\\.", ("\\d+") x $n;
$re = qr/^($re)/;

my %collapsed;
for (@ips) {
  if ( /$re/ ) {
    $collapsed{$1}++;
  } else {
    warn "Bad ip [$_] or # of blocks [$n]\n";
  }
}

my $zero = join ".", ("0") x ( 4-$n );
print "$_.$zero\n" for keys %collapsed;
[download]

use strict;
use warnings;

my @ips = qw(
   1.1.1.1    1.1.1.2   1.1.1.127
   1.1.1.128  1.1.1.129
   10.1.2.5   10.1.2.6  10.1.2.10
);

my $mask = 25;

sub pack_ip4   { return pack 'C4', split /\./, $_ for @_ ? $_[0] : $_}
sub unpack_ip4 { return join '.', unpack 'C4', $_ for @_ ? $_[0] : $_}
sub sort_ip4   { map unpack_ip4, sort map pack_ip4, @_ }

my $packed_mask = pack('B32', ('1'x$mask) . ('0'x(32-$mask)));

my %by_net;
foreach my $ip (@ips) {
   my $net = unpack_ip4(pack_ip4($ip) & $packed_mask);
   push @{$by_net{$net}}, $ip;
}

foreach my $net (sort_ip4(keys(%by_net))) {
   print("Network $net/$mask:\n");
   foreach my $ip (sort_ip4(@{$by_net{$net}})) {
      print("  $ip\n");
   }
   print("\n");
}
[download]

Network 1.1.1.0/25:
  1.1.1.1
  1.1.1.2
  1.1.1.127

Network 1.1.1.128/25:
  1.1.1.128
  1.1.1.129

Network 10.1.2.0/25:
  10.1.2.5
  10.1.2.6
  10.1.2.10
[download]

use strict;
use warnings;

my @ips = qw(1.2.3.4 1.2.3.5 1.2.3.7);

my $first = shift @ips;
my @identicals = split m/\./, $first;
for (@ips){
    my @b = split m/\./;
    for my $i (0 .. $#identicals){
        if ($b[$i] ne $identicals[$i]){
            splice @identicals, $i;
            last;
        }
    }
}

my @rest = (0) x (4 - @identicals);
my $net = join('.', @identicals, @rest) . '/' . (8 * @identicals);
print "$net\n";
[download]

If you want it to work bit by bit instead, you have to map the IPs to binary representation first.

If somebody suggests a good module, you should use that instead.