# leading common substring
# returns length of LCS
# requires Perl 5.6+
sub lcs {
  ($_[0] ^ $_[1]) =~ /\0*/;
  return $+[0];
}
[download]

# leading common substring
# returns length of LCS
# requires Perl 5.6+
sub lcs {
  ($_[0] ^ $_[1]) =~ /(\0*)/;
  return length $1;
}
[download]

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

I had this problem come up a while back (in fact I think it was my question that prompted the thread on fwp about it . . .). At any rate, this was something I had lying around from it that benchmarks three solutions. You can decide for yourself if the first is cheating or if you really, really care about speed. :)

Also, note that these are returning the length of the common string not the string itself.

#!/usr/bin/perl
use Benchmark qw( cmpthese );

use Inline C => <<EOF;
int comlen(char *p, char *q) {
  int i = 0;
  while( *p && (*p++ == *q++) )
    i++;
  return i;
}
EOF

sub comlen_or {
  length((($_[0]^$_[1])=~m/^(\0+)/)[0]);
}

sub comlen_tr {
  my( $t );

  return ($t=$_[0]^$_[1])=~ y/\0/\0/;
}

$a = "abcdefghijk";
$b = "abcdefg";

cmpthese( shift || 2_000_000,
           {
            inline_c => sub { comlen( $a, $b ) },
            comlen_or => sub { comlen_or( $a, $b ) },
            comlen_tr => sub { comlen_tr( $a, $b ) },
           },
         );

exit 0;
[download]

You've beaten me to the use of C. I remembered that it would be faster to call an XS (or Inline::C) function here. However, I'd like to point out that using tr/// for this problem is not a help at all. Using tr/\0// merely tells you how many characters are the same between the two words in total, not how many characters are the same at the start of the string. This is the fatal flaw. I believe this flaw existed in the LCS presentation at a YAPC in years gone by.

Example: calling the function with "brought" and "wrought" should return 0, except that the tr/// solution returns 6.

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

If you sort a list of the strings into an array, the deepest matches will be neighbors. That allows you to terminate the search after relatively few applications of japhy's excellent advice.

After Compline,
Zaxo

#! /usr/local/bin/perl

$string1 = "the date is today";
$string2 = "the date is tomorrow";

$concat = $string1 . "#" . $string2;

if ( $concat =~ m/^(.*)(.*)#\1(.*)$/ ) {
    print "matching part: $1\n";
    print "difference: $2\ndifference: $3\n";
} else {
    print "strings $string1 and $string2 do not match!\n";
}
[download]

matching part: the date is to
difference: day
difference: morrow
[download]

...
$concat = $string1 . "#!!#" . $string2;

if ( $concat =~ m/^(.*)(.*)#!!#\1(.*)$/ ) {
...
[download]