File Coverage

blib/lib/Test/Type.pm

Criterion	Covered	Total	%
statement	85	85	100.0
branch	55	66	83.3
condition			n/a
subroutine	13	13	100.0
pod	7	7	100.0
total	160	171	93.5

package Test::Type;

use strict;
use warnings;

use Carp qw();
use Data::Validate::Type;
use Exporter 'import';
use Test::More qw();


=head1 NAME

Test::Type - Functions to validate data types in test files.


=head1 VERSION

Version 1.2.0

=cut

our $VERSION = '1.2.0';


=head1 SYNOPSIS

	use Test::Type;

	# Test strings.
	ok_string( $variable );
	ok_string(
		$variable,
		name => 'My variable',
	);

	# Test arrayrefs.
	ok_arrayref( $variable );
	ok_arrayref(
		$variable,
		name => 'My variable',
	);

	# Test hashrefs.
	ok_hashref( $variable );
	ok_hashref(
		$variable,
		name => 'Test variable',
	);

	# Test coderefs.
	ok_coderef( $variable );
	ok_coderef(
		$variable,
		name => 'Test variable',
	);

	# Test numbers.
	ok_number( $variable );
	ok_number(
		$variable,
		name => 'Test variable',
	);

	# Test instances.
	ok_instance(
		$variable,
		class => $class,
	);
	ok_instance(
		$variable,
		name  => 'Test variable',
		class => $class,
	);

	# Test regular expressions.
	ok_regex( $variable );
	ok_regex(
		$variable,
		name => 'Test regular expression',
	);

=cut

our @EXPORT = ## no critic (Modules::ProhibitAutomaticExportation)
(
	'ok_arrayref',
	'ok_coderef',
	'ok_hashref',
	'ok_instance',
	'ok_number',
	'ok_string',
	'ok_regex',
);


=head1 FUNCTIONS

=head2 ok_string()

Test if the variable passed is a string.

	ok_string(
		$variable,
	);

	ok_string(
		$variable,
		name => 'My variable',
	);

	ok_string(
		$variable,
		name        => 'My variable',
		allow_empty => 1,
	);

Parameters:

=over 4

=item * name

Optional, the name of the variable being tested.

=item * allow_empty

Boolean, default 1. Allow the string to be empty or not.

=back

=cut

sub ok_string
{
	my ( $variable, %args ) = @_;

	# Verify arguments and set defaults.
	my $name = delete( $args{'name'} );
	$name = 'Variable' if !defined( $name );
	my $allow_empty = delete( $args{'allow_empty'} );
	$allow_empty = 1 if !defined( $allow_empty );
	Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
		if scalar( keys %args ) != 0;

	my @test_properties = ();
	push( @test_properties, $allow_empty ? 'allow empty' : 'non-empty' );
	my $test_properties = scalar( @test_properties ) == 0
		? ''
		: ' (' . join( ', ', @test_properties ) . ')';

	return Test::More::ok(
		Data::Validate::Type::is_string(
			$variable,
			allow_empty => $allow_empty,
		),
		$name . ' is a string' . $test_properties . '.',
	);
}


=head2 ok_arrayref()

Test if the variable passed is an arrayref that can be dereferenced into an
array.

	ok_arrayref( $variable );

	ok_arrayref(
		$variable,
		name => 'My variable',
	);

	ok_arrayref(
		$variable,
		allow_empty => 1,
		no_blessing => 0,
	);

	# Check if the variable is an arrayref of hashrefs.
	ok_arrayref(
		$variable,
		allow_empty           => 1,
		no_blessing           => 0,
		element_validate_type =>
			sub
			{
				return Data::Validate::Type::is_hashref( $_[0] );
			},
	);

Parameters:

=over 4

=item * name

Optional, the name of the variable being tested.

=item * allow_empty

Boolean, default 1. Allow the array to be empty or not.

=item * no_blessing

Boolean, default 0. Require that the variable is not blessed.

=item * element_validate_type

None by default. Set it to a coderef to validate the elements in the array.
The coderef will be passed the element to validate as first parameter, and it
must return a boolean indicating whether the element was valid or not.

=back

=cut

sub ok_arrayref
{
	my ( $variable, %args ) = @_;

	# Verify arguments and set defaults.
	my $name = delete( $args{'name'} );
	$name = 'Variable' if !defined( $name );
	my $allow_empty = delete( $args{'allow_empty'} );
	$allow_empty = 1 if !defined( $allow_empty );
	my $no_blessing = delete( $args{'no_blessing'} );
	$no_blessing = 0 if !defined( $no_blessing );
	my $element_validate_type = delete( $args{'element_validate_type'} );
	Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
		if scalar( keys %args ) != 0;

	my @test_properties = ();
	push( @test_properties, $allow_empty ? 'allow empty' : 'non-empty' );
	push( @test_properties, $no_blessing ? 'no blessing' : 'allow blessed' );
	push( @test_properties, 'validate elements' )
		if $element_validate_type;
	my $test_properties = scalar( @test_properties ) == 0
		? ''
		: ' (' . join( ', ', @test_properties ) . ')';

	return Test::More::ok(
		Data::Validate::Type::is_arrayref(
			$variable,
			allow_empty           => $allow_empty,
			no_blessing           => $no_blessing,
			element_validate_type => $element_validate_type,
		),
		$name . ' is an arrayref' . $test_properties . '.',
	);
}


=head2 ok_hashref()

Test if the variable passed is a hashref that can be dereferenced into a hash.

	ok_hashref( $variable );

	ok_hashref(
		$variable,
		name => 'Test variable',
	);

	ok_hashref(
		$variable,
		allow_empty => 1,
		no_blessing => 0,
	);

