← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:45 2010

File /project/perl/lib/Scalar/Util.pm
Statements Executed 14
Statement Execution Time 1.28ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
462234.38ms4.38msScalar::Util::::weakenScalar::Util::weaken (xsub)
0000s0sScalar::Util::::BEGINScalar::Util::BEGIN
0000s0sScalar::Util::::export_failScalar::Util::export_fail
0000s0sScalar::Util::::openhandleScalar::Util::openhandle
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 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
7package Scalar::Util;
8
93112µs126µsuse strict;
# spent 26µs making 1 call to strict::import
103811µs1368µsuse vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
# spent 368µs making 1 call to vars::import
1117µsrequire Exporter;
121214µsrequire List::Util; # List::Util loads the XS
13
14114µs@ISA = qw(Exporter);
15115µs@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
1615µs$VERSION = "1.23";
17172µs$VERSION = eval $VERSION;
18
1915µsunless (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
26sub 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
48sub 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
66127µs1;
67
68__END__
69
70=head1 NAME
71
72Scalar::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
82C<Scalar::Util> contains a selection of subroutines that people have
83expressed would be nice to have in the perl core, but the usage would
84not really be high enough to warrant the use of a keyword, and the size
85so small such that being individual extensions would be wasteful.
86
87By default C<Scalar::Util> does not export any subroutines. The
88subroutines defined are
89
90=over 4
91
92=item blessed EXPR
93
94If EXPR evaluates to a blessed reference the name of the package
95that 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
108Returns a scalar that has the value NUM in a numeric context and the
109value 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
117If 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
125If 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
132B<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
139Returns true if perl thinks EXPR is a number. See
140L<perlapi/looks_like_number>.
141
142=item openhandle FH
143
144Returns FH if FH may be used as a filehandle and is open, or FH is a tied
145handle. 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
154Returns 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
163If EXPR evaluates to a reference the internal memory address of
164the 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
175If EXPR evaluates to a reference the type of the variable referenced
176is 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
187Sets the prototype of the given function, or deletes it if PROTOTYPE is
188undef. Returns the CODEREF.
189
190 set_prototype \&foo, '$$';
191
192=item tainted EXPR
193
194Return 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
201REF will be turned into a weak reference. This means that it will not
202hold a reference count on the object it references. Also when the reference
203count on that object reaches zero, REF will be set to undef.
204
205This is useful for keeping copies of references , but you don't want to
206prevent 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
215Note that if you take a copy of a scalar with a weakened reference,
216the 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
223This may be less obvious in other situations, such as C<grep()>, for instance
224when grepping through a list of weakened references to objects that may have
225been destroyed already:
226
227 @object = grep { defined } @object;
228
229This will indeed remove all references to destroyed objects, but the remaining
230references to objects will be strong, causing the remaining objects to never
231be destroyed because there is now always a strong reference to them in the
232@object array.
233
234=back
235
236=head1 DIAGNOSTICS
237
238Module 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
244The version of perl that you are using does not implement weak references, to use
245C<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
249The version of perl that you are using does not implement Vstrings, to use
250C<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
254C<Scalar::Util> contains both perl and C implementations of many of its functions
255so that those without access to a C compiler may still use it. However some of the functions
256are only available when a C compiler was available to compile the XS version of the extension.
257
258At present that list is: weaken, isweak, dualvar, isvstring, set_prototype
259
260=back
261
262=head1 KNOWN BUGS
263
264There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will
265show up as tests 8 and 9 of dualvar.t failing
266
267=head1 SEE ALSO
268
269L<List::Util>
270
271=head1 COPYRIGHT
272
273Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
274This program is free software; you can redistribute it and/or modify it
275under the same terms as Perl itself.
276
277Except weaken and isweak which are
278
279Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
280This program is free software; you can redistribute it and/or modify it
281under the same terms as perl itself.
282
283=cut
# spent 4.38ms within Scalar::Util::weaken which was called 462 times, avg 9µs/call: # 461 times (4.37ms+0s) by Class::DBI::_fresh_init at line 509 of Class/DBI.pm, avg 9µs/call # once (15µs+0s) by base::import at line 285 of DBI.pm
sub Scalar::Util::weaken; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.