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