X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fgit-codeowners;a=blobdiff_plain;f=lib%2FFile%2FCodeowners.pm;fp=lib%2FFile%2FCodeowners.pm;h=0000000000000000000000000000000000000000;hp=9238a29a2939084390c3567eeadbda2480687839;hb=fd8bad44a70558edb1e643ec6f86cad1650700fa;hpb=b94d5acee38ce17d5d4e5fa233cae415d5c9f52c 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;