File Coverage

blib/lib/App/Git/Workflow/Command/Files.pm
Criterion Covered Total %
statement 75 75 100.0
branch 15 16 93.7
condition 6 6 100.0
subroutine 10 10 100.0
pod 4 4 100.0
total 110 111 99.1


line stmt bran cond sub pod time code
1             package App::Git::Workflow::Command::Files;
2              
3             # Created on: 2014-03-11 20:58:59
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 2     2   108308 use strict;
  2         18  
  2         65  
10 2     2   13 use warnings;
  2         4  
  2         70  
11 2     2   466 use version;
  2         2110  
  2         11  
12 2     2   675 use English qw/ -no_match_vars /;
  2         3936  
  2         15  
13 2     2   1359 use App::Git::Workflow;
  2         10  
  2         146  
14 2     2   626 use App::Git::Workflow::Command qw/get_options/;
  2         7  
  2         2211  
15              
16             our $VERSION = version->new(1.1.16);
17             our $workflow = App::Git::Workflow->new;
18             my ($name) = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
19             our %option;
20              
21             sub run {
22 8     8 1 29 %option = (
23             age => 28,
24             );
25 8 100       37 get_options(
26             \%option,
27             'since|s=s',
28             'age|a=i',
29             'tag|t=s',
30             'branch|b=s',
31             'local|l',
32             'max_history|max-history|m=i',
33             ) or return;
34              
35             # do stuff here
36 7         20 $workflow->{VERBOSE} = $option{verbose};
37 7         14 $workflow->{TEST } = $option{test};
38              
39 7 100 100     76 my $action = @ARGV && __PACKAGE__->can("do_$ARGV[0]") ? 'do_' . shift @ARGV : 'do_changed';
40              
41 7         45 my ($release) = $workflow->releases(%option);
42              
43 7         33 return __PACKAGE__->$action($release, @ARGV);
44             }
45              
46             sub do_local {
47 5     5 1 12 my (undef, $release) = @_;
48              
49             # get local branch changed files vs prod
50 5         17 my @local_files = map {/(.*)$/; $1} $workflow->git->diff('--name-only', $release->{name});
  10         27  
  10         32  
51 5         15 my $all_files = files_changed();
52 5         28 my ($type, $name) = $workflow->current();
53 5         17 my %files;
54              
55             # iterate over all locally changed files
56 5         15 for my $file (@local_files) {
57 10 100       134 warn "$file\n" if $option{verbose};
58              
59             # check that it has been modified in recent times
60 10 100       43 if ($all_files->{$file}) {
61             # iterate over each commit id to eliminate them from the current branch
62 8         14 for my $sha (@{ $all_files->{$file}{sha} }) {
  8         24  
63 16 100 100     119 warn " $sha\n" if $option{verbose} && $option{verbose} > 1;
64              
65             # get a list of branches that the file changed on (apart from the current)
66             my @branches =
67 30         83 grep {$_ ne $name}
68 16         59 map {m{ ([^/\s]*) $}xms; $1}
  30         147  
  30         87  
69             $workflow->git->branch(qw/-a --contains/, $sha);
70              
71 16 100       43 next if !@branches;
72              
73 15         44 my $show = $workflow->git->show($sha);
74 15         89 my ($author) = $show =~ /^Author: \s+ (.*?) \s+ </xms;
75 15         24 push @{ $files{$file}{branches} }, @branches;
  15         47  
76 15         24 push @{ $files{$file}{authors} }, $author;
  15         48  
77             }
78             }
79             }
80 5         26 for my $file (sort keys %files) {
81 8         18 my %branches = map { $_ => 1 } @{ $files{$file}{branches} };
  30         68  
  8         27  
82 8         18 my %authors = map { $_ => 1 } @{ $files{$file}{authors} };
  15         36  
  8         18  
83 8         224 print "$file\n";
84 8         198 print " Modified in : " . (join ', ', sort keys %branches) . "\n";
85 8         170 print " by : " . (join ', ', sort keys %authors) . "\n";
86             }
87             }
88              
89             sub do_changed {
90 2     2 1 7 my $files = files_changed();
91             print
92 4         155 map { sprintf "%4d %s\n", $files->{$_}{count}, $_ }
93 2 50       11 sort { $files->{$a}{count} <=> $files->{$b}{count} || $a cmp $b }
  2         12  
94             keys %$files;
95             }
96              
97             sub files_changed {
98 7 100   7 1 34 my $args = $option{since} ? "--since=$option{since}" : "--max-age=" . ( time - 60 * 60 * 24 * $option{age} );
99 7         18 my @commits = $workflow->git->rev_list('--all', $args);
100 7         14 my %files;
101              
102 7         19 for my $id (@commits) {
103 23         46 chomp $id;
104 23         57 my (undef, @files) = $workflow->git->show(qw/--name-only --oneline/, $id);
105 23         48 for my $file (@files) {
106 23         39 chomp $file;
107 23         51 $files{$file}{count}++;
108 23         35 push @{ $files{$file}{sha} }, $id;
  23         67  
109             }
110             }
111              
112 7         20 return \%files;
113             }
114              
115             1;
116              
117             __DATA__
118              
119             =head1 NAME
120              
121             git-files - Get information on files changed across branches.
122              
123             =head1 VERSION
124              
125             This documentation refers to git-files version 1.1.16
126              
127             =head1 SYNOPSIS
128              
129             git-files [changed] [(-s|--age) days] [(-s|--since) YYYY-MM-DD] [-v|--verbose]
130             git-files local [(-s|--age) days] [(-s|--since) YYYY-MM-DD] [-v|--verbose]
131             git-files set [-v|--verbose]
132             git-files
133              
134             SUB COMMANDS:
135             changed Files that have changed
136             local See if any locally (to the branch) modified files have been
137             modified in other branches.
138             set Sets files modified time to the date they were last committed.
139              
140             OPTIONS:
141             -a --age[=]days
142             Age in days to look changed files
143             -s --since[=]YYYY-MM-DDTHH::MM
144             Files changed since date
145             -t --tag[=]tag
146             Tag to use to define a release
147             -b --branch[=]branch
148             Branch to use to define a release
149             -l --local
150             Use master as release
151             -m --max-history[=]int
152             Limit getting release history to this number of commits
153              
154             -v --verbose Show more detailed option
155             --version Prints the version information
156             --help Prints this help information
157             --man Prints the full documentation for git-files
158              
159             =head1 DESCRIPTION
160              
161             The C<git-files> command helps to find out which files are being actively
162             changed by whom and where those files changes are occurring. The aim is to
163             help developers see if other developers are working on the same files. This
164             should reduce the potential for conflicts later on (or at least start the
165             process to resolve those conflicts).
166              
167             =head1 SUBROUTINES/METHODS
168              
169             =head2 C<run ()>
170              
171             Executes the git workflow command
172              
173             =head2 C<do_local ($release)>
174              
175             =head2 C<do_changed ()>
176              
177             =head2 C<files_changed ()>
178              
179             =head1 DIAGNOSTICS
180              
181             =head1 CONFIGURATION AND ENVIRONMENT
182              
183             =head1 DEPENDENCIES
184              
185             =head1 INCOMPATIBILITIES
186              
187             =head1 BUGS AND LIMITATIONS
188              
189             There are no known bugs in this module.
190              
191             Please report problems to Ivan Wills (ivan.wills@gmail.com).
192              
193             Patches are welcome.
194              
195             =head1 AUTHOR
196              
197             Ivan Wills - (ivan.wills@gmail.com)
198              
199             =head1 LICENSE AND COPYRIGHT
200              
201             Copyright (c) 2014 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
202             All rights reserved.
203              
204             This module is free software; you can redistribute it and/or modify it under
205             the same terms as Perl itself. See L<perlartistic>. This program is
206             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
207             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
208             PARTICULAR PURPOSE.
209              
210             =cut