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)});
211 for my $line (@{$self->write_to_array($charset)}) {
216 =method write_to_string
218 $scalarref = $codeowners->write_to_string;
220 Format the file contents
and return a reference to a formatted string
.
224 sub write_to_string
{
228 my $str = join("\n", @{$self->write_to_array($charset)}) . "\n";
232 =method write_to_array
234 $lines = $codeowners->write_to_array;
236 Format the file contents as an arrayref of lines
.
246 for my $line (@{$self->_lines}) {
247 if (my $comment = $line->{comment
}) {
248 push @format, "#$comment";
250 elsif (my $pattern = $line->{pattern
}) {
251 my $owners = join(' ', @{$line->{owners
}});
252 push @format, "$pattern $owners";
259 my @unowned = sort keys %{$self->_unowned};
261 push @format, '' if $format[-1];
262 push @format, '### UNOWNED (File::Codeowners)';
263 for my $unowned (@unowned) {
264 push @format, "# $unowned";
268 if (defined $charset) {
269 $_ = encode
($charset, $_) for @format;
276 $owners = $codeowners->match($filepath);
278 Match the
given filepath against the available patterns
and return just the
279 owners
for the matching pattern
. Patterns are checked
in the
reverse order
280 they were
defined in the file
.
282 Returns C
<undef> if no patterns match
.
288 my $filepath = shift or _usage
(q{$codeowners->match($filepath)});
290 my $lines = $self->{match_lines
} ||= [reverse grep { ($_ || {})->{pattern
} } @{$self->_lines}];
292 for my $line (@$lines) {
293 my $matcher = $line->{matcher
} ||= build_gitignore_matcher
([$line->{pattern
}]);
295 pattern
=> $line->{pattern
},
296 owners
=> [@{$line->{owners
} || []}],
297 $line->{project
} ? (project
=> $line->{project
}) : (),
298 } if $matcher->($filepath);
301 return undef; ## no critic (Subroutines::ProhibitExplicitReturn)
306 $owners = $codeowners->owners; # get all defined owners
307 $owners = $codeowners->owners($pattern);
309 Get an arrayref of owners
defined in the file
. If a pattern argument
is given,
310 only owners
for the
given pattern are returned
(or empty arrayref
if the
311 pattern
does not exist
). If
no argument
is given, simply returns all owners
320 return $self->{owners
} if !$pattern && $self->{owners
};
323 for my $line (@{$self->_lines}) {
324 next if $pattern && $line->{pattern
} && $pattern ne $line->{pattern
};
325 $owners{$_}++ for (@{$line->{owners
} || []});
328 my $owners = [sort keys %owners];
329 $self->{owners
} = $owners if !$pattern;
336 $patterns = $codeowners->patterns;
337 $patterns = $codeowners->patterns($owner);
339 Get an arrayref of all patterns
defined.
347 return $self->{patterns
} if !$owner && $self->{patterns
};
350 for my $line (@{$self->_lines}) {
351 next if $owner && !grep { $_ eq $owner } @{$line->{owners
} || []};
352 my $pattern = $line->{pattern
};
353 $patterns{$pattern}++ if $pattern;
356 my $patterns = [sort keys %patterns];
357 $self->{patterns
} = $patterns if !$owner;
364 $projects = $codeowners->projects;
366 Get an arrayref of all projects
defined.
373 return $self->{projects
} if $self->{projects
};
376 for my $line (@{$self->_lines}) {
377 my $project = $line->{project
};
378 $projects{$project}++ if $project;
381 my $projects = [sort keys %projects];
382 $self->{projects
} = $projects;
387 =method update_owners
389 $codeowners->update_owners($pattern => \
@new_owners);
391 Set a new set of owners
for a
given pattern
. If
for some reason the file
has
392 multiple such patterns
, they will all be updated
.
394 Nothing happens
if the file
does not already have at least one such pattern
.
402 $pattern && $owners or _usage
(q{$codeowners->update_owners($pattern => \@owners)});
404 $owners = [$owners] if ref($owners) ne 'ARRAY';
410 for my $line (@{$self->_lines}) {
411 next if !$line->{pattern
};
412 next if $pattern ne $line->{pattern
};
413 $line->{owners
} = [@$owners];
420 =method update_owners_by_project
422 $codeowners->update_owners_by_project($project => \
@new_owners);
424 Set a new set of owners
for all patterns under the
given project
.
426 Nothing happens
if the file
does not have a project with the
given name
.
430 sub update_owners_by_project
{
434 $project && $owners or _usage
(q{$codeowners->update_owners_by_project($project => \@owners)});
436 $owners = [$owners] if ref($owners) ne 'ARRAY';
442 for my $line (@{$self->_lines}) {
443 next if !$line->{project
} || !$line->{owners
};
444 next if $project ne $line->{project
};
445 $line->{owners
} = [@$owners];
452 =method rename_project
454 $codeowners->rename_project($old_name => $new_name);
458 Nothing happens
if the file
does not have a project with the old name
.
464 my $old_project = shift;
465 my $new_project = shift;
466 $old_project && $new_project or _usage
(q{$codeowners->rename_project($project => $new_project)});
472 for my $line (@{$self->_lines}) {
473 next if !exists $line->{project
} || $old_project ne $line->{project
};
474 $line->{project
} = $new_project;
475 $line->{comment
} = " Project: $new_project" if exists $line->{comment
};
484 $codeowners->append(comment
=> $str);
485 $codeowners->append(pattern
=> $pattern, owners
=> \
@owners);
486 $codeowners->append(); # blank line
495 push @{$self->_lines}, (@_ ? {@_} : undef);
500 $codeowners->prepend(comment
=> $str);
501 $codeowners->prepend(pattern
=> $pattern, owners
=> \
@owners);
502 $codeowners->prepend(); # blank line
511 unshift @{$self->_lines}, (@_ ? {@_} : undef);
516 $filepaths = $codeowners->unowned;
518 Get the list of filepaths
in the
"unowned" section
.
520 This parser supports an
"extension" to the F
<CODEOWNERS
> file format which
521 lists unowned files at the end of the file
. This list can be useful to have
in
522 order to figure out what files we know are unowned versus what files we don
't
529 [sort keys %{$self->{unowned} || {}}];
534 $codeowners->add_unowned($filepath, ...);
536 Add one or more filepaths to the "unowned" list.
538 This method does not check to make sure the filepath(s) actually do not match
539 any patterns in the file, so you might want to call L</match> first.
541 See L</unowned> for an explanation.
547 $self->_unowned->{$_}++ for @_;
550 =method remove_unowned
552 $codeowners->remove_unowned($filepath, ...);
554 Remove one or more filepaths from the "unowned" list.
556 Silently ignores filepaths that are already not listed.
558 See L</unowned> for an explanation.
564 delete $self->_unowned->{$_} for @_;
569 my $filepath = shift;
570 $self->_unowned->{$filepath};
573 =method clear_unowned
575 $codeowners->clear_unowned;
577 Remove all filepaths from the "unowned" list.
579 See L</unowned> for an explanation.
585 $self->{unowned} = {};
588 sub _lines { shift->{lines} ||= [] }
589 sub _unowned { shift->{unowned} ||= {} }
593 delete $self->{match_lines};
594 delete $self->{owners};
595 delete $self->{patterns};
596 delete $self->{projects};