| 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; | ||||||