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 Exporter qw(import);
   9 use File::Codeowners::Util;
  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.50'; # VERSION
  27
  28
  29 sub find_nearest_codeowners { goto &File::Codeowners::Util::find_nearest_codeowners }
  30
  31
  32 sub find_codeowners_in_directory { goto &File::Codeowners::Util::find_codeowners_in_directory }
  33
  34
  35 sub run_command { goto &File::Codeowners::Util::run_command }
  36
  37
  38 sub run_git { goto &File::Codeowners::Util::run_git }
  39
  40
  41 sub git_ls_files { goto &File::Codeowners::Util::git_ls_files }
  42
  43
  44 sub git_toplevel { goto &File::Codeowners::Util::git_toplevel }
  45
  46
  47 sub colorstrip {
  48     my $str = shift || '';
  49     $str =~ s/\e\[[\d;]*m//g;
  50     return $str;
  51 }
  52
  53
  54 sub stringify {
  55     my $item = shift;
  56     return ref($item) eq 'ARRAY' ? join(',', @$item) : $item;
  57 }
  58
  59
  60 # The stringf code is from String::Format (thanks SREZIC), with changes:
  61 # - Use Unicode::GCString for better Unicode character padding,
  62 # - Strip ANSI color sequences,
  63 # - Prevent 'Negative repeat count does nothing' warnings
  64 sub _replace {
  65     my ($args, $orig, $alignment, $min_width,
  66         $max_width, $passme, $formchar) = @_;
  67
  68     # For unknown escapes, return the orignial
  69     return $orig unless defined $args->{$formchar};
  70
  71     $alignment = '+' unless defined $alignment;
  72
  73     my $replacement = $args->{$formchar};
  74     if (ref $replacement eq 'CODE') {
  75         # $passme gets passed to subrefs.
  76         $passme ||= "";
  77         $passme =~ tr/{}//d;
  78         $replacement = $replacement->($passme);
  79     }
  80
  81     my $replength;
  82     if (eval { require Unicode::GCString }) {
  83         my $gcstring = Unicode::GCString->new(colorstrip($replacement));
  84         $replength = $gcstring->columns;
  85     }
  86     else {
  87         $replength = length colorstrip($replacement);
  88     }
  89
  90     $min_width  ||= $replength;
  91     $max_width  ||= $replength;
  92
  93     # length of replacement is between min and max
  94     if (($replength > $min_width) && ($replength < $max_width)) {
  95         return $replacement;
  96     }
  97
  98     # length of replacement is longer than max; truncate
  99     if ($replength > $max_width) {
 100         return substr($replacement, 0, $max_width);
 101     }
 102
 103     my $padding = $min_width - $replength;
 104     $padding = 0 if $padding < 0;
 105
 106     # length of replacement is less than min: pad
 107     if ($alignment eq '-') {
 108         # left align; pad in front
 109         return $replacement . ' ' x $padding;
 110     }
 111
 112     # right align, pad at end
 113     return ' ' x $padding . $replacement;
 114 }
 115 my $regex = qr/
 116                (%             # leading '%'
 117                 (-)?          # left-align, rather than right
 118                 (\d*)?        # (optional) minimum field width
 119                 (?:\.(\d*))?  # (optional) maximum field width
 120                 (\{.*?\})?    # (optional) stuff inside
 121                 (\S)          # actual format character
 122              )/x;
 123 sub stringf {
 124     my $format = shift || return;
 125     my $args = UNIVERSAL::isa($_[0], 'HASH') ? shift : { @_ };
 126        $args->{'n'} = "\n" unless exists $args->{'n'};
 127        $args->{'t'} = "\t" unless exists $args->{'t'};
 128        $args->{'%'} = "%"  unless exists $args->{'%'};
 129
 130     $format =~ s/$regex/_replace($args, $1, $2, $3, $4, $5, $6)/ge;
 131
 132     return $format;
 133 }
 134
 135
 136 # The unbacklash code is from String::Escape (thanks EVO), with changes:
 137 # - Handle \a, \b, \f and \v (thanks Berk Akinci)
 138 my %unbackslash;
 139 sub unbackslash {
 140     my $str = shift;
 141     # Earlier definitions are preferred to later ones, thus we output \n not \x0d
 142     %unbackslash = (
 143         ( map { $_ => $_ } ( '\\', '"', '$', '@' ) ),
 144         ( 'r' => "\r", 'n' => "\n", 't' => "\t" ),
 145         ( map { 'x' . unpack('H2', chr($_)) => chr($_) } (0..255) ),
 146         ( map { sprintf('%03o', $_) => chr($_) } (0..255) ),
 147         ( 'a' => "\x07", 'b' => "\x08", 'f' => "\x0c", 'v' => "\x0b" ),
 148     ) if !%unbackslash;
 149     $str =~ s/ (\A|\G|[^\\]) \\ ( [0-7]{3} | x[\da-fA-F]{2} | . ) / $1 . $unbackslash{lc($2)} /gsxe;
 150     return $str;
 151 }
 152
 153
 154 # The zip code is from List::SomeUtils (thanks DROLSKY), copied just so as not
 155 # to bring in the extra dependency.
 156 sub zip (\@\@) {    ## no critic (Subroutines::ProhibitSubroutinePrototypes)
 157     my $max = -1;
 158     $max < $#$_ && ( $max = $#$_ ) foreach @_;
 159     map {
 160         my $ix = $_;
 161         map $_->[$ix], @_;
 162     } 0 .. $max;
 163 }
 164
 165 1;
 166
 167 __END__
 168
 169 =pod
 170
 171 =encoding UTF-8
 172
 173 =head1 NAME
 174
 175 App::Codeowners::Util - Grab bag of utility subs for Codeowners modules
 176
 177 =head1 VERSION
 178
 179 version 0.50
 180
 181 =head1 DESCRIPTION
 182
 183 B<DO NOT USE> except in L<App::Codeowners> and related modules.
 184
 185 =head1 FUNCTIONS
 186
 187 =head2 find_nearest_codeowners
 188
 189 Deprecated.
 190
 191 Use L<File::Codeowners::Util/find_nearest_codeowners> instead.
 192
 193 =head2 find_codeowners_in_directory
 194
 195 Deprecated.
 196
 197 Use L<File::Codeowners::Util/find_codeowners_in_directory> instead.
 198
 199 =head2 run_command
 200
 201 Deprecated.
 202
 203 Use L<File::Codeowners::Util/run_command> instead.
 204
 205 =head2 run_git
 206
 207 Deprecated.
 208
 209 Use L<File::Codeowners::Util/run_git> instead.
 210
 211 =head2 git_ls_files
 212
 213 Deprecated.
 214
 215 Use L<File::Codeowners::Util/git_ls_files> instead.
 216
 217 =head2 git_toplevel
 218
 219 Deprecated.
 220
 221 Use L<File::Codeowners::Util/git_toplevel> instead.
 222
 223 =head2 colorstrip
 224
 225     $str = colorstrip($str);
 226
 227 Strip ANSI color control commands.
 228
 229 =head2 stringify
 230
 231     $str = stringify($scalar);
 232     $str = stringify(\@array);
 233
 234 Get a useful string representation of a scallar or arrayref.
 235
 236 =head2 stringf
 237
 238 TODO
 239
 240 =head2 unbackslash
 241
 242 Deprecated.
 243
 244 Use L<File::Codeowners::Util/unbackslash> instead.
 245
 246 =head2 zip
 247
 248 Same as L<List::SomeUtils/zip-ARRAY1-ARRAY2-[-ARRAY3-...-]>.
 249
 250 =head1 BUGS
 251
 252 Please report any bugs or feature requests on the bugtracker website
 253 L<https://github.com/chazmcgarvey/git-codeowners/issues>
 254
 255 When submitting a bug or request, please include a test-file or a
 256 patch to an existing test-file that illustrates the bug or desired
 257 feature.
 258
 259 =head1 AUTHOR
 260
 261 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 262
 263 =head1 COPYRIGHT AND LICENSE
 264
 265 This software is copyright (c) 2021 by Charles McGarvey.
 266
 267 This is free software; you can redistribute it and/or modify it under
 268 the same terms as the Perl 5 programming language system itself.
 269
 270 =cut