Filename | /usr/share/perl/5.18/Pod/Perldoc/GetOptsOO.pm |
Statements | Executed 7 statements in 428µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 10µs | 21µs | BEGIN@2 | Pod::Perldoc::GetOptsOO::
1 | 1 | 1 | 7µs | 23µs | BEGIN@4 | Pod::Perldoc::GetOptsOO::
1 | 1 | 1 | 4µs | 4µs | BEGIN@7 | Pod::Perldoc::GetOptsOO::
0 | 0 | 0 | 0s | 0s | getopts | Pod::Perldoc::GetOptsOO::
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 # 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 # 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 | ||||
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__ |