#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11131998
use warnings;
use List::Util qw( uniq first );
$| = 1;

my $braces = qr/(\{(?:(?1))\}|[^{}\n])/;     # {} must be balanced
my $leftduplicate = qr/^($braces+).*\n\1/m;
my $rightduplicate = qr/($braces+)\n(?:.*\n)*.*\1$/m;
my %cache;
my $fast;

sub list2glob                           # find the glob for a set of words
  {
  local $_ = join "\n", my @words = uniq sort @_;
  @words > 1 or return $words[0];
  $cache{$_} and return $cache{$_};
  my (@best, @found);

  /$leftduplicate(?{ push @{ $found[length $1] }, "l $1" })(*FAIL)/;
  /$rightduplicate(?{ push @{ $found[length $1] }, "r $1" })(*FAIL)/;

  @found or return $cache{$_} =  # join all words in brace group
      '{' . join(',', map s/^\{($braces*)\}$/$1/r, @words) . '}';

  my $count = 0;
  for ( reverse grep defined, @found )       # process duplicate ends
    {
    for ( uniq @$_ ) # a duplicate left or right end (trie it !)
      {
      my ($side, $same) = split;
      my ($regex, $left, $right) = $side eq 'l' ?
        (qr/^\Q$same\E/, $same, '') : (qr/\Q$same\E$/, '', $same);
      my $answer = list2glob( (grep !/$regex/, @words ),
        $left . list2glob( map { /$regex/ ? "$`$'" : () } @words ) . $right);
      $best[$answer =~ tr/{},//c] = $answer;
      }
    $fast and ++$count >= 2 and last; # do only two longest duplicates in fast
    }
  return $cache{$_} = first {defined} @best; # shortest solution
  }

sub runtest          # run, show, and validate the glob
  {
  %cache = ();
  my @words = uniq sort @_;
  print $fast ? "(      fast)  " : "(exhaustive)  ";
  my $answer = list2glob(@words) // '*NONE*';
  print "$answer\n";
  my @glob = uniq sort glob $answer;
  "@glob" eq "@words" or die "\n** FAILED **\n got: @glob\nwant: @words\n";
  }

while( <DATA> )
  {
  s/#.*//;                     # remove comments
  my @words = split or next;   # ignore blank lines
  print "@words  =>\n";
  $fast = 1;
  runtest( @words );
  $fast = 0;
  @words <= 20 and             # FIXME skip big exhaustive tests
  runtest( @words );
  print "\n";
  }
print "SUCCESS !!\n";

__DATA__

aVb aWb aXXb aYb aZb                             # debugging test cases
abcdXegh abcdYfgh
ac ad bc bd
ad ae af bd be bf cd ce cf
a1b3c a1b4c a2b3c a2b4c a1b5c a2b5c
fee fie foe fum
one two three four five six seven eight nine ten
a bx cy dx ey fx g hx i jy aa
a aa aaa aaaa aaaaa anestingtest

a b                       # tests from https://perlmonks.org/?node_id=11131998
ab ac
aXb aYb
a1b3c a1b4c a2b3c a2b4c
/ab/ef/ij/kl /ab/ef/ij/mn /ab/ef/ij /ab/gh/ij/kl /ab/gh/ij/mn /ab/gh/ij /cd/ef/ij/kl /cd/ef/ij/mn /cd/ef/ij /cd/gh/ij/kl /cd/gh/ij/mn /cd/gh/ij
abdel abdelmn abdelmo abdfgkl abdfgklmn abdfgklmo abdfghkl abdfghklmn abdfghklmo abdfgijkl abdfgijklmn abdfgijklmo acdel acdelmn acdelmo acdfgkl acdfgklmn acdfgklmo acdfghkl acdfghklmn acdfghklmo acdfgijkl acdfgijklmn acdfgijklmo

##</code><code>##

aVb aWb aXXb aYb aZb  =>
(      fast)  a{V,W,XX,Y,Z}b
(exhaustive)  a{V,W,XX,Y,Z}b

abcdXegh abcdYfgh  =>
(      fast)  abcd{Xe,Yf}gh
(exhaustive)  abcd{Xe,Yf}gh

ac ad bc bd  =>
(      fast)  {a,b}{c,d}
(exhaustive)  {a,b}{c,d}

ad ae af bd be bf cd ce cf  =>
(      fast)  {a,b,c}{d,e,f}
(exhaustive)  {a,b,c}{d,e,f}

a1b3c a1b4c a2b3c a2b4c a1b5c a2b5c  =>
(      fast)  a{1,2}b{3,4,5}c
(exhaustive)  a{1,2}b{3,4,5}c

fee fie foe fum  =>
(      fast)  f{um,{e,i,o}e}
(exhaustive)  f{um,{e,i,o}e}

one two three four five six seven eight nine ten  =>
(      fast)  {eight,four,six,two,{fiv,thre,{ni,o}n}e,{sev,t}en}
(exhaustive)  {eight,four,six,two,{fiv,thre,{ni,o}n}e,{sev,t}en}

a bx cy dx ey fx g hx i jy aa  =>
(      fast)  {g,i,{,a}a,{b,d,f,h}x,{c,e,j}y}
(exhaustive)  {g,i,{,a}a,{b,d,f,h}x,{c,e,j}y}

a aa aaa aaaa aaaaa anestingtest  =>
(      fast)  a{,a{,a{,{,a}a}},nestingtest}
(exhaustive)  a{,nestingtest,{,{,{,a}a}a}a}

a b  =>
(      fast)  {a,b}
(exhaustive)  {a,b}

ab ac  =>
(      fast)  a{b,c}
(exhaustive)  a{b,c}

aXb aYb  =>
(      fast)  a{X,Y}b
(exhaustive)  a{X,Y}b

a1b3c a1b4c a2b3c a2b4c  =>
(      fast)  a{1,2}b{3,4}c
(exhaustive)  a{1,2}b{3,4}c

/ab/ef/ij/kl /ab/ef/ij/mn /ab/ef/ij /ab/gh/ij/kl /ab/gh/ij/mn /ab/gh/ij /cd/ef/ij/kl /cd/ef/ij/mn /cd/ef/ij /cd/gh/ij/kl /cd/gh/ij/mn /cd/gh/ij  =>
(      fast)  /{ab,cd}/{ef,gh}/ij{,/{kl,mn}}
(exhaustive)  /{ab,cd}/{ef,gh}/ij{,/{kl,mn}}

abdel abdelmn abdelmo abdfgkl abdfgklmn abdfgklmo abdfghkl abdfghklmn abdfghklmo abdfgijkl abdfgijklmn abdfgijklmo acdel acdelmn acdelmo acdfgkl acdfgklmn acdfgklmo acdfghkl acdfghklmn acdfghklmo acdfgijkl acdfgijklmn acdfgijklmo  =>
(      fast)  a{b,c}d{e,fg{,h,ij}k}l{,m{n,o}}

SUCCESS !!