1 package File
::Codeowners
;
2 # ABSTRACT: Read and write CODEOWNERS files
4 use v5
.10
.1; # defined-or
10 use Scalar
::Util
qw(openhandle);
11 use Text
::Gitignore
qw(build_gitignore_matcher);
13 our $VERSION = '9999.999'; # VERSION
15 sub _croak
{ require Carp
; Carp
::croak
(@_); }
16 sub _usage
{ _croak
("Usage: @_\n") }
20 $codeowners = File
::Codeowners-
>new;
22 Construct a new L
<File
::Codeowners
>.
28 my $self = bless {}, $class;
33 $codeowners = File
::Codeowners-
>parse('path/to/CODEOWNERS');
34 $codeowners = File
::Codeowners-
>parse($filehandle);
35 $codeowners = File
::Codeowners-
>parse(\
@lines);
36 $codeowners = File
::Codeowners-
>parse(\
$string);
38 Parse a F
<CODEOWNERS
> file
.
40 This
is a shortcut
for the C
<parse_from_
*> methods
.
46 my $input = shift or _usage
(q{$codeowners->parse($input)});
48 return $self->parse_from_array($input, @_) if @_;
49 return $self->parse_from_array($input) if ref($input) eq 'ARRAY';
50 return $self->parse_from_string($input) if ref($input) eq 'SCALAR';
51 return $self->parse_from_fh($input) if openhandle
($input);
52 return $self->parse_from_filepath($input);
55 =method parse_from_filepath
57 $codeowners = File
::Codeowners-
>parse_from_filepath('path/to/CODEOWNERS');
59 Parse a F
<CODEOWNERS
> file from the filesystem
.
63 sub parse_from_filepath
{
65 my $path = shift or _usage
(q{$codeowners->parse_from_filepath($filepath)});
67 $self = bless({}, $self) if !ref($self);
69 return $self->parse_from_fh(path
($path)->openr_utf8);
74 $codeowners = File
::Codeowners-
>parse_from_fh($filehandle);
76 Parse a F
<CODEOWNERS
> file from an
open filehandle
.
82 my $fh = shift or _usage
(q{$codeowners->parse_from_fh($fh)});
84 $self = bless({}, $self) if !ref($self);
92 while (my $line = <$fh>) {
95 if ($line eq '### UNOWNED (File::Codeowners)') {
99 elsif ($line =~ /^\h*#(.*)/) {
102 if ($comment =~ /^\h*Project:\h*(.+?)\h*$/i) {
103 $project = $current_project = $1 || undef;
107 $project ? (project
=> $project) : (),
110 elsif ($line =~ /^\h*$/) {
113 elsif ($line =~ /^\h*(.+?)(?<!\\)\h+(.+)/) {
115 my @owners = $2 =~ /( (?:\@+"[^"]*") | (?:\H+) )/gx;
119 $current_project ? (project
=> $current_project) : (),
123 die "Parse error on line $.: $line\n";
127 if ($parse_unowned) {
128 while (my $line = <$fh>) {
130 if ($line =~ /# (.+)/) {
132 $unowned{$filepath}++;
137 $self->{lines
} = \
@lines;
138 $self->{unowned
} = \
%unowned;
143 =method parse_from_array
145 $codeowners = File
::Codeowners-
>parse_from_array(\
@lines);
147 Parse a F
<CODEOWNERS
> file stored as lines
in an array
.
151 sub parse_from_array
{
153 my $arr = shift or _usage
(q{$codeowners->parse_from_array(\@lines)});
155 $self = bless({}, $self) if !ref($self);
157 $arr = [$arr, @_] if @_;
158 my $str = join("\n", @$arr);
159 return $self->parse_from_string(\
$str);
162 =method parse_from_string
164 $codeowners = File
::Codeowners-
>parse_from_string(\
$string);
165 $codeowners = File
::Codeowners-
>parse_from_string($string);
167 Parse a F
<CODEOWNERS
> file stored as a string
. String should be UTF-8 encoded
.
171 sub parse_from_string
{
173 my $str = shift or _usage
(q{$codeowners->parse_from_string(\$string)});
175 $self = bless({}, $self) if !ref($self);
177 my $ref = ref($str) eq 'SCALAR' ? $str : \
$str;
178 open(my $fh, '<:encoding(UTF-8)', $ref) or die "open failed: $!";
180 return $self->parse_from_fh($fh);
183 =method write_to_filepath
185 $codeowners->write_to_filepath($filepath);
187 Write the contents of the file to the filesystem atomically
.
191 sub write_to_filepath
{
193 my $path = shift or _usage
(q{$codeowners->write_to_filepath($filepath)});
195 path
($path)->spew_utf8([map { "$_\n" } @{$self->write_to_array('')}]);
200 $codeowners->write_to_fh($fh);
202 Format the file contents
and write to a filehandle
.
208 my $fh = shift or _usage
(q{$codeowners->write_to_fh($fh)});
210 for my $line (@{$self->write_to_array}) {
215 =method write_to_string
217 $scalarref = $codeowners->write_to_string;
219 Format the file contents
and return a reference to a formatted string
.
223 sub write_to_string
{
226 my $str = join("\n", @{$self->write_to_array}) . "\n";
230 =method write_to_array
232 $lines = $codeowners->write_to_array;
234 Format the file contents as an arrayref of lines
.
240 my $charset = shift // 'UTF-8';
244 for my $line (@{$self->_lines}) {
245 if (my $comment = $line->{comment
}) {
246 push @format, "#$comment";
248 elsif (my $pattern = $line->{pattern
}) {
249 my $owners = join(' ', @{$line->{owners
}});
250 push @format, "$pattern $owners";
257 my @unowned = sort keys %{$self->_unowned};
259 push @format, '' if $format[-1];
260 push @format, '### UNOWNED (File::Codeowners)';
261 for my $unowned (@unowned) {
262 push @format, "# $unowned";
267 $_ = encode
($charset, $_) for @format;
274 $owners = $codeowners->match($filepath);
276 Match the
given filepath against the available patterns
and return just the
277 owners
for the matching pattern
. Patterns are checked
in the
reverse order
278 they were
defined in the file
.
280 Returns C
<undef> if no patterns match
.
286 my $filepath = shift or _usage
(q{$codeowners->match($filepath)});
288 my $lines = $self->{match_lines
} ||= [reverse grep { ($_ || {})->{pattern
} } @{$self->_lines}];
290 for my $line (@$lines) {
291 my $matcher = $line->{matcher
} ||= build_gitignore_matcher
([$line->{pattern
}]);
293 pattern
=> $line->{pattern
},
294 owners
=> [@{$line->{owners
} || []}],
295 $line->{project
} ? (project
=> $line->{project
}) : (),
296 } if $matcher->($filepath);
299 return undef; ## no critic (Subroutines::ProhibitExplicitReturn)
304 $owners = $codeowners->owners; # get all defined owners
305 $owners = $codeowners->owners($pattern);
307 Get an arrayref of owners
defined in the file
. If a pattern argument
is given,
308 only owners
for the
given pattern are returned
(or empty arrayref
if the
309 pattern
does not exist
). If
no argument
is given, simply returns all owners
318 return $self->{owners
} if !$pattern && $self->{owners
};
321 for my $line (@{$self->_lines}) {
322 next if $pattern && $line->{pattern
} && $pattern ne $line->{pattern
};
323 $owners{$_}++ for (@{$line->{owners
} || []});
326 my $owners = [sort keys %owners];
327 $self->{owners
} = $owners if !$pattern;
334 $patterns = $codeowners->patterns;
335 $patterns = $codeowners->patterns($owner);
337 Get an arrayref of all patterns
defined.
345 return $self->{patterns
} if !$owner && $self->{patterns
};
348 for my $line (@{$self->_lines}) {
349 next if $owner && !grep { $_ eq $owner } @{$line->{owners
} || []};
350 my $pattern = $line->{pattern
};
351 $patterns{$pattern}++ if $pattern;
354 my $patterns = [sort keys %patterns];
355 $self->{patterns
} = $patterns if !$owner;
362 $projects = $codeowners->projects;
364 Get an arrayref of all projects
defined.
371 return $self->{projects
} if $self->{projects
};
374 for my $line (@{$self->_lines}) {
375 my $project = $line->{project
};
376 $projects{$project}++ if $project;
379 my $projects = [sort keys %projects];
380 $self->{projects
} = $projects;
385 =method update_owners
387 $codeowners->update_owners($pattern => \
@new_owners);
389 Set a new set of owners
for a
given pattern
. If
for some reason the file
has
390 multiple such patterns
, they will all be updated
.
392 Nothing happens
if the file
does not already have at least one such pattern
.
400 $pattern && $owners or _usage
(q{$codeowners->update_owners($pattern => \@owners)});
402 $owners = [$owners] if ref($owners) ne 'ARRAY';
408 for my $line (@{$self->_lines}) {
409 next if !$line->{pattern
};
410 next if $pattern ne $line->{pattern
};
411 $line->{owners
} = [@$owners];
418 =method update_owners_by_project
420 $codeowners->update_owners_by_project($project => \
@new_owners);
422 Set a new set of owners
for all patterns under the
given project
.
424 Nothing happens
if the file
does not have a project with the
given name
.
428 sub update_owners_by_project
{
432 $project && $owners or _usage
(q{$codeowners->update_owners_by_project($project => \@owners)});
434 $owners = [$owners] if ref($owners) ne 'ARRAY';
440 for my $line (@{$self->_lines}) {
441 next if !$line->{project
} || !$line->{owners
};
442 next if $project ne $line->{project
};
443 $line->{owners
} = [@$owners];
450 =method rename_project
452 $codeowners->rename_project($old_name => $new_name);
456 Nothing happens
if the file
does not have a project with the old name
.
462 my $old_project = shift;
463 my $new_project = shift;
464 $old_project && $new_project or _usage
(q{$codeowners->rename_project($project => $new_project)});
470 for my $line (@{$self->_lines}) {
471 next if !exists $line->{project
} || $old_project ne $line->{project
};
472 $line->{project
} = $new_project;
473 $line->{comment
} = " Project: $new_project" if exists $line->{comment
};
482 $codeowners->append(comment
=> $str);
483 $codeowners->append(pattern
=> $pattern, owners
=> \
@owners);
484 $codeowners->append(); # blank line
493 push @{$self->_lines}, (@_ ? {@_} : undef);
498 $codeowners->prepend(comment
=> $str);
499 $codeowners->prepend(pattern
=> $pattern, owners
=> \
@owners);
500 $codeowners->prepend(); # blank line
509 unshift @{$self->_lines}, (@_ ? {@_} : undef);
514 $filepaths = $codeowners->unowned;
516 Get the list of filepaths
in the
"unowned" section
.
518 This parser supports an
"extension" to the F
<CODEOWNERS
> file format which
519 lists unowned files at the end of the file
. This list can be useful to have
in
520 order to figure out what files we know are unowned versus what files we don
't
527 [sort keys %{$self->{unowned} || {}}];
532 $codeowners->add_unowned($filepath, ...);
534 Add one or more filepaths to the "unowned" list.
536 This method does not check to make sure the filepath(s) actually do not match
537 any patterns in the file, so you might want to call L</match> first.
539 See L</unowned> for an explanation.
545 $self->_unowned->{$_}++ for @_;
548 =method remove_unowned
550 $codeowners->remove_unowned($filepath, ...);
552 Remove one or more filepaths from the "unowned" list.
554 Silently ignores filepaths that are already not listed.
556 See L</unowned> for an explanation.
562 delete $self->_unowned->{$_} for @_;
567 my $filepath = shift;
568 $self->_unowned->{$filepath};
571 =method clear_unowned
573 $codeowners->clear_unowned;
575 Remove all filepaths from the "unowned" list.
577 See L</unowned> for an explanation.
583 $self->{unowned} = {};
586 sub _lines { shift->{lines} ||= [] }
587 sub _unowned { shift->{unowned} ||= {} }
591 delete $self->{match_lines};
592 delete $self->{owners};
593 delete $self->{patterns};
594 delete $self->{projects};