File: | blib/lib/Git/ReleaseRepo/Test.pm |
Coverage: | 75.0% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Git::ReleaseRepo::Test; | ||||||
2 | |||||||
3 | 2 2 2 | 2170 2 31 | use strict; | ||||
4 | 2 2 2 | 5 2 22 | use warnings; | ||||
5 | 2 2 2 | 4 2 8 | use Test::Most; | ||||
6 | 2 2 2 | 10402 23694 16 | use App::Cmd::Tester::CaptureExternal 'test_app'; | ||||
7 | 2 | 10 | use Sub::Exporter -setup => { | ||||
8 | exports => [qw( | ||||||
9 | get_cmd_result run_cmd is_repo_clean last_commit repo_branches repo_tags repo_refs | ||||||
10 | current_branch is_current_tag | ||||||
11 | )], | ||||||
12 | 2 2 | 287 2 | }; | ||||
13 | |||||||
14 | sub get_cmd_result { | ||||||
15 | 45 | 0 | 54798 | return test_app( 'Git::ReleaseRepo' => \@_ ); | |||
16 | } | ||||||
17 | |||||||
18 | sub run_cmd { | ||||||
19 | 43 | 0 | 844506 | my $result = get_cmd_result( @_ ); | |||
20 | 43 | 108481 | ok !$result->stderr, 'nothing on stderr'; | ||||
21 | 43 | 11834 | is $result->error, undef, 'no error'; | ||||
22 | 43 | 7249 | is $result->exit_code, 0, 'ran with no errors or warnings' or do { | ||||
23 | 0 0 | 0 0 | diag $result->stdout; diag $result->stderr | ||||
24 | }; | ||||||
25 | 43 | 6891 | return $result; | ||||
26 | } | ||||||
27 | |||||||
28 | sub is_repo_clean($;$) { | ||||||
29 | 14 | 0 | 86248 | my ( $git, $message ) = @_; | |||
30 | 14 | 91 | $message ||= 'repository is clean'; | ||||
31 | 14 | 35 | my $cmd = $git->command( status => '--porcelain' ); | ||||
32 | 14 | 61180 | my @lines = readline $cmd->stdout; | ||||
33 | 14 | 56299 | is scalar @lines, 0, $message or diag "Found:\n" . join "", @lines; | ||||
34 | } | ||||||
35 | |||||||
36 | sub last_commit($) { | ||||||
37 | 2 | 0 | 69604 | my ( $git ) = @_; | |||
38 | 2 | 10 | my $cmd = $git->command( 'diff-tree' => '--raw', '--root', 'HEAD' ); | ||||
39 | 2 | 9236 | my @lines = readline $cmd->stdout; | ||||
40 | #; use Data::Dumper; | ||||||
41 | #; print Dumper \@lines; | ||||||
42 | 3 | 13 | my @changes = map {; { | ||||
43 | 3 | 24 | mode_src => $_->[0], | ||||
44 | mode_dst => $_->[1], | ||||||
45 | sha1_src => $_->[2], | ||||||
46 | sha1_dst => $_->[3], | ||||||
47 | status => $_->[4], | ||||||
48 | path_src => $_->[5], | ||||||
49 | path_dst => $_->[6], | ||||||
50 | } } | ||||||
51 | 3 | 12 | map { [ split /\s+/, $_ ] } | ||||
52 | 2 3 | 3102 6 | map { s/^://; $_ } | ||||
53 | @lines[1..$#lines]; | ||||||
54 | #; diag explain \@changes; | ||||||
55 | 2 | 39 | return @changes; | ||||
56 | } | ||||||
57 | |||||||
58 | sub repo_branches($) { | ||||||
59 | 9 | 0 | 2078 | my ( $git ) = @_; | |||
60 | 9 | 30 | my $cmd = $git->command( 'branch' ); | ||||
61 | # [* ] <branch> | ||||||
62 | 9 22 22 22 22 | 39988 27 144 12113 33 | return map { chomp; $_ } map { s/^[*\s]\s//; $_ } readline $cmd->stdout; | ||||
63 | } | ||||||
64 | |||||||
65 | sub repo_tags($) { | ||||||
66 | 9 | 0 | 5502 | my ( $git ) = @_; | |||
67 | 9 | 26 | my $cmd = $git->command( 'tag' ); | ||||
68 | 9 21 21 | 40492 11817 159 | return map { chomp; $_ } readline $cmd->stdout; | ||||
69 | } | ||||||
70 | |||||||
71 | sub repo_refs($) { | ||||||
72 | 2 | 0 | 8817 | my ( $git ) = @_; | |||
73 | 2 | 7 | my $cmd = $git->command( 'show-ref' ); | ||||
74 | 2 6 6 | 8777 45 2192 | return map { $_->[1], $_->[0] } map { [split] } readline $cmd->stdout; | ||||
75 | } | ||||||
76 | |||||||
77 | sub current_branch($) { | ||||||
78 | 0 | 0 | 0 | my ( $git ) = @_; | |||
79 | 0 | 0 | my $cmd = $git->command( 'branch' ); | ||||
80 | # [* ] <branch> | ||||||
81 | 0 0 0 0 0 0 | 0 0 0 0 0 0 | return map { chomp; $_ } map { s/^[*\s]\s//; $_ } grep { /^[*]/ } readline $cmd->stdout; | ||||
82 | } | ||||||
83 | |||||||
84 | sub is_current_tag($$) { | ||||||
85 | 4 | 0 | 937 | my ( $git, $tag ) = @_; | |||
86 | 4 | 12 | my $cmd = $git->command( 'describe', '--tags', '--match', $tag ); | ||||
87 | # <tag> | ||||||
88 | # OR | ||||||
89 | # <tag>-<commits since tag>-<shorthash> | ||||||
90 | 4 | 17648 | my $line = readline $cmd->stdout; | ||||
91 | 4 | 5536 | if ( $cmd->exit ) { | ||||
92 | 0 | 0 | fail "$tag is not current tag: " . readline $cmd->stderr; | ||||
93 | } | ||||||
94 | #print "describe: $line\n"; | ||||||
95 | 4 | 18 | chomp $line; | ||||
96 | 4 | 24 | is $line, $tag, "commit is tagged '$tag'"; | ||||
97 | } | ||||||
98 | |||||||
99 | 1; |