The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Bread::Board::Declare::Meta::Role::Attribute::Service;
BEGIN {
  $Bread::Board::Declare::Meta::Role::Attribute::Service::AUTHORITY = 'cpan:DOY';
}
{
  $Bread::Board::Declare::Meta::Role::Attribute::Service::VERSION = '0.13';
}
use Moose::Role;
Moose::Util::meta_attribute_alias('Service');
# ABSTRACT: attribute metarole for service attributes in Bread::Board::Declare

use Bread::Board::Types;
use Class::Load qw(load_class);
use List::MoreUtils qw(any);

use Bread::Board::Declare::BlockInjection;
use Bread::Board::Declare::ConstructorInjection;
use Bread::Board::Declare::Literal;



has block => (
    is        => 'ro',
    isa       => 'CodeRef',
    predicate => 'has_block',
);


# has_value is already a method
has literal_value => (
    is        => 'ro',
    isa       => 'Value',
    init_arg  => 'value',
    predicate => 'has_literal_value',
);


has lifecycle => (
    is        => 'ro',
    isa       => 'Str',
    predicate => 'has_lifecycle',
);


has dependencies => (
    is        => 'ro',
    isa       => 'Bread::Board::Service::Dependencies',
    coerce    => 1,
    predicate => 'has_dependencies',
);


has parameters => (
    is        => 'ro',
    isa       => 'Bread::Board::Service::Parameters',
    coerce    => 1,
    predicate => 'has_parameters',
);


has infer => (
    is  => 'ro',
    isa => 'Bool',
);


has constructor_name => (
    is        => 'ro',
    isa       => 'Str',
    predicate => 'has_constructor_name',
);


has associated_service => (
    is   => 'rw',
    does => 'Bread::Board::Service',
);

after attach_to_class => sub {
    my $self = shift;

    my %params = (
        associated_attribute => $self,
        name                 => $self->name,
        ($self->has_lifecycle
            ? (lifecycle => $self->lifecycle)
            : ()),
        ($self->has_dependencies
            ? (dependencies => $self->dependencies)
            : ()),
        ($self->has_parameters
            ? (parameters => $self->parameters)
            : ()),
        ($self->has_constructor_name
            ? (constructor_name => $self->constructor_name)
            : ()),
    );

    my $tc = $self->has_type_constraint ? $self->type_constraint : undef;

    my $service;
    if ($self->has_block) {
        if ($tc && $tc->isa('Moose::Meta::TypeConstraint::Class')) {
            %params = (%params, class => $tc->class);
            load_class($tc->class);
        }
        $service = Bread::Board::Declare::BlockInjection->new(
            %params,
            block => $self->block,
        );
    }
    elsif ($self->has_literal_value) {
        $service = Bread::Board::Declare::Literal->new(
            %params,
            value => $self->literal_value,
        );
    }
    elsif ($tc && $tc->isa('Moose::Meta::TypeConstraint::Class')) {
        load_class($tc->class);
        $service = Bread::Board::Declare::ConstructorInjection->new(
            %params,
            class => $tc->class,
        );
    }
    else {
        $service = Bread::Board::Declare::BlockInjection->new(
            %params,
            block => sub {
                die "Attribute " . $self->name . " did not specify a service."
                  . " It must be given a value through the constructor or"
                  . " writer method before it can be resolved."
            },
        );
    }

    $self->associated_service($service);
};

after _process_options => sub {
    my $class = shift;
    my ($name, $opts) = @_;

    return unless exists $opts->{default}
               || exists $opts->{builder};
    return unless exists $opts->{class}
               || exists $opts->{block}
               || exists $opts->{value};

    # XXX: uggggh
    return if any { $_ eq 'Moose::Meta::Attribute::Native::Trait::String'
                 || $_ eq 'Moose::Meta::Attribute::Native::Trait::Counter' }
              @{ $opts->{traits} };

    my $exists = exists($opts->{default}) ? 'default' : 'builder';
    die "$exists is not valid when Bread::Board service options are set";
};

around get_value => sub {
    my $orig = shift;
    my $self = shift;
    my ($instance) = @_;

    return $self->$orig($instance)
        if $self->has_value($instance);

    my $val = $instance->get_service($self->name)->get;

    if ($self->has_type_constraint) {
        $val = $self->type_constraint->coerce($val)
            if $self->should_coerce;

        $self->verify_against_type_constraint($val, instance => $instance);
    }

    if ($self->should_auto_deref) {
        if (ref($val) eq 'ARRAY') {
            return wantarray ? @$val : $val;
        }
        elsif (ref($val) eq 'HASH') {
            return wantarray ? %$val : $val;
        }
        else {
            die "Can't auto_deref $val.";
        }
    }
    else {
        return $val;
    }
};

around _inline_instance_get => sub {
    my $orig = shift;
    my $self = shift;
    my ($instance) = @_;
    return 'do {' . "\n"
            . 'my $val;' . "\n"
            . 'if (' . $self->_inline_instance_has($instance) . ') {' . "\n"
                . '$val = ' . $self->$orig($instance) . ';' . "\n"
            . '}' . "\n"
            . 'else {' . "\n"
                . '$val = ' . $instance . '->get_service(\'' . $self->name . '\')->get;' . "\n"
                . join("\n", $self->_inline_check_constraint(
                    '$val',
                    '$type_constraint',
                    '$type_message',
                )) . "\n"
            . '}' . "\n"
            . '$val' . "\n"
        . '}';
};

no Moose::Role;

1;

__END__

=pod

=head1 NAME

Bread::Board::Declare::Meta::Role::Attribute::Service - attribute metarole for service attributes in Bread::Board::Declare

=head1 VERSION

version 0.13

=head1 DESCRIPTION

This role adds functionality to the attribute metaclass for
L<Bread::Board::Declare> objects.

=head1 ATTRIBUTES

=head2 block

The block to use when creating a L<Bread::Board::BlockInjection> service.

=head2 literal_value

The value to use when creating a L<Bread::Board::Literal> service. Note that
the parameter that should be passed to C<has> is C<value>.

=head2 lifecycle

The lifecycle to use when creating the service. See L<Bread::Board::Service>
and L<Bread::Board::LifeCycle>.

=head2 dependencies

The dependency specification to use when creating the service. See
L<Bread::Board::Service::WithDependencies>.

=head2 parameters

The parameter specification to use when creating the service. See L<Bread::Board::Service::WithParameters>.

=head2 infer

If true, the dependency list will be inferred as much as possible from the
attributes in the class. See L<Bread::Board::Manual::Concepts::Typemap> for
more information. Note that this is only valid for constructor injection
services.

=head2 constructor_name

The constructor name to use when creating L<Bread::Board::ConstructorInjection>
services. Defaults to C<new>.

=head2 associated_service

The service object that is associated with this attribute.

=head1 AUTHOR

Jesse Luehrs <doy at tozt dot net>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Jesse Luehrs.

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

=cut