| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | #line 1 | 
| 2 |  |  |  |  |  |  | # Scalar::Util.pm | 
| 3 |  |  |  |  |  |  | # | 
| 4 |  |  |  |  |  |  | # Copyright (c) 1997-2007 Graham Barr . All rights reserved. | 
| 5 |  |  |  |  |  |  | # This program is free software; you can redistribute it and/or | 
| 6 |  |  |  |  |  |  | # modify it under the same terms as Perl itself. | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | package Scalar::Util; | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | use strict; | 
| 11 |  |  |  |  |  |  | use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL); | 
| 12 |  |  |  |  |  |  | require Exporter; | 
| 13 |  |  |  |  |  |  | require List::Util; # List::Util loads the XS | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | @ISA       = qw(Exporter); | 
| 16 |  |  |  |  |  |  | @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); | 
| 17 |  |  |  |  |  |  | $VERSION    = "1.21"; | 
| 18 |  |  |  |  |  |  | $VERSION   = eval $VERSION; | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | unless (defined &dualvar) { | 
| 21 |  |  |  |  |  |  | # Load Pure Perl version if XS not loaded | 
| 22 |  |  |  |  |  |  | require Scalar::Util::PP; | 
| 23 |  |  |  |  |  |  | Scalar::Util::PP->import; | 
| 24 |  |  |  |  |  |  | push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype); | 
| 25 |  |  |  |  |  |  | } | 
| 26 |  |  |  |  |  |  |  | 
| 27 | 0 | 0 |  | 0 | 0 |  | sub export_fail { | 
|  | 0 |  |  |  |  |  |  | 
| 28 | 0 |  |  |  |  |  | if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded | 
| 29 | 0 | 0 |  |  |  |  | my $pat = join("|", @EXPORT_FAIL); | 
|  | 0 |  |  |  |  |  |  | 
| 30 | 0 |  |  |  |  |  | if (my ($err) = grep { /^($pat)$/ } @_ ) { | 
| 31 | 0 |  |  |  |  |  | require Carp; | 
| 32 |  |  |  |  |  |  | Carp::croak("$err is only available with the XS version of Scalar::Util"); | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  | } | 
| 35 | 0 | 0 |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 36 | 0 |  |  |  |  |  | if (grep { /^(weaken|isweak)$/ } @_ ) { | 
| 37 | 0 |  |  |  |  |  | require Carp; | 
| 38 |  |  |  |  |  |  | Carp::croak("Weak references are not implemented in the version of perl"); | 
| 39 |  |  |  |  |  |  | } | 
| 40 | 0 | 0 |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 41 | 0 |  |  |  |  |  | if (grep { /^(isvstring)$/ } @_ ) { | 
| 42 | 0 |  |  |  |  |  | require Carp; | 
| 43 |  |  |  |  |  |  | Carp::croak("Vstrings are not implemented in the version of perl"); | 
| 44 |  |  |  |  |  |  | } | 
| 45 | 0 |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | @_; | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | sub openhandle ($) { | 
| 50 |  |  |  |  |  |  | my $fh = shift; | 
| 51 |  |  |  |  |  |  | my $rt = reftype($fh) || ''; | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | return defined(fileno($fh)) ? $fh : undef | 
| 54 |  |  |  |  |  |  | if $rt eq 'IO'; | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | if (reftype(\$fh) eq 'GLOB') { # handle  openhandle(*DATA) | 
| 57 |  |  |  |  |  |  | $fh = \(my $tmp=$fh); | 
| 58 |  |  |  |  |  |  | } | 
| 59 |  |  |  |  |  |  | elsif ($rt ne 'GLOB') { | 
| 60 |  |  |  |  |  |  | return undef; | 
| 61 |  |  |  |  |  |  | } | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | (tied(*$fh) or defined(fileno($fh))) | 
| 64 |  |  |  |  |  |  | ? $fh : undef; | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | 1; | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | __END__ |