#!/usr/bin/env perl
use warnings;
use strict;
use 5.032;

use Test::More;
use YAML::XS qw( Dump );

## Copied starting with Regexp::Trie
package GlobTrie {
    sub new { return bless {} => shift; }

    sub add {
        my $self = shift;
        my $str  = shift;
        my $ref  = $self;
        for my $char ( split //, $str ) {
            $ref->{$char} //= {};
            $ref = $ref->{$char};
        }
        $ref->{''} = 1;
        return $self;
    }

    sub _glob {
        my $self = shift;

        return if $self->{''} and scalar keys %{$self} == 1;

        my ( @alt, @cc );
        my $q = 0;

        for my $char ( sort keys %{$self} ) {
            my $qchar = $char =~ m{[*?]} ? quotemeta $char : $char;
            if ( ref $self->{$char} ) {
                if ( defined( my $recurse = _glob( $self->{$char} ) ) 
+) {
                    push @alt, $qchar . $recurse;
                } else {
                    push @cc, $qchar;
                }
            } else {
                $q = 1;
            }
        }

        my $cconly = !@alt;
        @cc and push @alt, @cc == 1 ? $cc[0] : '{' . join( ',', @cc ) 
+. '}';
        my $result = @alt == 1 ? $alt[0] : '{' . join( q{,}, @alt ) . 
+'}';
        ##$q and $result = $cconly ? "$result?" : "(?:$result)?";
        return $result;
    }
};

sub list2glob {
    my @pats = @_;
    my $ret  = GlobTrie->new;
    for my $item (@pats) {
        $ret->add($item);
    }

    ## say STDERR Dump( $ret );

    return $ret->_glob;
}

is glob( list2glob( 'a',  'b' ) ),  glob('{a,b}');
is glob( list2glob( 'ab', 'ac' ) ), glob('a{b,c}');

is glob( list2glob( 'aXb', 'aYb' ) ), glob('a{X,Y}b');
is glob( list2glob(qw( a1b3c a1b4c a2b3c a2b4c )) ), glob('a{1,2}b{3,4
+}c');

is glob(
    list2glob(
        qw( /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 )
    )
    ),
    glob('/{ab,cd}/{ef,gh}/ij{/{kl,mn},}');

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

done_testing();

__END__
[download]