line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Git::Workflow::Command::BranchClean; |
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
|
3
|
|
|
3
|
|
194595
|
use strict; |
|
3
|
|
|
|
|
24
|
|
|
3
|
|
|
|
|
102
|
|
10
|
3
|
|
|
3
|
|
17
|
use warnings; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
111
|
|
11
|
3
|
|
|
3
|
|
844
|
use version; |
|
3
|
|
|
|
|
3539
|
|
|
3
|
|
|
|
|
19
|
|
12
|
3
|
|
|
3
|
|
1157
|
use English qw/ -no_match_vars /; |
|
3
|
|
|
|
|
6985
|
|
|
3
|
|
|
|
|
21
|
|
13
|
3
|
|
|
3
|
|
2046
|
use App::Git::Workflow; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
168
|
|
14
|
3
|
|
|
3
|
|
969
|
use App::Git::Workflow::Command qw/get_options/; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
3387
|
|
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
|
|
|
|
|
|
|
our %p2u_extra; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub run { |
23
|
11
|
|
|
11
|
1
|
30
|
my ($self) = @_; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
%option = ( |
26
|
|
|
|
|
|
|
exclude => [], |
27
|
11
|
|
100
|
|
|
94
|
max_age => ( $ENV{GIT_WORKFLOW_MAX_AGE} || $workflow->config('workflow.max') || 120 ), |
28
|
|
|
|
|
|
|
tag_prefix => '', |
29
|
|
|
|
|
|
|
tag_suffix => '', |
30
|
|
|
|
|
|
|
); |
31
|
11
|
100
|
|
|
|
69
|
get_options( |
32
|
|
|
|
|
|
|
\%option, |
33
|
|
|
|
|
|
|
'remote|r', |
34
|
|
|
|
|
|
|
'all|a', |
35
|
|
|
|
|
|
|
'exclude|e=s@', |
36
|
|
|
|
|
|
|
'exclude_file|exclude-file|f=s', |
37
|
|
|
|
|
|
|
'max_age|max-age|m=i', |
38
|
|
|
|
|
|
|
'min_age|min-age|n=i', |
39
|
|
|
|
|
|
|
'tag|t!', |
40
|
|
|
|
|
|
|
'tag_prefix|tag-prefix|p=s', |
41
|
|
|
|
|
|
|
'tag_suffix|tag-suffix|s=s', |
42
|
|
|
|
|
|
|
'test!', |
43
|
|
|
|
|
|
|
) or return; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# get the list of branches to look at |
46
|
10
|
|
|
|
|
23
|
my $max = 0; |
47
|
10
|
100
|
|
|
|
65
|
my @branches = $workflow->branches($option{remote} ? 'remote' : $option{all} ? 'both' : undef ); |
|
|
100
|
|
|
|
|
|
48
|
10
|
|
|
|
|
19
|
my @excludes = @{ $option{exclude} }; |
|
10
|
|
|
|
|
26
|
|
49
|
10
|
|
50
|
|
|
49
|
my $action = 'do_' . ( $ARGV[0] || 'delete' ); |
50
|
10
|
|
|
|
|
28
|
my ($total, $deleted) = (0, 0); |
51
|
|
|
|
|
|
|
|
52
|
10
|
50
|
|
|
|
82
|
if (!$self->can($action)) { |
53
|
0
|
|
|
|
|
0
|
warn "Unknown action $ARGV[0]!\n"; |
54
|
0
|
|
|
|
|
0
|
Pod::Usage::pod2usage( %p2u_extra, -verbose => 1 ); |
55
|
0
|
|
|
|
|
0
|
return 1; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
10
|
100
|
|
|
|
32
|
if ($option{exclude_file}) { |
59
|
1
|
|
|
|
|
7
|
for my $exclude ($workflow->slurp($option{exclude_file})) { |
60
|
3
|
|
|
|
|
8
|
chomp $exclude; |
61
|
3
|
100
|
|
|
|
9
|
next if !$exclude; |
62
|
2
|
100
|
|
|
|
11
|
next if $exclude =~ /^\s*(?:[#].*)$/xms; |
63
|
1
|
|
|
|
|
5
|
push @excludes, $exclude; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
BRANCH: |
68
|
10
|
|
|
|
|
32
|
for my $branch (@branches) { |
69
|
|
|
|
|
|
|
# skip master branches |
70
|
31
|
100
|
|
|
|
137
|
next BRANCH if $branch =~ m{^ (?:[^/]+/)? master $}xms; |
71
|
19
|
100
|
|
|
|
50
|
next BRANCH if grep {$branch =~ /$_/} @excludes; |
|
2
|
|
|
|
|
21
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# get branch details |
74
|
18
|
|
|
|
|
85
|
my $details = $workflow->commit_details($branch, branches => 0); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# don't delete young branches even if merged |
77
|
18
|
100
|
|
|
|
53
|
next BRANCH if too_young_to_die($details); |
78
|
|
|
|
|
|
|
|
79
|
16
|
100
|
|
|
|
63
|
$max = $details->{time} if $max < $details->{time}; |
80
|
16
|
|
|
|
|
58
|
$deleted += __PACKAGE__->$action($branch, $details); |
81
|
16
|
|
|
|
|
65
|
$total++; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
10
|
|
|
|
|
285
|
warn "Deleted $deleted of $total branches\nMax = " . (int $max/60/60/24) . "\n"; |
85
|
|
|
|
|
|
|
|
86
|
10
|
|
|
|
|
82
|
return; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub do_delete { |
90
|
16
|
|
|
16
|
1
|
41
|
my ($self, $branch, $details) = @_; |
91
|
|
|
|
|
|
|
|
92
|
16
|
|
|
|
|
36
|
my $too_old = too_old($details); |
93
|
16
|
|
|
|
|
28
|
my $in_master; |
94
|
|
|
|
|
|
|
|
95
|
16
|
100
|
|
|
|
49
|
if (!$too_old) { |
96
|
15
|
|
|
|
|
48
|
$in_master = in_master($details); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
16
|
100
|
100
|
|
|
59
|
if ( $in_master || $too_old ) { |
100
|
10
|
100
|
|
|
|
491
|
warn 'deleting ' . ($in_master ? 'merged' : 'old') . " branch $branch\n"; |
101
|
|
|
|
|
|
|
|
102
|
10
|
100
|
|
|
|
111
|
my ($remote, $name) = $branch =~ m{/} ? split m{/}, $branch, 2 : (undef, $branch); |
103
|
|
|
|
|
|
|
|
104
|
10
|
100
|
|
|
|
41
|
if ( $option{tag} ) { |
105
|
5
|
|
|
|
|
19
|
my $tag = $option{tag_prefix} . $name . $option{tag_suffix}; |
106
|
5
|
100
|
|
|
|
35
|
$workflow->git->tag(qw/-a -m /, "Converting '$name' to the tag '$tag'", $tag) if !$option{test}; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
10
|
100
|
|
|
|
53
|
if ( !$option{test} ) { |
110
|
8
|
100
|
|
|
|
40
|
if ($remote) { |
111
|
|
|
|
|
|
|
eval { |
112
|
2
|
|
|
|
|
10
|
$workflow->git->push($remote, '--no-verify', ":refs/heads/$name"); |
113
|
2
|
|
|
|
|
9
|
1; |
114
|
2
|
50
|
|
|
|
5
|
} or do { |
115
|
0
|
|
|
|
|
0
|
return 0; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
else { |
119
|
6
|
|
|
|
|
25
|
$workflow->git->branch('-D', "$name"); |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
10
|
|
|
|
|
33
|
return 1; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
6
|
|
|
|
|
15
|
return 0; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub in_master { |
130
|
15
|
|
|
15
|
1
|
35
|
my ($details) = @_; |
131
|
|
|
|
|
|
|
|
132
|
15
|
|
|
|
|
52
|
my %branches = map { $_ => 1 } $workflow->branches('both', $details->{sha}); |
|
23
|
|
|
|
|
89
|
|
133
|
|
|
|
|
|
|
|
134
|
15
|
|
66
|
|
|
64
|
return $branches{master} || $branches{'origin/master'}; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub too_old { |
138
|
16
|
|
|
16
|
1
|
35
|
my ($details) = @_; |
139
|
|
|
|
|
|
|
|
140
|
16
|
100
|
|
|
|
45
|
return if !$option{max_age}; |
141
|
|
|
|
|
|
|
|
142
|
15
|
|
|
|
|
60
|
return time - $option{max_age} * 60 * 60 * 24 > $details->{time}; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub too_young_to_die { |
146
|
18
|
|
|
18
|
1
|
37
|
my ($details) = @_; |
147
|
|
|
|
|
|
|
|
148
|
18
|
100
|
|
|
|
62
|
return if !$option{min_age}; |
149
|
|
|
|
|
|
|
|
150
|
4
|
|
|
|
|
28
|
return time - $option{min_age} * 60 * 60 * 24 < $details->{time}; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
1; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
__DATA__ |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head1 NAME |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
git-branch-clean - Clean old branches out of the repository |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 VERSION |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
This documentation refers to git-branch-clean version 1.1.16 |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head1 SYNOPSIS |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
git-branch-clean [option] |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
OPTIONS: |
170
|
|
|
|
|
|
|
-r --remote Only remote branches (defaults to local branches) |
171
|
|
|
|
|
|
|
-a --all All branches |
172
|
|
|
|
|
|
|
-m --max-age[=]days |
173
|
|
|
|
|
|
|
Maximum age of a branch with out changes before it is cleaned |
174
|
|
|
|
|
|
|
weather it's merged to master or not. (Default 0, no max age) |
175
|
|
|
|
|
|
|
-n --min-age[=]days |
176
|
|
|
|
|
|
|
Leave branches this number of days or new alone even if merged |
177
|
|
|
|
|
|
|
to master. (default 7 days) |
178
|
|
|
|
|
|
|
-e --exclude[=]regex |
179
|
|
|
|
|
|
|
Regular expression to exclude specific branches from deletion. |
180
|
|
|
|
|
|
|
You can specify --exclude multiple times for more control. |
181
|
|
|
|
|
|
|
--exclude-file[=]file |
182
|
|
|
|
|
|
|
A file of exclude regular expressions, blank lines and lines |
183
|
|
|
|
|
|
|
starting with a hash (#) are ignored. |
184
|
|
|
|
|
|
|
-t --tag Create tags of the same name as the branch |
185
|
|
|
|
|
|
|
-p --tag-prefix[=]str |
186
|
|
|
|
|
|
|
When converting a branch to a tag prepend it with "str" |
187
|
|
|
|
|
|
|
-s --tag-suffix[=]str |
188
|
|
|
|
|
|
|
When converting a branch to a tag apend it with "str" |
189
|
|
|
|
|
|
|
--test Don't actually delete branches just report on what branches |
190
|
|
|
|
|
|
|
would be deleted. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
-v --verbose Show more detailed option |
193
|
|
|
|
|
|
|
--version Prints the version information |
194
|
|
|
|
|
|
|
--help Prints this help information |
195
|
|
|
|
|
|
|
--man Prints the full documentation for git-branch-clean |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 DESCRIPTION |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
C<git-branch-clean> deletes branches merged to master (but not newer than |
200
|
|
|
|
|
|
|
C<--min-age> days). Optionally also deleting branches that haven't been |
201
|
|
|
|
|
|
|
modified more than C<--max-age> days. When deleting branches they can be |
202
|
|
|
|
|
|
|
converted to tags (C<--tag>) with optional an prefix (C<--tag-prefix>) and/or |
203
|
|
|
|
|
|
|
an optional suffix (C<--tag-suffix>) added. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head2 C<run ()> |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Executes the git workflow command |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head2 C<do_delete ($branch, $details)> |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Performs the deleting of old branches. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head2 C<in_master ($details)> |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
The branch with C<$details> has been merged to master |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=head2 C<too_old ($details)> |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
The branch with C<$details> has not been modified in greater than C<--max-age> |
222
|
|
|
|
|
|
|
days. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head2 C<too_young_to_die ($details)> |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
The branch was only recently used and should be cleaned. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
There are no known bugs in this module. |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
Please report problems to Ivan Wills (ivan.wills@gmail.com). |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Patches are welcome. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head1 AUTHOR |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
Ivan Wills - (ivan.wills@gmail.com) |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Copyright (c) 2014 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077). |
251
|
|
|
|
|
|
|
All rights reserved. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it under |
254
|
|
|
|
|
|
|
the same terms as Perl itself. See L<perlartistic>. This program is |
255
|
|
|
|
|
|
|
distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; |
256
|
|
|
|
|
|
|
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
257
|
|
|
|
|
|
|
PARTICULAR PURPOSE. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=cut |