Bread::Board deferred injections & generational lifecycle

gistfile1.pl

#!/usr/bin/env perl
use strict;
use warnings;
use 5.018;

package App {
    use Moose;
    has model1 => ( is => 'ro', isa => 'Model1', );
    has model2 => ( is => 'ro', isa => 'Model2', );

    sub run {
        my ($self,$which) = @_;
        my $model_name = "model${which}";
        my $m = $self->$model_name;
        say "$self -> $model_name -> $m";
        say " m counter: ",$m->counter;
    }
};

package Model1 {
    use Moose;
    my $counter;
    sub BUILD { ++$counter;say "built $_[0] $counter times" }
    sub counter { $counter }
};

package Model2 {
    use Moose;
    my $counter;
    sub BUILD { ++$counter;say "built $_[0] $counter times"  }
    sub counter { $counter }
};

package Bread::Board::LifeCycle::Generational {
    use Moose::Role;
    with 'Bread::Board::LifeCycle::Singleton';
    my $COUNTER=0;
    has instance_generation => (
        traits    => [ 'NoClone' ],
        is        => 'rw',
        isa       => 'Int',
    );
    sub next_gen { ++$COUNTER }
    around get => sub {
        my ($next,$self,@etc) = @_;
        if (defined $self->instance_generation && $self->instance_generation < $COUNTER) {
            $self->flush_instance;
        }
        my $object = $self->$next(@etc);
        $self->instance_generation($COUNTER);
        return $object;
    };
};

package Bread::Board::DeferredInjection {
    use Moose;
    use Bread::Board::Types;
    with 'Bread::Board::Service';
    use Bread::Board::Service::Deferred;

    has service => (
        is => 'ro',
        isa => 'Bread::Board::Dependency',
        required => 1,
    );

    around BUILDARGS => sub {
        my ($next,$self,@args) = @_;
        my $args = $self->$next(@args);
        $args->{service} = Bread::Board::Dependency->new(
            service_path=>$args->{service}
        ) unless ref($args->{service});
        return $args;
    };

    has _actual_service => (
        is => 'ro',
        lazy_build => 1,
    );
    sub _build__actual_service {
        my ($self) = @_;
        $self->service->parent($self)
            unless $self->service->parent;
        my $ret = $self->service->service;
        return $ret;
    }

    sub get {
        my ($self) = @_;
        return Bread::Board::Service::Deferred->new(
            service=> $self->_actual_service,
        );
    }
};

package Foo {
    use Bread::Board;
    my $c = container Foo => as {
        service app => (
            class => 'App',
            dependencies => {
                model1 => 'model1_deferred',
                model2 => 'model2_deferred',
            },
            lifecycle => 'Singleton',
        );
        service model1 => (
            class => 'Model1',
            lifecycle => 'Generational',
        );
        service model2 => (
            class => 'Model2',
            lifecycle => 'Generational',
        );
        service model1_deferred => (
            service_type => 'Deferred',
            service => '/model1',
            lifecycle => 'Singleton',
        );
        service model2_deferred => (
            service_type => 'Deferred',
            service => '/model2',
            lifecycle => 'Singleton',
        );
    };
    sub app { $c->fetch('app')->get }
};

my $app = Foo->app;
$app->run(1);
$app->run(1);
$app->run(2);
$app->run(2);
Bread::Board::LifeCycle::Generational->next_gen;
$app->run(1);
$app->run(1);
$app->run(2);
$app->run(2);