From fd8bad44a70558edb1e643ec6f86cad1650700fa Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Fri, 2 Apr 2021 17:13:10 -0600 Subject: [PATCH] split off File::Codeowners --- LICENSE | 6 +- dist.ini | 3 +- lib/App/Codeowners/Options.pm | 60 ++- lib/App/Codeowners/Util.pm | 200 ++++------ lib/File/Codeowners.pm | 631 ------------------------------- lib/Test/File/Codeowners.pm | 106 ------ t/file-codeowners.t | 167 -------- t/samples/basic.CODEOWNERS | 2 - t/samples/kitchensink.CODEOWNERS | 18 - 9 files changed, 118 insertions(+), 1075 deletions(-) delete mode 100644 lib/File/Codeowners.pm delete mode 100644 lib/Test/File/Codeowners.pm delete mode 100644 t/file-codeowners.t delete mode 100644 t/samples/basic.CODEOWNERS delete mode 100644 t/samples/kitchensink.CODEOWNERS diff --git a/LICENSE b/LICENSE index 2eb2acb..9bd2169 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -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. @@ -12,7 +12,7 @@ b) the "Artistic License" --- 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: @@ -272,7 +272,7 @@ That's all there is to it! --- 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: diff --git a/dist.ini b/dist.ini index 4849184..5606ace 100644 --- a/dist.ini +++ b/dist.ini @@ -3,12 +3,11 @@ name = App-Codeowners main_module = bin/git-codeowners author = Charles McGarvey 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 diff --git a/lib/App/Codeowners/Options.pm b/lib/App/Codeowners/Options.pm index 154b098..80d0a4e 100644 --- a/lib/App/Codeowners/Options.pm +++ b/lib/App/Codeowners/Options.pm @@ -11,7 +11,7 @@ use Path::Tiny; our $VERSION = '9999.999'; # VERSION -sub pod2usage { +sub _pod2usage { eval { require Pod::Usage }; if ($@) { my $ref = $VERSION eq '9999.999' ? 'master' : "v$VERSION"; @@ -32,7 +32,7 @@ END } } -sub early_options { +sub _early_options { return { 'color|colour!' => (-t STDOUT ? 1 : 0), ## no critic (InputOutput::ProhibitInteractiveTest) 'format|f=s' => undef, @@ -43,7 +43,7 @@ sub early_options { }; } -sub command_options { +sub _command_options { return { 'create' => {}, 'owners' => { @@ -64,21 +64,29 @@ sub command_options { }; } -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 = @_; @@ -92,9 +100,9 @@ sub new { 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] || ''; @@ -114,10 +122,10 @@ sub new { 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}); @@ -126,31 +134,47 @@ sub new { # 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} || []}; @@ -285,7 +309,7 @@ sub completions { } 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'; @@ -300,7 +324,7 @@ sub completions { sub _completion_options { my $self = shift; - my $opts = shift || [$self->options]; + my $opts = shift || [$self->_options]; my @options; diff --git a/lib/App/Codeowners/Util.pm b/lib/App/Codeowners/Util.pm index ac613f1..6509cd3 100644 --- a/lib/App/Codeowners/Util.pm +++ b/lib/App/Codeowners/Util.pm @@ -10,8 +10,8 @@ B except in L and related modules. use warnings; use strict; -use Encode qw(decode); use Exporter qw(import); +use File::Codeowners::Util; use Path::Tiny; our @EXPORT_OK = qw( @@ -32,105 +32,71 @@ our $VERSION = '9999.999'; # VERSION =func find_nearest_codeowners - $filepath = find_nearest_codeowners($dirpath); +Deprecated. -Find the F file in the current working directory, or search in the -parent directory recursively until a F file is found. +Use L instead. -Returns C if no F is found. +=cut + +sub find_nearest_codeowners { goto &File::Codeowners::Util::find_nearest_codeowners } + +=func find_codeowners_in_directory + +Deprecated. + +Use L 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 instead. + +=cut - $filepath = find_codeowners_in_directory($dirpath); +sub run_command { goto &File::Codeowners::Util::run_command } -Find the F 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 -* F -* F<.bitbucket/CODEOWNERS> -* F<.github/CODEOWNERS> -* F<.gitlab/CODEOWNERS> +Use L 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 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 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 || ''; @@ -138,21 +104,25 @@ sub colorstrip { 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, @@ -229,6 +199,14 @@ sub stringf { return $format; } +=func unbackslash + +Deprecated. + +Use L instead. + +=cut + # The unbacklash code is from String::Escape (thanks EVO), with changes: # - Handle \a, \b, \f and \v (thanks Berk Akinci) my %unbackslash; @@ -246,55 +224,21 @@ sub unbackslash { return $str; } -{ - package App::Codeowners::Util::Process; +=func zip - sub new { - my $class = shift; - return bless {@_}, $class; - } +Same as L. - 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; diff --git a/lib/File/Codeowners.pm b/lib/File/Codeowners.pm deleted file mode 100644 index 9238a29..0000000 --- a/lib/File/Codeowners.pm +++ /dev/null @@ -1,631 +0,0 @@ -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. - -=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 file. - -This is a shortcut for the C 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 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 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*(.+?)(? $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 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 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 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 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 first. - -See L 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 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 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; diff --git a/lib/Test/File/Codeowners.pm b/lib/Test/File/Codeowners.pm deleted file mode 100644 index 332b3b7..0000000 --- a/lib/Test/File/Codeowners.pm +++ /dev/null @@ -1,106 +0,0 @@ -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 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 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; diff --git a/t/file-codeowners.t b/t/file-codeowners.t deleted file mode 100644 index 7bfb53c..0000000 --- a/t/file-codeowners.t +++ /dev/null @@ -1,167 +0,0 @@ -#!/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; diff --git a/t/samples/basic.CODEOWNERS b/t/samples/basic.CODEOWNERS deleted file mode 100644 index cbbe999..0000000 --- a/t/samples/basic.CODEOWNERS +++ /dev/null @@ -1,2 +0,0 @@ -#wat -* @whatever diff --git a/t/samples/kitchensink.CODEOWNERS b/t/samples/kitchensink.CODEOWNERS deleted file mode 100644 index 06c1688..0000000 --- a/t/samples/kitchensink.CODEOWNERS +++ /dev/null @@ -1,18 +0,0 @@ -# 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 -- 2.43.0