1 package App
::Codeowners
::Util
;
2 # ABSTRACT: Grab bag of utility subs for Codeowners modules
9 use Exporter
qw(import);
14 find_codeowners_in_directory
15 find_nearest_codeowners
26 our $VERSION = '0.49'; # VERSION
29 sub find_nearest_codeowners
{
30 my $path = path
(shift || '.')->absolute;
32 while (!$path->is_rootdir) {
33 my $filepath = find_codeowners_in_directory
($path);
34 return $filepath if $filepath;
35 $path = $path->parent;
40 sub find_codeowners_in_directory
{
41 my $path = path
(shift) or die;
45 [qw(docs CODEOWNERS)],
46 [qw(.bitbucket CODEOWNERS)],
47 [qw(.github CODEOWNERS)],
48 [qw(.gitlab CODEOWNERS)],
51 for my $parts (@tries) {
52 my $try = $path->child(@$parts);
53 return $try if $try->is_file;
59 $filter = pop if ref($_[-1]) eq 'CODE';
61 print STDERR
"# @_\n" if $ENV{GIT_CODEOWNERS_DEBUG
};
63 my ($child_in, $child_out);
65 my $pid = IPC
::Open2
::open2
($child_out, $child_in, @_);
68 binmode($child_out, ':encoding(UTF-8)');
70 my $proc = App
::Codeowners
::Util
::Process-
>new(
76 return wantarray ? ($proc, @{$proc->all}) : $proc;
80 return run_command
('git', @_);
84 my $dir = shift || '.';
85 return run_git
('-C', $dir, 'ls-files', @_, \
&_unescape_git_filepath
);
88 # Depending on git's "core.quotepath" config, non-ASCII chars may be
89 # escaped (identified by surrounding dquotes), so try to unescape.
90 sub _unescape_git_filepath
{
91 return $_ if $_ !~ /^"(.+)"$/;
92 return decode
('UTF-8', unbackslash
($1));
96 my $dir = shift || '.';
98 my ($proc, $path) = run_git
('-C', $dir, qw{rev-parse --show-toplevel});
100 return if $proc->wait != 0 || !$path;
105 my $str = shift || '';
106 $str =~ s/\e\[[\d;]*m//g;
112 return ref($item) eq 'ARRAY' ? join(',', @$item) : $item;
115 # The zip code is from List::SomeUtils (thanks DROLSKY), copied just so as not
116 # to bring in the extra dependency.
117 sub zip
(\
@\
@) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
119 $max < $#$_ && ( $max = $#$_ ) foreach @_;
126 # The stringf code is from String::Format (thanks SREZIC), with changes:
127 # - Use Unicode::GCString for better Unicode character padding,
128 # - Strip ANSI color sequences,
129 # - Prevent 'Negative repeat count does nothing' warnings
131 my ($args, $orig, $alignment, $min_width,
132 $max_width, $passme, $formchar) = @_;
134 # For unknown escapes, return the orignial
135 return $orig unless defined $args->{$formchar};
137 $alignment = '+' unless defined $alignment;
139 my $replacement = $args->{$formchar};
140 if (ref $replacement eq 'CODE') {
141 # $passme gets passed to subrefs.
144 $replacement = $replacement->($passme);
148 if (eval { require Unicode
::GCString
}) {
149 my $gcstring = Unicode
::GCString-
>new(colorstrip
($replacement));
150 $replength = $gcstring->columns;
153 $replength = length colorstrip
($replacement);
156 $min_width ||= $replength;
157 $max_width ||= $replength;
159 # length of replacement is between min and max
160 if (($replength > $min_width) && ($replength < $max_width)) {
164 # length of replacement is longer than max; truncate
165 if ($replength > $max_width) {
166 return substr($replacement, 0, $max_width);
169 my $padding = $min_width - $replength;
170 $padding = 0 if $padding < 0;
172 # length of replacement is less than min: pad
173 if ($alignment eq '-') {
174 # left align; pad in front
175 return $replacement . ' ' x
$padding;
178 # right align, pad at end
179 return ' ' x
$padding . $replacement;
183 (-)? # left-align, rather than right
184 (\d
*)? # (optional) minimum field width
185 (?:\
.(\d
*))? # (optional) maximum field width
186 (\
{.*?\
})? # (optional) stuff inside
187 (\S
) # actual format character
190 my $format = shift || return;
191 my $args = UNIVERSAL
::isa
($_[0], 'HASH') ? shift : { @_ };
192 $args->{'n'} = "\n" unless exists $args->{'n'};
193 $args->{'t'} = "\t" unless exists $args->{'t'};
194 $args->{'%'} = "%" unless exists $args->{'%'};
196 $format =~ s/$regex/_replace($args, $1, $2, $3, $4, $5, $6)/ge;
201 # The unbacklash code is from String::Escape (thanks EVO), with changes:
202 # - Handle \a, \b, \f and \v (thanks Berk Akinci)
206 # Earlier definitions are preferred to later ones, thus we output \n not \x0d
208 ( map { $_ => $_ } ( '\\', '"', '$', '@' ) ),
209 ( 'r' => "\r", 'n' => "\n", 't' => "\t" ),
210 ( map { 'x' . unpack('H2', chr($_)) => chr($_) } (0..255) ),
211 ( map { sprintf('%03o', $_) => chr($_) } (0..255) ),
212 ( 'a' => "\x07", 'b' => "\x08", 'f' => "\x0c", 'v' => "\x0b" ),
214 $str =~ s/ (\A|\G|[^\\]) \\ ( [0-7]{3} | x[\da-fA-F]{2} | . ) / $1 . $unbackslash{lc($2)} /gsxe;
219 package App
::Codeowners
::Util
::Process
;
223 return bless {@_}, $class;
228 my $line = readline($self->{fh
});
231 if (my $filter = $self->{filter
}) {
233 $line = $filter->($line);
241 chomp(my @lines = readline($self->{fh
}));
242 if (my $filter = $self->{filter
}) {
243 $_ = $filter->($_) for @lines;
250 my $pid = $self->{pid
} or return;
251 if (my $fh = $self->{fh
}) {
257 print STDERR
"# -> status $status\n" if $ENV{GIT_CODEOWNERS_DEBUG
};
263 my ($self, $global_destruction) = @_;
264 return if $global_destruction;
279 App::Codeowners::Util - Grab bag of utility subs for Codeowners modules
287 B<DO NOT USE> except in L<App::Codeowners> and related modules.
291 =head2 find_nearest_codeowners
293 $filepath = find_nearest_codeowners($dirpath);
295 Find the F<CODEOWNERS> file in the current working directory, or search in the
296 parent directory recursively until a F<CODEOWNERS> file is found.
298 Returns C<undef> if no F<CODEOWNERS> is found.
300 =head2 find_codeowners_in_directory
302 $filepath = find_codeowners_in_directory($dirpath);
304 Find the F<CODEOWNERS> file in a given directory. No recursive searching is done.
306 Returns the first of (or undef if none found):
320 F<.bitbucket/CODEOWNERS>
324 F<.github/CODEOWNERS>
328 F<.gitlab/CODEOWNERS>
334 Please report any bugs or feature requests on the bugtracker website
335 L<https://github.com/chazmcgarvey/git-codeowners/issues>
337 When submitting a bug or request, please include a test-file or a
338 patch to an existing test-file that illustrates the bug or desired
343 Charles McGarvey <chazmcgarvey@brokenzipper.com>
345 =head1 COPYRIGHT AND LICENSE
347 This software is copyright (c) 2019 by Charles McGarvey.
349 This is free software; you can redistribute it and/or modify it under
350 the same terms as the Perl 5 programming language system itself.