[gitmo/Moose.git] / lib / Moose / Meta / Class.pm


package Moose::Meta::Class;

use strict;
use warnings;

use Carp 'confess';

our $VERSION = '0.01';

use base 'Class::MOP::Class';

sub construct_instance {
    my ($class, %params) = @_;
    my $instance = {};
    foreach my $attr ($class->compute_all_applicable_attributes()) {
        my $init_arg = $attr->init_arg();
        # try to fetch the init arg from the %params ...
        my $val;        
        $val = $params{$init_arg} if exists $params{$init_arg};
        # if nothing was in the %params, we can use the 
        # attribute's default value (if it has one)
        $val ||= $attr->default($instance) if $attr->has_default; 
		if (defined $val && $attr->has_type_constraint) {
			(defined $attr->type_constraint->($val))
				|| confess "Attribute (" . $attr->name . ") does not pass the type contraint";			
		}
        $instance->{$attr->name} = $val;
    }
    return $instance;
}

1;

__END__

=pod

=head1 NAME

Moose::Meta::Class - 

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 METHODS

=over 4

=item B<construct_instance>

=back

=head1 BUGS

All complex software has bugs lurking in it, and this module is no 
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 CODE COVERAGE

I use L<Devel::Cover> to test the code coverage of my tests, below is the 
L<Devel::Cover> report on this module's test suite.

=head1 ACKNOWLEDGEMENTS

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut
Commit	Line	Data
c0e30cf5	1
	2	package Moose::Meta::Class;
	3
	4	use strict;
	5	use warnings;
	6
a15dff8d	7	use Carp 'confess';
a15dff8d	8
bc1e29b5	9	our $VERSION = '0.01';
bc1e29b5	10
c0e30cf5	11	use base 'Class::MOP::Class';
c0e30cf5	12
a15dff8d	13	sub construct_instance {
	14	my ($class, %params) = @_;
	15	my $instance = {};
	16	foreach my $attr ($class->compute_all_applicable_attributes()) {
	17	my $init_arg = $attr->init_arg();
	18	# try to fetch the init arg from the %params ...
	19	my $val;
	20	$val = $params{$init_arg} if exists $params{$init_arg};
	21	# if nothing was in the %params, we can use the
	22	# attribute's default value (if it has one)
	23	$val \|\|= $attr->default($instance) if $attr->has_default;
	24	if (defined $val && $attr->has_type_constraint) {
	25	(defined $attr->type_constraint->($val))
	26	\|\| confess "Attribute (" . $attr->name . ") does not pass the type contraint";
	27	}
	28	$instance->{$attr->name} = $val;
	29	}
	30	return $instance;
	31	}
	32
c0e30cf5	33	1;
	34
	35	__END__
	36
	37	=pod
	38
	39	=head1 NAME
	40
	41	Moose::Meta::Class -
	42
	43	=head1 SYNOPSIS
	44
	45	=head1 DESCRIPTION
	46
	47	=head1 METHODS
	48
	49	=over 4
	50
a15dff8d	51	=item B<construct_instance>
a15dff8d	52
c0e30cf5	53	=back
	54
	55	=head1 BUGS
	56
	57	All complex software has bugs lurking in it, and this module is no
	58	exception. If you find a bug please either email me, or add the bug
	59	to cpan-RT.
	60
	61	=head1 CODE COVERAGE
	62
	63	I use L<Devel::Cover> to test the code coverage of my tests, below is the
	64	L<Devel::Cover> report on this module's test suite.
	65
	66	=head1 ACKNOWLEDGEMENTS
	67
	68	=head1 AUTHOR
	69
	70	Stevan Little E<lt>stevan@iinteractive.comE<gt>
	71
	72	=head1 COPYRIGHT AND LICENSE
	73
	74	Copyright 2006 by Infinity Interactive, Inc.
	75
	76	L<http://www.iinteractive.com>
	77
	78	This library is free software; you can redistribute it and/or modify
	79	it under the same terms as Perl itself.
	80
	81	=cut