line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package ShipIt::VC; |
2
|
2
|
|
|
2
|
|
13
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
72
|
|
3
|
2
|
|
|
2
|
|
10
|
use ShipIt::VC::SVN; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
45
|
|
4
|
2
|
|
|
2
|
|
935
|
use ShipIt::VC::SVK; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
116
|
|
5
|
2
|
|
|
2
|
|
8951
|
use ShipIt::VC::Git; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
103
|
|
6
|
2
|
|
|
2
|
|
1279
|
use ShipIt::VC::Mercurial; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
1490
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
ShipIt::VC -- abstract base class for version control systems |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# done for you, elsewhere |
15
|
|
|
|
|
|
|
... ShipIt::VC->new($conf) |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# get your instance from your state handle: |
18
|
|
|
|
|
|
|
$vc = $state->vc; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# then |
21
|
|
|
|
|
|
|
$vc->commit($msg); |
22
|
|
|
|
|
|
|
$vc->tag_version("1.25"[, $msg]); |
23
|
|
|
|
|
|
|
$vc->exists_tagged_version("1.25"); # 1 |
24
|
|
|
|
|
|
|
$vc->local_diff("ChangeLog"); # returns diff of changelog |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 OVERVIEW |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
ShipIt::VC is an abstract base class, with a factory method 'new' to |
29
|
|
|
|
|
|
|
return a subclass instance for the version control system detected to |
30
|
|
|
|
|
|
|
be in use. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Rather than using 'new' directly, you should call your |
33
|
|
|
|
|
|
|
L $state's "vc" accessor method, which returns a |
34
|
|
|
|
|
|
|
memoized (er, singleton) instance of ShipIt::VC->new. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=cut |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub new { |
39
|
0
|
|
|
0
|
0
|
|
my ($class, $conf) = @_; |
40
|
0
|
0
|
|
|
|
|
return ShipIt::VC::SVN->new($conf) if -e ".svn"; |
41
|
0
|
0
|
|
|
|
|
return ShipIt::VC::Git->new($conf) if -e ".git"; |
42
|
0
|
0
|
|
|
|
|
return ShipIt::VC::Mercurial->new($conf) if -e ".hg"; |
43
|
0
|
0
|
|
|
|
|
return ShipIt::VC::SVK->new($conf) if $class->is_svk_co; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# look for any custom modules with an expensive search after exhausting the known ones |
46
|
0
|
|
|
|
|
|
for my $class (grep {!/::(SVN|Git|Mercurial|SVK)$/} find_subclasses($class)) { |
|
0
|
|
|
|
|
|
|
47
|
0
|
|
|
|
|
|
eval "CORE::require $class"; |
48
|
0
|
|
|
|
|
|
my $vc = $class->new($conf); |
49
|
0
|
0
|
|
|
|
|
return $vc if $vc; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
die "Unknown/undetected version control system. Currently only svn/svk/git/hg are supported."; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub is_svk_co { |
56
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
my $info = `yes | sed 's/y/n/' | svk info 2>&1`; |
59
|
0
|
|
0
|
|
|
|
return $info && $info =~ /Checkout Path/; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 ABSTRACT METHODS |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 commit($msg); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Commit all outstanding changes in working copy to repo, with provided commit message. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=cut |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub commit { |
71
|
0
|
|
|
0
|
1
|
|
my ($self, $msg) = @_; |
72
|
0
|
|
|
|
|
|
die "ABSTRACT commit method for $self"; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 tag_version($ver[, $msg]); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Tag the current version (already committed) as the provided version number. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub tag_version { |
82
|
0
|
|
|
0
|
1
|
|
my ($self, $ver, $msg) = @_; |
83
|
0
|
|
|
|
|
|
die "ABSTRACT commit tag_version for $self"; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head2 exists_tagged_version($ver) |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Returns true if the given version is already tagged. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=cut |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub exists_tagged_version { |
93
|
0
|
|
|
0
|
1
|
|
my ($self, $ver) = @_; |
94
|
0
|
|
|
|
|
|
die "ABSTRACT exists_tagged_version for $self"; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head2 local_diff($file) |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Returns diff of $file from what's on the server compared to the local on-disk copy. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=cut |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub local_diff { |
104
|
0
|
|
|
0
|
1
|
|
my ($self, $file) = @_; |
105
|
0
|
|
|
|
|
|
die "ABSTRACT local_diff for $self"; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head2 are_local_diffs |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Returns bool, if any files on disk are uncommitted. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub are_local_diffs { |
115
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
116
|
0
|
|
|
|
|
|
die "ABSTRACT are_local_diffs for $self"; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
1; |