#!/usr/bin/perl use strict; use warnings; my @str = map {$_->[0]} sort {$a->[1] <=> $b->[1]} map {chomp; [$_, length($_)]} ; print LCS(@str), "\n"; sub LCS { my @str = @_; my $next = combo(split //, $str[0]); SUBSEQ: while (my @subseq = $next->()) { my $regex = join '.*', @subseq; $regex = qr/$regex/; for (1 .. $#str) { next SUBSEQ if $str[$_] !~ /$regex/; } return join '', @subseq; } } sub combo { # modified [id://394168] to generate long to short # - my ($by, $next) = (0, 1); # + my ($by, $next) = ($#list + 2, 1); # - $by++; # - return () if $by > @list; # + $by--; # +return () if ! $by; }