#!/usr/bin/perl -w use strict; use Test::More tests => 3; sub lcos { my ($list1,$list2) = @_; my @list1 = @$list1; my @list2 = @$list2; # Assume that neither list1 nor list2 contain elements # that stringify to the same value, that is, neither # list1 nor list2 contain both "" and undef. # Also, a blank is chosen as a delimiting character which # shall appear in no element of list1 or list2 $list2 = " " . join(" ", @list2) . " "; my $matcher = lcos_match(@list1); #print $matcher,"\n"; my @result; @result = split " ", $1 if $list2 =~ $matcher; @result; }; sub lcos_match { my $match = '('; while (@_) { $match .= match_sequence(@_); shift; @_ and $match .= "|"; }; $match .= ')'; $match; }; sub match_sequence { my $result = ""; my $element; while (defined ($element = pop)) { $result = $result ? qr{ \Q$element\E$result?} : qr{ \Q$element\E }; }; $result; }; while () { my ($l1,$l2,$expected) = split /\s*\|\s*/; my @l1 = split /\s*/, $l1; my @l2 = split /\s*/, $l2; my @expected = split /\s*/, $expected; $" = ","; $, = ","; is_deeply( [ lcos(\@l1,\@l2)], \@expected, "@l1 | @l2"); }; __DATA__ a b c d f g h j q z | a b c d e f g i j k r x y z | a b c d a b c | a b x c | a b a b c d | a b x b c d | b c d