File Coverage

blib/lib/File/Codeowners.pm

Criterion	Covered	Total	%
statement	226	275	82.1
branch	95	136	69.8
condition	33	49	67.3
subroutine	33	41	80.4
pod	26	26	100.0
total	413	527	78.3

package File::Codeowners;
# ABSTRACT: Read and write CODEOWNERS files

use v5.10.1;    # defined-or
use warnings;
use strict;

use Encode qw(encode);
use Path::Tiny 0.089;
use Scalar::Util qw(openhandle);
use Text::Gitignore qw(build_gitignore_matcher);

our $VERSION = '0.55'; # VERSION

my $RE_PATTERN  = qr/.+?(?
my $RE_OWNER    = qr/(?:\@+"[^"]*")|(?:\H+)/;

sub _croak { require Carp; Carp::croak(@_); }
sub _usage { _croak("Usage: @_\n") }


sub new {
    my $class = shift;
    my $self  = bless {}, $class;
}


sub parse {
    my $self  = shift;
    my $input = shift or _usage(q{$codeowners->parse($input)});

    return $self->parse_from_array($input, @_)  if ref($input) eq 'ARRAY';
    return $self->parse_from_string($input, @_) if ref($input) eq 'SCALAR';
    return $self->parse_from_fh($input, @_)     if openhandle($input);
    return $self->parse_from_filepath($input, @_);
}


sub parse_from_filepath {
    my $self = shift;
    my $path = shift or _usage(q{$codeowners->parse_from_filepath($filepath)});

    $self = bless({}, $self) if !ref($self);

    return $self->parse_from_fh(path($path)->openr_utf8, @_);
}


sub parse_from_fh {
    my $self = shift;
    my $fh   = shift or _usage(q{$codeowners->parse_from_fh($fh)});
    my %opts = @_;

    $self = bless({}, $self) if !ref($self);

    my @lines;

    my $parse_unowned;
    my %unowned;
    my %aliases;
    my $current_project;

    while (my $line = <$fh>) {
        my $lineno = $. - 1;
        chomp $line;
        if ($line eq '### UNOWNED (File::Codeowners)') {
            $parse_unowned++;
            last;
        }
        elsif ($line =~ /^\h*#(.*)/) {
            my $comment = $1;
            my $project;
            if ($comment =~ /^\h*Project:\h*(.+?)\h*$/i) {
                $project = $current_project = $1 || undef;
            }
            $lines[$lineno] = {
                comment => $comment,
                $project ? (project => $project) : (),
            };
        }
        elsif ($line =~ /^\h*$/) {
            # blank line
        }
        elsif ($opts{aliases} && $line =~ /^\h*\@($RE_OWNER)\h+(.+)/) {
            my $alias   = $1;
            my @owners  = $2 =~ /($RE_OWNER)/g;
            $aliases{$alias} = \@owners;
            $lines[$lineno] = {
                alias   => $alias,
                owners  => \@owners,
            };
        }
        elsif ($line =~ /^\h*($RE_PATTERN)\h+(.+)/) {
            my $pattern = $1;
            my @owners  = $2 =~ /($RE_OWNER)/g;
            $lines[$lineno] = {
                pattern => $pattern,
                owners  => \@owners,
                $current_project ? (project => $current_project) : (),
            };
        }
        else {
            die "Parse error on line $.: $line\n";
        }
    }

    if ($parse_unowned) {
        while (my $line = <$fh>) {
            chomp $line;
            if ($line =~ /# (.+)/) {
                my $filepath = $1;
                $unowned{$filepath}++;
            }
        }
    }

    $self->{lines} = \@lines;
    $self->{unowned} = \%unowned;
    $self->{aliases} = \%aliases;

    return $self;
}


sub parse_from_array {
    my $self = shift;
    my $arr  = shift or _usage(q{$codeowners->parse_from_array(\@lines)});

    $self = bless({}, $self) if !ref($self);

    my $str = join("\n", @$arr);
    return $self->parse_from_string(\$str, @_);
}


sub parse_from_string {
    my $self = shift;
    my $str  = shift or _usage(q{$codeowners->parse_from_string(\$string)});

    $self = bless({}, $self) if !ref($self);

    my $ref = ref($str) eq 'SCALAR' ? $str : \$str;
    open(my $fh, '<:encoding(UTF-8)', $ref) or die "open failed: $!";

    return $self->parse_from_fh($fh, @_);
}


sub write_to_filepath {
    my $self = shift;
    my $path = shift or _usage(q{$codeowners->write_to_filepath($filepath)});

    path($path)->spew_utf8([map { "$_\n" } @{$self->write_to_array}]);
}


sub write_to_fh {
    my $self    = shift;
    my $fh      = shift or _usage(q{$codeowners->write_to_fh($fh)});
    my $charset = shift;

    for my $line (@{$self->write_to_array($charset)}) {
        print $fh "$line\n";
    }
}


sub write_to_string {
    my $self    = shift;
    my $charset = shift;

    my $str = join("\n", @{$self->write_to_array($charset)}) . "\n";
    return \$str;
}


sub write_to_array {
    my $self    = shift;
    my $charset = shift;

    my @format;

    for my $line (@{$self->_lines}) {
        if (my $comment = $line->{comment}) {
            push @format, "#$comment";
        }
        elsif (my $pattern = $line->{pattern}) {
            my $owners = join(' ', @{$line->{owners}});
            push @format, "$pattern  $owners";
        }
        elsif (my $alias = $line->{alias}) {
            my $owners = join(' ', @{$line->{owners}});
            push @format, "\@$alias  $owners";
        }
        else {
            push @format, '';
        }
    }

    my @unowned = sort keys %{$self->_unowned};
    if (@unowned) {
        push @format, '' if $format[-1];
        push @format, '### UNOWNED (File::Codeowners)';
        for my $unowned (@unowned) {
            push @format, "# $unowned";
        }
    }

    if (defined $charset) {
        $_ = encode($charset, $_) for @format;
    }
    return \@format;
}


sub match {
    my $self     = shift;
    my $filepath = shift or _usage(q{$codeowners->match($filepath)});
    my %opts     = @_;

    my $expand = $opts{expand} ? do {
        my $aliases = $self->aliases;
        sub {
            my $owner = shift;
            my $alias = $aliases->{$owner};
            return @$alias if $alias;
            return $owner;
        };
    } : sub { shift };  # noop

    my $lines = $self->{match_lines} ||= [reverse grep { ($_ || {})->{pattern} } @{$self->_lines}];

    for my $line (@$lines) {
        my $matcher = $line->{matcher} ||= build_gitignore_matcher([$line->{pattern}]);
        return {    # deep copy
            pattern => $line->{pattern},
            owners  => [map { $expand->($_) } @{$line->{owners} || []}],
            $line->{project} ? (project => $line->{project}) : (),
        } if $matcher->($filepath);
    }

    return undef;   ## no critic (Subroutines::ProhibitExplicitReturn)
}


sub owners {
    my $self    = shift;
    my $pattern = shift;

    return $self->{owners} if !$pattern && $self->{owners};

    my %owners;
    for my $line (@{$self->_lines}) {
        next if $pattern && $line->{pattern} && $pattern ne $line->{pattern};
        $owners{$_}++ for (@{$line->{owners} || []});
    }

    my $owners = [sort keys %owners];
    $self->{owners} = $owners if !$pattern;

    return $owners;
}


sub patterns {
    my $self  = shift;
    my $owner = shift;

    return $self->{patterns} if !$owner && $self->{patterns};

    my %patterns;
    for my $line (@{$self->_lines}) {
        next if $owner && !grep { $_ eq $owner  } @{$line->{owners} || []};
        my $pattern = $line->{pattern};
        $patterns{$pattern}++ if $pattern;
    }

    my $patterns = [sort keys %patterns];
    $self->{patterns} = $patterns if !$owner;

    return $patterns;
}


sub aliases {
    my $self = shift;

    return $self->{aliases} if $self->{aliases};

    my %aliases;
    for my $line (@{$self->_lines}) {
        next if !defined $line->{alias};
        $aliases{$line->{alias}} = [@{$line->{owners}}];
    }

    return $self->{aliases} = \%aliases;
}


sub projects {
    my $self  = shift;

    return $self->{projects} if $self->{projects};

    my %projects;
    for my $line (@{$self->_lines}) {
        my $project = $line->{project};
        $projects{$project}++ if $project;
    }

    my $projects = [sort keys %projects];
    $self->{projects} = $projects;

    return $projects;
}


sub update_owners {
    my $self    = shift;
    my $pattern = shift;
    my $owners  = shift;
    $pattern && $owners or _usage(q{$codeowners->update_owners($pattern => \@owners)});

    $owners = [$owners] if ref($owners) ne 'ARRAY';

    $self->_clear;

    my $count = 0;

    for my $line (@{$self->_lines}) {
        next if !$line->{pattern};
        next if $pattern ne $line->{pattern};
        $line->{owners} = [@$owners];
        ++$count;
    }

    return $count;
}


sub update_owners_by_project {
    my $self    = shift;
    my $project = shift;
    my $owners  = shift;
    $project && $owners or _usage(q{$codeowners->update_owners_by_project($project => \@owners)});

    $owners = [$owners] if ref($owners) ne 'ARRAY';

    $self->_clear;

    my $count = 0;

    for my $line (@{$self->_lines}) {
        next if !$line->{project} || !$line->{owners};
        next if $project ne $line->{project};
        $line->{owners} = [@$owners];
        ++$count;
    }

    return $count;
}


sub rename_owner {
    my $self        = shift;
    my $old_owner   = shift;
    my $new_owner   = shift;
    $old_owner && $new_owner or _usage(q{$codeowners->rename_owner($owner => $new_owner)});

    $self->_clear;

    my $count = 0;

    for my $line (@{$self->_lines}) {
        next if !exists $line->{owners};
        for (my $i = 0; $i < @{$line->{owners}}; ++$i) {
            next if $line->{owners}[$i] ne $old_owner;
            $line->{owners}[$i] = $new_owner;
            ++$count;
        }
    }

    return $count;
}


sub rename_project {
    my $self        = shift;
    my $old_project = shift;
    my $new_project = shift;
    $old_project && $new_project or _usage(q{$codeowners->rename_project($project => $new_project)});

    $self->_clear;

    my $count = 0;

    for my $line (@{$self->_lines}) {
        next if !exists $line->{project} || $old_project ne $line->{project};
        $line->{project} = $new_project;
        $line->{comment} = " Project: $new_project" if exists $line->{comment};
        ++$count;
    }

    return $count;
}


sub append {
    my $self = shift;
    $self->_clear;
    push @{$self->_lines}, (@_ ? {@_} : undef);
}


sub prepend {
    my $self = shift;
    $self->_clear;
    unshift @{$self->_lines}, (@_ ? {@_} : undef);
}


sub unowned {
    my $self = shift;
    [sort keys %{$self->{unowned} || {}}];
}


sub add_unowned {
    my $self = shift;
    $self->_unowned->{$_}++ for @_;
}


sub remove_unowned {
    my $self = shift;
    delete $self->_unowned->{$_} for @_;
}



sub is_unowned {
    my $self     = shift;
    my $filepath = shift;
    $self->_unowned->{$filepath};
}


sub clear_unowned {
    my $self = shift;
    $self->{unowned} = {};
}

sub _lines   { shift->{lines}   ||= [] }
sub _unowned { shift->{unowned} ||= {} }

sub _clear {
    my $self = shift;
    delete $self->{match_lines};
    delete $self->{owners};
    delete $self->{patterns};
    delete $self->{aliases};
    delete $self->{projects};
}


1;

__END__