File Coverage

File:blib/lib/Git/ReleaseRepo/Test.pm
Coverage:75.0%

linestmtbrancondsubpodtimecode
1package 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
14sub get_cmd_result {
15
45
0
54798
    return test_app( 'Git::ReleaseRepo' => \@_ );
16}
17
18sub 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
28sub 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
36sub 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
58sub 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
65sub 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
71sub 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
77sub 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
84sub 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
991;