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;
360 $projects = $codeowners->projects;
362 Get an arrayref of all projects
defined.
369 return $self->{projects
} if $self->{projects
};
372 for my $line (@{$self->_lines}) {
373 my $project = $line->{project
};
374 $projects{$project}++ if $project;
377 my $projects = [sort keys %projects];
378 $self->{projects
} = $projects;
383 =method update_owners
385 $codeowners->update_owners($pattern => \
@new_owners);
387 Set a new set of owners
for a
given pattern
. If
for some reason the file
has
388 multiple such patterns
, they will all be updated
.
390 Nothing happens
if the file
does not already have at least one such pattern
.
398 $pattern && $owners or _usage
(q{$codeowners->update_owners($pattern => \@owners)});
400 $owners = [$owners] if ref($owners) ne 'ARRAY';
404 for my $line (@{$self->_lines}) {
405 next if !$line->{pattern
};
406 next if $pattern ne $line->{pattern
};
407 $line->{owners
} = [@$owners];
413 $codeowners->append(comment
=> $str);
414 $codeowners->append(pattern
=> $pattern, owners
=> \
@owners);
415 $codeowners->append(); # blank line
424 push @{$self->_lines}, (@_ ? {@_} : undef);
429 $codeowners->prepend(comment
=> $str);
430 $codeowners->prepend(pattern
=> $pattern, owners
=> \
@owners);
431 $codeowners->prepend(); # blank line
440 unshift @{$self->_lines}, (@_ ? {@_} : undef);
445 $filepaths = $codeowners->unowned;
447 Get the list of filepaths
in the
"unowned" section
.
449 This parser supports an
"extension" to the F
<CODEOWNERS
> file format which
450 lists unowned files at the end of the file
. This list can be useful to have
in
451 order to figure out what files we know are unowned versus what files we don
't
458 [sort keys %{$self->{unowned} || {}}];
463 $codeowners->add_unowned($filepath, ...);
465 Add one or more filepaths to the "unowned" list.
467 This method does not check to make sure the filepath(s) actually do not match
468 any patterns in the file, so you might want to call L</match> first.
470 See L</unowned> for an explanation.
476 $self->_unowned->{$_}++ for @_;
479 =method remove_unowned
481 $codeowners->remove_unowned($filepath, ...);
483 Remove one or more filepaths from the "unowned" list.
485 Silently ignores filepaths that are already not listed.
487 See L</unowned> for an explanation.
493 delete $self->_unowned->{$_} for @_;
498 my $filepath = shift;
499 $self->_unowned->{$filepath};
502 =method clear_unowned
504 $codeowners->clear_unowned;
506 Remove all filepaths from the "unowned" list.
508 See L</unowned> for an explanation.
514 $self->{unowned} = {};
517 sub _lines { shift->{lines} ||= [] }
518 sub _unowned { shift->{unowned} ||= {} }
522 delete $self->{match_lines};
523 delete $self->{owners};
524 delete $self->{patterns};
525 delete $self->{projects};