From: Charles McGarvey Date: Wed, 13 Nov 2019 03:43:12 +0000 (-0700) Subject: refactor formatters X-Git-Tag: v0.42~5 X-Git-Url: https://git.brokenzipper.com/gitweb?a=commitdiff_plain;h=26eed33eb4aa577d9347e5ebaf577b3e3a2c0396;p=chaz%2Fgit-codeowners refactor formatters --- diff --git a/lib/App/Codeowners.pm b/lib/App/Codeowners.pm index c3d01d3..20be985 100644 --- a/lib/App/Codeowners.pm +++ b/lib/App/Codeowners.pm @@ -6,8 +6,9 @@ use utf8; 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; @@ -50,26 +51,25 @@ sub _command_show { 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 { @@ -84,12 +84,12 @@ 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 { @@ -104,12 +104,12 @@ 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 } @@ -165,166 +165,4 @@ END 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; diff --git a/lib/App/Codeowners/Formatter.pm b/lib/App/Codeowners/Formatter.pm new file mode 100644 index 0000000..db17ace --- /dev/null +++ b/lib/App/Codeowners/Formatter.pm @@ -0,0 +1,207 @@ +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 +* L +* L +* L +* L +* L + +=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. + +=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 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 method. + +This method may print a header to the L. 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. This +method is used by subclasses and should typically not called be called explicitly. + +The default implementation simply stores the L so they will be available to L. + +=method finish + + $formatter->finish; + +End formatting results. Called after all results are passed to the L method. + +This method may print a footer to the L. 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 +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; diff --git a/lib/App/Codeowners/Formatter/CSV.pm b/lib/App/Codeowners/Formatter/CSV.pm new file mode 100644 index 0000000..a101625 --- /dev/null +++ b/lib/App/Codeowners/Formatter/CSV.pm @@ -0,0 +1,75 @@ +package App::Codeowners::Formatter::CSV; +# ABSTRACT: Format codeowners output as comma-separated values + +=head1 DESCRIPTION + +This is a L that formats output using L. + +=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 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. + +=attr quote + +Get the value used for L. + +=attr escape_char + +Get the value used for L. + +=cut + +sub sep { $_[0]->{sep} || $_[0]->format } +sub quote { $_[0]->{quote} } +sub escape_char { $_[0]->{escape_char} } + +1; diff --git a/lib/App/Codeowners/Formatter/JSON.pm b/lib/App/Codeowners/Formatter/JSON.pm new file mode 100644 index 0000000..3c7f8b8 --- /dev/null +++ b/lib/App/Codeowners/Formatter/JSON.pm @@ -0,0 +1,41 @@ +package App::Codeowners::Formatter::JSON; +# ABSTRACT: Format codeowners output as JSON + +=head1 DESCRIPTION + +This is a L that formats output using L. + +=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; diff --git a/lib/App/Codeowners/Formatter/String.pm b/lib/App/Codeowners/Formatter/String.pm new file mode 100644 index 0000000..6421783 --- /dev/null +++ b/lib/App/Codeowners/Formatter/String.pm @@ -0,0 +1,132 @@ +package App::Codeowners::Formatter::String; +# ABSTRACT: Format codeowners output using printf-like strings + +=head1 DESCRIPTION + +This is a L that formats output using a printf-like string. + +See L. + +=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; diff --git a/lib/App/Codeowners/Formatter/TSV.pm b/lib/App/Codeowners/Formatter/TSV.pm new file mode 100644 index 0000000..dbf12d4 --- /dev/null +++ b/lib/App/Codeowners/Formatter/TSV.pm @@ -0,0 +1,19 @@ +package App::Codeowners::Formatter::TSV; +# ABSTRACT: Format codeowners output as tab-separated values + +=head1 DESCRIPTION + +This is a L that formats output using L. + +=cut + +use warnings; +use strict; + +our $VERSION = '9999.999'; # VERSION + +use parent 'App::Codeowners::Formatter::CSV'; + +sub sep { "\t" } + +1; diff --git a/lib/App/Codeowners/Formatter/Table.pm b/lib/App/Codeowners/Formatter/Table.pm new file mode 100644 index 0000000..1f9373e --- /dev/null +++ b/lib/App/Codeowners/Formatter/Table.pm @@ -0,0 +1,34 @@ +package App::Codeowners::Formatter::Table; +# ABSTRACT: Format codeowners output as a table + +=head1 DESCRIPTION + +This is a L that formats output using L. + +=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; diff --git a/lib/App/Codeowners/Formatter/YAML.pm b/lib/App/Codeowners/Formatter/YAML.pm new file mode 100644 index 0000000..8730e19 --- /dev/null +++ b/lib/App/Codeowners/Formatter/YAML.pm @@ -0,0 +1,30 @@ +package App::Codeowners::Formatter::YAML; +# ABSTRACT: Format codeowners output as YAML + +=head1 DESCRIPTION + +This is a L that formats output using L. + +=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; diff --git a/lib/App/Codeowners/Util.pm b/lib/App/Codeowners/Util.pm index afad95d..d7a4a4b 100644 --- a/lib/App/Codeowners/Util.pm +++ b/lib/App/Codeowners/Util.pm @@ -20,9 +20,12 @@ our @EXPORT_OK = qw( find_nearest_codeowners git_ls_files git_toplevel + run_command run_git stringf + stringify unbackslash + zip ); our $VERSION = '9999.999'; # VERSION @@ -82,49 +85,48 @@ sub find_codeowners_in_directory { } } -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); } @@ -134,6 +136,22 @@ sub colorstrip { 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, @@ -226,4 +244,54 @@ sub unbackslash { 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; diff --git a/lib/Test/File/Codeowners.pm b/lib/Test/File/Codeowners.pm index 8bdf14b..332b3b7 100644 --- a/lib/Test/File/Codeowners.pm +++ b/lib/Test/File/Codeowners.pm @@ -78,11 +78,11 @@ sub codeowners_git_files_ok { 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); diff --git a/t/app-codeowners-util.t b/t/app-codeowners-util.t index 4366fda..af153e9 100644 --- a/t/app-codeowners-util.t +++ b/t/app-codeowners-util.t @@ -8,11 +8,17 @@ use Path::Tiny qw(path tempdir); 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(); @@ -21,16 +27,16 @@ subtest 'git_ls_files' => sub { 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 { @@ -71,7 +77,7 @@ done_testing; 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 } @@ -79,7 +85,7 @@ sub _can_git { 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; diff --git a/t/app-codeowners.t b/t/app-codeowners.t index 8be4287..e3a1e2e 100644 --- a/t/app-codeowners.t +++ b/t/app-codeowners.t @@ -76,7 +76,7 @@ done_testing; 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 } @@ -93,9 +93,9 @@ sub _setup_git_repo { 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; }