File Coverage

blib/lib/Text/Gitignore.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	18	18	100.0
condition	6	6	100.0
subroutine	7	7	100.0
pod	2	2	100.0
total	96	96	100.0

package Text::Gitignore;
use strict;
use warnings;
use base 'Exporter';

our @EXPORT_OK = qw(match_gitignore build_gitignore_matcher);
our $VERSION   = "0.02";

sub match_gitignore {
    my ( $patterns, @paths ) = @_;

    my $matcher = build_gitignore_matcher($patterns);

    my @matched;
    for my $path (@paths) {
        push @matched, $path if $matcher->($path);
    }

    return @matched;
}

sub build_gitignore_matcher {
    my ($patterns) = @_;

    $patterns = [$patterns] unless ref $patterns eq 'ARRAY';
    $patterns = [ grep { !/^#/ } @$patterns ];

    # Escaped comments and trailing spaces
    for my $pattern (@$patterns) {
        $pattern =~ s{(?!\\)\s+$}{};
        $pattern =~ s{^\\#}{#};
    }

    # Empty lines
    $patterns = [ grep { length $_ } @$patterns ];

    my $build_pattern = sub {
        my ($pattern) = @_;

        $pattern = quotemeta $pattern;

        $pattern =~ s{\\\*\\\*\\/}{.*}g;
        $pattern =~ s{\\\*\\\*}{.*}g;
        $pattern =~ s{\\\*}{[^/]*}g;
        $pattern =~ s{\\\?}{[^/]}g;
        $pattern =~ s{^\\\/}{^};
        $pattern =~ s{\\\[(.*?)\\\]}{
            '[' . do { my $c = $1; $c =~ s{^\\!}{} ? '^' : '' }
              . do { my $c = $1; $c =~ s/\\\-/\-/; $c }
              . ']'
        }eg;

        $pattern .= '$' unless $pattern =~ m{\/$};

        return $pattern;
    };

    my @patterns_re;
    foreach my $pattern (@$patterns) {
        if ( $pattern =~ m/^!/ ) {
            my $re = $build_pattern->(substr $pattern, 1);

            push @patterns_re,
              {
                re       => $re,
                negative => 1
              };
        }
        else {

            # Transform escaped negation to normal path
            $pattern =~ s{^\\!}{!};

            push @patterns_re, { re => $build_pattern->($pattern) };
        }
    }

    my @negatives = grep { /^!/ } @$patterns;

    return sub {
        my $path = shift;

        my $match = 0;

        foreach my $pattern (@patterns_re) {
            my $re = $pattern->{re};

            next if $match && !$pattern->{negative};

            if ( $pattern->{negative} ) {
                if ( $path =~ m/$re/ ) {
                    $match = 0;
                }
            }
            else {
                $match = !!( $path =~ m/$re/ );

                if ( $match && !@negatives ) {
                    return $match;
                }
            }
        }

        return $match;
    };
}

1;
__END__