This is how I'd do it: (Update (200201251950+0100))

sub weirdmatch {
    my ($foo, $bar) = @_;
    $bar =~ s/\Q$1// or return 0   while $foo =~ s/(.)//;
    return 1;
}

print weirdmatch('the' => 'there');  # 1
print weirdmatch('foo' => 'raboof'); # 1
print weirdmatch('moo' => 'monkey'); # 0
[download]

2;0 juerd@ouranos:~$ perl -e'undef christmas'
Segmentation fault
2;139 juerd@ouranos:~$
[download]