File Coverage

blib/lib/Code/TidyAll/Git/Util.pm
Criterion Covered Total %
statement 48 48 100.0
branch 10 10 100.0
condition 3 3 100.0
subroutine 11 11 100.0
pod 0 2 0.0
total 72 74 97.3


line stmt bran cond sub pod time code
1             package Code::TidyAll::Git::Util;
2              
3 2     2   48163 use strict;
  2         19  
  2         69  
4 2     2   13 use warnings;
  2         4  
  2         74  
5              
6 2     2   427 use File::pushd qw(pushd);
  2         1224  
  2         125  
7 2     2   1158 use IPC::System::Simple qw(capturex);
  2         18149  
  2         141  
8 2     2   512 use List::SomeUtils qw(uniq);
  2         12881  
  2         147  
9 2     2   867 use Path::Tiny qw(path);
  2         12744  
  2         132  
10              
11 2     2   16 use Exporter qw(import);
  2         4  
  2         940  
12              
13             our $VERSION = '0.83';
14              
15             our @EXPORT_OK = qw(git_files_to_commit git_modified_files);
16              
17             sub git_files_to_commit {
18 15     15 0 6392483 my ($dir) = @_;
19 15         179 return _relevant_files_from_status( $dir, 1 );
20             }
21              
22             sub git_modified_files {
23 3     3 0 7816 my ($dir) = @_;
24 3         28 return _relevant_files_from_status( $dir, 0 );
25             }
26              
27             sub _relevant_files_from_status {
28 18     18   105 my ( $dir, $index_only ) = @_;
29              
30 18         299 $dir = path($dir);
31 18         1110 my $pushed = pushd( $dir->absolute );
32 18         6879 my $status = capturex(qw( git status --porcelain -z -uno ));
33              
34 18 100       132223 return unless $status;
35              
36 14         263 return map { $dir->child($_) } _parse_status( $status, $index_only );
  7         264  
37             }
38              
39             sub _parse_status {
40 15     15   131 my ( $status, $index_only ) = @_;
41              
42 15         217 local $_ = $status;
43              
44             # There can't possibly be more records than nuls plus one, so we use this
45             # as an upper bound on passes.
46 15         154 my $times = tr/\0/\0/;
47              
48 15         50 my @files;
49              
50 15         142 for my $i ( 0 .. $times ) {
51 39 100       382 last if /\G\Z/gc;
52              
53 24         319 /\G(..) /g;
54 24         494 my $mode = $1;
55              
56 24         225 /\G([^\0]+)\0/g;
57 24         113 my $name = $1;
58              
59             # on renames, parse but throw away the "renamed from" filename
60 24 100       224 if ( $mode =~ /[CR]/ ) {
61 2         7 /\G([^\0]+)\0/g;
62             }
63              
64             # deletions and renames don't cause tidying
65 24 100       152 next unless $mode =~ /[MA]/;
66 21 100 100     346 next if $index_only && $mode =~ /^ /;
67              
68 10         59 push @files, $name;
69             }
70              
71 15         246 return @files;
72             }
73              
74             1;
75              
76             # ABSTRACT: Utilities for the git hook classes
77              
78             __END__
79              
80             =pod
81              
82             =encoding UTF-8
83              
84             =head1 NAME
85              
86             Code::TidyAll::Git::Util - Utilities for the git hook classes
87              
88             =head1 VERSION
89              
90             version 0.83
91              
92             =head1 SUPPORT
93              
94             Bugs may be submitted at L<https://github.com/houseabsolute/perl-code-tidyall/issues>.
95              
96             =head1 SOURCE
97              
98             The source code repository for Code-TidyAll can be found at L<https://github.com/houseabsolute/perl-code-tidyall>.
99              
100             =head1 AUTHORS
101              
102             =over 4
103              
104             =item *
105              
106             Jonathan Swartz <swartz@pobox.com>
107              
108             =item *
109              
110             Dave Rolsky <autarch@urth.org>
111              
112             =back
113              
114             =head1 COPYRIGHT AND LICENSE
115              
116             This software is copyright (c) 2011 - 2022 by Jonathan Swartz.
117              
118             This is free software; you can redistribute it and/or modify it under
119             the same terms as the Perl 5 programming language system itself.
120              
121             The full text of the license can be found in the
122             F<LICENSE> file included with this distribution.
123              
124             =cut