| 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 | Getopt::Long::Descriptive::Usage::option_text |
| 1 | 1 | 1 | 46µs | 46µs | Getopt::Long::Descriptive::Usage::new |
| 2 | 2 | 1 | 33µs | 1.47ms | Getopt::Long::Descriptive::Usage::text |
| 1 | 1 | 1 | 25µs | 30µs | Getopt::Long::Descriptive::Usage::BEGIN@2 |
| 1 | 1 | 1 | 14µs | 23µs | Getopt::Long::Descriptive::Usage::BEGIN@3 |
| 1 | 1 | 1 | 14µs | 94µs | Getopt::Long::Descriptive::Usage::BEGIN@142 |
| 1 | 1 | 1 | 11µs | 53µs | Getopt::Long::Descriptive::Usage::BEGIN@7 |
| 2 | 1 | 1 | 8µs | 8µs | Getopt::Long::Descriptive::Usage::leader_text |
| 0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::__ANON__[:150] |
| 0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::__ANON__[:151] |
| 0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::die |
| 0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::warn |
| 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 | 16 | 88µ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 | 308 | 654µs | 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; |