Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
393 lines (279 sloc) 10.6 KB
package Role::Subsystem;
use MooseX::Role::Parameterized;
# ABSTRACT: a parameterized role for object subsystems, helpers, and delegates
Role::Subsystem is a L<parameterized role|MooseX::Role::Parameterized>. It's
meant to simplify creating classes that encapsulate specific parts of the
business logic related to parent classes. As in the L<synopsis|/What?>
below, it can be used to write "helpers." The subsystems it creates must have
a reference to a parent object, which might be referenced by id or with an
actual object reference. Role::Subsystem tries to guarantee that no matter
which kind of reference you have, the other kind can be obtained and stored for
=head2 What??
Okay, imagine you have a big class called Account. An Account is the central
point for a lot of behavior, and rather than dump all that logic in one place,
you partition it into subsytems. Let's say we want to write a subsystem that
handles all of an Account's Services. We might write this:
package Account::ServiceManager;
use Moose;
use Account;
with 'Role::Subsystem' => {
ident => 'acct-service-mgr',
type => 'Account',
what => 'account',
getter => sub { Account->retrieve_by_id( $_[0] ) },
sub add_service {
my ($self, @args) = @_;
# ... do some preliminary business logic
# ... do some cleanup business logic
Then you might add to F<>:
package Account;
sub service_mgr {
my ($self) = @_;
return Account::ServiceManager->for_account($self);
Then, to add a service you can write:
You could also just grab the service manager object and use it as a handle for
performing operations.
If you don't have an Account object, just a reference to its id, you could get
the service manager like this:
my $service_mgr = Account::ServiceManager->for_account_id( $account_id );
=head2 Why?
Here's an overview of everything this role will do for you, in terms of the
Account::ServiceManager example above.
It will create the C<for_account> and C<for_account_id> constructors on your
subsystem. (The C<for_account_id> constructor will only be created if a
C<getter> is supplied.)
It will defer retrieval of C<account> objects if you construct with only a
C<account_id>, so that if you never need the full object, you never waste time
getting it.
It will ensure that any C<account> and C<account_id> encountered match the
C<type> and C<id_type> types, respectively. This will prevent a bogus
identifier from being accepted, only to die later when it can't be used for
lazy retrieval.
If you create a subsystem object by passing in the parent object (the
C<account>), it will take a weak reference to it to prevent cyclical references
from interfering with garbage collection. If the reference goes away, or if
you did not start with a reference, a strong reference will be constructed to
allow the subsystem to function efficiently afterward. (This behavior can be
disabled, if you never want to take a weak reference.)
=head3 Swappable Subsystem Implementations
You can also have multiple implementations of a single kind of subsystem. For
example, you may eventually want to do something like this:
package Account::ServiceManager;
use Moose::Role;
with 'Role::Subsystem' => { ... };
requries 'add_service';
requries 'remove_service';
requries 'service_summary';
...and then...
package Account::ServiceManager::Legacy;
with 'Account::ServiceManager';
sub add_service { ... };
package Account::ServiceManager::Simple;
with 'Account::ServiceManager';
sub add_service { ... };
...and finally...
package Account;
sub settings_mgr {
my ($self) = @_;
my $mgr_class = $self->schema_version > 1
? 'Account::ServiceManager::Simple'
: 'Account::ServiceManager::Legacy';
return $mgr_class->for_account($self);
This requires a bit more work, but lets you replace subsystem implementations
as fairly isolated units.
These parameters can be given when including Role::Subsystem; these are in
contrast to the L<attributes|/ATTRIBUTES> and L<methods|/METHODS> below, which
are added to the classe composing this role.
=head2 ident
This is a simple name for the role to use when describing itself in messages.
It is required.
parameter ident => (isa => 'Str', required => 1);
=head2 what
This is the name of the attribute that will hold the parent object, like the
C<account> in the synopsis above.
This attribute is required.
parameter what => (
isa => 'Str',
required => 1,
=head2 what_id
This is the name of the attribute that will hold the parent object's
identifier, like the C<account_id> in the synopsis above.
If not given, it will be the value of C<what> with "_id" stuck on the end.
parameter what_id => (
isa => 'Str',
lazy => 1,
default => sub { $_[0]->what . '_id' },
=head2 type
This is the type that the C<what> must be. It may be a stringly Moose type or
an L<MooseX::Types> type. (Or anything else, right now, but anything else will
probably cause runtime failures or worse.)
This attribute is required.
parameter type => (isa => 'Defined', required => 1);
=head2 id_type
This parameter is like C<type>, but is used to check the C<what>'s id,
discussed more below. If not given, it defaults to C<Defined>.
parameter id_type => (isa => 'Defined', default => 'Defined');
=head2 id_method
This is the name of a method to call on C<what> to get its id. It defaults to
parameter id_method => (isa => 'Str', default => 'id');
=head2 getter
This (optional) attribute supplied a callback that will produce the parent
object from the C<what_id>.
parameter getter => (
isa => 'CodeRef',
=head2 weak_ref
If true, when a subsytem object is created with a defined parent object (that
is, a value for C<what>), the reference to the object will be weakened. This
allows the parent and the subsystem to store references to one another without
creating a problematic circular reference.
If the parent object is subsequently garbage collected, a new value for C<what>
will be retreived and stored, and it will B<not> be weakened. To allow this,
setting C<weak_ref> to true requires that C<getter> be supplied.
C<weak_ref> is true by default.
parameter weak_ref => (
isa => 'Bool',
default => 1,
role {
my ($p) = @_;
my $what = $p->what;
my $ident = $p->ident;
my $what_id = $p->what_id;
my $getter = $p->getter;
my $id_method = $p->id_method;
my $weak_ref = $p->weak_ref;
my $w_pred = "has_initialized_$what";
my $wi_pred = "has_initialized_$what_id";
my $w_reader = "_$what";
my $w_clearer = "_clear_$what";
confess "cannot use weak references for $ident without a getter"
if $weak_ref and not $getter;
has $what => (
is => 'bare',
reader => $w_reader,
isa => $p->type,
lazy => 1,
predicate => $w_pred,
clearer => $w_clearer,
default => sub {
# Basically, this should never happen. We should not be generating the
# for_what_id method if there is no getter, and we should be blowing up
# if produced without a what without a getter. Still, CYA.
# -- rjbs, 2010-05-05
confess "cannot get a $what based on $what_id; no getter" unless $getter;
$getter->( $_[0]->$what_id );
if ($weak_ref) {
method $what => sub {
my ($self) = @_;
my $value = $self->$w_reader;
return $value if defined $value;
return $self->$w_reader;
} else {
my $reader = "_$what";
method $what => sub { $_[0]->$reader },
has $what_id => (
is => 'ro',
isa => $p->id_type,
lazy => 1,
predicate => $wi_pred,
default => sub { $_[0]->$what->$id_method },
method BUILD => sub {};
after BUILD => sub {
my ($self) = @_;
# So, now we protect ourselves from pathological cases. These are:
# 1. neither $what nor $what_id given
unless ($self->$w_pred or $self->$wi_pred) {
confess "neither $what nor $what_id given in constructing $ident";
# 2. both $what and $what_id given, but not matching
if (
$self->$w_pred and $self->$wi_pred
and $self->$what->$id_method ne $self->$what_id
) {
confess "the result of $what->$id_method is not equal to the $what_id"
# 3. only $what_id given, but no getter
if ($self->$wi_pred and ! $self->$w_pred and ! $getter) {
confess "can't build $ident with only $what_id; no getter";
if ($weak_ref) {
# We get the id immediately, if we have a weak ref, on the assumption
# that if the ref expires, we will need the id for the getter
# to function. -- rjbs, 2010-05-05
$self->$what_id unless $self->$wi_pred;
# We only *really* weaken this if we're starting off with an object from
# outside, because if we got the object from our getter, nothing else is
# likely to be holding a reference to it. -- rjbs, 2010-05-05
Scalar::Util::weaken $self->{$what} if $self->$w_pred;
method "for_$what" => sub {
my ($class, $entity, $arg) = @_;
$arg ||= {};
$what => $entity,
if ($getter) {
method "for_$what_id" => sub {
my ($class, $id, $arg) = @_;
$arg ||= {};
$what_id => $id,
The following attributes are added classes composing Role::Subsystem.
=head2 $what
This will refer to the parent object of the subsystem. It will be a value of
the C<type> type defined when parameterizing Role::Subsystem. It may be lazily
computed if it was not supplied during creation or if the initial value was
weak and subsequently garbage collected.
If the value of C<what> when parameterizing Role::Subsystem was C<account>,
that will be the name of this attribute, as well as the method used to read it.
=head2 $what_id
This method gets the id of the parent object. It will be a defined value of
the C<id_type> provided when parameterizing Role::Subsystem. It may be lazily
computed by calling the C<id_method> on C<what> as needed.
=head1 METHODS
=head2 for_$what
my $settings_mgr = Account::ServiceManager->for_account($account);
This is a convenience constructor, returning a subsystem object for the given
=head2 for_$what_id
my $settings_mgr = Account::ServiceManager->for_account_id($account_id);
This is a convenience constructor, returning a subsystem object for the given