File Coverage

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


line stmt bran cond sub pod time code
1             package Getopt::Kingpin::Flags;
2 28     28   454 use 5.008001;
  28         93  
3 28     28   156 use strict;
  28         45  
  28         591  
4 28     28   141 use warnings;
  28         377  
  28         884  
5 28     28   166 use Object::Simple -base;
  28         48  
  28         165  
6 28     28   12901 use Getopt::Kingpin::Flag;
  28         78  
  28         210  
7 28     28   864 use Carp;
  28         55  
  28         24146  
8              
9             our $VERSION = "0.09";
10              
11             has _flags => sub {
12             return {};
13             };
14              
15             sub add {
16 304     304 1 675 my $self = shift;
17 304         787 my $hash = {@_};
18 304         717 my ($name, $description) = ($hash->{name}, $hash->{description});
19              
20 304 100       4830 if (exists $self->_flags->{$name}) {
21 1         23 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 303         1147 index => (scalar keys %{$self->_flags}),
  303         4356  
28             );
29              
30 303         13119 return $self->_flags->{$name};
31             }
32              
33             sub unshift {
34 24     24 1 43 my $self = shift;
35 24         47 my @flags = @_;
36              
37 24         42 my $index_offset = scalar @flags;
38 24         67 foreach my $name ($self->keys) {
39 44 100       220 if ($name ne "help") {
40 20         319 $self->_flags->{$name}->index($self->_flags->{$name}->index + $index_offset);
41             }
42             }
43              
44 24         534 my $index = 1;
45 24         47 foreach my $f (@flags) {
46 29         463 my $name = $f->name;
47              
48 29 100       242 if ($name eq "help") {
49              
50             } else {
51 5         81 $f->index($index);
52 5         94 $self->_flags->{$name} = $f;
53 5         36 $index++;
54             }
55             }
56             }
57              
58             sub get {
59 335     335 1 3706 my $self = shift;
60 335         642 my ($name) = @_;
61              
62 335 100       4884 if (not exists $self->_flags->{$name}) {
63 74         557 return;
64             }
65              
66 261         4939 return $self->_flags->{$name};
67              
68             }
69              
70             sub keys {
71 25     25 1 46 my $self = shift;
72 25         37 my @keys = sort {$self->_flags->{$a}->index <=> $self->_flags->{$b}->index} keys %{$self->_flags};
  32         1517  
  25         413  
73 25         1196 return @keys;
74             }
75              
76             sub values {
77 397     397 1 2276 my $self = shift;
78 397         544 my @values = sort {$a->index <=> $b->index} values %{$self->_flags};
  469         9689  
  397         5781  
79 397         4005 return @values;
80             }
81              
82             sub count {
83 26     26 1 180 my $self = shift;
84 26         56 return scalar $self->values;
85             }
86              
87             sub _help_length {
88 58     58   144 my $self = shift;
89              
90 58         118 my $len = [0, 0, 0];
91 58         125 foreach my $f (grep {$_->_hidden != 1} $self->values) {
  144         2406  
92 143         744 my $str = $f->help_str;
93              
94 143         256 for (my $i = 0; $i < scalar @{$len}; $i++) {
  572         1019  
95 429 100       724 if ($len->[$i] < length $str->[$i]) {
96 171         232 $len->[$i] = length $str->[$i];
97             }
98             }
99             }
100              
101 58         136 return $len;
102             }
103              
104             sub help {
105 46     46 1 345 my $self = shift;
106 46         74 my $ret = "";
107              
108 46         108 $ret .= "Flags:\n";
109              
110 46         94 my $len = $self->_help_length;
111 46         107 foreach my $f (grep {$_->_hidden != 1} $self->values) {
  102         1637  
112 101         366 my $x = "";
113              
114 101         151 my $long = $len->[1];
115 101 100       176 if ($len->[0] > 0) {
116 25 100       349 if (defined $f->short_name) {
117 14         81 $x .= sprintf " %s, %-${long}s %s\n", @{$f->help_str};
  14         27  
118             } else {
119 11         68 $x .= sprintf " %-${long}s %s\n", @{$f->help_str}[1, 2];
  11         21  
120             }
121             } else {
122 76         149 $x .= sprintf " %-${long}s %s\n", @{$f->help_str}[1, 2];
  76         193  
123             }
124 101         396 $x =~ s/ +$//;
125 101         241 $ret .= $x;
126             }
127 46         699 return $ret;
128             }
129              
130             1;
131             __END__