File Coverage

blib/lib/MooX/XSConstructor.pm

Criterion	Covered	Total	%
statement	54	59	91.5
branch	13	24	54.1
condition	5	12	41.6
subroutine	10	10	100.0
pod	0	2	0.0
total	82	107	76.6

use 5.008001;
use strict;
use warnings;

package MooX::XSConstructor;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.002';

use Moo 1.006000 ();
use Scalar::Util qw(blessed);
use Hook::AfterRuntime;

my $safe_spec = qr/\A(index|required|is|isa|builder|default|lazy|predicate|clearer|reader|writer)\z/;

sub is_suitable_class {
	my $self  = shift;
	my ($klass, $maybe_spec) = @_;

	my $ba = $klass->can('BUILDARGS');
	return if !$ba;
	return if $ba != \&Moo::Object::BUILDARGS;
	return if $klass->can('FOREIGNBUILDARGS');

	my %spec = %{ $maybe_spec or Moo->_constructor_maker_for($klass)->all_attribute_specs };
	my @attributes = sort { $spec{$a}{index} <=> $spec{$b}{index} } keys %spec;

	for my $attr (@attributes) {
		if ($spec{$attr}{isa} and !blessed($spec{$attr}{isa})) {
			return;
		}
		if ($spec{$attr}{isa} and !$spec{$attr}{isa}->can('compiled_check')) {
			return;
		}
		if ($spec{$attr}{default} and not $spec{$attr}{lazy}) {
			return;
		}
		if ($spec{$attr}{builder} and not $spec{$attr}{lazy}) {
			return;
		}
		if (my @unsafe = grep { $_ !~ $safe_spec } keys %{ $spec{$attr} }) {
			# print Dumper \@unsafe;
			return;
		}
	}

	return "yay!";
}

sub setup_for {
	my $self  = shift;
	my ($klass) = @_;

	my %spec = %{ Moo->_constructor_maker_for($klass)->all_attribute_specs };
	return unless $self->is_suitable_class($klass, \%spec);

	my @optlist =
		map {
			my $attrbang = my $attr = $_;
			$attrbang .= '!' if $spec{$attr}{required};
			$spec{$attr}{isa} ? ($attrbang, $spec{$attr}{isa}) : ($attrbang);
		}
		sort { $spec{$a}{index} <=> $spec{$b}{index} }
		keys %spec;

	require Class::XSConstructor;
	local $Class::XSConstructor::SETUP_FOR = $klass;
	local $Class::XSConstructor::REDEFINE  = !!1;
	Class::XSConstructor->import(@optlist);
}

sub import {
	my $self = shift;
	my $caller = caller;
	after_runtime {
		$self->setup_for($caller);
	};
}

1;

__END__