use strict;
use warnings;

my  $sPattern;
my  @aPlainText = qw(looked seemed liked cooked booked baked balked);

### $sPattern    =   "ABBCBD";  ### try this one later
$sPattern    =   "ABBCED";

while(<@aPlainText>){
    print "$_\n" if IsEqual($sPattern,$_);
}

sub IsEqual {
    my  $sPattern   = shift || die "missing argument";
    my  $sPlain     = shift || die "missing argument";
    my  $iLen       = 0;
    my  %hSubstit1  = ();
    my  %hSubstit2  = ();
    if(length($sPattern) != length($sPlain)){return 0;}
        else{$iLen = length($sPattern)-1};
    for (0 .. $iLen){
        my  $chrCiphr  = lc(substr($sPattern,$_,1));
        my  $chrPlain  = lc(substr($sPlain,$_,1));
        ### require a 1 to 1 mapping between plain chars and pattern chars
        $hSubstit1{$chrPlain}    =  $chrCiphr unless exists $hSubstit1{$chrPlain};
        $hSubstit2{$chrCiphr}    =  $chrPlain unless exists $hSubstit2{$chrCiphr};
        if($chrCiphr ne $hSubstit1{$chrPlain }){return 0;}
        if($chrPlain ne $hSubstit2{$chrCiphr }){return 0;}
    }
    return(1);
}###end_sub