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