Parameters:

=over 4

=item * name

Optional, the name of the variable being tested.

=item * allow_empty

Boolean, default 1. Allow the array to be empty or not.

=item * no_blessing

Boolean, default 0. Require that the variable is not blessed.

=back

=cut

sub ok_hashref
{
	my ( $variable, %args ) = @_;

	# Verify arguments and set defaults.
	my $name = delete( $args{'name'} );
	$name = 'Variable' if !defined( $name );
	my $allow_empty = delete( $args{'allow_empty'} );
	$allow_empty = 1 if !defined( $allow_empty );
	my $no_blessing = delete( $args{'no_blessing'} );
	$no_blessing =  0 if !defined( $no_blessing );
	Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
		if scalar( keys %args ) != 0;

	my @test_properties = ();
	push( @test_properties, $allow_empty ? 'allow empty' : 'non-empty' );
	push( @test_properties, $no_blessing ? 'no blessing' : 'allow blessed' );
	my $test_properties = scalar( @test_properties ) == 0
		? ''
		: ' (' . join( ', ', @test_properties ) . ')';

	return Test::More::ok(
		Data::Validate::Type::is_hashref(
			$variable,
			allow_empty           => $allow_empty,
			no_blessing           => $no_blessing,
		),
		$name . ' is a hashref' . $test_properties . '.',
	);
}


=head2 ok_coderef()

Test if the variable passed is an coderef that can be dereferenced into a block
of code.

	ok_coderef( $variable );

	ok_coderef(
		$variable,
		name => 'Test variable',
	);

Parameters:

=over 4

=item * name

Optional, the name of the variable being tested.

=back

=cut

sub ok_coderef
{
	my ( $variable, %args ) = @_;

	# Verify arguments and set defaults.
	my $name = delete( $args{'name'} );
	$name = 'Variable' if !defined( $name );
	Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
		if scalar( keys %args ) != 0;

	return Test::More::ok(
		Data::Validate::Type::is_coderef(
			$variable,
		),
		$name . ' is a coderef.',
	);
}


=head2 ok_number()

Test if the variable passed is a number.

	ok_number( $variable );

	ok_number(
		$variable,
		name => 'Test variable',
	);

	ok_number(
		$variable,
		positive => 1,
	);

	ok_number(
		$variable,
		strictly_positive => 1,
	);

Parameters:

=over 4

=item * name

Optional, the name of the variable being tested.

=item * strictly_positive

Boolean, default 0. Set to 1 to check for a strictly positive number.

=item * positive

Boolean, default 0. Set to 1 to check for a positive number.

=back

=cut

sub ok_number
{
	my ( $variable, %args ) = @_;

	# Verify arguments and set defaults.
	my $name = delete( $args{'name'} );
	$name = 'Variable' if !defined( $name );
	my $strictly_positive = delete( $args{'strictly_positive'} );
	$strictly_positive = 0 if !defined( $strictly_positive );
	my $positive = delete( $args{'positive'} );
	$positive = 0 if !defined( $positive );
	Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
		if scalar( keys %args ) != 0;

	my @test_properties = ();
	push( @test_properties, 'strictly positive' )
		if $strictly_positive;
	push( @test_properties, 'positive' )
		if $positive;
	my $test_properties = scalar( @test_properties ) == 0
		? ''
		: ' (' . join( ', ', @test_properties ) . ')';

	return Test::More::ok(
		Data::Validate::Type::is_number(
			$variable,
			strictly_positive => $strictly_positive,
			positive          => $positive,
		),
		$name . ' is a number' . $test_properties . '.',
	);
}


=head2 ok_instance()

Test if the variable is an instance of the given class.

Note that this handles inheritance properly, so it will succeed if the
variable is an instance of a subclass of the class given.

	ok_instance(
		$variable,
		class => $class,
	);

	ok_instance(
		$variable,
		name  => 'Test variable',
		class => $class,
	);

Parameters:

=over 4

=item * name

Optional, the name of the variable being tested.

=item * class

Required, the name of the class to check the variable against.

=back

=cut

sub ok_instance
{
	my ( $variable, %args ) = @_;

	# Verify arguments and set defaults.
	my $name = delete( $args{'name'} );
	$name = 'Variable' if !defined( $name );
	my $class = delete( $args{'class'} );
	Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
		if scalar( keys %args ) != 0;

	return Test::More::ok(
		Data::Validate::Type::is_instance(
			$variable,
			class => $class,
		),
		$name . ' is an instance of ' . $class . '.',
	);
}


=head2 ok_regex()

Test if the variable is a regular expression.

	ok_regex( $variable );

=cut

sub ok_regex
{
	my ( $variable, %args ) = @_;

	# Verify arguments and set defaults.
	my $name = delete( $args{'name'} );
	$name = 'Variable' if !defined( $name );
	Carp::croak( 'Unknown parameter(s): ' . join( ', ', keys %args ) . '.' )
		if scalar( keys %args ) != 0;

	return Test::More::ok(
		Data::Validate::Type::is_regex( $variable ),
		$name . ' is a regular expression.',
	);
}


=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

	perldoc Test::Type


You can also look for information at:

=over

=item *

GitHub (report bugs there)

L

=item *

AnnoCPAN: Annotated CPAN documentation

L

=item *

CPAN Ratings

L

=item *

Search CPAN

L

=back


=head1 AUTHOR

L,
C<<  >>.


=head1 COPYRIGHT & LICENSE

Copyright 2012-2014 Guillaume Aubert.

This program is free software: you can redistribute it and/or modify it under
the terms of the GNU General Public License version 3 as published by the Free
Software Foundation.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program. If not, see http://www.gnu.org/licenses/

=cut

1;