local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Scalar/Util.pm

   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 use strict;
  10 use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
  11 require Exporter;
  12 require List::Util; # List::Util loads the XS
  13
  14 @ISA       = qw(Exporter);
  15 @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
  16 $VERSION    = "1.22";
  17 $VERSION   = eval $VERSION;
  18
  19 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;
  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