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*#(.*)/) {
101 if ($comment =~ /^\h*Project:\h*(.+?)\h*$/i) {
102 $current_project = $1 || undef;
108 elsif ($line =~ /^\h*$/) {
111 elsif ($line =~ /^\h*(.+?)(?<!\\)\h+(.+)/) {
113 my @owners = $2 =~ /( (?:\@+"[^"]*") | (?:\H+) )/gx;
117 $current_project ? (project
=> $current_project) : (),
121 die "Parse error on line $.: $line\n";
125 if ($parse_unowned) {
126 while (my $line = <$fh>) {
128 if ($line =~ /# (.+)/) {
130 $unowned{$filepath}++;
135 $self->{lines
} = \
@lines;
136 $self->{unowned
} = \
%unowned;
141 =method parse_from_array
143 $codeowners = File
::Codeowners-
>parse_from_array(\
@lines);
145 Parse a F
<CODEOWNERS
> file stored as lines
in an array
.
149 sub parse_from_array
{
151 my $arr = shift or _usage
(q{$codeowners->parse_from_array(\@lines)});
153 $self = bless({}, $self) if !ref($self);
155 $arr = [$arr, @_] if @_;
156 my $str = join("\n", @$arr);
157 return $self->parse_from_string(\
$str);
160 =method parse_from_string
162 $codeowners = File
::Codeowners-
>parse_from_string(\
$string);
163 $codeowners = File
::Codeowners-
>parse_from_string($string);
165 Parse a F
<CODEOWNERS
> file stored as a string
. String should be UTF-8 encoded
.
169 sub parse_from_string
{
171 my $str = shift or _usage
(q{$codeowners->parse_from_string(\$string)});
173 $self = bless({}, $self) if !ref($self);
175 my $ref = ref($str) eq 'SCALAR' ? $str : \
$str;
176 open(my $fh, '<:encoding(UTF-8)', $ref) or die "open failed: $!";
178 return $self->parse_from_fh($fh);
181 =method write_to_filepath
183 $codeowners->write_to_filepath($filepath);
185 Write the contents of the file to the filesystem atomically
.
189 sub write_to_filepath
{
191 my $path = shift or _usage
(q{$codeowners->write_to_filepath($filepath)});
193 path
($path)->spew_utf8([map { "$_\n" } @{$self->write_to_array('')}]);
198 $codeowners->write_to_fh($fh);
200 Format the file contents
and write to a filehandle
.
206 my $fh = shift or _usage
(q{$codeowners->write_to_fh($fh)});
208 for my $line (@{$self->write_to_array}) {
213 =method write_to_string
215 $scalarref = $codeowners->write_to_string;
217 Format the file contents
and return a reference to a formatted string
.
221 sub write_to_string
{
224 my $str = join("\n", @{$self->write_to_array}) . "\n";
228 =method write_to_array
230 $lines = $codeowners->write_to_array;
232 Format the file contents as an arrayref of lines
.
238 my $charset = shift // 'UTF-8';
242 for my $line (@{$self->_lines}) {
243 if (my $comment = $line->{comment
}) {
244 push @format, "#$comment";
246 elsif (my $pattern = $line->{pattern
}) {
247 my $owners = join(' ', @{$line->{owners
}});
248 push @format, "$pattern $owners";
255 my @unowned = sort keys %{$self->_unowned};
257 push @format, '' if $format[-1];
258 push @format, '### UNOWNED (File::Codeowners)';
259 for my $unowned (@unowned) {
260 push @format, "# $unowned";
265 $_ = encode
($charset, $_) for @format;
272 $owners = $codeowners->match($filepath);
274 Match the
given filepath against the available patterns
and return just the
275 owners
for the matching pattern
. Patterns are checked
in the
reverse order
276 they were
defined in the file
.
278 Returns C
<undef> if no patterns match
.
284 my $filepath = shift or _usage
(q{$codeowners->match($filepath)});
286 my $lines = $self->{match_lines
} ||= [reverse grep { ($_ || {})->{pattern
} } @{$self->_lines}];
288 for my $line (@$lines) {
289 my $matcher = $line->{matcher
} ||= build_gitignore_matcher
([$line->{pattern
}]);
291 pattern
=> $line->{pattern
},
292 owners
=> [@{$line->{owners
} || []}],
293 $line->{project
} ? (project
=> $line->{project
}) : (),
294 } if $matcher->($filepath);
297 return undef; ## no critic (Subroutines::ProhibitExplicitReturn)
302 $owners = $codeowners->owners; # get all defined owners
303 $owners = $codeowners->owners($pattern);
305 Get an arrayref of owners
defined in the file
. If a pattern argument
is given,
306 only owners
for the
given pattern are returned
(or empty arrayref
if the
307 pattern
does not exist
). If
no argument
is given, simply returns all owners
316 return $self->{owners
} if !$pattern && $self->{owners
};
319 for my $line (@{$self->_lines}) {
320 next if $pattern && $line->{pattern
} && $pattern ne $line->{pattern
};
321 $owners{$_}++ for (@{$line->{owners
} || []});
324 my $owners = [sort keys %owners];
325 $self->{owners
} = $owners if !$pattern;
332 $patterns = $codeowners->patterns;
333 $patterns = $codeowners->patterns($owner);
335 Get an arrayref of all patterns
defined.
343 return $self->{patterns
} if !$owner && $self->{patterns
};
346 for my $line (@{$self->_lines}) {
347 next if $owner && !grep { $_ eq $owner } @{$line->{owners
} || []};
348 my $pattern = $line->{pattern
};
349 $patterns{$pattern}++ if $pattern;
352 my $patterns = [sort keys %patterns];
353 $self->{patterns
} = $patterns if !$owner;
358 =method update_owners
360 $codeowners->update_owners($pattern => \
@new_owners);
362 Set a new set of owners
for a
given pattern
. If
for some reason the file
has
363 multiple such patterns
, they will all be updated
.
365 Nothing happens
if the file
does not already have at least one such pattern
.
373 $pattern && $owners or _usage
(q{$codeowners->update_owners($pattern => \@owners)});
375 $owners = [$owners] if ref($owners) ne 'ARRAY';
379 for my $line (@{$self->_lines}) {
380 next if !$line->{pattern
};
381 next if $pattern ne $line->{pattern
};
382 $line->{owners
} = [@$owners];
388 $codeowners->append(comment
=> $str);
389 $codeowners->append(pattern
=> $pattern, owners
=> \
@owners);
390 $codeowners->append(); # blank line
399 push @{$self->_lines}, (@_ ? {@_} : undef);
404 $codeowners->prepend(comment
=> $str);
405 $codeowners->prepend(pattern
=> $pattern, owners
=> \
@owners);
406 $codeowners->prepend(); # blank line
415 unshift @{$self->_lines}, (@_ ? {@_} : undef);
420 $filepaths = $codeowners->unowned;
422 Get the list of filepaths
in the
"unowned" section
.
424 This parser supports an
"extension" to the F
<CODEOWNERS
> file format which
425 lists unowned files at the end of the file
. This list can be useful to have
in
426 order to figure out what files we know are unowned versus what files we don
't
433 [sort keys %{$self->{unowned} || {}}];
438 $codeowners->add_unowned($filepath, ...);
440 Add one or more filepaths to the "unowned" list.
442 This method does not check to make sure the filepath(s) actually do not match
443 any patterns in the file, so you might want to call L</match> first.
445 See L</unowned> for an explanation.
451 $self->_unowned->{$_}++ for @_;
454 =method remove_unowned
456 $codeowners->remove_unowned($filepath, ...);
458 Remove one or more filepaths from the "unowned" list.
460 Silently ignores filepaths that are already not listed.
462 See L</unowned> for an explanation.
468 delete $self->_unowned->{$_} for @_;
473 my $filepath = shift;
474 $self->_unowned->{$filepath};
477 =method clear_unowned
479 $codeowners->clear_unowned;
481 Remove all filepaths from the "unowned" list.
483 See L</unowned> for an explanation.
489 $self->{unowned} = {};
492 sub _lines { shift->{lines} ||= [] }
493 sub _unowned { shift->{unowned} ||= {} }
497 delete $self->{match_lines};
498 delete $self->{owners};
499 delete $self->{patterns};