File Coverage

blib/lib/Getopt/Kingpin/Flags.pm
Criterion Covered Total %
statement 85 85 100.0
branch 14 14 100.0
condition n/a
subroutine 14 14 100.0
pod 7 7 100.0
total 120 120 100.0


line stmt bran cond sub pod time code
1             package Getopt::Kingpin::Flags;
2 31     31   555 use 5.008001;
  31         114  
3 31     31   164 use strict;
  31         71  
  31         820  
4 31     31   163 use warnings;
  31         61  
  31         1199  
5 31     31   210 use Object::Simple -base;
  31         64  
  31         203  
6 31     31   16421 use Getopt::Kingpin::Flag;
  31         95  
  31         285  
7 31     31   1034 use Carp;
  31         74  
  31         30790  
8              
9             our $VERSION = "0.11";
10              
11             has _flags => sub {
12             return {};
13             };
14              
15             sub add {
16 393     393 1 1016 my $self = shift;
17 393         1136 my $hash = {@_};
18 393         968 my ($name, $description) = ($hash->{name}, $hash->{description});
19              
20 393 100       7026 if (exists $self->_flags->{$name}) {
21 1         50 croak sprintf "flag %s is already exists", $name;
22             }
23              
24             $self->_flags->{$name} = Getopt::Kingpin::Flag->new(
25             name => $name,
26             description => $description,
27 392         1699 index => (scalar keys %{$self->_flags}),
  392         6408  
28             );
29              
30 392         19199 return $self->_flags->{$name};
31             }
32              
33             sub unshift {
34 27     27 1 49 my $self = shift;
35 27         47 my @flags = @_;
36              
37 27         66 my $index_offset = scalar @flags;
38 27         56 foreach my $name ($self->keys) {
39 52 100       310 if ($name ne "help") {
40 25         401 $self->_flags->{$name}->index($self->_flags->{$name}->index + $index_offset);
41             }
42             }
43              
44 27         609 my $index = 1;
45 27         61 foreach my $f (@flags) {
46 33         557 my $name = $f->name;
47              
48 33 100       265 if ($name eq "help") {
49              
50             } else {
51 6         96 $f->index($index);
52 6         121 $self->_flags->{$name} = $f;
53 6         79 $index++;
54             }
55             }
56             }
57              
58             sub get {
59 421     421 1 4423 my $self = shift;
60 421         811 my ($name) = @_;
61              
62 421 100       6724 if (not exists $self->_flags->{$name}) {
63 102         825 return;
64             }
65              
66 319         6836 return $self->_flags->{$name};
67              
68             }
69              
70             sub keys {
71 508     508 1 739 my $self = shift;
72 508         729 my @keys = sort {$self->_flags->{$a}->index <=> $self->_flags->{$b}->index} keys %{$self->_flags};
  653         32174  
  508         8231  
73 508         21540 @keys = grep {$self->_flags->{$_}->_hidden == 0} @keys;
  1003         27769  
74 508         13637 return @keys;
75             }
76              
77             sub values {
78 451     451 1 3038 my $self = shift;
79 451         1020 my @values = map {$self->_flags->{$_}} $self->keys;
  876         16086  
80 451         3676 return @values;
81             }
82              
83             sub count {
84 28     28 1 168 my $self = shift;
85 28         58 return scalar $self->keys;
86             }
87              
88             sub _help_length {
89 63     63   172 my $self = shift;
90              
91 63         132 my $len = [0, 0, 0];
92 63         145 foreach my $f (grep {$_->_hidden != 1} $self->values) {
  155         2907  
93 155         791 my $str = $f->help_str;
94              
95 155         262 for (my $i = 0; $i < scalar @{$len}; $i++) {
  620         1282  
96 465 100       891 if ($len->[$i] < length $str->[$i]) {
97 186         280 $len->[$i] = length $str->[$i];
98             }
99             }
100             }
101              
102 63         369 return $len;
103             }
104              
105             sub help {
106 51     51 1 445 my $self = shift;
107 51         91 my $ret = "";
108              
109 51         123 $ret .= "Flags:\n";
110              
111 51         116 my $len = $self->_help_length;
112 51         126 foreach my $f (grep {$_->_hidden != 1} $self->values) {
  113         2261  
113 113         480 my $x = "";
114              
115 113         181 my $long = $len->[1];
116 113 100       235 if ($len->[0] > 0) {
117 25 100       422 if (defined $f->short_name) {
118 14         107 $x .= sprintf " %s, %-${long}s %s\n", @{$f->help_str};
  14         31  
119             } else {
120 11         77 $x .= sprintf " %-${long}s %s\n", @{$f->help_str}[1, 2];
  11         26  
121             }
122             } else {
123 88         220 $x .= sprintf " %-${long}s %s\n", @{$f->help_str}[1, 2];
  88         203  
124             }
125 113         478 $x =~ s/ +$//;
126 113         280 $ret .= $x;
127             }
128 51         973 return $ret;
129             }
130              
131             1;
132             __END__