[p5sagit/p5-mst-13.2.git] / cpan / List-Util / lib / Scalar / Util.pm

# Scalar::Util.pm
#
# Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Scalar::Util;

use strict;
use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
require Exporter;
require List::Util; # List::Util loads the XS

@ISA       = qw(Exporter);
@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
$VERSION    = "1.23";
$VERSION   = eval $VERSION;

unless (defined &dualvar) {
  # Load Pure Perl version if XS not loaded
  require Scalar::Util::PP;
  Scalar::Util::PP->import;
  push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
}

sub export_fail {
  if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded
    my $pat = join("|", @EXPORT_FAIL);
    if (my ($err) = grep { /^($pat)$/ } @_ ) {
      require Carp;
      Carp::croak("$err is only available with the XS version of Scalar::Util");
    }
  }

  if (grep { /^(weaken|isweak)$/ } @_ ) {
    require Carp;
    Carp::croak("Weak references are not implemented in the version of perl");
  }

  if (grep { /^(isvstring)$/ } @_ ) {
    require Carp;
    Carp::croak("Vstrings are not implemented in the version of perl");
  }

  @_;
}

sub openhandle ($) {
  my $fh = shift;
  my $rt = reftype($fh) || '';

  return defined(fileno($fh)) ? $fh : undef
    if $rt eq 'IO';

  if (reftype(\$fh) eq 'GLOB') { # handle  openhandle(*DATA)
    $fh = \(my $tmp=$fh);
  }
  elsif ($rt ne 'GLOB') {
    return undef;
  }

  (tied(*$fh) or defined(fileno($fh)))
    ? $fh : undef;
}

1;

__END__

=head1 NAME

Scalar::Util - A selection of general-utility scalar subroutines

=head1 SYNOPSIS

    use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
                        weaken isvstring looks_like_number set_prototype);
                        # and other useful utils appearing below

=head1 DESCRIPTION

C<Scalar::Util> contains a selection of subroutines that people have
expressed would be nice to have in the perl core, but the usage would
not really be high enough to warrant the use of a keyword, and the size
so small such that being individual extensions would be wasteful.

By default C<Scalar::Util> does not export any subroutines. The
subroutines defined are

=over 4

=item blessed EXPR

If EXPR evaluates to a blessed reference the name of the package
that it is blessed into is returned. Otherwise C<undef> is returned.

   $scalar = "foo";
   $class  = blessed $scalar;           # undef

   $ref    = [];
   $class  = blessed $ref;              # undef

   $obj    = bless [], "Foo";
   $class  = blessed $obj;              # "Foo"

=item dualvar NUM, STRING

Returns a scalar that has the value NUM in a numeric context and the
value STRING in a string context.

    $foo = dualvar 10, "Hello";
    $num = $foo + 2;                    # 12
    $str = $foo . " world";             # Hello world

=item isvstring EXPR

If EXPR is a scalar which was coded as a vstring the result is true.

    $vs   = v49.46.48;
    $fmt  = isvstring($vs) ? "%vd" : "%s"; #true
    printf($fmt,$vs);

=item isweak EXPR

If EXPR is a scalar which is a weak reference the result is true.

    $ref  = \$foo;
    $weak = isweak($ref);               # false
    weaken($ref);
    $weak = isweak($ref);               # true

B<NOTE>: Copying a weak reference creates a normal, strong, reference.

    $copy = $ref;
    $weak = isweak($copy);              # false

=item looks_like_number EXPR

Returns true if perl thinks EXPR is a number. See
L<perlapi/looks_like_number>.

=item openhandle FH

Returns FH if FH may be used as a filehandle and is open, or FH is a tied
handle. Otherwise C<undef> is returned.

    $fh = openhandle(*STDIN);		# \*STDIN
    $fh = openhandle(\*STDIN);		# \*STDIN
    $fh = openhandle(*NOTOPEN);		# undef
    $fh = openhandle("scalar");		# undef
    
=item readonly SCALAR

Returns true if SCALAR is readonly.

    sub foo { readonly($_[0]) }

    $readonly = foo($bar);              # false
    $readonly = foo(0);                 # true

=item refaddr EXPR

If EXPR evaluates to a reference the internal memory address of
the referenced value is returned. Otherwise C<undef> is returned.

    $addr = refaddr "string";           # undef
    $addr = refaddr \$var;              # eg 12345678
    $addr = refaddr [];                 # eg 23456784

    $obj  = bless {}, "Foo";
    $addr = refaddr $obj;               # eg 88123488

=item reftype EXPR

If EXPR evaluates to a reference the type of the variable referenced
is returned. Otherwise C<undef> is returned.

    $type = reftype "string";           # undef
    $type = reftype \$var;              # SCALAR
    $type = reftype [];                 # ARRAY

    $obj  = bless {}, "Foo";
    $type = reftype $obj;               # HASH

=item set_prototype CODEREF, PROTOTYPE

Sets the prototype of the given function, or deletes it if PROTOTYPE is
undef. Returns the CODEREF.

    set_prototype \&foo, '$$';

=item tainted EXPR

Return true if the result of EXPR is tainted

    $taint = tainted("constant");       # false
    $taint = tainted($ENV{PWD});        # true if running under -T

=item weaken REF

REF will be turned into a weak reference. This means that it will not
hold a reference count on the object it references. Also when the reference
count on that object reaches zero, REF will be set to undef.

