use warnings;
use strict;
+use App::Codeowners::Formatter;
use App::Codeowners::Options;
-use App::Codeowners::Util qw(find_codeowners_in_directory run_git git_ls_files git_toplevel stringf);
+use App::Codeowners::Util qw(find_codeowners_in_directory run_git git_ls_files git_toplevel);
use Color::ANSI::Util 0.03 qw(ansifg);
use Encode qw(encode);
use File::Codeowners;
or die "No CODEOWNERS file in $toplevel\n";
my $codeowners = File::Codeowners->parse_from_filepath($codeowners_path);
- my ($cdup) = run_git(qw{rev-parse --show-cdup});
+ my ($proc, $cdup) = run_git(qw{rev-parse --show-cdup});
+ $proc->wait and exit 1;
- my @results;
+ my $formatter = App::Codeowners::Formatter->new(
+ format => $opts->{format} || ' * %-50F %O',
+ handle => *STDOUT,
+ columns => [qw(File Owner), $opts->{project} ? 'Project' : ()],
+ );
- my $filepaths = git_ls_files('.', $opts->args) or die "Cannot list files\n";
- for my $filepath (@$filepaths) {
+ $proc = git_ls_files('.', $opts->args);
+ while (my $filepath = $proc->next) {
my $match = $codeowners->match(path($filepath)->relative($cdup));
- push @results, [
+ $formatter->add_result([
$filepath,
$match->{owners},
$opts->{project} ? $match->{project} : (),
- ];
+ ]);
}
-
- _format(
- format => $opts->{format} || ' * %-50F %O',
- out => *STDOUT,
- headers => [qw(File Owner), $opts->{project} ? 'Project' : ()],
- rows => \@results,
- );
+ $proc->wait and exit 1;
}
sub _command_owners {
my $results = $codeowners->owners($opts->{pattern});
- _format(
+ my $formatter = App::Codeowners::Formatter->new(
format => $opts->{format} || '%O',
- out => *STDOUT,
- headers => [qw(Owner)],
- rows => [map { [$_] } @$results],
+ handle => *STDOUT,
+ columns => [qw(Owner)],
);
+ $formatter->add_result(map { [$_] } @$results);
}
sub _command_patterns {
my $results = $codeowners->patterns($opts->{owner});
- _format(
+ my $formatter = App::Codeowners::Formatter->new(
format => $opts->{format} || '%T',
- out => *STDOUT,
- headers => [qw(Pattern)],
- rows => [map { [$_] } @$results],
+ handle => *STDOUT,
+ columns => [qw(Pattern)],
);
+ $formatter->add_result(map { [$_] } @$results);
}
sub _command_create { goto &_command_update }
print STDERR "Wrote $path\n";
}
-sub _format {
- my %args = @_;
-
- my $format = $args{format} || 'table';
- my $fh = $args{out} || *STDOUT;
- my $headers = $args{headers} || [];
- my $rows = $args{rows} || [];
-
- if ($format eq 'table') {
- eval { require Text::Table::Any } or die "Missing dependency: Text::Table::Any\n";
-
- my $table = Text::Table::Any::table(
- header_row => 1,
- rows => [$headers, map { [map { _stringify($_) } @$_] } @$rows],
- backend => $ENV{PERL_TEXT_TABLE},
- );
- print { $fh } encode('UTF-8', $table);
- }
- elsif ($format =~ /^json(:pretty)?$/) {
- my $pretty = !!$1;
- eval { require JSON::MaybeXS } or die "Missing dependency: JSON::MaybeXS\n";
-
- my $json = JSON::MaybeXS->new(canonical => 1, utf8 => 1, pretty => $pretty);
- my $data = _combine_headers_rows($headers, $rows);
- print { $fh } $json->encode($data);
- }
- elsif ($format =~ /^([ct])sv$/) {
- my $sep = $1 eq 'c' ? ',' : "\t";
- eval { require Text::CSV } or die "Missing dependency: Text::CSV\n";
-
- my $csv = Text::CSV->new({binary => 1, eol => $/, sep => $sep});
- $csv->print($fh, $headers);
- $csv->print($fh, [map { encode('UTF-8', _stringify($_)) } @$_]) for @$rows;
- }
- elsif ($format =~ /^ya?ml$/) {
- eval { require YAML } or die "Missing dependency: YAML\n";
-
- my $data = _combine_headers_rows($headers, $rows);
- print { $fh } encode('UTF-8', YAML::Dump($data));
- }
- else {
- my $data = _combine_headers_rows($headers, $rows);
-
- # https://sashat.me/2017/01/11/list-of-20-simple-distinct-colors/
- my @contrasting_colors = qw(
- e6194b 3cb44b ffe119 4363d8 f58231
- 911eb4 42d4f4 f032e6 bfef45 fabebe
- 469990 e6beff 9a6324 fffac8 800000
- aaffc3 808000 ffd8b1 000075 a9a9a9
- );
-
- # assign a color to each owner, on demand
- my %owner_colors;
- my $num = -1;
- my $owner_color = sub {
- my $owner = shift or return;
- $owner_colors{$owner} ||= do {
- $num = ($num + 1) % scalar @contrasting_colors;
- $contrasting_colors[$num];
- };
- };
-
- my %filter = (
- quote => sub { local $_ = $_[0]; s/"/\"/s; "\"$_\"" },
- );
-
- my $create_filterer = sub {
- my $value = shift || '';
- my $color = shift || '';
- my $gencolor = ref($color) eq 'CODE' ? $color : sub { $color };
- return sub {
- my $arg = shift;
- my ($filters, $color) = _expand_filter_args($arg);
- if (ref($value) eq 'ARRAY') {
- $value = join(',', map { _colored($_, $color // $gencolor->($_)) } @$value);
- }
- else {
- $value = _colored($value, $color // $gencolor->($value));
- }
- for my $key (@$filters) {
- if (my $filter = $filter{$key}) {
- $value = $filter->($value);
- }
- else {
- warn "Unknown filter: $key\n"
- }
- }
- $value || '';
- };
- };
-
- for my $row (@$data) {
- my %info = (
- F => $create_filterer->($row->{File}, undef),
- O => $create_filterer->($row->{Owner}, $owner_color),
- P => $create_filterer->($row->{Project}, undef),
- T => $create_filterer->($row->{Pattern}, undef),
- );
-
- my $text = stringf($format, %info);
- print { $fh } encode('UTF-8', $text), "\n";
- }
- }
-}
-
-sub _expand_filter_args {
- my $arg = shift || '';
-
- my @filters = split(/,/, $arg);
- my $color_override;
-
- for (my $i = 0; $i < @filters; ++$i) {
- my $filter = $filters[$i] or next;
- if ($filter =~ /^(?:nocolor|color:([0-9a-fA-F]{3,6}))$/) {
- $color_override = $1 || '';
- splice(@filters, $i, 1);
- redo;
- }
- }
-
- return (\@filters, $color_override);
-}
-
-sub _ansi_reset { "\033[0m" }
-
-sub _colored {
- my $text = shift;
- my $rgb = shift or return $text;
-
- return $text if $ENV{NO_COLOR};
-
- $rgb =~ s/^(.)(.)(.)$/$1$1$2$2$3$3/;
- if ($rgb !~ m/^[0-9a-fA-F]{6}$/) {
- warn "Color value must be in 'ffffff' or 'fff' form.\n";
- return $text;
- }
-
- my ($begin, $end) = (ansifg($rgb), _ansi_reset);
- return "${begin}${text}${end}";
-}
-
-sub _combine_headers_rows {
- my $headers = shift;
- my $rows = shift;
-
- my @new_rows;
-
- for my $row (@$rows) {
- push @new_rows, (my $new_row = {});
- for (my $i = 0; $i < @$headers; ++$i) {
- $new_row->{$headers->[$i]} = $row->[$i];
- }
- }
-
- return \@new_rows;
-}
-
-sub _stringify {
- my $item = shift;
- return ref($item) eq 'ARRAY' ? join(',', @$item) : $item;
-}
-
1;
--- /dev/null
+package App::Codeowners::Formatter;
+# ABSTRACT: Base class for formatting codeowners output
+
+=head1 SYNOPSIS
+
+ my $formatter = App::Codeowners::Formatter->new(handle => *STDOUT);
+ $formatter->add_result($_) for @results;
+
+=head1 DESCRIPTION
+
+This is a base class for formatters. A formatter is a class that takes data records, stringifies
+them, and prints them to an IO handle.
+
+This class is mostly abstract, though it is also usable as a null formatter where results are simply
+discarded if it is instantiated directly. These other formatters do more interesting things:
+
+=for :list
+* L<App::Codeowners::Formatter::CSV>
+* L<App::Codeowners::Formatter::String>
+* L<App::Codeowners::Formatter::JSON>
+* L<App::Codeowners::Formatter::TSV>
+* L<App::Codeowners::Formatter::Table>
+* L<App::Codeowners::Formatter::YAML>
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use Module::Load;
+
+=method new
+
+ $formatter = App::Codeowners::Formatter->new;
+ $formatter = App::Codeowners::Formatter->new(%attributes);
+
+Construct a new formatter.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $args = {@_ == 1 && ref $_[0] eq 'HASH' ? %{$_[0]} : @_};
+
+ $args->{results} = [];
+
+ # see if we can find a better class to bless into
+ ($class, my $format) = $class->_best_formatter($args->{format}) if $args->{format};
+ $args->{format} = $format;
+
+ my $self = bless $args, $class;
+
+ $self->start;
+
+ return $self;
+}
+
+### _best_formatter
+# Find a formatter that can handle the format requested.
+sub _best_formatter {
+ my $class = shift;
+ my $type = shift || '';
+
+ return ($class, $type) if $class ne __PACKAGE__;
+
+ my ($name, $format) = $type =~ /^([A-Za-z]+)(?::(.*))?$/;
+ if (!$name) {
+ $name = '';
+ $format = '';
+ }
+
+ $name = lc($name);
+ $name =~ s/:.*//;
+
+ my @formatters = $class->formatters;
+
+ # default to the string formatter since it has no dependencies
+ my $package = __PACKAGE__.'::String';
+
+ # look for a formatter whose name matches the format
+ for my $formatter (@formatters) {
+ my $module = lc($formatter);
+ $module =~ s/.*:://;
+
+ if ($module eq $name) {
+ $package = $formatter;
+ $type = $format;
+ last;
+ }
+ }
+
+ load $package;
+ return ($package, $type);
+}
+
+=method DESTROY
+
+Destructor calls L</finish>.
+
+=cut
+
+sub DESTROY {
+ my $self = shift;
+ my $global_destruction = shift;
+
+ return if $global_destruction;
+
+ my $results = $self->{results};
+ $self->finish($results) if $results;
+ delete $self->{results};
+}
+
+=attr handle
+
+Get the IO handle associated with a formatter.
+
+=attr format
+
+Get the format string, which may be used to customize the formatting.
+
+=attr columns
+
+Get an arrayref of column headings.
+
+=attr results
+
+Get an arrayref of all the results that have been provided to the formatter using L</add_result> but
+have not yet been formatted.
+
+=cut
+
+sub handle { shift->{handle} }
+sub format { shift->{format} || '' }
+sub columns { shift->{columns} || [] }
+sub results { shift->{results} }
+
+=method add_result
+
+ $formatter->add_result($result);
+
+Provide an additional lint result to be formatted.
+
+=cut
+
+sub add_result {
+ my $self = shift;
+ $self->stream($_) for @_;
+}
+
+=method start
+
+ $formatter->start;
+
+Begin formatting results. Called before any results are passed to the L</stream> method.
+
+This method may print a header to the L</handle>. This method is used by subclasses and should
+typically not be called explicitly.
+
+=method stream
+
+ $formatter->stream(\@result, ...);
+
+Format one result.
+
+This method is expected to print a string representation of the result to the L</handle>. This
+method is used by subclasses and should typically not called be called explicitly.
+
+The default implementation simply stores the L</results> so they will be available to L</finish>.
+
+=method finish
+
+ $formatter->finish;
+
+End formatting results. Called after all results are passed to the L</stream> method.
+
+This method may print a footer to the L</handle>. This method is used by subclasses and should
+typically not be called explicitly.
+
+=cut
+
+sub start {}
+sub stream { push @{$_[0]->results}, $_[1] }
+sub finish {}
+
+=method formatters
+
+ @formatters = App::Codeowners::Formatter->formatters;
+
+Get a list of package names of potential formatters within the C<App::Codeowners::Formatter>
+namespace.
+
+=cut
+
+sub formatters {
+ return qw(
+ App::Codeowners::Formatter::CSV
+ App::Codeowners::Formatter::JSON
+ App::Codeowners::Formatter::String
+ App::Codeowners::Formatter::TSV
+ App::Codeowners::Formatter::Table
+ App::Codeowners::Formatter::YAML
+ );
+}
+
+1;
--- /dev/null
+package App::Codeowners::Formatter::CSV;
+# ABSTRACT: Format codeowners output as comma-separated values
+
+=head1 DESCRIPTION
+
+This is a L<App::Codeowners::Formatter> that formats output using L<Text::CSV>.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use parent 'App::Codeowners::Formatter';
+
+use App::Codeowners::Util qw(stringify);
+use Encode qw(encode);
+
+sub start {
+ my $self = shift;
+
+ $self->text_csv->print($self->handle, $self->columns);
+}
+
+sub stream {
+ my $self = shift;
+ my $result = shift;
+
+ $self->text_csv->print($self->handle, [map { encode('UTF-8', stringify($_)) } @$result]);
+}
+
+=attr text_csv
+
+Get the L<Text::CSV> instance.
+
+=cut
+
+sub text_csv {
+ my $self = shift;
+
+ $self->{text_csv} ||= do {
+ eval { require Text::CSV } or die "Missing dependency: Text::CSV\n";
+
+ my %options;
+ $options{escape_char} = $self->escape_char if $self->escape_char;
+ $options{quote} = $self->quote if $self->quote;
+ $options{sep} = $self->sep if $self->sep;
+ if ($options{sep} && $options{sep} eq ($options{quote} || '"')) {
+ die "Invalid separator value for CSV format.\n";
+ }
+
+ Text::CSV->new({binary => 1, eol => $/, %options});
+ } or die "Failed to construct Text::CSV object";
+}
+
+=attr sep
+
+Get the value used for L<Text::CSV/sep>.
+
+=attr quote
+
+Get the value used for L<Text::CSV/quote>.
+
+=attr escape_char
+
+Get the value used for L<Text::CSV/escape_char>.
+
+=cut
+
+sub sep { $_[0]->{sep} || $_[0]->format }
+sub quote { $_[0]->{quote} }
+sub escape_char { $_[0]->{escape_char} }
+
+1;
--- /dev/null
+package App::Codeowners::Formatter::JSON;
+# ABSTRACT: Format codeowners output as JSON
+
+=head1 DESCRIPTION
+
+This is a L<App::Codeowners::Formatter> that formats output using L<JSON::MaybeXS>.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use parent 'App::Codeowners::Formatter';
+
+use App::Codeowners::Util qw(zip);
+
+=attr format
+
+If unset (default), the output will be compact. If "pretty", the output will look nicer to humans.
+
+=cut
+
+sub finish {
+ my $self = shift;
+ my $results = shift;
+
+ eval { require JSON::MaybeXS } or die "Missing dependency: JSON::MaybeXS\n";
+
+ my %options;
+ $options{pretty} = 1 if lc($self->format) eq 'pretty';
+
+ my $json = JSON::MaybeXS->new(canonical => 1, utf8 => 1, %options);
+
+ my $columns = $self->columns;
+ $results = [map { +{zip @$columns, @$_} } @$results];
+ print { $self->handle } $json->encode($results);
+}
+
+1;
--- /dev/null
+package App::Codeowners::Formatter::String;
+# ABSTRACT: Format codeowners output using printf-like strings
+
+=head1 DESCRIPTION
+
+This is a L<App::Codeowners::Formatter> that formats output using a printf-like string.
+
+See L<git-codeowners/"Format string">.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use parent 'App::Codeowners::Formatter';
+
+use App::Codeowners::Util qw(stringf zip);
+use Color::ANSI::Util 0.03 qw(ansifg);
+use Encode qw(encode);
+
+sub stream {
+ my $self = shift;
+ my $result = shift;
+
+ $result = {zip @{$self->columns}, @$result};
+
+ my %info = (
+ F => $self->_create_filterer->($result->{File}, undef),
+ O => $self->_create_filterer->($result->{Owner}, $self->_owner_colorgen),
+ P => $self->_create_filterer->($result->{Project}, undef),
+ T => $self->_create_filterer->($result->{Pattern}, undef),
+ );
+
+ my $text = stringf($self->format, %info);
+ print { $self->handle } encode('UTF-8', $text), "\n";
+}
+
+sub _expand_filter_args {
+ my $arg = shift || '';
+
+ my @filters = split(/,/, $arg);
+ my $color_override;
+
+ for (my $i = 0; $i < @filters; ++$i) {
+ my $filter = $filters[$i] or next;
+ if ($filter =~ /^(?:nocolor|color:([0-9a-fA-F]{3,6}))$/) {
+ $color_override = $1 || '';
+ splice(@filters, $i, 1);
+ redo;
+ }
+ }
+
+ return (\@filters, $color_override);
+}
+
+sub _ansi_reset { "\033[0m" }
+
+sub _colored {
+ my $text = shift;
+ my $rgb = shift or return $text;
+
+ return $text if $ENV{NO_COLOR};
+
+ $rgb =~ s/^(.)(.)(.)$/$1$1$2$2$3$3/;
+ if ($rgb !~ m/^[0-9a-fA-F]{6}$/) {
+ warn "Color value must be in 'ffffff' or 'fff' form.\n";
+ return $text;
+ }
+
+ my ($begin, $end) = (ansifg($rgb), _ansi_reset);
+ return "${begin}${text}${end}";
+}
+
+sub _create_filterer {
+ my $self = shift;
+
+ my %filter = (
+ quote => sub { local $_ = $_[0]; s/"/\"/s; "\"$_\"" },
+ );
+
+ return sub {
+ my $value = shift || '';
+ my $color = shift || '';
+ my $gencolor = ref($color) eq 'CODE' ? $color : sub { $color };
+ return sub {
+ my $arg = shift;
+ my ($filters, $color) = _expand_filter_args($arg);
+ if (ref($value) eq 'ARRAY') {
+ $value = join(',', map { _colored($_, $color // $gencolor->($_)) } @$value);
+ }
+ else {
+ $value = _colored($value, $color // $gencolor->($value));
+ }
+ for my $key (@$filters) {
+ if (my $filter = $filter{$key}) {
+ $value = $filter->($value);
+ }
+ else {
+ warn "Unknown filter: $key\n"
+ }
+ }
+ $value || '';
+ };
+ };
+}
+
+sub _owner_colorgen {
+ my $self = shift;
+
+ # https://sashat.me/2017/01/11/list-of-20-simple-distinct-colors/
+ my @contrasting_colors = qw(
+ e6194b 3cb44b ffe119 4363d8 f58231
+ 911eb4 42d4f4 f032e6 bfef45 fabebe
+ 469990 e6beff 9a6324 fffac8 800000
+ aaffc3 808000 ffd8b1 000075 a9a9a9
+ );
+
+ # assign a color to each owner, on demand
+ my %owner_colors;
+ my $num = -1;
+ $self->{owner_color} ||= sub {
+ my $owner = shift or return;
+ $owner_colors{$owner} ||= do {
+ $num = ($num + 1) % scalar @contrasting_colors;
+ $contrasting_colors[$num];
+ };
+ };
+}
+
+1;
--- /dev/null
+package App::Codeowners::Formatter::TSV;
+# ABSTRACT: Format codeowners output as tab-separated values
+
+=head1 DESCRIPTION
+
+This is a L<App::Codeowners::Formatter::CSV> that formats output using L<Text::CSV>.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use parent 'App::Codeowners::Formatter::CSV';
+
+sub sep { "\t" }
+
+1;
--- /dev/null
+package App::Codeowners::Formatter::Table;
+# ABSTRACT: Format codeowners output as a table
+
+=head1 DESCRIPTION
+
+This is a L<App::Codeowners::Formatter> that formats output using L<Text::Table::Any>.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use parent 'App::Codeowners::Formatter';
+
+use App::Codeowners::Util qw(stringify);
+use Encode qw(encode);
+
+sub finish {
+ my $self = shift;
+ my $results = shift;
+
+ eval { require Text::Table::Any } or die "Missing dependency: Text::Table::Any\n";
+
+ my $table = Text::Table::Any::table(
+ header_row => 1,
+ rows => [$self->columns, map { [map { stringify($_) } @$_] } @$results],
+ backend => $ENV{PERL_TEXT_TABLE},
+ );
+ print { $self->handle } encode('UTF-8', $table);
+}
+
+1;
--- /dev/null
+package App::Codeowners::Formatter::YAML;
+# ABSTRACT: Format codeowners output as YAML
+
+=head1 DESCRIPTION
+
+This is a L<App::Codeowners::Formatter> that formats output using L<YAML>.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use parent 'App::Codeowners::Formatter';
+
+use App::Codeowners::Util qw(zip);
+
+sub finish {
+ my $self = shift;
+ my $results = shift;
+
+ eval { require YAML } or die "Missing dependency: YAML\n";
+
+ my $columns = $self->columns;
+ $results = [map { +{zip @$columns, @$_} } @$results];
+ print { $self->handle } YAML::Dump($results);
+}
+
+1;
find_nearest_codeowners
git_ls_files
git_toplevel
+ run_command
run_git
stringf
+ stringify
unbackslash
+ zip
);
our $VERSION = '9999.999'; # VERSION
}
}
-sub run_git {
- my @cmd = ('git', @_);
-
- require IPC::Open2;
+sub run_command {
+ my $filter;
+ $filter = pop if ref($_[-1]) eq 'CODE';
my ($child_in, $child_out);
- my $pid = IPC::Open2::open2($child_out, $child_in, @cmd);
+ require IPC::Open2;
+ my $pid = IPC::Open2::open2($child_out, $child_in, @_);
close($child_in);
binmode($child_out, ':encoding(UTF-8)');
- chomp(my @lines = <$child_out>);
- waitpid($pid, 0);
- return if $? != 0;
+ my $proc = App::Codeowners::Util::Process->new(
+ pid => $pid,
+ fh => $child_out,
+ filter => $filter,
+ );
+
+ return wantarray ? ($proc, @{$proc->all}) : $proc;
+}
- return @lines;
+sub run_git {
+ return run_command('git', @_);
}
sub git_ls_files {
my $dir = shift || '.';
+ return run_git('-C', $dir, 'ls-files', @_, \&_unescape_git_filepath);
+}
- my @files = run_git('-C', $dir, qw{ls-files}, @_);
-
- return undef if !@files; ## no critic (Subroutines::ProhibitExplicitReturn)
-
- # Depending on git's "core.quotepath" config, non-ASCII chars may be
- # escaped (identified by surrounding dquotes), so try to unescape.
- for my $file (@files) {
- next if $file !~ /^"(.+)"$/;
- $file = $1;
- $file = unbackslash($file);
- $file = decode('UTF-8', $file);
- }
-
- return \@files;
+# Depending on git's "core.quotepath" config, non-ASCII chars may be
+# escaped (identified by surrounding dquotes), so try to unescape.
+sub _unescape_git_filepath {
+ return $_ if $_ !~ /^"(.+)"$/;
+ return decode('UTF-8', unbackslash($1));
}
sub git_toplevel {
my $dir = shift || '.';
- my ($path) = run_git('-C', $dir, qw{rev-parse --show-toplevel});
+ my ($proc, $path) = run_git('-C', $dir, qw{rev-parse --show-toplevel});
- return if !$path;
+ return if $proc->wait != 0 || !$path;
return path($path);
}
return $str;
}
+sub stringify {
+ my $item = shift;
+ return ref($item) eq 'ARRAY' ? join(',', @$item) : $item;
+}
+
+# The zip code is from List::SomeUtils (thanks DROLSKY), copied just so as not
+# to bring in the extra dependency.
+sub zip (\@\@) { ## no critic (Subroutines::ProhibitSubroutinePrototypes)
+ my $max = -1;
+ $max < $#$_ && ( $max = $#$_ ) foreach @_;
+ map {
+ my $ix = $_;
+ map $_->[$ix], @_;
+ } 0 .. $max;
+}
+
# The stringf code is from String::Format (thanks SREZIC), with changes:
# - Use Unicode::GCString for better Unicode character padding,
# - Strip ANSI color sequences,
return $str;
}
+{
+ package App::Codeowners::Util::Process;
+
+ sub new {
+ my $class = shift;
+ return bless {@_}, $class;
+ }
+
+ sub next {
+ my $self = shift;
+ my $line = readline($self->{fh});
+ if (defined $line) {
+ chomp $line;
+ if (my $filter = $self->{filter}) {
+ local $_ = $line;
+ $line = $filter->($line);
+ }
+ }
+ $line;
+ }
+
+ sub all {
+ my $self = shift;
+ chomp(my @lines = readline($self->{fh}));
+ if (my $filter = $self->{filter}) {
+ $_ = $filter->($_) for @lines;
+ }
+ \@lines;
+ }
+
+ sub wait {
+ my $self = shift;
+ my $pid = $self->{pid} or return;
+ if (my $fh = $self->{fh}) {
+ close($fh);
+ delete $self->{fh};
+ }
+ waitpid($pid, 0);
+ my $status = $?;
+ delete $self->{pid};
+ return $status;
+ }
+
+ sub DESTROY {
+ my ($self, $global_destruction) = @_;
+ return if $global_destruction;
+ $self->wait;
+ }
+}
+
1;
return;
}
- my $files = git_ls_files(git_toplevel());
+ my ($proc, @files) = git_ls_files(git_toplevel());
- $Test->plan(@$files ? (tests => scalar @$files) : (skip_all => 'git ls-files failed'));
+ $Test->plan($proc->wait == 0 ? (tests => scalar @files) : (skip_all => 'git ls-files failed'));
- for my $filepath (@$files) {
+ for my $filepath (@files) {
my $msg = encode('UTF-8', "Check file: $filepath");
my $match = $codeowners->match($filepath);
use Test::More;
can_ok('App::Codeowners::Util', qw{
- find_nearest_codeowners
+ colorstrip
find_codeowners_in_directory
- run_git
+ find_nearest_codeowners
git_ls_files
git_toplevel
+ run_command
+ run_git
+ stringf
+ stringify
+ unbackslash
+ zip
});
my $can_git = _can_git();
plan skip_all => 'Cannot run git' if !$can_git;
my $repodir =_setup_git_repo();
- my $r = App::Codeowners::Util::git_ls_files($repodir);
- is($r, undef, 'git ls-files returns undef when no repo files') or diag explain $r;
+ my (undef, @r) = App::Codeowners::Util::git_ls_files($repodir);
+ is_deeply(\@r, [], 'git ls-files returns [] when no repo files') or diag explain \@r;
- run_git('-C', $repodir, qw{add .});
- run_git('-C', $repodir, qw{commit -m}, 'initial commit');
+ run_git('-C', $repodir, qw{add .})->wait;
+ run_git('-C', $repodir, qw{commit -m}, 'initial commit')->wait;
- $r = App::Codeowners::Util::git_ls_files($repodir);
- is_deeply($r, [
+ (undef, @r) = App::Codeowners::Util::git_ls_files($repodir);
+ is_deeply(\@r, [
qw(a/b/c/bar.txt foo.txt)
- ], 'git ls-files returns correct repo files') or diag explain $r;
+ ], 'git ls-files returns correct repo files') or diag explain \@r;
};
subtest 'git_toplevel' => sub {
exit;
sub _can_git {
- my ($version) = run_git('--version');
+ my (undef, $version) = run_git('--version');
note "Found: $version" if $version;
return $version && $version ge 'git version 1.8.5'; # for -C flag
}
sub _setup_git_repo {
my $repodir = tempdir;
- run_git('-C', $repodir, 'init');
+ run_git('-C', $repodir, 'init')->wait;
$repodir->child('foo.txt')->touchpath;
$repodir->child('a/b/c/bar.txt')->touchpath;
exit;
sub _can_git {
- my ($version) = run_git('--version');
+ my (undef, $version) = run_git('--version');
note "Found: $version" if $version;
return $version && $version ge 'git version 1.8.5'; # for -C flag
}
a/ @snickers
END
- run_git('-C', $repodir, qw{init});
- run_git('-C', $repodir, qw{add .});
- run_git('-C', $repodir, qw{commit -m}, 'initial commit');
+ run_git('-C', $repodir, qw{init})->wait;
+ run_git('-C', $repodir, qw{add .})->wait;
+ run_git('-C', $repodir, qw{commit -m}, 'initial commit')->wait;
return $repodir;
}
projects / chaz / git-codeowners / commitdiff
