← 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
StatementsExecuted 7 statements in 428µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11110µs21µsPod::Perldoc::GetOptsOO::::BEGIN@2Pod::Perldoc::GetOptsOO::BEGIN@2
1117µs23µsPod::Perldoc::GetOptsOO::::BEGIN@4Pod::Perldoc::GetOptsOO::BEGIN@4
1114µs4µsPod::Perldoc::GetOptsOO::::BEGIN@7Pod::Perldoc::GetOptsOO::BEGIN@7
0000s0sPod::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
1package Pod::Perldoc::GetOptsOO;
2228µs231µ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
4250µs239µ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
51700ns$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
1014µs : sub(){10};
111343µs14µs}
# spent 4µs making 1 call to Pod::Perldoc::GetOptsOO::BEGIN@7
12
13
14sub 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
9312µs1;
94
95__END__