File Coverage

blib/lib/Bread/Board/LifeCycle/Singleton.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Bread::Board::LifeCycle::Singleton;
2             our $AUTHORITY = 'cpan:STEVAN';
3             # ABSTRACT: service role for singleton lifecycle
4             $Bread::Board::LifeCycle::Singleton::VERSION = '0.35';
5 55     55   1418 use Moose::Role;
  55         126  
  55         514  
6              
7 55     55   308319 use Try::Tiny;
  55         147  
  55         16109  
8              
9             with 'Bread::Board::LifeCycle';
10              
11             has 'instance' => (
12             traits => [ 'NoClone' ],
13             is => 'rw',
14             isa => 'Any',
15             predicate => 'has_instance',
16             clearer => 'flush_instance'
17             );
18              
19             has 'resolving_singleton' => (
20             traits => [ 'NoClone' ],
21             is => 'rw',
22             isa => 'Bool',
23             default => 0,
24             );
25              
26             around 'get' => sub {
27             my $next = shift;
28             my $self = shift;
29              
30             # return it if we got it ...
31             return $self->instance if $self->has_instance;
32              
33             my $instance;
34             if ($self->resolving_singleton) {
35             $instance = Bread::Board::Service::Deferred->new(service => $self);
36             }
37             else {
38             $self->resolving_singleton(1);
39             my @args = @_;
40             try {
41             # otherwise fetch it ...
42             $instance = $self->$next(@args);
43             }
44             catch {
45             die $_;
46             }
47             finally {
48             $self->resolving_singleton(0);
49             };
50             }
51              
52             # if we get a copy, and our copy
53             # has not already been set ...
54             $self->instance($instance);
55              
56             # return whatever we have ...
57             return $self->instance;
58             };
59              
60 55     55   430 no Moose::Role; 1;
  55         133  
  55         328  
61              
62             __END__
63              
64             =pod
65              
66             =encoding UTF-8
67              
68             =head1 NAME
69              
70             Bread::Board::LifeCycle::Singleton - service role for singleton lifecycle
71              
72             =head1 VERSION
73              
74             version 0.35
75              
76             =head1 DESCRIPTION
77              
78             Sub-role of L<Bread::Board::LifeCycle>, this role defines the
79             "singleton" lifecycle for a service. The C<get> method will only do
80             its work the first time it is invoked; subsequent invocations will
81             return the same object.
82              
83             =head1 ATTRIBUTES
84              
85             =head2 C<instance>
86              
87             The object build by the last call to C<get> to actually do any work,
88             and returned by any subsequent call to C<get>.
89              
90             =head1 METHODS
91              
92             =head2 C<get>
93              
94             The first time this is called (or the first time after calling
95             L</flush_instance>), the actual C<get> method will be invoked, and its
96             return value cached in the L</instance> attribute. The value of that
97             attribute will always be returned, so you can call C<get> as many time
98             as you need, and always receive the same instance.
99              
100             =head2 C<has_instance>
101              
102             Predicate for the L</instance> attribute.
103              
104             =head2 C<flush_instance>
105              
106             Clearer for the L</instance> attribute. Clearing the attribute will
107             cause the next call to C<get> to instantiate a new object.
108              
109             =head1 AUTHOR
110              
111             Stevan Little <stevan@iinteractive.com>
112              
113             =head1 BUGS
114              
115             Please report any bugs or feature requests on the bugtracker website
116             https://github.com/stevan/BreadBoard/issues
117              
118             When submitting a bug or request, please include a test-file or a
119             patch to an existing test-file that illustrates the bug or desired
120             feature.
121              
122             =head1 COPYRIGHT AND LICENSE
123              
124             This software is copyright (c) 2017, 2016, 2015, 2014, 2013, 2011, 2009 by Infinity Interactive.
125              
126             This is free software; you can redistribute it and/or modify it under
127             the same terms as the Perl 5 programming language system itself.
128              
129             =cut