use strict;
use warnings;

my @words = qw{
   cooling
   rooting
   hooting
   looking
   doormat
   cooking
   cookies
   noodles
   };

print qq{pat_mc : @{ [ pat_mc() ] }\n};
print qq{almut  : @{ [ almut() ] }\n};
print qq{pat_mc : @{ [ pat_mc() ] }\n};
print qq{almut  : @{ [ almut() ] }\n};

sub almut {

    my $w1 = $words[0];
    my $and = "\xff" x length($w1);
    my $or  = "\0"   x length($w1);
    
    for my $w (@words) {
        
        $and &= $w;
        $or  |= $w;
    }
    
    my $xor = $and ^ $or;
    $xor =~ tr/\0/\xff/c;
    my $mask = ~$xor;
    
    my $common = $w1 & $mask;
    $common =~ tr/\0/-/;

    return $common;
}

sub pat_mc {
    our @common_letters;
    our @wordsCopy = @words;
    my $reference = shift @wordsCopy;

    () = $reference =~ /(.)(?{        
       my $letter = $1; 
       my $position = $-[0]; 
       my $bolean = 1; 
       for ( @wordsCopy ) 
       { 
           if ( substr( $_, $position, 1 ) ne $letter )
           { 
               $bolean = 0; 
               last
           } 
       }
       $common_letters[ $position ] = $letter if ( $bolean ); 
       })/gx;
    return join '',
       map { $common_letters[ $_ ] || '-' }
       0 .. length( $reference ) - 1;
}