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   550 use 5.008001;
  31         107  
3 31     31   177 use strict;
  31         75  
  31         836  
4 31     31   163 use warnings;
  31         85  
  31         1045  
5 31     31   192 use Object::Simple -base;
  31         63  
  31         199  
6 31     31   15838 use Getopt::Kingpin::Flag;
  31         82  
  31         266  
7 31     31   1038 use Carp;
  31         63  
  31         29340  
8              
9             our $VERSION = "0.10";
10              
11             has _flags => sub {
12             return {};
13             };
14              
15             sub add {
16 393     393 1 1004 my $self = shift;
17 393         1060 my $hash = {@_};
18 393         978 my ($name, $description) = ($hash->{name}, $hash->{description});
19              
20 393 100       6498 if (exists $self->_flags->{$name}) {
21 1         34 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         1563 index => (scalar keys %{$self->_flags}),
  392         5966  
28             );
29              
30 392         17840 return $self->_flags->{$name};
31             }
32              
33             sub unshift {
34 27     27 1 48 my $self = shift;
35 27         49 my @flags = @_;
36              
37 27         41 my $index_offset = scalar @flags;
38 27         56 foreach my $name ($self->keys) {
39 52 100       306 if ($name ne "help") {
40 25         368 $self->_flags->{$name}->index($self->_flags->{$name}->index + $index_offset);
41             }
42             }
43              
44 27         520 my $index = 1;
45 27         44 foreach my $f (@flags) {
46 33         482 my $name = $f->name;
47              
48 33 100       244 if ($name eq "help") {
49              
50             } else {
51 6         92 $f->index($index);
52 6         97 $self->_flags->{$name} = $f;
53 6         37 $index++;
54             }
55             }
56             }
57              
58             sub get {
59 421     421 1 3952 my $self = shift;
60 421         784 my ($name) = @_;
61              
62 421 100       6392 if (not exists $self->_flags->{$name}) {
63 102         837 return;
64             }
65              
66 319         6338 return $self->_flags->{$name};
67              
68             }
69              
70             sub keys {
71 508     508 1 690 my $self = shift;
72 508         693 my @keys = sort {$self->_flags->{$a}->index <=> $self->_flags->{$b}->index} keys %{$self->_flags};
  648         29300  
  508         7568  
73 508         19870 @keys = grep {$self->_flags->{$_}->_hidden == 0} @keys;
  1003         25691  
74 508         13234 return @keys;
75             }
76              
77             sub values {
78 451     451 1 2726 my $self = shift;
79 451         952 my @values = map {$self->_flags->{$_}} $self->keys;
  876         15268  
80 451         3302 return @values;
81             }
82              
83             sub count {
84 28     28 1 140 my $self = shift;
85 28         49 return scalar $self->keys;
86             }
87              
88             sub _help_length {
89 63     63   154 my $self = shift;
90              
91 63         173 my $len = [0, 0, 0];
92 63         147 foreach my $f (grep {$_->_hidden != 1} $self->values) {
  155         2699  
93 155         694 my $str = $f->help_str;
94              
95 155         246 for (my $i = 0; $i < scalar @{$len}; $i++) {
  620         1239  
96 465 100       801 if ($len->[$i] < length $str->[$i]) {
97 186         276 $len->[$i] = length $str->[$i];
98             }
99             }
100             }
101              
102 63         156 return $len;
103             }
104              
105             sub help {
106 51     51 1 369 my $self = shift;
107 51         78 my $ret = "";
108              
109 51         98 $ret .= "Flags:\n";
110              
111 51         120 my $len = $self->_help_length;
112 51         124 foreach my $f (grep {$_->_hidden != 1} $self->values) {
  113         1915  
113 113         399 my $x = "";
114              
115 113         171 my $long = $len->[1];
116 113 100       199 if ($len->[0] > 0) {
117 25 100       436 if (defined $f->short_name) {
118 14         92 $x .= sprintf " %s, %-${long}s %s\n", @{$f->help_str};
  14         36  
119             } else {
120 11         75 $x .= sprintf " %-${long}s %s\n", @{$f->help_str}[1, 2];
  11         28  
121             }
122             } else {
123 88         183 $x .= sprintf " %-${long}s %s\n", @{$f->help_str}[1, 2];
  88         209  
124             }
125 113         430 $x =~ s/ +$//;
126 113         273 $ret .= $x;
127             }
128 51         817 return $ret;
129             }
130              
131             1;
132             __END__