Example Glob Grammars

use v6;

grammar Glob {
    token TOP { <term>+ }
    token term {
        || <match>
        || <char>
    }
    token match { <match-any> | <match-one> }
    token match-any { '*' }
    token match-one { '?' }
    token char { . }
}

class GlobMatcher {
    has @.terms;

    method ACCEPTS(Str:D $s) {
        my @backtracks = [ \([ $s.comb ], [ @!terms ]) ];
        BACKTRACK: while @backtracks.pop -> (@letters, @terms) {
            LETTER: while @letters.shift -> $c {
                last LETTER unless @terms;

                my $this-term = @terms.shift;
                my $next-term = @terms[0];

                given $this-term {
                    when '*' {
                        # Continue to the next term if we can
                        if @terms and $next-term ne '*' | '?' and $c eq $next-term {
                            push @backtracks, ([ @letters ], [ '*', |@terms ]);
                            redo;
                        }

                        # Match anything, and try again next round
                        unshift @terms, $this-term;
                    }

                    # We have a letter, so we match!
                    when '?' { }

                    # Only match exactly
                    default {
                        # If not an exact match, we fail; try again if we can
                        next BACKTRACK if $c ne $this-term;
                    }
                }
            }

            # If we matched everything, we succeed
            return True unless @terms;

            # Otherwise, try the next backtrack, if any
        }

        # We ran out of back tracks, so we fail
        False;
    }
}

class GlobAction {
    method TOP($/)       { make GlobMatcher.new(terms => $<term>».made) }
    method term($/)      { make $/.values».made.first }
    method match($/)     { make $/.values».made.first }
    method match-any($/) { make '*' }
    method match-one($/) { make '?' }
    method char($/)      { make ~$/ }
}

my $matcher = Glob.parse("*.txt", :actions(GlobAction.new)).made;
for <foo.txt bar.txt baz.html blah.blah.txt> -> $f {
    say "$f matches" if $f ~~ $matcher;
}

sub glob($glob, :$globlang = Glob) {
    $globlang.parse($glob, :actions(GlobAction.new)).made;
}

for <foo.txt bar.txt baz.html blah.blah.txt>.grep(glob('*.txt')) -> $f {
    next unless $f ~~ glob('*.txt');
    say "$f matches";
}

<foo.txt bar.txt baz.html blah.blah.txt>.grep(glob('*.txt')).say;

grammar SQLGlob is Glob {
    token match-any { '%' }
    token match-one { '_' }
}

<foo.txt bar.txt baz.html blah.blah.txt>.grep(glob('%.txt', :globlang(SQLGlob))).say;