File Coverage

blib/lib/Shipwright/Script/Ktf.pm
Criterion Covered Total %
statement 18 41 43.9
branch 0 14 0.0
condition 0 5 0.0
subroutine 6 9 66.6
pod 0 2 0.0
total 24 71 33.8


line stmt bran cond sub pod time code
1             package Shipwright::Script::Ktf;
2              
3 1     1   1107 use strict;
  1         2  
  1         43  
4 1     1   5 use warnings;
  1         2  
  1         28  
5 1     1   6 use Shipwright::Util;
  1         2  
  1         103  
6              
7 1     1   6 use base qw/App::CLI::Command Shipwright::Base Shipwright::Script/;
  1         2  
  1         159  
8             __PACKAGE__->mk_accessors(qw/set delete/);
9              
10 1     1   6 use Shipwright;
  1         3  
  1         6  
11 1     1   29 use List::MoreUtils qw/uniq/;
  1         2  
  1         374  
12              
13             sub options {
14             (
15 0     0 0   'd|delete' => 'delete',
16             's|set=s' => 'set',
17             );
18             }
19              
20             sub run {
21 0     0 0   my $self = shift;
22 0           my @names = @_;
23              
24 0           my $shipwright = Shipwright->new( repository => $self->repository, );
25              
26 0           my $ktf = $shipwright->backend->ktf;
27              
28 0 0 0       if ( $self->delete || defined $self->set ) {
29 0 0         confess_or_die "need name arg\n" unless @names;
30              
31 0 0         if ( $self->delete ) {
32 0           delete $ktf->{$_} for @names;
33             }
34 0 0         if ( defined $self->set ) {
35 0           $ktf->{$_} = $self->set for @names;
36             }
37 0           $shipwright->backend->ktf($ktf);
38             }
39              
40 0 0         if ( @names ) {
41 0           $self->_show_ktf( $ktf, $_ ) for @names;
42             }
43             else {
44 0           $self->_show_ktf( $ktf, $_ ) for sort keys %$ktf;
45             }
46             }
47              
48             sub _show_ktf {
49 0     0     my $self = shift;
50 0           my $ktf = shift;
51 0           my $name = shift;
52              
53 0 0         if ( $self->delete ) {
54 0           $self->log->fatal( "deleted known test failure for $name" );
55             }
56             else {
57 0 0         if ( defined $self->set ) {
58 0           $self->log->fatal(
59             "successfully set known test failure condition for $name");
60             }
61              
62 0   0       $self->log->fatal( "the condition of $name is: " . ( $ktf->{$name} || 'undef' ) );
63             }
64             }
65              
66             1;
67              
68             __END__