The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Frost::Meta::Constructor;

#	LIBS
#
use Moose::Role;

use Frost::Util;

#	CLASS VARS
#
our $VERSION	= 0.62;
our $AUTHORITY	= 'cpan:ERNESTO';

#	CLASS METHODS
#

#	PUBLIC ATTRIBUTES
#

#	PRIVATE ATTRIBUTES
#

#	CONSTRUCTORS
#

#	DESTRUCTORS
#

#	PUBLIC METHODS
#

#	PRIVATE METHODS
#
around '_generate_instance' => sub
{
	my $next									= shift;
	my ( $self, $var, $class_var )	= @_;

	my $plain_instance	= $self->$next ( $var, $class_var );

	#	Order of attributes / params is unpredictable!
	#	So we have to make shure, that db and id are set first - and in this order!
	#
	my $id_index;
	my $am_index;

	my $default_initializers	= '';

	my @attributes	= @{ $self->_attributes || [] };

	for ( my $i = 0; $i < @attributes; $i++ )
	{
		my $attr		= $attributes[$i];

		$id_index	= $i		if $attr->name eq 'id';
		$am_index	= $i		if $attr->name eq 'asylum';

#		last		if defined $id_index and defined $am_index;

#	see Locum::_populate_defaults...
#
#		next	if $attr->name eq 'id';
#		next	if $attr->name eq 'asylum';
#		next	if $attr->name eq '_status';
#		next	if $attr->name eq '_dirty';
#
#		if ( $attr->is_transient )
#		{
#	    	if ( ( $attr->has_default || $attr->has_builder ) && ! $attr->is_lazy )
#	    	{
#	    		$default_initializers	||= ";\n"	if $default_initializers;
#	    		$default_initializers	.= $self->_generate_slot_initializer ( $i );
#	    	}
#		}
#
#	now inline...
	}

	my $id_initializer		= $self->_generate_slot_initializer ( $id_index );
	my $am_initializer		= $self->_generate_slot_initializer ( $am_index );

	my $status_exists			= "'" . STATUS_EXISTS . "'";

	my $populate_defaults	= $self->_generate_populate_defaults();

	my $code		=<<"EOT";

$plain_instance;		#	my $var = ...

#::DEBUG 'AA XXXXXXXXXXXXXXXXXXX', ::Dumper $var\->{id}, $var;

$am_initializer;		#	order!

#::DEBUG 'BB XXXXXXXXXXXXXXXXXXX', ::Dumper $var\->{id}, $var;

$id_initializer;		#	sets _status as well... see Frost::Locum->_evoke 'id'

#::DEBUG 'CC XXXXXXXXXXXXXXXXXXX', ::Dumper $var\->{id}, $var;

{
	if ( $var\->{_status} eq $status_exists )
	{
#		$default_initializers;
#		$var\->_populate_defaults();

my \$was_dirty	= $var\->_evoke ( "_dirty" );

$populate_defaults;

$var->_silence ( "_dirty", 0 )	unless \$was_dirty;

		return $var;
	}

	#::DEBUG 'DD XXXXXXXXXXXXXXXXXXX MISSING', ::Dumper $var\->{id}, $var;

	#	continue with
	#	_generate_slot_initializers
	#	_generate_triggers
	#	_generate_BUILDALL
}

EOT

	#DEBUG "\n============================\n", $code, "\n============================\n";

	return $code;
};

sub _generate_populate_defaults
{
	my ( $self )	= @_;

	return
	(
		join ";\n" => map
		{
			$self->_generate_populate_default ( $_ )
		}
		0 .. ( @ { $self->_attributes } - 1 )
	) . ";\n";
}

sub _generate_populate_default
{
	my $self		= shift;
	my $index	= shift;

	my $attr			= $self->_attributes->[$index];

	my $is_moose	= $attr->isa('Moose::Meta::Attribute'); # XXX FIXME

	my $slot			= $attr->name;

	my $header		= '## ' . $slot;

	return $header			unless	( $attr->is_virtual or $attr->is_transient );
	return $header			if			( $slot =~ /^( asylum | _dirty | _status )$/x );
	return $header			unless	(($attr->has_default || $attr->has_builder) && !($is_moose && $attr->is_lazy));

	my @source		= ( $header );

	push @source => "unless ( \$instance->_exists ( '$slot' ) )";
	push @source => "{";

	my $default;

	if ( $attr->has_default )
	{
		$default		= $self->_generate_default_value ( $attr, $index );
	}
	else
	{
		my $builder	= $attr->builder;
		$default		= '$instance->' . $builder;
	}

	push @source	=> '{';	#	wrap this to avoid my $val overwrite warnings
	push @source	=> 'my $val = ' . $default . ';';
	push @source	=> $self->_generate_type_constraint_and_coercion ( $attr, $index )		if $is_moose;
	push @source	=> $self->_generate_slot_assignment ( $attr, '$val', $index );
	push @source	=> '}'; 	#	close - wrap this to avoid my $val overrite warnings

	push @source => "}";

   return join "\n" => @source;
}


#	CALLBACKS
#

#	IMMUTABLE
#
no Moose::Role;

#	__PACKAGE__->meta->make_immutable ( debug => 0 );

1;

__END__

=head1 NAME

Frost::Meta::Constructor - The Builder

=head1 ABSTRACT

No documentation yet...

=head1 DESCRIPTION

No user maintainable parts inside ;-)

=for comment CLASS VARS

=for comment CLASS METHODS

=for comment PUBLIC ATTRIBUTES

=for comment PRIVATE ATTRIBUTES

=for comment CONSTRUCTORS

=for comment DESTRUCTORS

=for comment PUBLIC METHODS

=head1 PRIVATE METHODS

=head2 _generate_instance

=head2 _generate_populate_defaults

=head2 _generate_populate_default

=for comment CALLBACKS

=for comment IMMUTABLE

=head1 GETTING HELP

I'm reading the Moose mailing list frequently, so please ask your
questions there.

The mailing list is L<moose@perl.org>. You must be subscribed to send
a message. To subscribe, send an empty message to
L<moose-subscribe@perl.org>

=head1 BUGS

All complex software has bugs lurking in it, and this module is no
exception.

Please report any bugs to me or the mailing list.

=head1 AUTHOR

Ernesto L<ernesto@dienstleistung-kultur.de>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Dienstleistung Kultur Ltd. & Co. KG

L<http://dienstleistung-kultur.de/frost/>

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

=cut