package Params::Util;

=pod

=head1 NAME

Params::Util - Simple standalone param-checking functions

=head1 SYNOPSIS

  # Import some functions
  use Params::Util qw{_SCALAR _HASH _INSTANCE};
  
  sub foo {
      my $object  = _INSTANCE(shift, 'Foo') or return undef;
      my $image   = _SCALAR(shift)          or return undef;
      my $options = _HASH(shift)            or return undef;
      # etc...
  }

=head1 DESCRIPTION

C<Params::Util> provides a basic set of importable functions that makes
checking parameters a hell of a lot easier.

The functions provided by C<Params::Util> check in the most strictly
correct manner, and in should not be fooled by odd cases.

To use, simply load the module providing the functions you want to use
as arguments (as shown in the SYNOPSIS). For now, to aid in clarity and
code maintenance, you will need to name the functions explicitly, rather
than just importing everything.

=head1 FUNCTIONS

=cut

use strict;
use base 'Exporter';
use Scalar::Util ();

use vars qw{$VERSION @EXPORT_OK};
BEGIN {
	$VERSION   = '0.04';

	@EXPORT_OK = qw{
		_IDENTIFIER _CLASS
		_SCALAR     _SCALAR0
		_ARRAY      _ARRAY0
		_HASH       _HASH0
		_CODE
		_INSTANCE   _SET   _SET0
		};
}





#####################################################################
# Param Checking Functions

=pod

=head2 _IDENTIFIER $string

The C<_IDENTIFIER> function is intended to be imported into your
package, and provides a convenient way to test to see if a value is
a string that is a valid Perl identifier.

Returns the string as a convenience if it is a valid identifier, or
C<undef> if not.

=cut

sub _IDENTIFIER ($) {
	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*$/s) ? $_[0] : undef;
}

=pod

=head2 _CLASS $string

The C<_CLASS> function is intended to be imported into your
package, and provides a convenient way to test to see if a value is
a string that is a valid Perl class.

This function only checks that the format is valid, not that the
class is actually loaded. It also assumes "normalised" form, and does
not accept class names such as C<::Foo> or C<D'Oh>.

Returns the string as a convenience if it is a valid class name, or
C<undef> if not.

=cut

sub _CLASS ($) {
	(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::[^\W\d]\w*)*$/s) ? $_[0] : undef;
}

=pod

=head2 _SCALAR \$scalar

The C<_SCALAR> function is intended to be imported into your package,
and provides a convenient way to test for a raw and unblessed
C<SCALAR> reference, with content of non-zero length.

For a version that allows zero length C<SCALAR> references, see
the C<_SCALAR0> function.

Returns the C<SCALAR> reference itself as a convenience, or C<undef>
if the value provided is not a C<SCALAR> reference.

=cut

sub _SCALAR ($) {
	(ref $_[0] eq 'SCALAR' and defined ${$_[0]} and ${$_[0]} ne '') ? $_[0] : undef;
}

=pod

=head2 _SCALAR0 \$scalar

The C<_SCALAR0> function is intended to be imported into your package,
and provides a convenient way to test for a raw and unblessed
C<SCALAR0> reference, allowing content of zero-length.

For a simpler "give me some content" version that requires non-zero
length, C<_SCALAR> function.

Returns the C<SCALAR> reference itself as a convenience, or C<undef>
if the value provided is not a C<SCALAR> reference.

=cut

sub _SCALAR0 ($) {
	ref $_[0] eq 'SCALAR' ? $_[0] : undef;
}

=pod

=head2 _ARRAY $value

The C<_ARRAY> function is intended to be imported into your package,
and provides a convenient way to test for a raw and unblessed
C<ARRAY> reference containing B<at least> one element of any kind.

For a more basic form that allows zero length ARRAY references, see
the C<_ARRAY0> function.

Returns the C<ARRAY> reference itself as a convenience, or C<undef>
if the value provided is not an C<ARRAY> reference.

=cut

sub _ARRAY ($) {
	(ref $_[0] eq 'ARRAY' and @{$_[0]}) ? $_[0] : undef;
}

=pod

=head2 _ARRAY0 $value

