Dogcows Code - chaz/git-codeowners/blob - lib/App/Codeowners/Util.pm

   1 package App::Codeowners::Util;
   2 # ABSTRACT: Grab bag of utility subs for Codeowners modules
   3
   4
   5 use warnings;
   6 use strict;
   7
   8 use Encode qw(decode);
   9 use Exporter qw(import);
  10 use Path::Tiny;
  11
  12 our @EXPORT_OK = qw(
  13     colorstrip
  14     find_codeowners_in_directory
  15     find_nearest_codeowners
  16     git_ls_files
  17     git_toplevel
  18     run_command
  19     run_git
  20     stringf
  21     stringify
  22     unbackslash
  23     zip
  24 );
  25
  26 our $VERSION = '0.45'; # VERSION
  27
  28
  29 sub find_nearest_codeowners {
  30     my $path = path(shift || '.')->absolute;
  31
  32     while (!$path->is_rootdir) {
  33         my $filepath = find_codeowners_in_directory($path);
  34         return $filepath if $filepath;
  35         $path = $path->parent;
  36     }
  37 }
  38
  39
  40 sub find_codeowners_in_directory {
  41     my $path = path(shift) or die;
  42
  43     my @tries = (
  44         [qw(CODEOWNERS)],
  45         [qw(docs CODEOWNERS)],
  46         [qw(.bitbucket CODEOWNERS)],
  47         [qw(.github CODEOWNERS)],
  48         [qw(.gitlab CODEOWNERS)],
  49     );
  50
  51     for my $parts (@tries) {
  52         my $try = $path->child(@$parts);
  53         return $try if $try->is_file;
  54     }
  55 }
  56
  57 sub run_command {
  58     my $filter;
  59     $filter = pop if ref($_[-1]) eq 'CODE';
  60
  61     print STDERR "# @_\n" if $ENV{GIT_CODEOWNERS_DEBUG};
  62
  63     my ($child_in, $child_out);
  64     require IPC::Open2;
  65     my $pid = IPC::Open2::open2($child_out, $child_in, @_);
  66     close($child_in);
  67
  68     binmode($child_out, ':encoding(UTF-8)');
  69
  70     my $proc = App::Codeowners::Util::Process->new(
  71         pid     => $pid,
  72         fh      => $child_out,
  73         filter  => $filter,
  74     );
  75
  76     return wantarray ? ($proc, @{$proc->all}) : $proc;
  77 }
  78
  79 sub run_git {
  80     return run_command('git', @_);
  81 }
  82
  83 sub git_ls_files {
  84     my $dir = shift || '.';
  85     return run_git('-C', $dir, 'ls-files', @_, \&_unescape_git_filepath);
  86 }
  87
  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));
  93 }
  94
  95 sub git_toplevel {
  96     my $dir = shift || '.';
  97
  98     my ($proc, $path) = run_git('-C', $dir, qw{rev-parse --show-toplevel});
  99
 100     return if $proc->wait != 0 || !$path;
 101     return path($path);
 102 }
 103
 104 sub colorstrip {
 105     my $str = shift || '';
 106     $str =~ s/\e\[[\d;]*m//g;
 107     return $str;
 108 }
 109
 110 sub stringify {
 111     my $item = shift;
 112     return ref($item) eq 'ARRAY' ? join(',', @$item) : $item;
 113 }
 114
 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)
 118     my $max = -1;
 119     $max < $#$_ && ( $max = $#$_ ) foreach @_;
 120     map {
 121         my $ix = $_;
 122         map $_->[$ix], @_;
 123     } 0 .. $max;
 124 }
 125
 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
 130 sub _replace {
 131     my ($args, $orig, $alignment, $min_width,
 132         $max_width, $passme, $formchar) = @_;
 133
 134     # For unknown escapes, return the orignial
 135     return $orig unless defined $args->{$formchar};
 136
 137     $alignment = '+' unless defined $alignment;
 138
 139     my $replacement = $args->{$formchar};
 140     if (ref $replacement eq 'CODE') {
 141         # $passme gets passed to subrefs.
 142         $passme ||= "";
 143         $passme =~ tr/{}//d;
 144         $replacement = $replacement->($passme);
 145     }
 146
 147     my $replength;
 148     if (eval { require Unicode::GCString }) {
 149         my $gcstring = Unicode::GCString->new(colorstrip($replacement));
 150         $replength = $gcstring->columns;
 151     }
 152     else {
 153         $replength = length colorstrip($replacement);
 154     }
 155
 156     $min_width  ||= $replength;
 157     $max_width  ||= $replength;
 158
 159     # length of replacement is between min and max
 160     if (($replength > $min_width) && ($replength < $max_width)) {
 161         return $replacement;
 162     }
 163
 164     # length of replacement is longer than max; truncate
 165     if ($replength > $max_width) {
 166         return substr($replacement, 0, $max_width);
 167     }
 168
 169     my $padding = $min_width - $replength;
 170     $padding = 0 if $padding < 0;
 171
 172     # length of replacement is less than min: pad
 173     if ($alignment eq '-') {
 174         # left align; pad in front
 175         return $replacement . ' ' x $padding;
 176     }
 177
 178     # right align, pad at end
 179     return ' ' x $padding . $replacement;
 180 }
 181 my $regex = qr/
 182                (%             # leading '%'
 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
 188              )/x;
 189 sub stringf {
 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->{'%'};
 195
 196     $format =~ s/$regex/_replace($args, $1, $2, $3, $4, $5, $6)/ge;
 197
 198     return $format;
 199 }
 200
 201 # The unbacklash code is from String::Escape (thanks EVO), with changes:
 202 # - Handle \a, \b, \f and \v (thanks Berk Akinci)
 203 my %unbackslash;
 204 sub unbackslash {
 205     my $str = shift;
 206     # Earlier definitions are preferred to later ones, thus we output \n not \x0d
 207     %unbackslash = (
 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" ),
 213     ) if !%unbackslash;
 214     $str =~ s/ (\A|\G|[^\\]) \\ ( [0-7]{3} | x[\da-fA-F]{2} | . ) / $1 . $unbackslash{lc($2)} /gsxe;
 215     return $str;
 216 }
 217
 218 {
 219     package App::Codeowners::Util::Process;
 220
 221     sub new {
 222         my $class = shift;
 223         return bless {@_}, $class;
 224     }
 225
 226     sub next {
 227         my $self = shift;
 228         my $line = readline($self->{fh});
 229         if (defined $line) {
 230             chomp $line;
 231             if (my $filter = $self->{filter}) {
 232                 local $_ = $line;
 233                 $line = $filter->($line);
 234             }
 235         }
 236         $line;
 237     }
 238
 239     sub all {
 240         my $self = shift;
 241         chomp(my @lines = readline($self->{fh}));
 242         if (my $filter = $self->{filter}) {
 243             $_ = $filter->($_) for @lines;
 244         }
 245         \@lines;
 246     }
 247
 248     sub wait {
 249         my $self = shift;
 250         my $pid  = $self->{pid} or return;
 251         if (my $fh = $self->{fh}) {
 252             close($fh);
 253             delete $self->{fh};
 254         }
 255         waitpid($pid, 0);
 256         my $status = $?;
 257         print STDERR "# -> status $status\n" if $ENV{GIT_CODEOWNERS_DEBUG};
 258         delete $self->{pid};
 259         return $status;
 260     }
 261
 262     sub DESTROY {
 263         my ($self, $global_destruction) = @_;
 264         return if $global_destruction;
 265         $self->wait;
 266     }
 267 }
 268
 269 1;
 270
 271 __END__
 272
 273 =pod
 274
 275 =encoding UTF-8
 276
 277 =head1 NAME
 278
 279 App::Codeowners::Util - Grab bag of utility subs for Codeowners modules
 280
 281 =head1 VERSION
 282
 283 version 0.45
 284
 285 =head1 DESCRIPTION
 286
 287 B<DO NOT USE> except in L<App::Codeowners> and related modules.
 288
 289 =head1 FUNCTIONS
 290
 291 =head2 find_nearest_codeowners
 292
 293     $filepath = find_nearest_codeowners($dirpath);
 294
 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.
 297
 298 Returns C<undef> if no F<CODEOWNERS> is found.
 299
 300 =head2 find_codeowners_in_directory
 301
 302     $filepath = find_codeowners_in_directory($dirpath);
 303
 304 Find the F<CODEOWNERS> file in a given directory. No recursive searching is done.
 305
 306 Returns the first of (or undef if none found):
 307
 308 =over 4
 309
 310 =item *
 311
 312 F<CODEOWNERS>
 313
 314 =item *
 315
 316 F<docs/CODEOWNERS>
 317
 318 =item *
 319
 320 F<.bitbucket/CODEOWNERS>
 321
 322 =item *
 323
 324 F<.github/CODEOWNERS>
 325
 326 =item *
 327
 328 F<.gitlab/CODEOWNERS>
 329
 330 =back
 331
 332 =head1 BUGS
 333
 334 Please report any bugs or feature requests on the bugtracker website
 335 L<https://github.com/chazmcgarvey/git-codeowners/issues>
 336
 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
 339 feature.
 340
 341 =head1 AUTHOR
 342
 343 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 344
 345 =head1 COPYRIGHT AND LICENSE
 346
 347 This software is copyright (c) 2019 by Charles McGarvey.
 348
 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.
 351
 352 =cut