Profile of Pod/Perldoc/GetOptsOO.pm

← Index
NYTProf Performance Profile «line view»
For script/ponapi
Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename | /usr/share/perl/5.18/Pod/Perldoc/GetOptsOO.pm
Statements | Executed 7 statements in 428µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 10µs | 21µs | Pod::Perldoc::GetOptsOO::::BEGIN@2Pod::Perldoc::GetOptsOO::BEGIN@2
1 | 1 | 1 | 7µs | 23µs | Pod::Perldoc::GetOptsOO::::BEGIN@4Pod::Perldoc::GetOptsOO::BEGIN@4
1 | 1 | 1 | 4µs | 4µs | Pod::Perldoc::GetOptsOO::::BEGIN@7Pod::Perldoc::GetOptsOO::BEGIN@7
0 | 0 | 0 | 0s | 0s | Pod::Perldoc::GetOptsOO::::getoptsPod::Perldoc::GetOptsOO::getopts

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Pod::Perldoc::GetOptsOO;
2 | 2 | 28µs | 2 | 31µs | # spent 21µs (10+11) within Pod::Perldoc::GetOptsOO::BEGIN@2 which was called: # once (10µs+11µs) by Pod::Perldoc::BEGIN@30 at line 2 use strict; # spent 21µs making 1 call to Pod::Perldoc::GetOptsOO::BEGIN@2 # spent 11µs making 1 call to strict::import
3 |  |  |  |  |
4 | 2 | 50µs | 2 | 39µs | # spent 23µs (7+16) within Pod::Perldoc::GetOptsOO::BEGIN@4 which was called: # once (7µs+16µs) by Pod::Perldoc::BEGIN@30 at line 4 use vars qw($VERSION); # spent 23µs making 1 call to Pod::Perldoc::GetOptsOO::BEGIN@4 # spent 16µs making 1 call to vars::import
5 | 1 | 700ns |  |  | $VERSION = '3.19';
6 |  |  |  |  |
7 |  |  |  |  | # spent 4µs within Pod::Perldoc::GetOptsOO::BEGIN@7 which was called: # once (4µs+0s) by Pod::Perldoc::BEGIN@30 at line 11 BEGIN { # Make a DEBUG constant ASAP
8 |  |  |  |  | *DEBUG = defined( &Pod::Perldoc::DEBUG )
9 |  |  |  |  | ? \&Pod::Perldoc::DEBUG
10 | 1 | 4µs |  |  | : sub(){10};
11 | 1 | 343µs | 1 | 4µs | } # spent 4µs making 1 call to Pod::Perldoc::GetOptsOO::BEGIN@7
12 |  |  |  |  |
13 |  |  |  |  |
14 |  |  |  |  | sub getopts {
15 |  |  |  |  | my($target, $args, $truth) = @_;
16 |  |  |  |  |
17 |  |  |  |  | $args ||= \@ARGV;
18 |  |  |  |  |
19 |  |  |  |  | $target->aside(
20 |  |  |  |  | "Starting switch processing. Scanning arguments [@$args]\n"
21 |  |  |  |  | ) if $target->can('aside');
22 |  |  |  |  |
23 |  |  |  |  | return unless @$args;
24 |  |  |  |  |
25 |  |  |  |  | $truth = 1 unless @_ > 2;
26 |  |  |  |  |
27 |  |  |  |  | DEBUG > 3 and print " Truth is $truth\n";
28 |  |  |  |  |
29 |  |  |  |  |
30 |  |  |  |  | my $error_count = 0;
31 |  |  |  |  |
32 |  |  |  |  | while( @$args and ($_ = $args->[0]) =~ m/^-(.)(.*)/s ) {
33 |  |  |  |  | my($first,$rest) = ($1,$2);
34 |  |  |  |  | if ($_ eq '--') { # early exit if "--"
35 |  |  |  |  | shift @$args;
36 |  |  |  |  | last;
37 |  |  |  |  | }
38 |  |  |  |  | if ($first eq '-' and $rest) { # GNU style long param names
39 |  |  |  |  | ($first, $rest) = split '=', $rest, 2;
40 |  |  |  |  | }
41 |  |  |  |  | my $method = "opt_${first}_with";
42 |  |  |  |  | if( $target->can($method) ) { # it's argumental
43 |  |  |  |  | if($rest eq '') { # like -f bar
44 |  |  |  |  | shift @$args;
45 |  |  |  |  | $target->warn( "Option $first needs a following argument!\n" ) unless @$args;
46 |  |  |  |  | $rest = shift @$args;
47 |  |  |  |  | } else { # like -fbar (== -f bar)
48 |  |  |  |  | shift @$args;
49 |  |  |  |  | }
50 |  |  |  |  |
51 |  |  |  |  | DEBUG > 3 and print " $method => $rest\n";
52 |  |  |  |  | $target->$method( $rest );
53 |  |  |  |  |
54 |  |  |  |  | # Otherwise, it's not argumental...
55 |  |  |  |  | } else {
56 |  |  |  |  |
57 |  |  |  |  | if( $target->can( $method = "opt_$first" ) ) {
58 |  |  |  |  | DEBUG > 3 and print " $method is true ($truth)\n";
59 |  |  |  |  | $target->$method( $truth );
60 |  |  |  |  |
61 |  |  |  |  | # Otherwise it's an unknown option...
62 |  |  |  |  |
63 |  |  |  |  | } elsif( $target->can('handle_unknown_option') ) {
64 |  |  |  |  | DEBUG > 3
65 |  |  |  |  | and print " calling handle_unknown_option('$first')\n";
66 |  |  |  |  |
67 |  |  |  |  | $error_count += (
68 |  |  |  |  | $target->handle_unknown_option( $first ) || 0
69 |  |  |  |  | );
70 |  |  |  |  |
71 |  |  |  |  | } else {
72 |  |  |  |  | ++$error_count;
73 |  |  |  |  | $target->warn( "Unknown option: $first\n" );
74 |  |  |  |  | }
75 |  |  |  |  |
76 |  |  |  |  | if($rest eq '') { # like -f
77 |  |  |  |  | shift @$args
78 |  |  |  |  | } else { # like -fbar (== -f -bar )
79 |  |  |  |  | DEBUG > 2 and print " Setting args->[0] to \"-$rest\"\n";
80 |  |  |  |  | $args->[0] = "-$rest";
81 |  |  |  |  | }
82 |  |  |  |  | }
83 |  |  |  |  | }
84 |  |  |  |  |
85 |  |  |  |  |
86 |  |  |  |  | $target->aside(
87 |  |  |  |  | "Ending switch processing. Args are [@$args] with $error_count errors.\n"
88 |  |  |  |  | ) if $target->can('aside');
89 |  |  |  |  |
90 |  |  |  |  | $error_count == 0;
91 |  |  |  |  | }
92 |  |  |  |  |
93 | 1 | 2µs |  |  | 1;
94 |  |  |  |  |
95 |  |  |  |  | __END__