This sample code demonstrates a technique for detecting a common prefix between two strings. It uses the detected match length to copy the prefix out to another string and remove it from the two original strings.
Update: Modified per frodo72 and blazar's suggestions.
#!/usr/bin/perl
use warnings;
use strict;

my $str0 = "C:/Build~~/Win/App/Experiments/1_0/";
my $str1 = "${str0}Experiments/Blood Pressure/_pieces";
my $str2 = "${str0}temp/Blood Pressure/_pieces";

($str0 ^ $str1) =~ /^\0*/;

my $commonLen = $+[0];
my $commonStr = substr $str1, 0, $commonLen, "";
substr $str2, 0, $commonLen, "";

print "Common: $commonStr\n";
print "Tail 1: $str1\n";
print "Tail 2: $str2\n";

[download]

Output:

Common: C:/Build~~/Win/App/Experiments/1_0/
Tail 1: Experiments/Blood Pressure/_pieces
Tail 2: temp/Blood Pressure/_pieces

[download]

Replies are listed 'Best First'.
Re: Remove a common prefix from two strings
by polettix (Vicar) on Aug 05, 2005 at 02:09 UTC
    Acknowledgement: this comment is here thanks to this post and the resulting thread :)

    No need to disable warnings, you don't need chr at all:

    #!/usr/bin/perl
use warnings;
use strict;
 
my $str0 = "C:/Build~~/Win/App/Experiments/1_0/";
my $str1 = "${str0}Experiments/Blood Pressure/_pieces";
my $str2 = "${str0}temp/Blood Pressure/_pieces";
 
my $commonLen = 0;
($str0 ^ $str1) =~ /^(\0*)/;
$commonLen = $+[0];
 
my $commonStr = substr $str1, 0, $commonLen, "";
substr $str2, 0, $commonLen, "";
 
print "Common: $commonStr\n";
print "Tail 1: $str1\n";
print "Tail 2: $str2\n";

    [download]

    Flavio
    perl -ple'$_=reverse' <<<ti.xittelop@oivalf

    Don't fool yourself.
[reply]
[d/l]
[select]

      Thanks frodo72. I knew there was a way of quoting a char in that fashion (but couldn't find it quickly) and I just didn't try the obvious way :(

      Perl is Huffman encoded by design.
[reply]
Re: Remove a common prefix from two strings
by blazar (Canon) on Aug 05, 2005 at 09:36 UTC 
    no warnings 'regexp'; ($str0 ^ $str1) =~ /^((??{chr(0)})*)/;
$commonLen = $+[0];

    [download]
    Two things
    • AFAICT @+ doesn't require capturing parens,
    • unless you use single quotes as delimiters, regexen obey the same substituon rules as double quoted strings.
    Thus 
    ($str0 ^ $str1) =~ /^\0*)/;

    [download]
    should suffice and it shouldn't even be necessary to initialize $commonLen to zero: 
    #!/usr/bin/perl -l

use strict;
use warnings;

sub clen {
    ($_[0] ^ $_[1]) =~ /^\0*/;
    $+[0];
}

print +(clen split) while <DATA>;
__END__
aaaa bbbb
aaaa abbb
aaaa aabb
aaaa aaab
aaaa aaaa

    [download]
[reply]
[d/l]
[select]

Back to Cool Uses for Perl