File Coverage

blib/lib/Shipwright/Script/Flags.pm
Criterion Covered Total %
statement 18 75 24.0
branch 0 36 0.0
condition 0 12 0.0
subroutine 6 9 66.6
pod 0 2 0.0
total 24 134 17.9


line stmt bran cond sub pod time code
1             package Shipwright::Script::Flags;
2              
3 1     1   947 use strict;
  1         2  
  1         23  
4 1     1   4 use warnings;
  1         2  
  1         20  
5 1     1   4 use Shipwright::Util;
  1         2  
  1         78  
6              
7 1     1   6 use base qw/App::CLI::Command Shipwright::Base Shipwright::Script/;
  1         1  
  1         151  
8             __PACKAGE__->mk_accessors(qw/add delete set mandatory/);
9              
10 1     1   7 use Shipwright;
  1         2  
  1         5  
11 1     1   28 use List::MoreUtils qw/uniq/;
  1         3  
  1         16  
12              
13             sub options {
14             (
15 0     0 0   'a|add=s' => 'add',
16             'd|delete=s' => 'delete',
17             's|set=s' => 'set',
18             'mandatory' => 'mandatory',
19             );
20             }
21              
22             sub run {
23 0     0 0   my $self = shift;
24 0           my $name = shift;
25              
26 0 0         confess_or_die "need name arg\n" unless $name;
27              
28 0 0         if ( $name =~ /^__/ ) {
29 0           $self->log->fatal( "$name can't start as __" );
30 0           return;
31             }
32              
33 0           my $shipwright = Shipwright->new( repository => $self->repository, );
34              
35 0           my $flags = $shipwright->backend->flags;
36              
37 0 0 0       unless ( defined $self->add || defined $self->delete || defined $self->set )
      0        
38             {
39              
40             # show without change
41 0           $self->_show_flags( $flags, $name );
42 0           return;
43             }
44              
45 0 0         unless ( 1 == grep { defined $_ } $self->add, $self->delete, $self->set ) {
  0            
46 0           confess_or_die "you should specify one and only one of add, delete and set\n";
47             }
48              
49 0           my $list;
50              
51 0 0         if ( defined $self->add ) {
    0          
    0          
52 0           $self->add( [ grep { /^[-\w]+$/ } split /,\s*/, $self->add ] );
  0            
53 0 0         $list = [ uniq @{ $self->add }, @{ $flags->{$name} || [] } ];
  0            
  0            
54             }
55             elsif ( defined $self->delete ) {
56 0           $self->delete( [ split /,\s*/, $self->delete ] );
57 0           my %seen; # lookup table
58 0           @seen{ @{ $self->delete } } = ();
  0            
59              
60 0 0         $list = [ grep { !exists $seen{$_} } @{ $flags->{$name} || [] } ];
  0            
  0            
61              
62             }
63             elsif ( defined $self->set ) {
64 0           $list = [ grep { /^[-\w]+$/ } split /,\s*/, $self->set ];
  0            
65             }
66              
67 0 0         if ( $self->mandatory ) {
68 0           $flags->{__mandatory}{$name} = $list;
69             }
70             else {
71 0           $flags->{$name} = $list;
72             }
73              
74 0           $shipwright->backend->flags($flags);
75 0           $self->_show_flags( $flags, $name );
76             }
77              
78             sub _show_flags {
79 0     0     my $self = shift;
80 0           my $flags = shift;
81 0           my $name = shift;
82              
83 0           my $changed;
84 0 0 0       $changed = 1 if $self->add || $self->delete || $self->set;
      0        
85              
86 0           my $flags_info;
87 0 0         if ( $self->mandatory ) {
88 0 0         $self->log->fatal( 'successfully set mandatory flags' ) if $changed;
89 0 0         if ( @{ $flags->{__mandatory}{$name} || [] } ) {
  0 0          
90 0           $flags_info = join ', ', @{ $flags->{__mandatory}{$name} };
  0            
91             }
92             else {
93 0           $flags_info = '*nothing*';
94             }
95 0           $self->log->fatal( "mandatory flags of $name are $flags_info" );
96             }
97             else {
98 0 0         $self->log->fatal( 'successfully set flags' ) if $changed;
99 0 0         if ( @{ $flags->{$name} || [] } ) {
  0 0          
100 0           $flags_info = join ', ', @{ $flags->{$name} };
  0            
101             }
102             else {
103 0           $flags_info = '*nothing*';
104             }
105 0           $self->log->fatal( "flags of $name are $flags_info" );
106             }
107              
108             }
109              
110             1;
111              
112             __END__