1 package App
::Codeowners
::Util
;
2 # ABSTRACT: Grab bag of utility subs for Codeowners modules
6 B<DO NOT USE> except in L<App::Codeowners> and related modules.
13 use Encode
qw(decode);
14 use Exporter
qw(import);
19 find_codeowners_in_directory
20 find_nearest_codeowners
31 our $VERSION = '9999.999'; # VERSION
33 =func find_nearest_codeowners
35 $filepath = find_nearest_codeowners
($dirpath);
37 Find the F
<CODEOWNERS
> file
in the current working directory
, or search
in the
38 parent directory recursively
until a F
<CODEOWNERS
> file
is found
.
40 Returns C
<undef> if no F
<CODEOWNERS
> is found
.
44 sub find_nearest_codeowners
{
45 my $path = path
(shift || '.')->absolute;
47 while (!$path->is_rootdir) {
48 my $filepath = find_codeowners_in_directory
($path);
49 return $filepath if $filepath;
50 $path = $path->parent;
54 =func find_codeowners_in_directory
56 $filepath = find_codeowners_in_directory
($dirpath);
58 Find the F
<CODEOWNERS
> file
in a
given directory
. No recursive searching
is done
.
60 Returns the first of
(or undef if none found
):
65 * F<.bitbucket/CODEOWNERS>
66 * F<.github/CODEOWNERS>
67 * F<.gitlab/CODEOWNERS>
71 sub find_codeowners_in_directory
{
72 my $path = path
(shift) or die;
76 [qw(docs CODEOWNERS)],
77 [qw(.bitbucket CODEOWNERS)],
78 [qw(.github CODEOWNERS)],
79 [qw(.gitlab CODEOWNERS)],
82 for my $parts (@tries) {
83 my $try = $path->child(@$parts);
84 return $try if $try->is_file;
90 $filter = pop if ref($_[-1]) eq 'CODE';
92 print STDERR
"# @_\n" if $ENV{GIT_CODEOWNERS_DEBUG
};
94 my ($child_in, $child_out);
96 my $pid = IPC
::Open2
::open2
($child_out, $child_in, @_);
99 binmode($child_out, ':encoding(UTF-8)');
101 my $proc = App
::Codeowners
::Util
::Process-
>new(
107 return wantarray ? ($proc, @{$proc->all}) : $proc;
111 return run_command
('git', @_);
115 my $dir = shift || '.';
116 return run_git
('-C', $dir, 'ls-files', @_, \
&_unescape_git_filepath
);
119 # Depending on git's "core.quotepath" config, non-ASCII chars may be
120 # escaped (identified by surrounding dquotes), so try to unescape.
121 sub _unescape_git_filepath
{
122 return $_ if $_ !~ /^"(.+)"$/;
123 return decode
('UTF-8', unbackslash
($1));
127 my $dir = shift || '.';
129 my ($proc, $path) = run_git
('-C', $dir, qw{rev-parse --show-toplevel});
131 return if $proc->wait != 0 || !$path;
136 my $str = shift || '';
137 $str =~ s/\e\[[\d;]*m//g;
143 return ref($item) eq 'ARRAY' ? join(',', @$item) : $item;
146 # The zip code is from List::SomeUtils (thanks DROLSKY), copied just so as not
147 # to bring in the extra dependency.
148 sub zip
(\
@\
@) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
150 $max < $#$_ && ( $max = $#$_ ) foreach @_;
157 # The stringf code is from String::Format (thanks SREZIC), with changes:
158 # - Use Unicode::GCString for better Unicode character padding,
159 # - Strip ANSI color sequences,
160 # - Prevent 'Negative repeat count does nothing' warnings
162 my ($args, $orig, $alignment, $min_width,
163 $max_width, $passme, $formchar) = @_;
165 # For unknown escapes, return the orignial
166 return $orig unless defined $args->{$formchar};
168 $alignment = '+' unless defined $alignment;
170 my $replacement = $args->{$formchar};
171 if (ref $replacement eq 'CODE') {
172 # $passme gets passed to subrefs.
175 $replacement = $replacement->($passme);
179 if (eval { require Unicode
::GCString
}) {
180 my $gcstring = Unicode
::GCString-
>new(colorstrip
($replacement));
181 $replength = $gcstring->columns;
184 $replength = length colorstrip
($replacement);
187 $min_width ||= $replength;
188 $max_width ||= $replength;
190 # length of replacement is between min and max
191 if (($replength > $min_width) && ($replength < $max_width)) {
195 # length of replacement is longer than max; truncate
196 if ($replength > $max_width) {
197 return substr($replacement, 0, $max_width);
200 my $padding = $min_width - $replength;
201 $padding = 0 if $padding < 0;
203 # length of replacement is less than min: pad
204 if ($alignment eq '-') {
205 # left align; pad in front
206 return $replacement . ' ' x
$padding;
209 # right align, pad at end
210 return ' ' x
$padding . $replacement;
214 (-)? # left-align, rather than right
215 (\d
*)? # (optional) minimum field width
216 (?:\
.(\d
*))? # (optional) maximum field width
217 (\
{.*?\
})? # (optional) stuff inside
218 (\S
) # actual format character
221 my $format = shift || return;
222 my $args = UNIVERSAL
::isa
($_[0], 'HASH') ? shift : { @_ };
223 $args->{'n'} = "\n" unless exists $args->{'n'};
224 $args->{'t'} = "\t" unless exists $args->{'t'};
225 $args->{'%'} = "%" unless exists $args->{'%'};
227 $format =~ s/$regex/_replace($args, $1, $2, $3, $4, $5, $6)/ge;
232 # The unbacklash code is from String::Escape (thanks EVO), with changes:
233 # - Handle \a, \b, \f and \v (thanks Berk Akinci)
237 # Earlier definitions are preferred to later ones, thus we output \n not \x0d
239 ( map { $_ => $_ } ( '\\', '"', '$', '@' ) ),
240 ( 'r' => "\r", 'n' => "\n", 't' => "\t" ),
241 ( map { 'x' . unpack('H2', chr($_)) => chr($_) } (0..255) ),
242 ( map { sprintf('%03o', $_) => chr($_) } (0..255) ),
243 ( 'a' => "\x07", 'b' => "\x08", 'f' => "\x0c", 'v' => "\x0b" ),
245 $str =~ s/ (\A|\G|[^\\]) \\ ( [0-7]{3} | x[\da-fA-F]{2} | . ) / $1 . $unbackslash{lc($2)} /gsxe;
250 package App
::Codeowners
::Util
::Process
;
254 return bless {@_}, $class;
259 my $line = readline($self->{fh
});
262 if (my $filter = $self->{filter
}) {
264 $line = $filter->($line);
272 chomp(my @lines = readline($self->{fh
}));
273 if (my $filter = $self->{filter
}) {
274 $_ = $filter->($_) for @lines;
281 my $pid = $self->{pid
} or return;
282 if (my $fh = $self->{fh
}) {
288 print STDERR
"# -> status $status\n" if $ENV{GIT_CODEOWNERS_DEBUG
};
294 my ($self, $global_destruction) = @_;
295 return if $global_destruction;