| 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 | Scalar::Util::blessed(xsub) |
| 869 | 8 | 8 | 2.95ms | 2.95ms | Scalar::Util::weaken(xsub) |
| 746 | 7 | 5 | 2.01ms | 2.01ms | Scalar::Util::reftype(xsub) |
| 23 | 2 | 2 | 64µs | 64µs | Scalar::Util::refaddr(xsub) |
| 0 | 0 | 0 | 0s | 0s | Scalar::Util::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Scalar::Util::export_fail |
| 0 | 0 | 0 | 0s | 0s | Scalar::Util::openhandle |
| 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 |