File | /usr/lib/perl/5.10/Scalar/Util.pm |
Statements Executed | 14 |
Total Time | 0.0006081 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
34657 | 23 | 20 | 75.7ms | 75.7ms | blessed(xsub) | Scalar::Util::
869 | 8 | 8 | 2.95ms | 2.95ms | weaken(xsub) | Scalar::Util::
746 | 7 | 5 | 2.01ms | 2.01ms | reftype(xsub) | Scalar::Util::
23 | 2 | 2 | 64µs | 64µs | refaddr(xsub) | Scalar::Util::
0 | 0 | 0 | 0s | 0s | BEGIN | Scalar::Util::
0 | 0 | 0 | 0s | 0s | export_fail | Scalar::Util::
0 | 0 | 0 | 0s | 0s | openhandle | Scalar::Util::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | # Scalar::Util.pm | |||
2 | # | |||
3 | # Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved. | |||
4 | # This program is free software; you can redistribute it and/or | |||
5 | # modify it under the same terms as Perl itself. | |||
6 | ||||
7 | package Scalar::Util; | |||
8 | ||||
9 | 3 | 28µs | 9µs | use strict; # spent 7µs making 1 call to strict::import |
10 | 3 | 437µs | 146µs | use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL); # spent 58µs making 1 call to vars::import |
11 | 1 | 700ns | 700ns | require Exporter; |
12 | 1 | 86µs | 86µs | require List::Util; # List::Util loads the XS |
13 | ||||
14 | 1 | 9µs | 9µs | @ISA = qw(Exporter); |
15 | 1 | 3µs | 3µs | @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); |
16 | 1 | 500ns | 500ns | $VERSION = "1.23"; |
17 | 1 | 33µs | 33µs | $VERSION = eval $VERSION; |
18 | ||||
19 | 1 | 500ns | 500ns | unless (defined &dualvar) { |
20 | # Load Pure Perl version if XS not loaded | |||
21 | require Scalar::Util::PP; | |||
22 | Scalar::Util::PP->import; | |||
23 | push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype); | |||
24 | } | |||
25 | ||||
26 | sub export_fail { | |||
27 | if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded | |||
28 | my $pat = join("|", @EXPORT_FAIL); | |||
29 | if (my ($err) = grep { /^($pat)$/ } @_ ) { | |||
30 | require Carp; | |||
31 | Carp::croak("$err is only available with the XS version of Scalar::Util"); | |||
32 | } | |||
33 | } | |||
34 | ||||
35 | if (grep { /^(weaken|isweak)$/ } @_ ) { | |||
36 | require Carp; | |||
37 | Carp::croak("Weak references are not implemented in the version of perl"); | |||
38 | } | |||
39 | ||||
40 | if (grep { /^(isvstring)$/ } @_ ) { | |||
41 | require Carp; | |||
42 | Carp::croak("Vstrings are not implemented in the version of perl"); | |||
43 | } | |||
44 | ||||
45 | @_; | |||
46 | } | |||
47 | ||||
48 | sub openhandle ($) { | |||
49 | my $fh = shift; | |||
50 | my $rt = reftype($fh) || ''; | |||
51 | ||||
52 | return defined(fileno($fh)) ? $fh : undef | |||
53 | if $rt eq 'IO'; | |||
54 | ||||
55 | if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA) | |||
56 | $fh = \(my $tmp=$fh); | |||
57 | } | |||
58 | elsif ($rt ne 'GLOB') { | |||
59 | return undef; | |||
60 | } | |||
61 | ||||
62 | (tied(*$fh) or defined(fileno($fh))) | |||
63 | ? $fh : undef; | |||
64 | } | |||
65 | ||||
66 | 1 | 10µs | 10µs | 1; |
67 | ||||
68 | __END__ | |||
69 | ||||
70 | =head1 NAME | |||
71 | ||||
72 | Scalar::Util - A selection of general-utility scalar subroutines | |||
73 | ||||
74 | =head1 SYNOPSIS | |||
75 | ||||
76 | use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted | |||
77 | weaken isvstring looks_like_number set_prototype); | |||
78 | # and other useful utils appearing below | |||
79 | ||||
80 | =head1 DESCRIPTION | |||
81 | ||||
82 | C<Scalar::Util> contains a selection of subroutines that people have | |||
83 | expressed would be nice to have in the perl core, but the usage would | |||
84 | not really be high enough to warrant the use of a keyword, and the size | |||
85 | so small such that being individual extensions would be wasteful. | |||
86 | ||||
87 | By default C<Scalar::Util> does not export any subroutines. The | |||
88 | subroutines defined are | |||
89 | ||||
90 | =over 4 | |||
91 | ||||
92 | =item blessed EXPR | |||
93 | ||||
94 | If EXPR evaluates to a blessed reference the name of the package | |||
95 | that it is blessed into is returned. Otherwise C<undef> is returned. | |||
96 | ||||
97 | $scalar = "foo"; | |||
98 | $class = blessed $scalar; # undef | |||
99 | ||||
100 | $ref = []; | |||
101 | $class = blessed $ref; # undef | |||
102 | ||||
103 | $obj = bless [], "Foo"; | |||
104 | $class = blessed $obj; # "Foo" | |||
105 | ||||
106 | =item dualvar NUM, STRING | |||
107 | ||||
108 | Returns a scalar that has the value NUM in a numeric context and the | |||
109 | value STRING in a string context. | |||
110 | ||||
111 | $foo = dualvar 10, "Hello"; | |||
112 | $num = $foo + 2; # 12 | |||
113 | $str = $foo . " world"; # Hello world | |||
114 | ||||
115 | =item isvstring EXPR | |||
116 | ||||
117 | If EXPR is a scalar which was coded as a vstring the result is true. | |||
118 | ||||
119 | $vs = v49.46.48; | |||
120 | $fmt = isvstring($vs) ? "%vd" : "%s"; #true | |||
121 | printf($fmt,$vs); | |||
122 | ||||
123 | =item isweak EXPR | |||
124 | ||||
125 | If EXPR is a scalar which is a weak reference the result is true. | |||
126 | ||||
127 | $ref = \$foo; | |||
128 | $weak = isweak($ref); # false | |||
129 | weaken($ref); | |||
130 | $weak = isweak($ref); # true | |||
131 | ||||
132 | B<NOTE>: Copying a weak reference creates a normal, strong, reference. | |||
133 | ||||
134 | $copy = $ref; | |||
135 | $weak = isweak($copy); # false | |||
136 | ||||
137 | =item looks_like_number EXPR | |||
138 | ||||
139 | Returns true if perl thinks EXPR is a number. See | |||
140 | L<perlapi/looks_like_number>. | |||
141 | ||||
142 | =item openhandle FH | |||
143 | ||||
144 | Returns FH if FH may be used as a filehandle and is open, or FH is a tied | |||
145 | handle. Otherwise C<undef> is returned. | |||
146 | ||||
147 | $fh = openhandle(*STDIN); # \*STDIN | |||
148 | $fh = openhandle(\*STDIN); # \*STDIN | |||
149 | $fh = openhandle(*NOTOPEN); # undef | |||
150 | $fh = openhandle("scalar"); # undef | |||
151 | ||||
152 | =item readonly SCALAR | |||
153 | ||||
154 | Returns true if SCALAR is readonly. | |||
155 | ||||
156 | sub foo { readonly($_[0]) } | |||
157 | ||||
158 | $readonly = foo($bar); # false | |||
159 | $readonly = foo(0); # true | |||
160 | ||||
161 | =item refaddr EXPR | |||
162 | ||||
163 | If EXPR evaluates to a reference the internal memory address of | |||
164 | the referenced value is returned. Otherwise C<undef> is returned. | |||
165 | ||||
166 | $addr = refaddr "string"; # undef | |||
167 | $addr = refaddr \$var; # eg 12345678 | |||
168 | $addr = refaddr []; # eg 23456784 | |||
169 | ||||
170 | $obj = bless {}, "Foo"; | |||
171 | $addr = refaddr $obj; # eg 88123488 | |||
172 | ||||
173 | =item reftype EXPR | |||
174 | ||||
175 | If EXPR evaluates to a reference the type of the variable referenced | |||
176 | is returned. Otherwise C<undef> is returned. | |||
177 | ||||
178 | $type = reftype "string"; # undef | |||
179 | $type = reftype \$var; # SCALAR | |||
180 | $type = reftype []; # ARRAY | |||
181 | ||||
182 | $obj = bless {}, "Foo"; | |||
183 | $type = reftype $obj; # HASH | |||
184 | ||||
185 | =item set_prototype CODEREF, PROTOTYPE | |||
186 | ||||
187 | Sets the prototype of the given function, or deletes it if PROTOTYPE is | |||
188 | undef. Returns the CODEREF. | |||
189 | ||||
190 | set_prototype \&foo, '$$'; | |||
191 | ||||
192 | =item tainted EXPR | |||
193 | ||||
194 | Return true if the result of EXPR is tainted | |||
195 | ||||
196 | $taint = tainted("constant"); # false | |||
197 | $taint = tainted($ENV{PWD}); # true if running under -T | |||
198 | ||||
199 | =item weaken REF | |||
200 | ||||
201 | REF will be turned into a weak reference. This means that it will not | |||
202 | hold a reference count on the object it references. Also when the reference | |||
203 | count on that object reaches zero, REF will be set to undef. | |||
204 | ||||
205 | This is useful for keeping copies of references , but you don't want to | |||
206 | prevent the object being DESTROY-ed at its usual time. | |||
207 | ||||
208 | { | |||
209 | my $var; | |||
210 | $ref = \$var; | |||
211 | weaken($ref); # Make $ref a weak reference | |||
212 | } | |||
213 | # $ref is now undef | |||
214 | ||||
215 | Note that if you take a copy of a scalar with a weakened reference, | |||
216 | the copy will be a strong reference. | |||
217 | ||||
218 | my $var; | |||
219 | my $foo = \$var; | |||
220 | weaken($foo); # Make $foo a weak reference | |||
221 | my $bar = $foo; # $bar is now a strong reference | |||
222 | ||||
223 | This may be less obvious in other situations, such as C<grep()>, for instance | |||
224 | when grepping through a list of weakened references to objects that may have | |||
225 | been destroyed already: | |||
226 | ||||
227 | @object = grep { defined } @object; | |||
228 | ||||
229 | This will indeed remove all references to destroyed objects, but the remaining | |||
230 | references to objects will be strong, causing the remaining objects to never | |||
231 | be destroyed because there is now always a strong reference to them in the | |||
232 | @object array. | |||
233 | ||||
234 | =back | |||
235 | ||||
236 | =head1 DIAGNOSTICS | |||
237 | ||||
238 | Module use may give one of the following errors during import. | |||
239 | ||||
240 | =over | |||
241 | ||||
242 | =item Weak references are not implemented in the version of perl | |||
243 | ||||
244 | The version of perl that you are using does not implement weak references, to use | |||
245 | C<isweak> or C<weaken> you will need to use a newer release of perl. | |||
246 | ||||
247 | =item Vstrings are not implemented in the version of perl | |||
248 | ||||
249 | The version of perl that you are using does not implement Vstrings, to use | |||
250 | C<isvstring> you will need to use a newer release of perl. | |||
251 | ||||
252 | =item C<NAME> is only available with the XS version of Scalar::Util | |||
253 | ||||
254 | C<Scalar::Util> contains both perl and C implementations of many of its functions | |||
255 | so that those without access to a C compiler may still use it. However some of the functions | |||
256 | are only available when a C compiler was available to compile the XS version of the extension. | |||
257 | ||||
258 | At present that list is: weaken, isweak, dualvar, isvstring, set_prototype | |||
259 | ||||
260 | =back | |||
261 | ||||
262 | =head1 KNOWN BUGS | |||
263 | ||||
264 | There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will | |||
265 | show up as tests 8 and 9 of dualvar.t failing | |||
266 | ||||
267 | =head1 SEE ALSO | |||
268 | ||||
269 | L<List::Util> | |||
270 | ||||
271 | =head1 COPYRIGHT | |||
272 | ||||
273 | Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved. | |||
274 | This program is free software; you can redistribute it and/or modify it | |||
275 | under the same terms as Perl itself. | |||
276 | ||||
277 | Except weaken and isweak which are | |||
278 | ||||
279 | Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved. | |||
280 | This program is free software; you can redistribute it and/or modify it | |||
281 | under the same terms as perl itself. | |||
282 | ||||
283 | =cut | |||
# spent 75.7ms within Scalar::Util::blessed which was called 34656 times, avg 2µs/call:
# 32002 times (67.8ms+0s) by Class::MOP::Method::Generated::__ANON__[generated method (unknown origin):4] or Class::MOP::Method::Generated::__ANON__[generated method (unknown origin):21] or Class::MOP::Method::Generated::__ANON__[generated method (unknown origin):28] or Class::MOP::Method::Generated::__ANON__[generated method (unknown origin):25] or Class::MOP::Method::Generated::__ANON__[generated method (unknown origin):16] or Class::MOP::Method::Generated::__ANON__[generated method (unknown origin):63] or Class::MOP::Method::Generated::__ANON__[generated method (unknown origin):43] at line 2 of /home/tamil/util/marc-moose/generated method (unknown origin), avg 2µs/call
# 813 times (2.66ms+0s) by Class::MOP::Mixin::HasMethods::_get_maybe_raw_method at line 150 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasMethods.pm, avg 3µs/call
# 393 times (1.21ms+0s) by Class::MOP::Mixin::HasMethods::add_method at line 65 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasMethods.pm, avg 3µs/call
# 219 times (532µs+0s) by Class::MOP::Mixin::HasMethods::get_method at line 124 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasMethods.pm, avg 2µs/call
# 210 times (598µs+0s) by Class::MOP::Method::Meta::_generate_meta_method or Class::MOP::Method::Meta::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Meta.pm:45] at line 44 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Meta.pm, avg 3µs/call
# 202 times (555µs+0s) by Class::MOP::Method::wrap at line 31 of /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm, avg 3µs/call
# 177 times (578µs+0s) by Class::MOP::Method::Accessor::new at line 26 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 3µs/call
# 123 times (310µs+0s) by Class::MOP::Mixin::HasAttributes::add_attribute at line 21 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasAttributes.pm, avg 3µs/call
# 123 times (306µs+0s) by Class::MOP::Attribute::attach_to_class at line 232 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 2µs/call
# 58 times (172µs+0s) by Class::MOP::Instance::BUILDARGS at line 18 of /usr/local/lib/perl/5.10.0/Class/MOP/Instance.pm, avg 3µs/call
# 46 times (147µs+0s) by Class::MOP::Method::Wrapped::wrap at line 74 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm, avg 3µs/call
# 43 times (187µs+0s) by Class::MOP::Class::_construct_instance at line 583 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 4µs/call
# 41 times (98µs+0s) by Moose::Util::TypeConstraints::find_type_constraint at line 256 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm, avg 2µs/call
# 37 times (97µs+0s) by Class::MOP::class_of at line 60 of /usr/local/lib/perl/5.10.0/Class/MOP.pm, avg 3µs/call
# 33 times (75µs+0s) at line 18 of /usr/local/lib/perl/5.10.0/Class/MOP/Object.pm, avg 2µs/call
# 31 times (97µs+0s) by Class::MOP::Method::Constructor::new at line 20 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm, avg 3µs/call
# 29 times (87µs+0s) by Moose::Meta::TypeConstraint::Registry::add_type_constraint at line 47 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Registry.pm, avg 3µs/call
# 20 times (60µs+0s) by Class::MOP::Method::clone at line 133 of /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm, avg 3µs/call
# 18 times (47µs+0s) at line 14 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin.pm, avg 3µs/call
# 17 times (49µs+0s) by Moose::Util::TypeConstraints::_create_type_constraint at line 547 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm, avg 3µs/call
# 8 times (22µs+0s) by Moose::Meta::Class::add_attribute at line 294 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm, avg 3µs/call
# 7 times (23µs+0s) by Moose::Meta::Method::Destructor::is_needed at line 58 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Destructor.pm, avg 3µs/call
# 6 times (18µs+0s) by Moose::Meta::Attribute::_process_options at line 287 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 3µs/call | ||||
# spent 64µs within Scalar::Util::refaddr which was called 22 times, avg 3µs/call:
# 14 times (42µs+0s) by Class::MOP::Method::Inlined::can_be_inlined at line 74 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm, avg 3µs/call
# 8 times (22µs+0s) by Class::MOP::Method::Inlined::can_be_inlined at line 79 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm, avg 3µs/call | ||||
# spent 2.01ms within Scalar::Util::reftype which was called 745 times, avg 3µs/call:
# 397 times (1.12ms+0s) by Package::Stash::_valid_for_type at line 69 of /usr/local/share/perl/5.10.0/Package/Stash.pm, avg 3µs/call
# 202 times (467µs+0s) by Class::MOP::Method::wrap at line 31 of /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm, avg 2µs/call
# 116 times (310µs+0s) by Sub::Install::_CODELIKE at line 98 of /usr/local/share/perl/5.10.0/Sub/Install.pm, avg 3µs/call
# 16 times (53µs+0s) by Moose::Util::TypeConstraints::subtype or Moose::Util::TypeConstraints::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm:315] at line 315 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm, avg 3µs/call
# 11 times (43µs+0s) by Package::Stash::has_package_symbol at line 134 of /usr/local/share/perl/5.10.0/Package/Stash.pm, avg 4µs/call
# 2 times (7µs+0s) by Moose::Util::TypeConstraints::type or Moose::Util::TypeConstraints::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm:278] at line 278 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm, avg 3µs/call
# once (4µs+0s) by Moose::Util::TypeConstraints::subtype at line 303 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm | ||||
# spent 2.95ms within Scalar::Util::weaken which was called 868 times, avg 3µs/call:
# 370 times (1.06ms+0s) by Class::MOP::Method::attach_to_class at line 75 of /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm, avg 3µs/call
# 177 times (740µs+0s) by Class::MOP::Method::Accessor::new at line 37 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 4µs/call
# 123 times (346µs+0s) by Class::MOP::Attribute::attach_to_class at line 234 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 3µs/call
# 95 times (356µs+0s) by Class::MOP::Method::wrap at line 46 of /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm, avg 4µs/call
# 58 times (261µs+0s) by Class::MOP::Instance::new at line 42 of /usr/local/lib/perl/5.10.0/Class/MOP/Instance.pm, avg 5µs/call
# 31 times (138µs+0s) by Class::MOP::Method::Constructor::new at line 32 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm, avg 4µs/call
# 7 times (27µs+0s) by Moose::Meta::Method::Constructor::new at line 39 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 4µs/call
# 7 times (24µs+0s) by Moose::Meta::Method::Destructor::new at line 41 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Destructor.pm, avg 3µs/call |