Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Config/Perl/V.pm |
Statements | Executed 18 statements in 1.95ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 664µs | 688µs | BEGIN@9 | Config::Perl::V::
1 | 1 | 1 | 17µs | 33µs | BEGIN@5 | Config::Perl::V::
1 | 1 | 1 | 14µs | 24µs | BEGIN@8 | Config::Perl::V::
1 | 1 | 1 | 12µs | 79µs | BEGIN@10 | Config::Perl::V::
1 | 1 | 1 | 10µs | 15µs | BEGIN@6 | Config::Perl::V::
0 | 0 | 0 | 0s | 0s | _make_derived | Config::Perl::V::
0 | 0 | 0 | 0s | 0s | myconfig | Config::Perl::V::
0 | 0 | 0 | 0s | 0s | plv2hash | Config::Perl::V::
0 | 0 | 0 | 0s | 0s | signature | Config::Perl::V::
0 | 0 | 0 | 0s | 0s | summary | Config::Perl::V::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #!/pro/bin/perl | ||||
2 | |||||
3 | package Config::Perl::V; | ||||
4 | |||||
5 | 2 | 34µs | 2 | 49µs | # spent 33µs (17+16) within Config::Perl::V::BEGIN@5 which was called:
# once (17µs+16µs) by Benchmark::Perl::Formance::BEGIN@9 at line 5 # spent 33µs making 1 call to Config::Perl::V::BEGIN@5
# spent 16µs making 1 call to strict::import |
6 | 2 | 27µs | 2 | 20µs | # spent 15µs (10+5) within Config::Perl::V::BEGIN@6 which was called:
# once (10µs+5µs) by Benchmark::Perl::Formance::BEGIN@9 at line 6 # spent 15µs making 1 call to Config::Perl::V::BEGIN@6
# spent 5µs making 1 call to warnings::import |
7 | |||||
8 | 2 | 25µs | 2 | 34µs | # spent 24µs (14+10) within Config::Perl::V::BEGIN@8 which was called:
# once (14µs+10µs) by Benchmark::Perl::Formance::BEGIN@9 at line 8 # spent 24µs making 1 call to Config::Perl::V::BEGIN@8
# spent 10µs making 1 call to Config::import |
9 | 2 | 670µs | 2 | 712µs | # spent 688µs (664+23) within Config::Perl::V::BEGIN@9 which was called:
# once (664µs+23µs) by Benchmark::Perl::Formance::BEGIN@9 at line 9 # spent 688µs making 1 call to Config::Perl::V::BEGIN@9
# spent 24µs making 1 call to Exporter::import |
10 | 2 | 1.09ms | 2 | 147µs | # spent 79µs (12+67) within Config::Perl::V::BEGIN@10 which was called:
# once (12µs+67µs) by Benchmark::Perl::Formance::BEGIN@9 at line 10 # spent 79µs making 1 call to Config::Perl::V::BEGIN@10
# spent 67µs making 1 call to vars::import |
11 | 1 | 400ns | $VERSION = "0.24"; | ||
12 | 1 | 6µs | @ISA = ("Exporter"); | ||
13 | 1 | 800ns | @EXPORT_OK = qw( plv2hash summary myconfig signature ); | ||
14 | 1 | 2µs | %EXPORT_TAGS = ( | ||
15 | all => [ @EXPORT_OK ], | ||||
16 | sig => [ "signature" ], | ||||
17 | ); | ||||
18 | |||||
19 | # Characteristics of this binary (from libperl): | ||||
20 | # Compile-time options: DEBUGGING PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP | ||||
21 | # USE_64_BIT_INT USE_LARGE_FILES USE_PERLIO | ||||
22 | |||||
23 | # The list are as the perl binary has stored it in PL_bincompat_options | ||||
24 | # search for it in | ||||
25 | # perl.c line 1643 S_Internals_V () | ||||
26 | # perl -ne'(/^S_Internals_V/../^}/)&&s/^\s+"( .*)"/$1/ and print' perl.c | ||||
27 | # perl.h line 4566 PL_bincompat_options | ||||
28 | # perl -ne'(/^\w.*PL_bincompat/../^\w}/)&&s/^\s+"( .*)"/$1/ and print' perl.h | ||||
29 | 1 | 42µs | my %BTD = map { $_ => 0 } qw( | ||
30 | |||||
31 | DEBUGGING | ||||
32 | NO_HASH_SEED | ||||
33 | NO_MATHOMS | ||||
34 | NO_TAINT_SUPPORT | ||||
35 | PERL_BOOL_AS_CHAR | ||||
36 | PERL_DISABLE_PMC | ||||
37 | PERL_DONT_CREATE_GVSV | ||||
38 | PERL_EXTERNAL_GLOB | ||||
39 | PERL_HASH_FUNC_DJB2 | ||||
40 | PERL_HASH_FUNC_MURMUR3 | ||||
41 | PERL_HASH_FUNC_ONE_AT_A_TIME | ||||
42 | PERL_HASH_FUNC_ONE_AT_A_TIME_HARD | ||||
43 | PERL_HASH_FUNC_ONE_AT_A_TIME_OLD | ||||
44 | PERL_HASH_FUNC_SDBM | ||||
45 | PERL_HASH_FUNC_SIPHASH | ||||
46 | PERL_HASH_FUNC_SUPERFAST | ||||
47 | PERL_IS_MINIPERL | ||||
48 | PERL_MALLOC_WRAP | ||||
49 | PERL_MEM_LOG | ||||
50 | PERL_MEM_LOG_ENV | ||||
51 | PERL_MEM_LOG_ENV_FD | ||||
52 | PERL_MEM_LOG_NOIMPL | ||||
53 | PERL_MEM_LOG_STDERR | ||||
54 | PERL_MEM_LOG_TIMESTAMP | ||||
55 | PERL_NEW_COPY_ON_WRITE | ||||
56 | PERL_PERTURB_KEYS_DETERMINISTIC | ||||
57 | PERL_PERTURB_KEYS_DISABLED | ||||
58 | PERL_PERTURB_KEYS_RANDOM | ||||
59 | PERL_PRESERVE_IVUV | ||||
60 | PERL_RELOCATABLE_INCPUSH | ||||
61 | PERL_USE_DEVEL | ||||
62 | PERL_USE_SAFE_PUTENV | ||||
63 | UNLINK_ALL_VERSIONS | ||||
64 | USE_ATTRIBUTES_FOR_PERLIO | ||||
65 | USE_FAST_STDIO | ||||
66 | USE_HASH_SEED_EXPLICIT | ||||
67 | USE_LOCALE | ||||
68 | USE_LOCALE_CTYPE | ||||
69 | USE_PERL_ATOF | ||||
70 | USE_SITECUSTOMIZE | ||||
71 | |||||
72 | DEBUG_LEAKING_SCALARS | ||||
73 | DEBUG_LEAKING_SCALARS_FORK_DUMP | ||||
74 | DECCRTL_SOCKETS | ||||
75 | FAKE_THREADS | ||||
76 | FCRYPT | ||||
77 | HAS_TIMES | ||||
78 | HAVE_INTERP_INTERN | ||||
79 | MULTIPLICITY | ||||
80 | MYMALLOC | ||||
81 | PERL_DEBUG_READONLY_COW | ||||
82 | PERL_DEBUG_READONLY_OPS | ||||
83 | PERL_GLOBAL_STRUCT | ||||
84 | PERL_GLOBAL_STRUCT_PRIVATE | ||||
85 | PERL_IMPLICIT_CONTEXT | ||||
86 | PERL_IMPLICIT_SYS | ||||
87 | PERLIO_LAYERS | ||||
88 | PERL_MAD | ||||
89 | PERL_MICRO | ||||
90 | PERL_NEED_APPCTX | ||||
91 | PERL_NEED_TIMESBASE | ||||
92 | PERL_OLD_COPY_ON_WRITE | ||||
93 | PERL_POISON | ||||
94 | PERL_SAWAMPERSAND | ||||
95 | PERL_TRACK_MEMPOOL | ||||
96 | PERL_USES_PL_PIDSTATUS | ||||
97 | PL_OP_SLAB_ALLOC | ||||
98 | THREADS_HAVE_PIDS | ||||
99 | USE_64_BIT_ALL | ||||
100 | USE_64_BIT_INT | ||||
101 | USE_IEEE | ||||
102 | USE_ITHREADS | ||||
103 | USE_LARGE_FILES | ||||
104 | USE_LOCALE_COLLATE | ||||
105 | USE_LOCALE_NUMERIC | ||||
106 | USE_LOCALE_TIME | ||||
107 | USE_LONG_DOUBLE | ||||
108 | USE_PERLIO | ||||
109 | USE_QUADMATH | ||||
110 | USE_REENTRANT_API | ||||
111 | USE_SFIO | ||||
112 | USE_SOCKS | ||||
113 | VMS_DO_SOCKETS | ||||
114 | VMS_SHORTEN_LONG_SYMBOLS | ||||
115 | VMS_SYMBOL_CASE_AS_IS | ||||
116 | ); | ||||
117 | |||||
118 | # These are all the keys that are | ||||
119 | # 1. Always present in %Config - lib/Config.pm #87 tie %Config | ||||
120 | # 2. Reported by 'perl -V' (the rest) | ||||
121 | 1 | 8µs | my @config_vars = qw( | ||
122 | |||||
123 | api_subversion | ||||
124 | api_version | ||||
125 | api_versionstring | ||||
126 | archlibexp | ||||
127 | dont_use_nlink | ||||
128 | d_readlink | ||||
129 | d_symlink | ||||
130 | exe_ext | ||||
131 | inc_version_list | ||||
132 | ldlibpthname | ||||
133 | patchlevel | ||||
134 | path_sep | ||||
135 | perl_patchlevel | ||||
136 | privlibexp | ||||
137 | scriptdir | ||||
138 | sitearchexp | ||||
139 | sitelibexp | ||||
140 | subversion | ||||
141 | usevendorprefix | ||||
142 | version | ||||
143 | |||||
144 | git_commit_id | ||||
145 | git_describe | ||||
146 | git_branch | ||||
147 | git_uncommitted_changes | ||||
148 | git_commit_id_title | ||||
149 | git_snapshot_date | ||||
150 | |||||
151 | package revision version_patchlevel_string | ||||
152 | |||||
153 | osname osvers archname | ||||
154 | myuname | ||||
155 | config_args | ||||
156 | hint useposix d_sigaction | ||||
157 | useithreads usemultiplicity | ||||
158 | useperlio d_sfio uselargefiles usesocks | ||||
159 | use64bitint use64bitall uselongdouble | ||||
160 | usemymalloc bincompat5005 | ||||
161 | |||||
162 | cc ccflags | ||||
163 | optimize | ||||
164 | cppflags | ||||
165 | ccversion gccversion gccosandvers | ||||
166 | intsize longsize ptrsize doublesize byteorder | ||||
167 | d_longlong longlongsize d_longdbl longdblsize | ||||
168 | ivtype ivsize nvtype nvsize lseektype lseeksize | ||||
169 | alignbytes prototype | ||||
170 | |||||
171 | ld ldflags | ||||
172 | libpth | ||||
173 | libs | ||||
174 | perllibs | ||||
175 | libc so useshrplib libperl | ||||
176 | gnulibc_version | ||||
177 | |||||
178 | dlsrc dlext d_dlsymun ccdlflags | ||||
179 | cccdlflags lddlflags | ||||
180 | ); | ||||
181 | |||||
182 | 1 | 18µs | my %empty_build = ( | ||
183 | osname => "", | ||||
184 | stamp => 0, | ||||
185 | options => { %BTD }, | ||||
186 | patches => [], | ||||
187 | ); | ||||
188 | |||||
189 | sub _make_derived | ||||
190 | { | ||||
191 | my $conf = shift; | ||||
192 | |||||
193 | for ( [ lseektype => "Off_t" ], | ||||
194 | [ myuname => "uname" ], | ||||
195 | [ perl_patchlevel => "patch" ], | ||||
196 | ) { | ||||
197 | my ($official, $derived) = @$_; | ||||
198 | $conf->{config}{$derived} ||= $conf->{config}{$official}; | ||||
199 | $conf->{config}{$official} ||= $conf->{config}{$derived}; | ||||
200 | $conf->{derived}{$derived} = delete $conf->{config}{$derived}; | ||||
201 | } | ||||
202 | |||||
203 | if (exists $conf->{config}{version_patchlevel_string} && | ||||
204 | !exists $conf->{config}{api_version}) { | ||||
205 | my $vps = $conf->{config}{version_patchlevel_string}; | ||||
206 | $vps =~ s{\b revision \s+ (\S+) }{}x and | ||||
207 | $conf->{config}{revision} ||= $1; | ||||
208 | |||||
209 | $vps =~ s{\b version \s+ (\S+) }{}x and | ||||
210 | $conf->{config}{api_version} ||= $1; | ||||
211 | $vps =~ s{\b subversion \s+ (\S+) }{}x and | ||||
212 | $conf->{config}{subversion} ||= $1; | ||||
213 | $vps =~ s{\b patch \s+ (\S+) }{}x and | ||||
214 | $conf->{config}{perl_patchlevel} ||= $1; | ||||
215 | } | ||||
216 | |||||
217 | ($conf->{config}{version_patchlevel_string} ||= join " ", | ||||
218 | map { ($_, $conf->{config}{$_} ) } | ||||
219 | grep { $conf->{config}{$_} } | ||||
220 | qw( api_version subversion perl_patchlevel )) =~ s/\bperl_//; | ||||
221 | |||||
222 | $conf->{config}{perl_patchlevel} ||= ""; # 0 is not a valid patchlevel | ||||
223 | |||||
224 | if ($conf->{config}{perl_patchlevel} =~ m{^git\w*-([^-]+)}i) { | ||||
225 | $conf->{config}{git_branch} ||= $1; | ||||
226 | $conf->{config}{git_describe} ||= $conf->{config}{perl_patchlevel}; | ||||
227 | } | ||||
228 | |||||
229 | $conf; | ||||
230 | } # _make_derived | ||||
231 | |||||
232 | sub plv2hash | ||||
233 | { | ||||
234 | my %config; | ||||
235 | |||||
236 | my $pv = join "\n" => @_; | ||||
237 | |||||
238 | if ($pv =~ m/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)/m) { | ||||
239 | $config{"package"} = $1; | ||||
240 | my $rev = $2; | ||||
241 | $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1; | ||||
242 | $rev and $config{version_patchlevel_string} = $rev; | ||||
243 | my ($rel) = $config{"package"} =~ m{perl(\d)}; | ||||
244 | my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)}; | ||||
245 | defined $vers && defined $subvers && defined $rel and | ||||
246 | $config{version} = "$rel.$vers.$subvers"; | ||||
247 | } | ||||
248 | |||||
249 | if ($pv =~ m/^\s+(Snapshot of:)\s+(\S+)/) { | ||||
250 | $config{git_commit_id_title} = $1; | ||||
251 | $config{git_commit_id} = $2; | ||||
252 | } | ||||
253 | |||||
254 | if (my %kv = ($pv =~ m{\b | ||||
255 | (\w+) # key | ||||
256 | \s*= # assign | ||||
257 | ( '\s*[^']*?\s*' # quoted value | ||||
258 | | \S+[^=]*?\s*\n # unquoted running till end of line | ||||
259 | | \S+ # unquoted value | ||||
260 | | \s*\n # empty | ||||
261 | ) | ||||
262 | (?:,?\s+|\s*\n)? # separator (5.8.x reports did not have a ',' | ||||
263 | }gx)) { # between every kv pair | ||||
264 | |||||
265 | while (my ($k, $v) = each %kv) { | ||||
266 | $k =~ s/\s+$//; | ||||
267 | $v =~ s/\s*\n\z//; | ||||
268 | $v =~ s/,$//; | ||||
269 | $v =~ m/^'(.*)'$/ and $v = $1; | ||||
270 | $v =~ s/\s+$//; | ||||
271 | $config{$k} = $v; | ||||
272 | } | ||||
273 | } | ||||
274 | |||||
275 | my $build = { %empty_build }; | ||||
276 | |||||
277 | $pv =~ m{^\s+Compiled at\s+(.*)}m | ||||
278 | and $build->{stamp} = $1; | ||||
279 | $pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*?)(?:[\s\n]+Buil[td] under)}ms | ||||
280 | and $build->{patches} = [ split m/\n+\s*/, $1 ]; | ||||
281 | $pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*?)(?:[\s\n]+(?:Locally applied|Buil[td] under))}ms | ||||
282 | and map { $build->{options}{$_} = 1 } split m/\s+|\n/ => $1; | ||||
283 | |||||
284 | $build->{osname} = $config{osname}; | ||||
285 | $pv =~ m{^\s+Built under\s+(.*)}m | ||||
286 | and $build->{osname} = $1; | ||||
287 | $config{osname} ||= $build->{osname}; | ||||
288 | |||||
289 | return _make_derived ({ | ||||
290 | build => $build, | ||||
291 | environment => {}, | ||||
292 | config => \%config, | ||||
293 | derived => {}, | ||||
294 | inc => [], | ||||
295 | }); | ||||
296 | } # plv2hash | ||||
297 | |||||
298 | sub summary | ||||
299 | { | ||||
300 | my $conf = shift || myconfig (); | ||||
301 | ref $conf eq "HASH" && | ||||
302 | exists $conf->{config} && exists $conf->{build} or return; | ||||
303 | |||||
304 | my %info = map { | ||||
305 | exists $conf->{config}{$_} ? ( $_ => $conf->{config}{$_} ) : () } | ||||
306 | qw( archname osname osvers revision patchlevel subversion version | ||||
307 | cc ccversion gccversion config_args inc_version_list | ||||
308 | d_longdbl d_longlong use64bitall use64bitint useithreads | ||||
309 | uselongdouble usemultiplicity usemymalloc useperlio useshrplib | ||||
310 | doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize | ||||
311 | ); | ||||
312 | $info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}}; | ||||
313 | |||||
314 | return \%info; | ||||
315 | } # summary | ||||
316 | |||||
317 | sub signature | ||||
318 | { | ||||
319 | eval { require Digest::MD5 }; | ||||
320 | $@ and return "00000000000000000000000000000000"; | ||||
321 | |||||
322 | my $conf = shift || summary (); | ||||
323 | delete $conf->{config_args}; | ||||
324 | return Digest::MD5::md5_hex (join "\xFF" => map { | ||||
325 | "$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE"); | ||||
326 | } sort keys %$conf); | ||||
327 | } # signature | ||||
328 | |||||
329 | sub myconfig | ||||
330 | { | ||||
331 | my $args = shift; | ||||
332 | my %args = ref $args eq "HASH" ? %$args : | ||||
333 | ref $args eq "ARRAY" ? @$args : (); | ||||
334 | |||||
335 | my $build = { %empty_build }; | ||||
336 | |||||
337 | # 5.14.0 and later provide all the information without shelling out | ||||
338 | my $stamp = eval { Config::compile_date () }; | ||||
339 | if (defined $stamp) { | ||||
340 | $stamp =~ s/^Compiled at //; | ||||
341 | $build->{osname} = $^O; | ||||
342 | $build->{stamp} = $stamp; | ||||
343 | $build->{patches} = [ Config::local_patches () ]; | ||||
344 | $build->{options}{$_} = 1 for Config::bincompat_options (), | ||||
345 | Config::non_bincompat_options (); | ||||
346 | } | ||||
347 | else { | ||||
348 | #y $pv = qx[$^X -e"sub Config::myconfig{};" -V]; | ||||
349 | my $cnf = plv2hash (qx[$^X -V]); | ||||
350 | |||||
351 | $build->{$_} = $cnf->{build}{$_} for qw( osname stamp patches options ); | ||||
352 | } | ||||
353 | |||||
354 | my @KEYS = keys %ENV; | ||||
355 | my %env = | ||||
356 | map { $_ => $ENV{$_} } grep m/^PERL/ => @KEYS; | ||||
357 | $args{env} and | ||||
358 | map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS; | ||||
359 | |||||
360 | my %config = map { $_ => $Config{$_} } @config_vars; | ||||
361 | |||||
362 | return _make_derived ({ | ||||
363 | build => $build, | ||||
364 | environment => \%env, | ||||
365 | config => \%config, | ||||
366 | derived => {}, | ||||
367 | inc => \@INC, | ||||
368 | }); | ||||
369 | } # myconfig | ||||
370 | |||||
371 | 1 | 18µs | 1; | ||
372 | |||||
373 | __END__ |