File Coverage

blib/lib/Bread/Board/LifeCycle/Singleton/WithParameters.pm
Criterion Covered Total %
statement 10 10 100.0
branch 1 2 50.0
condition n/a
subroutine 3 3 100.0
pod 1 1 100.0
total 15 16 93.7


line stmt bran cond sub pod time code
1             package Bread::Board::LifeCycle::Singleton::WithParameters;
2             our $AUTHORITY = 'cpan:STEVAN';
3             # ABSTRACT: singleton lifecycle role for a parameterized service
4             $Bread::Board::LifeCycle::Singleton::WithParameters::VERSION = '0.35';
5 1     1   438 use Moose::Role;
  1         3  
  1         8  
6              
7             with 'Bread::Board::LifeCycle';
8              
9             has 'instances' => (
10             traits => [ 'Hash', 'NoClone' ],
11             is => 'rw',
12             isa => 'HashRef',
13             lazy => 1,
14             default => sub { +{} },
15             clearer => 'flush_instances',
16             handles => {
17             'has_instance_at_key' => 'exists',
18             'get_instance_at_key' => 'get',
19             'set_instance_at_key' => 'set',
20             }
21             );
22              
23             around 'get' => sub {
24             my $next = shift;
25             my $self = shift;
26             my $key = $self->generate_instance_key(@_);
27              
28             # return it if we got it ...
29             return $self->get_instance_at_key($key)
30             if $self->has_instance_at_key($key);
31              
32             # otherwise fetch it ...
33             my $instance = $self->$next(@_);
34              
35             # if we get a copy, and our copy
36             # has not already been set ...
37             $self->set_instance_at_key($key => $instance)
38             unless $self->has_instance_at_key($key);
39              
40             # return whatever we have ...
41             return $self->get_instance_at_key($key);
42             };
43              
44             sub generate_instance_key {
45 5     5 1 15 my ($self, @args) = @_;
46 5 50       14 return "$self" unless @args;
47 5         14 return join "|" => sort map { "$_" } @args
  20         60  
48             }
49              
50 1     1   4937 no Moose::Role; 1;
  1         3  
  1         4  
51              
52             __END__
53              
54             =pod
55              
56             =encoding UTF-8
57              
58             =head1 NAME
59              
60             Bread::Board::LifeCycle::Singleton::WithParameters - singleton lifecycle role for a parameterized service
61              
62             =head1 VERSION
63              
64             version 0.35
65              
66             =head1 DESCRIPTION
67              
68             Sub-role of L<Bread::Board::LifeCycle>, this role defines the
69             "singleton" lifecycle for a parameterized service. The C<get> method
70             will only do its work the first time it is invoked for each set of
71             parameters; subsequent invocations with the same parameters will
72             return the same object.
73              
74             =head1 ATTRIBUTES
75              
76             =head2 C<instances>
77              
78             Hashref mapping keys to objects, used to cache the results of L</get>
79              
80             =head1 METHODS
81              
82             =head2 C<get>
83              
84             Generates a key using L</generate_instance_key> (passing it all the
85             arguments); if the L</instances> attribute does not hold an object for
86             that key, it will build it (by calling the underlying C<get> method)
87             and store it in L</instances>. The object (either retrieved from
88             L</instances> or freshly built) will be returned.
89              
90             =head2 C<generate_instance_key>
91              
92             Generates a (hopefully) unique key from the given arguments (usually,
93             whatever was passed to L</get>). The current implementation
94             stringifies all arguments, so different references to identical values
95             will be considered different.
96              
97             =head1 AUTHOR
98              
99             Stevan Little <stevan@iinteractive.com>
100              
101             =head1 BUGS
102              
103             Please report any bugs or feature requests on the bugtracker website
104             https://github.com/stevan/BreadBoard/issues
105              
106             When submitting a bug or request, please include a test-file or a
107             patch to an existing test-file that illustrates the bug or desired
108             feature.
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             This software is copyright (c) 2017, 2016, 2015, 2014, 2013, 2011, 2009 by Infinity Interactive.
113              
114             This is free software; you can redistribute it and/or modify it under
115             the same terms as the Perl 5 programming language system itself.
116              
117             =cut