This is useful for keeping copies of references , but you don't want to
prevent the object being DESTROY-ed at its usual time.

    {
      my $var;
      $ref = \$var;
      weaken($ref);                     # Make $ref a weak reference
    }
    # $ref is now undef

Note that if you take a copy of a scalar with a weakened reference,
the copy will be a strong reference.

    my $var;
    my $foo = \$var;
    weaken($foo);                       # Make $foo a weak reference
    my $bar = $foo;                     # $bar is now a strong reference

This may be less obvious in other situations, such as C<grep()>, for instance
when grepping through a list of weakened references to objects that may have
been destroyed already:

    @object = grep { defined } @object;

This will indeed remove all references to destroyed objects, but the remaining
references to objects will be strong, causing the remaining objects to never
be destroyed because there is now always a strong reference to them in the
@object array.

=back

=head1 DIAGNOSTICS

Module use may give one of the following errors during import.

=over

=item Weak references are not implemented in the version of perl

The version of perl that you are using does not implement weak references, to use
C<isweak> or C<weaken> you will need to use a newer release of perl.

=item Vstrings are not implemented in the version of perl

The version of perl that you are using does not implement Vstrings, to use
C<isvstring> you will need to use a newer release of perl.

=item C<NAME> is only available with the XS version of Scalar::Util

C<Scalar::Util> contains both perl and C implementations of many of its functions
so that those without access to a C compiler may still use it. However some of the functions
are only available when a C compiler was available to compile the XS version of the extension.

At present that list is: weaken, isweak, dualvar, isvstring, set_prototype

=back

=head1 KNOWN BUGS

There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will
show up as tests 8 and 9 of dualvar.t failing

=head1 SEE ALSO

L<List::Util>

=head1 COPYRIGHT

Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

Except weaken and isweak which are

Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.

=cut
Commit	Line	Data
f4a2945e	1	# Scalar::Util.pm
f4a2945e	2	#
2ff28616	3	# Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
f4a2945e	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
4984adac	9	use strict;
2ff28616	10	use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
f4a2945e	11	require Exporter;
	12	require List::Util; # List::Util loads the XS
	13
09c2a9b8	14	@ISA = qw(Exporter);
09c2a9b8	15	@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
4daffb2b	16	$VERSION = "1.23";
09c2a9b8	17	$VERSION = eval $VERSION;
09c2a9b8	18
2ff28616	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
09c2a9b8	26	sub export_fail {
2ff28616	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
09c2a9b8	35	if (grep { /^(weaken\|isweak)$/ } @_ ) {
	36	require Carp;
	37	Carp::croak("Weak references are not implemented in the version of perl");
	38	}
2ff28616	39
09c2a9b8	40	if (grep { /^(isvstring)$/ } @_ ) {
	41	require Carp;
	42	Carp::croak("Vstrings are not implemented in the version of perl");
	43	}
09c2a9b8	44
	45	@_;
	46	}
f4a2945e	47
c0f790df	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
f4a2945e	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
4984adac	76	use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
4984adac	77	weaken isvstring looks_like_number set_prototype);
2ff28616	78	# and other useful utils appearing below
f4a2945e	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
c29e891d	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
f4a2945e	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";
c29e891d	112	$num = $foo + 2; # 12
c29e891d	113	$str = $foo . " world"; # Hello world
f4a2945e	114
60f3865b	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
f4a2945e	123	=item isweak EXPR
	124
	125	If EXPR is a scalar which is a weak reference the result is true.
	126
c29e891d	127	$ref = \$foo;
	128	$weak = isweak($ref); # false
	129	weaken($ref);
	130	$weak = isweak($ref); # true
	131
4984adac	132	B<NOTE>: Copying a weak reference creates a normal, strong, reference.
	133
	134	$copy = $ref;
2ff28616	135	$weak = isweak($copy); # false
4984adac	136
9e7deb6c	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
c0f790df	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
ee4ffb48	152	=item readonly SCALAR
	153
	154	Returns true if SCALAR is readonly.
	155
c29e891d	156	sub foo { readonly($_[0]) }
	157
	158	$readonly = foo($bar); # false
	159	$readonly = foo(0); # true
	160
60f3865b	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
f4a2945e	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
c29e891d	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
97605c51	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
ee4ffb48	192	=item tainted EXPR
	193
	194	Return true if the result of EXPR is tainted
	195
c29e891d	196	$taint = tainted("constant"); # false
	197	$taint = tainted($ENV{PWD}); # true if running under -T
	198
f4a2945e	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
022735b4	206	prevent the object being DESTROY-ed at its usual time.
f4a2945e	207
c29e891d	208	{
	209	my $var;
	210	$ref = \$var;
	211	weaken($ref); # Make $ref a weak reference
	212	}
	213	# $ref is now undef
	214
cf083cf9	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
f4a2945e	234	=back
f4a2945e	235
2ff28616	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
9c3c560b	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
ddf53ba4	267	=head1 SEE ALSO
	268
	269	L<List::Util>
	270
f4a2945e	271	=head1 COPYRIGHT
f4a2945e	272
2ff28616	273	Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
c29e891d	274	This program is free software; you can redistribute it and/or modify it
f4a2945e	275	under the same terms as Perl itself.
f4a2945e	276
c29e891d	277	Except weaken and isweak which are
f4a2945e	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
f4a2945e	283	=cut