File Coverage

blib/lib/Data/ResultSet.pm

Criterion	Covered	Total	%
statement	73	79	92.4
branch	5	6	83.3
condition			n/a
subroutine	22	23	95.6
pod	10	10	100.0
total	110	118	93.2

package Data::ResultSet;
use warnings;
use strict;
use 5.006;

our $VERSION = '1.002';

sub new
{
	my ($class) = @_;
	return bless [], $class;
}

sub make_wrappers
{
	my ($class, @methods ) = @_;

	$class->make_wrappers_for_all(@methods);
	$class->make_wrappers_for_has(@methods);
	$class->make_wrappers_for_get(@methods);
	$class->make_wrappers_for_get_not(@methods);

	return;
}

sub make_wrappers_for_get
{
	my ($class, @methods) = @_;

	my $generator = sub {
		my ($methodname) = @_;
		return sub {
			return grep { $_->$methodname() } @{$_[0]};
		};
	};

	return $class->_generate_methods( 'get', $generator, @methods );
}

sub make_wrappers_for_get_not
{
	my ($class, @methods) = @_;

	my $generator = sub {
		my ($methodname) = @_;
		return sub {
			return grep { ! $_->$methodname() } @{$_[0]};
		};
	};

	return $class->_generate_methods( 'get_not', $generator, @methods );
}

sub make_wrappers_for_has
{
	my ($class, @methods) = @_;

	my $generator = sub {
		my ($methodname) = @_;
		return sub {
			for( @{$_[0]} ) {
				if( $_->$methodname() ) {
					return 1;
				}
			}
			return 0;
		};
	};

	return $class->_generate_methods( 'has', $generator, @methods );
}

sub make_wrappers_for_all
{
	my ($class, @methods) = @_;

	my $generator = sub {
		my ($methodname) = @_;
		return sub {
			for( @{$_[0]} ) {
				if( ! $_->$methodname() ) {
					return 0;
				}
			}
			return 1;
		};
	};

	return $class->_generate_methods( 'all', $generator, @methods );
}

sub _generate_methods
{
	my ($class, $prefix, $generator, @methods) = @_;

	no strict 'refs';  ## no critic (ProhibitNoStrict)
	foreach my $name (@methods) {
		my $wrappername = $name;
		$wrappername =~ s/is_//;
		$wrappername = "${class}::${prefix}_${wrappername}";
		if( ! defined &{$wrappername} ) {
			*{$wrappername} = $generator->($name);

		}
	}

	return;
}

sub add
{
	my ($self, $obj) = @_;
	push @{$self}, $obj;
	return $self;
}

sub clear
{
	my ($self) = @_;
	@{$self} = ();
	return 1;
}

sub count
{
	my ($self) = @_;
	return scalar @{$self};
}

sub contents
{
	my ($self) = @_;
	return @{$self};
}

1;
__END__