-This software is copyright (c) 2019 by Charles McGarvey.
+This software is copyright (c) 2021 by Charles McGarvey.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2019 by Charles McGarvey.
+This software is Copyright (c) 2021 by Charles McGarvey.
This is free software, licensed under:
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2019 by Charles McGarvey.
+This software is Copyright (c) 2021 by Charles McGarvey.
This is free software, licensed under:
main_module = bin/git-codeowners
author = Charles McGarvey <chazmcgarvey@brokenzipper.com>
copyright_holder = Charles McGarvey
-copyright_year = 2019
+copyright_year = 2021
license = Perl_5
[@Filter]
-bundle = @Author::CCM
--remove = PodCoverageTests
-remove = Test::CleanNamespaces
max_target_perl = 5.10.1
PruneFiles.filename = maint
our $VERSION = '9999.999'; # VERSION
-sub pod2usage {
+sub _pod2usage {
eval { require Pod::Usage };
if ($@) {
my $ref = $VERSION eq '9999.999' ? 'master' : "v$VERSION";
}
}
-sub early_options {
+sub _early_options {
return {
'color|colour!' => (-t STDOUT ? 1 : 0), ## no critic (InputOutput::ProhibitInteractiveTest)
'format|f=s' => undef,
};
}
-sub command_options {
+sub _command_options {
return {
'create' => {},
'owners' => {
};
}
-sub commands {
+sub _commands {
my $self = shift;
- my @commands = sort keys %{$self->command_options};
+ my @commands = sort keys %{$self->_command_options};
return @commands;
}
-sub options {
+sub _options {
my $self = shift;
my @command_options;
if (my $command = $self->{command}) {
- @command_options = keys %{$self->command_options->{$command} || {}};
+ @command_options = keys %{$self->_command_options->{$command} || {}};
}
- return (keys %{$self->early_options}, @command_options);
+ return (keys %{$self->_early_options}, @command_options);
}
+=method new
+
+ $options = App::Codeowners::Options->new(@ARGV);
+
+Construct a new object.
+
+=cut
+
sub new {
my $class = shift;
my @args = @_;
my $opts = $self->get_options(
args => \@args,
- spec => $self->early_options,
+ spec => $self->_early_options,
config => 'pass_through',
- ) or pod2usage(2);
+ ) or _pod2usage(2);
if ($ENV{CODEOWNERS_COMPLETIONS}) {
$self->{command} = $args[0] || '';
exit 0;
}
if ($opts->{help}) {
- pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS COMMANDS)]);
+ _pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS COMMANDS)]);
}
if ($opts->{manual}) {
- pod2usage(-exitval => 0, -verbose => 2);
+ _pod2usage(-exitval => 0, -verbose => 2);
}
if (defined $opts->{shell_completion}) {
$self->shell_completion($opts->{shell_completion});
# figure out the command (or default to "show")
my $command = shift @args;
- my $command_options = $self->command_options->{$command || ''};
+ my $command_options = $self->_command_options->{$command || ''};
if (!$command_options) {
unshift @args, $command if defined $command;
$command = 'show';
- $command_options = $self->command_options->{$command};
+ $command_options = $self->_command_options->{$command};
}
my $more_opts = $self->get_options(
args => \@args,
spec => $command_options,
- ) or pod2usage(2);
+ ) or _pod2usage(2);
%$self = (%$opts, %$more_opts, command => $command, args => \@args);
return $self;
}
+=method command
+
+ $str = $options->command;
+
+Get the command specified by args provided when the object was created.
+
+=cut
+
sub command {
my $self = shift;
my $command = $self->{command};
- my @commands = sort keys %{$self->command_options};
+ my @commands = sort keys %{$self->_command_options};
return if not grep { $_ eq $command } @commands;
$command =~ s/[^a-z]/_/g;
return $command;
}
+=method args
+
+ $args = $options->args;
+
+Get the args provided when the object was created.
+
+=cut
+
sub args {
my $self = shift;
return @{$self->{args} || []};
}
else {
if (!$self->command) {
- $reply = [$self->commands, @{$self->_completion_options([keys %{$self->early_options}])}];
+ $reply = [$self->_commands, @{$self->_completion_options([keys %{$self->_early_options}])}];
}
else {
print 'file';
sub _completion_options {
my $self = shift;
- my $opts = shift || [$self->options];
+ my $opts = shift || [$self->_options];
my @options;
use warnings;
use strict;
-use Encode qw(decode);
use Exporter qw(import);
+use File::Codeowners::Util;
use Path::Tiny;
our @EXPORT_OK = qw(
=func find_nearest_codeowners
- $filepath = find_nearest_codeowners($dirpath);
+Deprecated.
-Find the F<CODEOWNERS> file in the current working directory, or search in the
-parent directory recursively until a F<CODEOWNERS> file is found.
+Use L<File::Codeowners::Util/find_nearest_codeowners> instead.
-Returns C<undef> if no F<CODEOWNERS> is found.
+=cut
+
+sub find_nearest_codeowners { goto &File::Codeowners::Util::find_nearest_codeowners }
+
+=func find_codeowners_in_directory
+
+Deprecated.
+
+Use L<File::Codeowners::Util/find_codeowners_in_directory> instead.
=cut
-sub find_nearest_codeowners {
- my $path = path(shift || '.')->absolute;
+sub find_codeowners_in_directory { goto &File::Codeowners::Util::find_codeowners_in_directory }
- while (!$path->is_rootdir) {
- my $filepath = find_codeowners_in_directory($path);
- return $filepath if $filepath;
- $path = $path->parent;
- }
-}
+=func run_command
-=func find_codeowners_in_directory
+Deprecated.
+
+Use L<File::Codeowners::Util/run_command> instead.
+
+=cut
- $filepath = find_codeowners_in_directory($dirpath);
+sub run_command { goto &File::Codeowners::Util::run_command }
-Find the F<CODEOWNERS> file in a given directory. No recursive searching is done.
+=func run_git
-Returns the first of (or undef if none found):
+Deprecated.
-=for :list
-* F<CODEOWNERS>
-* F<docs/CODEOWNERS>
-* F<.bitbucket/CODEOWNERS>
-* F<.github/CODEOWNERS>
-* F<.gitlab/CODEOWNERS>
+Use L<File::Codeowners::Util/run_git> instead.
=cut
-sub find_codeowners_in_directory {
- my $path = path(shift) or die;
+sub run_git { goto &File::Codeowners::Util::run_git }
- my @tries = (
- [qw(CODEOWNERS)],
- [qw(docs CODEOWNERS)],
- [qw(.bitbucket CODEOWNERS)],
- [qw(.github CODEOWNERS)],
- [qw(.gitlab CODEOWNERS)],
- );
+=func git_ls_files
- for my $parts (@tries) {
- my $try = $path->child(@$parts);
- return $try if $try->is_file;
- }
-}
+Deprecated.
-sub run_command {
- my $filter;
- $filter = pop if ref($_[-1]) eq 'CODE';
+Use L<File::Codeowners::Util/git_ls_files> instead.
- print STDERR "# @_\n" if $ENV{GIT_CODEOWNERS_DEBUG};
+=cut
- my ($child_in, $child_out);
- require IPC::Open2;
- my $pid = IPC::Open2::open2($child_out, $child_in, @_);
- close($child_in);
+sub git_ls_files { goto &File::Codeowners::Util::git_ls_files }
- binmode($child_out, ':encoding(UTF-8)');
+=func git_toplevel
- my $proc = App::Codeowners::Util::Process->new(
- pid => $pid,
- fh => $child_out,
- filter => $filter,
- );
+Deprecated.
- return wantarray ? ($proc, @{$proc->all}) : $proc;
-}
+Use L<File::Codeowners::Util/git_toplevel> instead.
-sub run_git {
- return run_command('git', @_);
-}
+=cut
-sub git_ls_files {
- my $dir = shift || '.';
- return run_git('-C', $dir, 'ls-files', @_, \&_unescape_git_filepath);
-}
+sub git_toplevel { goto &File::Codeowners::Util::git_toplevel }
-# Depending on git's "core.quotepath" config, non-ASCII chars may be
-# escaped (identified by surrounding dquotes), so try to unescape.
-sub _unescape_git_filepath {
- return $_ if $_ !~ /^"(.+)"$/;
- return decode('UTF-8', unbackslash($1));
-}
+=func colorstrip
-sub git_toplevel {
- my $dir = shift || '.';
+ $str = colorstrip($str);
- my ($proc, $path) = run_git('-C', $dir, qw{rev-parse --show-toplevel});
+Strip ANSI color control commands.
- return if $proc->wait != 0 || !$path;
- return path($path);
-}
+=cut
sub colorstrip {
my $str = shift || '';
return $str;
}
+=func stringify
+
+ $str = stringify($scalar);
+ $str = stringify(\@array);
+
+Get a useful string representation of a scallar or arrayref.
+
+=cut
+
sub stringify {
my $item = shift;
return ref($item) eq 'ARRAY' ? join(',', @$item) : $item;
}
-# The zip code is from List::SomeUtils (thanks DROLSKY), copied just so as not
-# to bring in the extra dependency.
-sub zip (\@\@) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
- my $max = -1;
- $max < $#$_ && ( $max = $#$_ ) foreach @_;
- map {
- my $ix = $_;
- map $_->[$ix], @_;
- } 0 .. $max;
-}
+=func stringf
+
+TODO
+
+=cut
# The stringf code is from String::Format (thanks SREZIC), with changes:
# - Use Unicode::GCString for better Unicode character padding,
return $format;
}
+=func unbackslash
+
+Deprecated.
+
+Use L<File::Codeowners::Util/unbackslash> instead.
+
+=cut
+
# The unbacklash code is from String::Escape (thanks EVO), with changes:
# - Handle \a, \b, \f and \v (thanks Berk Akinci)
my %unbackslash;
return $str;
}
-{
- package App::Codeowners::Util::Process;
+=func zip
- sub new {
- my $class = shift;
- return bless {@_}, $class;
- }
+Same as L<List::SomeUtils/zip-ARRAY1-ARRAY2-[-ARRAY3-...-]>.
- sub next {
- my $self = shift;
- my $line = readline($self->{fh});
- if (defined $line) {
- chomp $line;
- if (my $filter = $self->{filter}) {
- local $_ = $line;
- $line = $filter->($line);
- }
- }
- $line;
- }
-
- sub all {
- my $self = shift;
- chomp(my @lines = readline($self->{fh}));
- if (my $filter = $self->{filter}) {
- $_ = $filter->($_) for @lines;
- }
- \@lines;
- }
-
- sub wait {
- my $self = shift;
- my $pid = $self->{pid} or return;
- if (my $fh = $self->{fh}) {
- close($fh);
- delete $self->{fh};
- }
- waitpid($pid, 0);
- my $status = $?;
- print STDERR "# -> status $status\n" if $ENV{GIT_CODEOWNERS_DEBUG};
- delete $self->{pid};
- return $status;
- }
+=cut
- sub DESTROY {
- my ($self, $global_destruction) = @_;
- return if $global_destruction;
- $self->wait;
- }
+# The zip code is from List::SomeUtils (thanks DROLSKY), copied just so as not
+# to bring in the extra dependency.
+sub zip (\@\@) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
+ my $max = -1;
+ $max < $#$_ && ( $max = $#$_ ) foreach @_;
+ map {
+ my $ix = $_;
+ map $_->[$ix], @_;
+ } 0 .. $max;
}
1;
+++ /dev/null
-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 = '9999.999'; # VERSION
-
-sub _croak { require Carp; Carp::croak(@_); }
-sub _usage { _croak("Usage: @_\n") }
-
-=method new
-
- $codeowners = File::Codeowners->new;
-
-Construct a new L<File::Codeowners>.
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = bless {}, $class;
-}
-
-=method parse
-
- $codeowners = File::Codeowners->parse('path/to/CODEOWNERS');
- $codeowners = File::Codeowners->parse($filehandle);
- $codeowners = File::Codeowners->parse(\@lines);
- $codeowners = File::Codeowners->parse(\$string);
-
-Parse a F<CODEOWNERS> file.
-
-This is a shortcut for the C<parse_from_*> methods.
-
-=cut
-
-sub parse {
- my $self = shift;
- my $input = shift or _usage(q{$codeowners->parse($input)});
-
- return $self->parse_from_array($input, @_) if @_;
- 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);
-}
-
-=method parse_from_filepath
-
- $codeowners = File::Codeowners->parse_from_filepath('path/to/CODEOWNERS');
-
-Parse a F<CODEOWNERS> file from the filesystem.
-
-=cut
-
-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);
-}
-
-=method parse_from_fh
-
- $codeowners = File::Codeowners->parse_from_fh($filehandle);
-
-Parse a F<CODEOWNERS> file from an open filehandle.
-
-=cut
-
-sub parse_from_fh {
- my $self = shift;
- my $fh = shift or _usage(q{$codeowners->parse_from_fh($fh)});
-
- $self = bless({}, $self) if !ref($self);
-
- my @lines;
-
- my $parse_unowned;
- my %unowned;
- 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 ($line =~ /^\h*(.+?)(?<!\\)\h+(.+)/) {
- my $pattern = $1;
- my @owners = $2 =~ /( (?:\@+"[^"]*") | (?:\H+) )/gx;
- $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;
-
- return $self;
-}
-
-=method parse_from_array
-
- $codeowners = File::Codeowners->parse_from_array(\@lines);
-
-Parse a F<CODEOWNERS> file stored as lines in an array.
-
-=cut
-
-sub parse_from_array {
- my $self = shift;
- my $arr = shift or _usage(q{$codeowners->parse_from_array(\@lines)});
-
- $self = bless({}, $self) if !ref($self);
-
- $arr = [$arr, @_] if @_;
- my $str = join("\n", @$arr);
- return $self->parse_from_string(\$str);
-}
-
-=method parse_from_string
-
- $codeowners = File::Codeowners->parse_from_string(\$string);
- $codeowners = File::Codeowners->parse_from_string($string);
-
-Parse a F<CODEOWNERS> file stored as a string. String should be UTF-8 encoded.
-
-=cut
-
-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);
-}
-
-=method write_to_filepath
-
- $codeowners->write_to_filepath($filepath);
-
-Write the contents of the file to the filesystem atomically.
-
-=cut
-
-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}]);
-}
-
-=method write_to_fh
-
- $codeowners->write_to_fh($fh);
-
-Format the file contents and write to a filehandle.
-
-=cut
-
-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";
- }
-}
-
-=method write_to_string
-
- $scalarref = $codeowners->write_to_string;
-
-Format the file contents and return a reference to a formatted string.
-
-=cut
-
-sub write_to_string {
- my $self = shift;
- my $charset = shift;
-
- my $str = join("\n", @{$self->write_to_array($charset)}) . "\n";
- return \$str;
-}
-
-=method write_to_array
-
- $lines = $codeowners->write_to_array;
-
-Format the file contents as an arrayref of lines.
-
-=cut
-
-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";
- }
- 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;
-}
-
-=method match
-
- $owners = $codeowners->match($filepath);
-
-Match the given filepath against the available patterns and return just the
-owners for the matching pattern. Patterns are checked in the reverse order
-they were defined in the file.
-
-Returns C<undef> if no patterns match.
-
-=cut
-
-sub match {
- my $self = shift;
- my $filepath = shift or _usage(q{$codeowners->match($filepath)});
-
- 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 => [@{$line->{owners} || []}],
- $line->{project} ? (project => $line->{project}) : (),
- } if $matcher->($filepath);
- }
-
- return undef; ## no critic (Subroutines::ProhibitExplicitReturn)
-}
-
-=method owners
-
- $owners = $codeowners->owners; # get all defined owners
- $owners = $codeowners->owners($pattern);
-
-Get an arrayref of owners defined in the file. If a pattern argument is given,
-only owners for the given pattern are returned (or empty arrayref if the
-pattern does not exist). If no argument is given, simply returns all owners
-defined in the file.
-
-=cut
-
-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;
-}
-
-=method patterns
-
- $patterns = $codeowners->patterns;
- $patterns = $codeowners->patterns($owner);
-
-Get an arrayref of all patterns defined.
-
-=cut
-
-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;
-}
-
-=method projects
-
- $projects = $codeowners->projects;
-
-Get an arrayref of all projects defined.
-
-=cut
-
-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;
-}
-
-=method update_owners
-
- $codeowners->update_owners($pattern => \@new_owners);
-
-Set a new set of owners for a given pattern. If for some reason the file has
-multiple such patterns, they will all be updated.
-
-Nothing happens if the file does not already have at least one such pattern.
-
-=cut
-
-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;
-}
-
-=method update_owners_by_project
-
- $codeowners->update_owners_by_project($project => \@new_owners);
-
-Set a new set of owners for all patterns under the given project.
-
-Nothing happens if the file does not have a project with the given name.
-
-=cut
-
-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;
-}
-
-=method rename_owner
-
- $codeowners->rename_owner($old_name => $new_name);
-
-Rename an owner.
-
-Nothing happens if the file does not have an owner with the old name.
-
-=cut
-
-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;
-}
-
-=method rename_project
-
- $codeowners->rename_project($old_name => $new_name);
-
-Rename a project.
-
-Nothing happens if the file does not have a project with the old name.
-
-=cut
-
-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;
-}
-
-=method append
-
- $codeowners->append(comment => $str);
- $codeowners->append(pattern => $pattern, owners => \@owners);
- $codeowners->append(); # blank line
-
-Append a new line.
-
-=cut
-
-sub append {
- my $self = shift;
- $self->_clear;
- push @{$self->_lines}, (@_ ? {@_} : undef);
-}
-
-=method prepend
-
- $codeowners->prepend(comment => $str);
- $codeowners->prepend(pattern => $pattern, owners => \@owners);
- $codeowners->prepend(); # blank line
-
-Prepend a new line.
-
-=cut
-
-sub prepend {
- my $self = shift;
- $self->_clear;
- unshift @{$self->_lines}, (@_ ? {@_} : undef);
-}
-
-=method unowned
-
- $filepaths = $codeowners->unowned;
-
-Get the list of filepaths in the "unowned" section.
-
-This parser supports an "extension" to the F<CODEOWNERS> file format which
-lists unowned files at the end of the file. This list can be useful to have in
-order to figure out what files we know are unowned versus what files we don't
-know are unowned.
-
-=cut
-
-sub unowned {
- my $self = shift;
- [sort keys %{$self->{unowned} || {}}];
-}
-
-=method add_unowned
-
- $codeowners->add_unowned($filepath, ...);
-
-Add one or more filepaths to the "unowned" list.
-
-This method does not check to make sure the filepath(s) actually do not match
-any patterns in the file, so you might want to call L</match> first.
-
-See L</unowned> for an explanation.
-
-=cut
-
-sub add_unowned {
- my $self = shift;
- $self->_unowned->{$_}++ for @_;
-}
-
-=method remove_unowned
-
- $codeowners->remove_unowned($filepath, ...);
-
-Remove one or more filepaths from the "unowned" list.
-
-Silently ignores filepaths that are already not listed.
-
-See L</unowned> for an explanation.
-
-=cut
-
-sub remove_unowned {
- my $self = shift;
- delete $self->_unowned->{$_} for @_;
-}
-
-sub is_unowned {
- my $self = shift;
- my $filepath = shift;
- $self->_unowned->{$filepath};
-}
-
-=method clear_unowned
-
- $codeowners->clear_unowned;
-
-Remove all filepaths from the "unowned" list.
-
-See L</unowned> for an explanation.
-
-=cut
-
-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->{projects};
-}
-
-1;
+++ /dev/null
-package Test::File::Codeowners;
-# ABSTRACT: Write tests for CODEOWNERS files
-
-=head1 SYNOPSIS
-
- use Test::More;
-
- eval 'use Test::File::Codeowners';
- plan skip_all => 'Test::File::Codeowners required for testing CODEOWNERS' if $@;
-
- codeowners_syntax_ok();
- done_testing;
-
-=head1 DESCRIPTION
-
-This package has assertion subroutines for testing F<CODEOWNERS> files.
-
-=cut
-
-use warnings;
-use strict;
-
-use App::Codeowners::Util qw(find_nearest_codeowners git_ls_files git_toplevel);
-use Encode qw(encode);
-use File::Codeowners;
-use Test::Builder;
-
-our $VERSION = '9999.999'; # VERSION
-
-my $Test = Test::Builder->new;
-
-sub import {
- my $self = shift;
- my $caller = caller;
- no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
- *{$caller.'::codeowners_syntax_ok'} = \&codeowners_syntax_ok;
- *{$caller.'::codeowners_git_files_ok'} = \&codeowners_git_files_ok;
-
- $Test->exported_to($caller);
- $Test->plan(@_);
-}
-
-=func codeowners_syntax_ok
-
- codeowners_syntax_ok(); # search up the tree for a CODEOWNERS file
- codeowners_syntax_ok($filepath);
-
-Check the syntax of a F<CODEOWNERS> file.
-
-=cut
-
-sub codeowners_syntax_ok {
- my $filepath = shift || find_nearest_codeowners();
-
- eval { File::Codeowners->parse($filepath) };
- my $err = $@;
-
- $Test->ok(!$err, "Check syntax: $filepath");
- $Test->diag($err) if $err;
-}
-
-=func codeowners_git_files_ok
-
- codeowners_git_files_ok(); # search up the tree for a CODEOWNERS file
- codeowners_git_files_ok($filepath);
-
-=cut
-
-sub codeowners_git_files_ok {
- my $filepath = shift || find_nearest_codeowners();
-
- $Test->subtest('codeowners_git_files_ok' => sub {
- my $codeowners = eval { File::Codeowners->parse($filepath) };
- if (my $err = $@) {
- $Test->plan(tests => 1);
- $Test->ok(0, "Parse $filepath");
- $Test->diag($err);
- return;
- }
-
- my ($proc, @files) = git_ls_files(git_toplevel());
-
- $Test->plan($proc->wait == 0 ? (tests => scalar @files) : (skip_all => 'git ls-files failed'));
-
- for my $filepath (@files) {
- my $msg = encode('UTF-8', "Check file: $filepath");
-
- my $match = $codeowners->match($filepath);
- my $is_unowned = $codeowners->is_unowned($filepath);
-
- if (!$match && !$is_unowned) {
- $Test->ok(0, $msg);
- $Test->diag("File is unowned\n");
- }
- elsif ($match && $is_unowned) {
- $Test->ok(0, $msg);
- $Test->diag("File is owned but listed as unowned\n");
- }
- else {
- $Test->ok(1, $msg);
- }
- }
- });
-}
-
-1;
+++ /dev/null
-#!/usr/bin/env perl
-
-use warnings;
-use strict;
-
-use FindBin '$Bin';
-
-use File::Codeowners;
-use Test::More;
-
-subtest 'parse CODEOWNERS files', sub {
- my @basic_arr = ('#wat', '* @whatever');
- my $basic_str = "#wat\n* \@whatever\n";
- my $expected = [
- {comment => 'wat'},
- {pattern => '*', owners => ['@whatever']},
- ];
- my $r;
-
- my $file = File::Codeowners->parse_from_filepath("$Bin/samples/basic.CODEOWNERS");
- is_deeply($r = $file->_lines, $expected, 'parse from filepath') or diag explain $r;
-
- $file = File::Codeowners->parse_from_array(\@basic_arr);
- is_deeply($r = $file->_lines, $expected, 'parse from array') or diag explain $r;
-
- $file = File::Codeowners->parse_from_string(\$basic_str);
- is_deeply($r = $file->_lines, $expected, 'parse from string') or diag explain $r;
-
- open(my $fh, '<', \$basic_str) or die "open failed: $!";
- $file = File::Codeowners->parse_from_fh($fh);
- is_deeply($r = $file->_lines, $expected, 'parse from filehandle') or diag explain $r;
- close($fh);
-};
-
-subtest 'query information from CODEOWNERS', sub {
- my $file = File::Codeowners->parse("$Bin/samples/kitchensink.CODEOWNERS");
- my $r;
-
- is_deeply($r = $file->owners, [
- '@"Lucius Fox"',
- '@bane',
- '@batman',
- '@joker',
- '@robin',
- '@the-penguin',
- 'alfred@waynecorp.example.com',
- ], 'list all owners') or diag explain $r;
-
- is_deeply($r = $file->owners('tricks/Grinning/'), [qw(
- @joker
- @the-penguin
- )], 'list owners matching pattern') or diag explain $r;
-
- is_deeply($r = $file->patterns, [qw(
- *
- /a/b/c/deep
- /vehicles/**/batmobile.cad
- mansion.txt
- tricks/Explosions.doc
- tricks/Grinning/
- )], 'list all patterns') or diag explain $r;
-
- is_deeply($r = $file->patterns('@joker'), [qw(
- tricks/Explosions.doc
- tricks/Grinning/
- )], 'list patterns matching owner') or diag explain $r;
-
- is_deeply($r = $file->unowned, [qw(
- lightcycle.cad
- )], 'list unowned') or diag explain $r;
-
- is_deeply($r = $file->match('whatever'), {
- owners => [qw(@batman @robin)],
- pattern => '*',
- }, 'match solitary wildcard') or diag explain $r;
- is_deeply($r = $file->match('subdir/mansion.txt'), {
- owners => ['alfred@waynecorp.example.com'],
- pattern => 'mansion.txt',
- }, 'match filename') or diag explain $r;
- is_deeply($r = $file->match('vehicles/batmobile.cad'), {
- owners => ['@"Lucius Fox"'],
- pattern => '/vehicles/**/batmobile.cad',
- project => 'Transportation',
- }, 'match double asterisk') or diag explain $r;
- is_deeply($r = $file->match('vehicles/extra/batmobile.cad'), {
- owners => ['@"Lucius Fox"'],
- pattern => '/vehicles/**/batmobile.cad',
- project => 'Transportation',
- }, 'match double asterisk again') or diag explain $r;
-};
-
-subtest 'parse errors', sub {
- eval { File::Codeowners->parse(\q{meh}) };
- like($@, qr/^Parse error on line 1/, 'parse error');
-};
-
-subtest 'handling projects', sub {
- my $file = File::Codeowners->parse("$Bin/samples/kitchensink.CODEOWNERS");
- my $r;
-
- is_deeply($r = $file->projects, [
- 'Transportation',
- ], 'projects listed') or diag explain $r;
-
- $file->rename_project('Transportation', 'Getting Around');
- is_deeply($r = $file->projects, [
- 'Getting Around',
- ], 'project renamed') or diag explain $r;
-
- is_deeply($r = [@{$file->_lines}[-3 .. -1]], [
- {comment => ' Project: Getting Around', project => 'Getting Around'},
- {},
- {pattern => '/vehicles/**/batmobile.cad', 'owners' => ['@"Lucius Fox"'], project => 'Getting Around'},
- ], 'renaming project properly modifies lines') or diag explain $r;
-
- $file->update_owners_by_project('Getting Around', '@twoface');
- ok( scalar grep { $_ eq '@twoface' } @{$file->owners}, 'updating owner adds new owner');
- ok(!scalar grep { $_ eq '@"Lucius Fox"' } @{$file->owners}, 'updating owner removes old owner');
-};
-
-subtest 'editing and writing files', sub {
- my $file = File::Codeowners->parse("$Bin/samples/basic.CODEOWNERS");
- my $r;
-
- $file->update_owners('*' => [qw(@foo @bar @baz)]);
- is_deeply($r = $file->_lines, [
- {comment => 'wat'},
- {pattern => '*', owners => [qw(@foo @bar @baz)]},
- ], 'update owners for a pattern') or diag explain $r;
- is_deeply($r = $file->owners, [qw(@bar @baz @foo)], 'got updated owners') or diag explain $r;
-
- $file->update_owners('no/such/pattern' => [qw(@wuf)]);
- is_deeply($r = $file->_lines, [
- {comment => 'wat'},
- {pattern => '*', owners => [qw(@foo @bar @baz)]},
- ], 'no change when updating nonexistent pattern') or diag explain $r;
-
- $file->prepend(comment => 'start');
- $file->append(pattern => 'end', owners => ['@qux']);
- is_deeply($r = $file->_lines, [
- {comment => 'start'},
- {comment => 'wat'},
- {pattern => '*', owners => [qw(@foo @bar @baz)]},
- {pattern => 'end', owners => [qw(@qux)]},
- ], 'prepand and append') or diag explain $r;
-
- $file->add_unowned('lonely', 'afraid');
- is_deeply($r = $file->unowned, [qw(afraid lonely)], 'set unowned files') or diag explain $r;
-
- $file->remove_unowned('afraid');
- is_deeply($r = $file->unowned, [qw(lonely)], 'remove unowned files') or diag explain $r;
-
- is_deeply($r = $file->write_to_array, [
- '#start',
- '#wat',
- '* @foo @bar @baz',
- 'end @qux',
- '',
- '### UNOWNED (File::Codeowners)',
- '# lonely',
- ], 'format file') or diag explain $r;
-
- $file->clear_unowned;
- is_deeply($r = $file->unowned, [], 'clear unowned files') or diag explain $r;
-};
-
-done_testing;
+++ /dev/null
-#wat
-* @whatever
+++ /dev/null
-# This is a comment.
-* @batman @robin
-
-mansion.txt alfred@waynecorp.example.com
-
-tricks/Explosions.doc @joker
-tricks/Grinning/ @joker @the-penguin
-
- # not the hero gotham deserves!
-/a/b/c/deep @bane @the-penguin
-
-# project: Transportation
-
-/vehicles/**/batmobile.cad @"Lucius Fox"
-
-
-### UNOWNED (File::Codeowners)
-# lightcycle.cad
projects / chaz / git-codeowners / commitdiff
