use strict;
use warnings;

my $file1 = shift;
my $file2 = shift;

open(my $fh1, '<', $file1) or die "Cant open $file1: $!\n";
open(my $fh2, '<', $file2) or die "Cant open $file2: $!\n";

chomp( my @file1 = <$fh1> );
chomp( my @file2 = <$fh2> );

my %counts;
for my $base (@file1) {
   my $re = qr/^\Q$base\E(\.|\z)/;
   for my $node (@file2) {
        ++$counts{$base} if $node =~ /$re/;
   }
}

for my $base (keys(%counts)) {
   print("$base: $counts{$base}\n");
}
[download]

...

my %counts;
for my $base (@file1) {
   my $re = qr/^\Q$base\E(\.|\z)/;
   $counts{$base} += grep /$re/, @file2;
}

...
[download]

#!/usr/bin/perl
use strict;
use warnings;

my @file1 = qw(
    1.10.10
    1.10.1040
    1.10.150
    1.10.220
);

my @file2 = qw(
    1.10.10.640
    1.10.10.650
    1.10.10.660
    1.10.1040.20
    1.10.150.290
    1.10.150.300
    1.10.150.310
    1.10.220.80
);

for(my $i=0; $i<@file1; $i++)
{
    chomp($file1[$i]);
    #print "F $file1[$i]";

    for(my $j=0; $j<@file2; $j++)
    {
        chomp($file2[$j]);
    
        my @array = split(/\./, $file2[$j]);
    
        my $cat = "$array[0]" . "." . "$array[1]" . "." . "$array[2]";
    
        if("$file1[$i]" eq "$cat")
        {
            print "$file1[$i] $cat\n";
        }
    
    }
}
[download]

(with null-op chomps) yields the result

1.10.10 1.10.10
1.10.10 1.10.10
1.10.10 1.10.10
1.10.1040 1.10.1040
1.10.150 1.10.150
1.10.150 1.10.150
1.10.150 1.10.150
1.10.220 1.10.220
[download]

which seems to my eyes to be the spec. There are some stylistic modifications I would implement (Foreach Loops, hash instead of iterating with eq), but this should fix your bug.

Update: I'd missed that you were chopping in an inner loop, as ikegami notes below. The bug fix still holds.

If your input files are not newline terminated, your chops will remove data values from the terminating entry. The code:

If the files weren't newline terninated, @file1 and @file2 would only have one element.

I think kennethk is probably right about what may be causing your issue.

However, I'd like to offer a tip on debugging. The Data::Dumper module is a very handy tool in debugging. If you encounter a problem with regular expression's with variables not matching as you want, try using Data::Dumper (or a simple print) just before the regex to find out for sure what is being stored in the variable(s). If the variable(s) don't have what you think they should, then you know where to begin to look for the source of the problem.

Or see How can I visualize my complex data structure?

The Basic debugging checklist may also help.

HTH,

planetscape

use strict;
use warnings;
open(my $data_1 ,"<", "data1.dat");
my %stubs;
while (<$data_1>){
   chomp;
   $stubs{$_}=0;
}
close $data_1;
open(my $data_2 ,"<", "data2.dat");
while (<$data_2>){
   chomp;
   for my $stub (reverse sort keys %stubs){
      if ($_=~ /\Q$stub\E/){
         $stubs{$stub}++;
         last
      }
   }
}
for my $stub (sort  {$stubs{$a} <=> $stubs{$b}} (keys %stubs)){
   printf "%-10s: %d\n",$stub, $stubs{$stub};
}

__OUTPUT__
1.10.220  : 1
1.10.1040 : 1
1.10.10   : 3
1.10.150  : 3
[download]