File Coverage

blib/lib/Mock/Data.pm

Criterion	Covered	Total	%
statement	61	88	69.3
branch	29	52	55.7
condition	8	18	44.4
subroutine	11	16	68.7
pod	9	9	100.0
total	118	183	64.4

package Mock::Data;

# ABSTRACT: Extensible toolkit for generating mock data
our $VERSION = '0.01'; # VERSION


use strict;
use warnings;
BEGIN {
	require MRO::Compat if "$]" < '5.009005';
	require mro;
	mro::set_mro(__PACKAGE__, 'c3');
}
require Storable;
require Module::Runtime;


sub new {
	my $class= shift;
	my $self= ref $class? $class->clone
		: bless {
			generators => {}, # can't initialize, plugins go first
			generator_state => {},
			_generator_cache => {},
			_loaded_plugins => {},
		}, $class;
	if (@_) {
		my $args
			= (@_ == 1 && ref $_[0] eq 'ARRAY')? { plugins => $_[0] }
			: (@_ == 1 && ref $_[0] eq 'HASH')? $_[0]
			: { @_ };
		if (my $plugins= $args->{plugins}) {
			$self= $self->load_plugin($_)
				for ref $plugins? @$plugins : ( $plugins );
		}
		$self->add_generators($args->{generators})
			if $args->{generators};
	}
	return $self;
}


sub clone {
	my $self= shift;
	my $new= {
		%$self,
		# Shallow clone generators and _loaded_plugins
		_loaded_plugins => { %{ $self->{_loaded_plugins} } },
		generators => { %{ $self->{generators} } },
		# deep clone generator_state
		generator_state => Storable::dclone($self->{generator_state}),
		# clear cache
		_generator_cache => {},
	};
	# Allow generators to handle cloned state
	for (values %{ $new->{generators} }) {
		$_= $_->clone if ref->can('clone');
	}
	bless $new, ref $self;
}


sub generators {
	return $_[0]{generators} if @_ == 1;
	# Coerce generators
	my %new= %{ $_[1] };
	$_= Mock::Data::Util::coerce_generator($_) for values %new;
	# clear cache first
	%{$_[0]{_generator_cache}}= ();
	return $_[0]{generators}= \%new;
}

sub generator_state {
	$_[0]{generator_state}= $_[1] if @_ > 1;
	$_[0]{generator_state};
}


sub load_plugin {
	my ($self, $name)= @_;
	return $self if $self->{_loaded_plugins}{$name};
	my $class= "Mock::Data::Plugin::$name";
	unless ($class->can('apply_mockdata_plugin')) {
		Module::Runtime::require_module($class);
		$class->can('apply_mockdata_plugin')
			or Carp::croak("No such method ${class}->apply_mockdata_plugin");
	}
	my $new= $class->apply_mockdata_plugin($self);
	ref($new) && ref($new)->isa(__PACKAGE__)
		or Carp::croak("$class->apply_mockdata_plugin did not return a Mock::Data");
	++$self->{_loaded_plugins}{$name};
	return $new;
}


sub add_generators {
	my $self= shift;
	my @args= @_ == 1? %{ $_[0] } : @_;
	while (@args) {
		my ($name, $gen)= splice @args, 0, 2;
		$gen= Mock::Data::Util::coerce_generator($gen);
		$self->generators->{$name}= $gen;
		delete $self->{_generator_cache}{$name};
		if ($name =~ /::([^:]+)$/ and !defined $self->generators->{$1}) {
			$self->generators->{$1}= $gen;
		}
	}
	$self;
}

sub combine_generators {
	my $self= shift;
	my @args= @_ == 1? %{ $_[0] } : @_;
	while (@args) {
		my ($name, $gen)= splice @args, 0, 2;
		$gen= Mock::Data::Util::coerce_generator($gen);
		my $merged= $gen;
		if (defined (my $cur= $self->generators->{$name})) {
			$merged= $cur->combine_generator($gen);
			delete $self->{_generator_cache}{$name};
		}
		$self->generators->{$name}= $merged;

		# If given a namespace-qualified name, also install as the 'leaf' of that name
		if ($name =~ /::([^:]+)$/) {
			($name, $merged)= ($1, $gen);
			if (defined (my $cur= $self->generators->{$name})) {
				$merged= $cur->combine_generator($gen);
				delete $self->{_generator_cache}{$name};
			}
			$self->generators->{$name}= $merged;
		}
	}
	$self;
}


sub call {
	my ($self, $name)= (shift, shift);
	defined $self->{generators}{$name}
		or Carp::croak("No such generator '$name'");
	return $self->{generators}{$name}->generate($self, @_) if @_;
	# If no params, call the cached compiled version
	($self->{_generator_cache}{$name} ||= $self->{generators}{$name}->compile)
		->($self, @_);
}


sub wrap {
	my ($self, $name)= (shift, shift);
	my $gen= $self->{generators}{$name};
	defined $gen or Carp::croak("No such generator '$name'");
	my $code= @_? $gen->compile(@_)
		: ($self->{_generator_cache}{$name} ||= $gen->compile);
	return sub { $code->($self) }
}

our $AUTOLOAD;
sub AUTOLOAD {
	my $self= shift;
	Carp::croak("No method $AUTOLOAD in package $self") unless ref $self;
	my $name= substr($AUTOLOAD, rindex($AUTOLOAD,':')+1);
	$self->call($name, @_);
	# don't install, because generators are defined per-instance not per-package
}

sub DESTROY {} # prevent AUTOLOAD from triggering on ->DESTROY


sub import {
	Mock::Data::Util->export_to_level(1, @_);
}

require Mock::Data::Util;

__END__