Filename | /home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive/Usage.pm |
Statements | Executed 345 statements in 1.37ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 761µs | 1.43ms | option_text | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 46µs | 46µs | new | Getopt::Long::Descriptive::Usage::
2 | 2 | 1 | 33µs | 1.47ms | text | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 25µs | 30µs | BEGIN@2 | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 14µs | 23µs | BEGIN@3 | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 14µs | 94µs | BEGIN@142 | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 11µs | 53µs | BEGIN@7 | Getopt::Long::Descriptive::Usage::
2 | 1 | 1 | 8µs | 8µs | leader_text | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | __ANON__[:150] | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | __ANON__[:151] | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | die | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | warn | Getopt::Long::Descriptive::Usage::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Getopt::Long::Descriptive::Usage; | ||||
2 | 2 | 26µs | 2 | 35µs | # spent 30µs (25+5) within Getopt::Long::Descriptive::Usage::BEGIN@2 which was called:
# once (25µs+5µs) by Getopt::Long::Descriptive::BEGIN@13 at line 2 # spent 30µs making 1 call to Getopt::Long::Descriptive::Usage::BEGIN@2
# spent 5µs making 1 call to strict::import |
3 | 2 | 37µs | 2 | 32µs | # spent 23µs (14+9) within Getopt::Long::Descriptive::Usage::BEGIN@3 which was called:
# once (14µs+9µs) by Getopt::Long::Descriptive::BEGIN@13 at line 3 # spent 23µs making 1 call to Getopt::Long::Descriptive::Usage::BEGIN@3
# spent 9µs making 1 call to warnings::import |
4 | |||||
5 | 1 | 2µs | our $VERSION = '0.086'; | ||
6 | |||||
7 | 2 | 437µs | 2 | 96µs | # spent 53µs (11+43) within Getopt::Long::Descriptive::Usage::BEGIN@7 which was called:
# once (11µs+43µs) by Getopt::Long::Descriptive::BEGIN@13 at line 7 # spent 53µs making 1 call to Getopt::Long::Descriptive::Usage::BEGIN@7
# spent 43µs making 1 call to Exporter::import |
8 | |||||
9 | =head1 NAME | ||||
10 | |||||
11 | Getopt::Long::Descriptive::Usage - the usage description for GLD | ||||
12 | |||||
13 | =head1 SYNOPSIS | ||||
14 | |||||
15 | use Getopt::Long::Descriptive; | ||||
16 | my ($opt, $usage) = describe_options( ... ); | ||||
17 | |||||
18 | $usage->text; # complete usage message | ||||
19 | |||||
20 | $usage->die; # die with usage message | ||||
21 | |||||
22 | =head1 DESCRIPTION | ||||
23 | |||||
24 | This document only describes the methods of the Usage object. For information | ||||
25 | on how to use L<Getopt::Long::Descriptive>, consult its documentation. | ||||
26 | |||||
27 | =head1 METHODS | ||||
28 | |||||
29 | =head2 new | ||||
30 | |||||
31 | my $usage = Getopt::Long::Descriptive::Usage->new(\%arg); | ||||
32 | |||||
33 | You B<really> don't need to call this. GLD will do it for you. | ||||
34 | |||||
35 | Valid arguments are: | ||||
36 | |||||
37 | options - an arrayref of options | ||||
38 | leader_text - the text that leads the usage; this may go away! | ||||
39 | |||||
40 | =cut | ||||
41 | |||||
42 | # spent 46µs within Getopt::Long::Descriptive::Usage::new which was called:
# once (46µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 393 of Getopt/Long/Descriptive.pm | ||||
43 | 5 | 49µs | my ($class, $arg) = @_; | ||
44 | |||||
45 | my @to_copy = qw(options leader_text); | ||||
46 | |||||
47 | my %copy; | ||||
48 | @copy{ @to_copy } = @$arg{ @to_copy }; | ||||
49 | |||||
50 | bless \%copy => $class; | ||||
51 | } | ||||
52 | |||||
53 | =head2 text | ||||
54 | |||||
55 | This returns the full text of the usage message. | ||||
56 | |||||
57 | =cut | ||||
58 | |||||
59 | # spent 1.47ms (33µs+1.44) within Getopt::Long::Descriptive::Usage::text which was called 2 times, avg 737µs/call:
# once (21µs+746µs) by MouseX::Getopt::Basic::new_with_options at line 72 of MouseX/Getopt/Basic.pm
# once (13µs+696µs) by MouseX::Getopt::Basic::new_with_options at line 78 of MouseX/Getopt/Basic.pm | ||||
60 | 4 | 29µs | my ($self) = @_; | ||
61 | |||||
62 | 4 | 1.44ms | return join qq{\n}, $self->leader_text, $self->option_text; # spent 1.43ms making 2 calls to Getopt::Long::Descriptive::Usage::option_text, avg 717µs/call
# spent 8µs making 2 calls to Getopt::Long::Descriptive::Usage::leader_text, avg 4µs/call | ||
63 | } | ||||
64 | |||||
65 | =head2 leader_text | ||||
66 | |||||
67 | This returns the text that comes at the beginning of the usage message. | ||||
68 | |||||
69 | =cut | ||||
70 | |||||
71 | 2 | 11µs | # spent 8µs within Getopt::Long::Descriptive::Usage::leader_text which was called 2 times, avg 4µs/call:
# 2 times (8µs+0s) by Getopt::Long::Descriptive::Usage::text at line 62, avg 4µs/call | ||
72 | |||||
73 | =head2 option_text | ||||
74 | |||||
75 | This returns the text describing the available options. | ||||
76 | |||||
77 | =cut | ||||
78 | |||||
79 | # spent 1.43ms (761µs+673µs) within Getopt::Long::Descriptive::Usage::option_text which was called 2 times, avg 717µs/call:
# 2 times (761µs+673µs) by Getopt::Long::Descriptive::Usage::text at line 62, avg 717µs/call | ||||
80 | 324 | 742µs | my ($self) = @_; | ||
81 | |||||
82 | my @options = @{ $self->{options} || [] }; | ||||
83 | my $string = q{}; | ||||
84 | |||||
85 | # a spec can grow up to 4 characters in usage output: | ||||
86 | # '-' on short option, ' ' between short and long, '--' on long | ||||
87 | my @specs = map { $_->{spec} } grep { $_->{desc} ne 'spacer' } @options; | ||||
88 | 2 | 5µs | my $length = (max(map { length } @specs) || 0) + 4; # spent 5µs making 2 calls to List::Util::max, avg 3µs/call | ||
89 | my $spec_fmt = "\t%-${length}s"; | ||||
90 | |||||
91 | while (@options) { | ||||
92 | my $opt = shift @options; | ||||
93 | my $spec = $opt->{spec}; | ||||
94 | my $desc = $opt->{desc}; | ||||
95 | if ($desc eq 'spacer') { | ||||
96 | $string .= sprintf "$spec_fmt\n", $opt->{spec}; | ||||
97 | next; | ||||
98 | } | ||||
99 | |||||
100 | 44 | 667µs | $spec = Getopt::Long::Descriptive->_strip_assignment($spec); # spent 667µs making 44 calls to Getopt::Long::Descriptive::_strip_assignment, avg 15µs/call | ||
101 | $spec = join " ", reverse map { length > 1 ? "--$_" : "-$_" } | ||||
102 | split /\|/, $spec; | ||||
103 | $string .= sprintf "$spec_fmt %s\n", $spec, $desc; | ||||
104 | } | ||||
105 | |||||
106 | return $string; | ||||
107 | } | ||||
108 | |||||
109 | =head2 warn | ||||
110 | |||||
111 | This warns with the usage message. | ||||
112 | |||||
113 | =cut | ||||
114 | |||||
115 | sub warn { warn shift->text } | ||||
116 | |||||
117 | =head2 die | ||||
118 | |||||
119 | This throws the usage message as an exception. | ||||
120 | |||||
121 | $usage_obj->die(\%arg); | ||||
122 | |||||
123 | Some arguments can be provided | ||||
124 | |||||
125 | pre_text - text to be prepended to the usage message | ||||
126 | post_text - text to be appended to the usage message | ||||
127 | |||||
128 | The C<pre_text> and C<post_text> arguments are concatenated with the usage | ||||
129 | message with no line breaks, so supply this if you need them. | ||||
130 | |||||
131 | =cut | ||||
132 | |||||
133 | sub die { | ||||
134 | my $self = shift; | ||||
135 | my $arg = shift || {}; | ||||
136 | |||||
137 | die( | ||||
138 | join q{}, grep { defined } $arg->{pre_text}, $self->text, $arg->{post_text} | ||||
139 | ); | ||||
140 | } | ||||
141 | |||||
142 | # spent 94µs (14+80) within Getopt::Long::Descriptive::Usage::BEGIN@142 which was called:
# once (14µs+80µs) by Getopt::Long::Descriptive::BEGIN@13 at line 152 | ||||
143 | q{""} => "text", | ||||
144 | |||||
145 | # This is only needed because Usage used to be a blessed coderef that worked | ||||
146 | # this way. Later we can toss a warning in here. -- rjbs, 2009-08-19 | ||||
147 | '&{}' => sub { | ||||
148 | my ($self) = @_; | ||||
149 | Carp::cluck("use of __PACKAGE__ objects as a code ref is deprecated"); | ||||
150 | return sub { return $_[0] ? $self->text : $self->warn; }; | ||||
151 | } | ||||
152 | 2 | 32µs | 2 | 174µs | ); # spent 94µs making 1 call to Getopt::Long::Descriptive::Usage::BEGIN@142
# spent 80µs making 1 call to overload::import |
153 | |||||
154 | =head1 AUTHOR | ||||
155 | |||||
156 | Hans Dieter Pearcey, C<< <hdp@cpan.org> >> | ||||
157 | |||||
158 | =head1 BUGS | ||||
159 | |||||
160 | Please report any bugs or feature requests through the web interface at | ||||
161 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Getopt-Long-Descriptive>. I | ||||
162 | will be notified, and then you'll automatically be notified of progress on your | ||||
163 | bug as I make changes. | ||||
164 | |||||
165 | =head1 COPYRIGHT & LICENSE | ||||
166 | |||||
167 | Copyright 2005 Hans Dieter Pearcey, all rights reserved. | ||||
168 | |||||
169 | This program is free software; you can redistribute it and/or modify it | ||||
170 | under the same terms as Perl itself. | ||||
171 | |||||
172 | =cut | ||||
173 | |||||
174 | 1 | 3µs | 1; |