The C<_ARRAY0> function is intended to be imported into your package,
and provides a convenient way to test for a raw and unblessed
C<ARRAY> reference, allowing C<ARRAY> references that contain no
elements.

For a more basic "An array of something" form that also requires at
least one element, see the C<_ARRAY> function.

Returns the C<ARRAY> reference itself as a convenience, or C<undef>
if the value provided is not an C<ARRAY> reference.

=cut

sub _ARRAY0 ($) {
	ref $_[0] eq 'ARRAY' ? $_[0] : undef;
}

=pod

=head2 _HASH $value

The C<_HASH> function is intended to be imported into your package,
and provides a convenient way to test for a raw and unblessed
C<HASH> reference with at least one entry.

For a version of this function that allows the C<HASH> to be empty,
see the C<_HASH0> function.

Returns the C<HASH> reference itself as a convenience, or C<undef>
if the value provided is not an C<HASH> reference.

=cut

sub _HASH ($) {
	(ref $_[0] eq 'HASH' and scalar %{$_[0]}) ? $_[0] : undef;
}

=pod

=head2 _HASH0 $value

The C<_HASH0> function is intended to be imported into your package,
and provides a convenient way to test for a raw and unblessed
C<HASH> reference, regardless of the C<HASH> content.

For a simpler "A hash of something" version that requires at least one
element, see the C<_HASH> function.

Returns the C<HASH> reference itself as a convenience, or C<undef>
if the value provided is not an C<HASH> reference.

=cut

sub _HASH0 ($) {
	ref $_[0] eq 'HASH' ? $_[0] : undef;
}


=pod

=head2 _CODE $value

The C<_CODE> function is intended to be imported into your package,
and provides a convenient way to test for a raw and unblessed
C<CODE> reference.

Returns the C<CODE> reference itself as a convenience, or C<undef>
if the value provided is not an C<CODE> reference.

=cut

sub _CODE ($) {
	ref $_[0] eq 'CODE' ? $_[0] : undef;
}

=pod

=head2 _INSTANCE $object, $class

The C<_INSTANCE> function is intended to be imported into your package,
and provides a convenient way to test for an object of a particular class
in a strictly correct manner.

Returns the object itself as a convenience, or C<undef> if the value
provided is not an object of that type.

=cut

sub _INSTANCE ($$) {
	(Scalar::Util::blessed($_[0]) and $_[0]->isa($_[1])) ? $_[0] : undef;
}

=pod

=head2 _SET \@array, $class

The C<_SET> function is intended to be imported into your package,
and provides a convenient way to test for set of at least one object of
a particular class in a strictly correct manner.

The set is provided as a reference to an C<ARRAY> of objects of the
class provided.

For an alternative function that allows zero-length sets, see the
C<_SET0> function.

Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
the value provided is not a set of that class.

=cut

sub _SET ($$) {
	my $set = shift;
	ref $set eq 'ARRAY' and @$set or return undef;
	foreach ( @$set ) {
		Scalar::Util::blessed($_) and $_->isa($_[0]) or return undef;
	}
	$set;
}

=pod

=head2 _SET0 \@array, $class

The C<_SET0> function is intended to be imported into your package,
and provides a convenient way to test for set of objects of a particular
class in a strictly correct manner, allowing for zero objects.

The set is provided as a reference to an C<ARRAY> of objects of the
class provided.

For an alternative function that requires at least one object, see the
C<_SET> function.

Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
the value provided is not a set of that class.

=cut

sub _SET0 ($$) {
	my $set = shift;
	ref $set eq 'ARRAY' or return undef;
	foreach ( @$set ) {
		Scalar::Util::blessed($_) and $_->isa($_[0]) or return undef;
	}
	$set;
}

1;

=pod

=head1 TO DO

- More comprehensive tests for _SET and _SET0

- Would be nice if someone would re-implement in XS for me? :)

=head1 SUPPORT

Bugs should be reported via the CPAN bug tracker at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Param-Util>

For other issues, contact the author.

=head1 AUTHOR

Adam Kennedy (Maintainer), L<http://ali.as/>, cpan@ali.as

=head1 COPYRIGHT

Copyright 2005 Adam Kennedy. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut
