Got it to work by changing line 94 of Moose/Meta/Method/Delegation
From
my $accessor = $self->associated_attribute->get_read_method_ref;
To
my $accessor = $self->associated_attribute->get_read_method;
This appears to make the delegator run the accessor fully
and not just retrieve the value set in the attribute.
So now I can do...
has 'foo' => (is=>'rw', handles=>[qw/meth1 meth2/]);
around 'foo' => sub {
my ($next,$self) = (shift,shift);
my $obj = $self->$next(@_);
return ref($res) ? $res : Foo->new();
}
* If foo is provided, it will be held and used to delegate to.
* If not provided, a new Foo object will be created each time to delegate to.
* Since Foo is a Singleton it will return the same object.
* A reference of this Foo object wont be stored in the containing object,
keeping the object serialisation clean.
* If required, the 'around' method can now dynamically decide
what kind of object to delegate to.
Tom Howe
Morgan Stanley | Technology
25 Cabot Square | Canary Wharf | Floor 03
London, E14 4QA
Phone: +44 20 7425-9380
tom.h...@morganstanley.com
> -----Original Message-----
> From: Howe, Tom (IT)
> Sent: 15 January 2009 13:56
> To: ch...@prather.org
> Cc: Sartak; Yuval Kogman; Stevan Little; moose@perl.org
> Subject: RE: Possible to use coerce and auto_deref?
>
> Just to follow up re delegation,
> I found in the code for Moose::Meta::Method::Delegation...
>
>
> sub _initialize_body {
> my $self = shift;
>
> my $method_to_call = $self->delegate_to_method;
> return $self->{body} = $method_to_call
> if ref $method_to_call;
>
> my $accessor = $self->_get_delegate_accessor; <
> ======= gets coderef to access raw value
>
> my $handle_name = $self->name;
>
> # NOTE: we used to do a goto here, but the goto didn't handle
> # failure correctly (it just returned nothing), so I took that
> # out. However, the more I thought about it, the less I liked it
> # doing the goto, and I prefered the act of delegation being
> # actually represented in the stack trace. - SL
> $self->{body} = sub {
> my $instance = shift;
> my $proxy = $instance->$accessor();
> <=== gets raw value
> ( defined $proxy )
> || $self->throw_error(
> "Cannot delegate $handle_name to $method_to_call because "
> . "the value of "
> . $self->name
> . " is not defined",
> method_name => $method_to_call,
> object => $instance
> );
> $proxy->$method_to_call(@_);
> <====== runs against raw value
> };
> }
>
> sub _get_delegate_accessor {
> my $self = shift;
>
> my $accessor =
> $self->associated_attribute->get_read_method_ref; <==
> retrieves the coderef to access raw value
>
> $accessor = $accessor->body if blessed $accessor;
>
> return $accessor;
> }
>
>
>
> This means that if the value is not defined it will fail to
> delegate to it. Makes sense except in my situation.
>
> One option would be to get the value post 'around' processing.
>
> Maybe this would break other things though??
>
>
>
>
>
>
>
> > -----Original Message-----
> > From: Chris Prather [mailto:perig...@gmail.com]
> > Sent: 14 January 2009 19:41
> > To: Howe, Tom (IT)
> > Cc: Sartak; Yuval Kogman; Stevan Little; moose@perl.org
> > Subject: Re: Possible to use coerce and auto_deref?
> >
> > On Wed, Jan 14, 2009 at 1:06 PM, Howe, Tom (IT)
> > <tom.h...@morganstanley.com> wrote:
> > > I have something like this:
> > >
> > > subtype 'Thing'
> > > => as 'Object'
> > > => where { $_->isa('ThingClass') };
> > >
> > > coerce 'Thing'
> > > => from 'Str'
> > > => via { ThingClass->new ( xyz=> $_ ) };
> > >
> > >
> > > has 'things' => (
> > > is=>'rw',
> > > isa=>'ArrayRef[Thing]',
> > > lazy=>1,
> > > coerce=>1,
> > > auto_deref=>1,
> > > default => sub { [] },
> > > };
> > >
> > >
> > > But if I pass in a list of strings to convert to Things, I
> > get the error:
> > >
> > > "Cannot coerce without a type coercion"
> > >
> > > I've managed to get around it by defining a type 'ArrayRef[Thing]'
> > >
> > > Eg
> > > Subtype 'ArrayRef[Thing]'
> > > => as 'ArrayRef'
> > > => where {
> > > foreach (@{$_} ....
> > > };
> > >
> > > Coerce 'ArrayRef[Thing]'
> > > => from 'ArrayRef'
> > >
> > > But this means
> > > A) I'm essentially reimplementing ArrayRef each time.
> > > B) It always coerces!
> >
> > isa => 'Arrayref[Thing]' is setting up the subtype for you,
> > so you don't need to do that explicitly You will need to
> > create the coercion however, and yes every time you enable
> > coerce => 1 Moose will look for an applicable coercion (for
> > example: from ArrayRef to ArrayRef[Thing]) and apply it.
> >
> > > It should ideally check before it coerces...
> > >
> > > Anything I can do to improve on this?
> >
> > What are you hoping it will check?
> >
> > Moose doesn't do any kind of "Deep Coercion" because the edge
> > cases become far to messy to handle in an elegant way ... or
> > at least so far as anybody has thought of. What you are doing
> > seems to be the right solution ... with my comments about the
> > "subtype ArrayRef[Thing]"
> > statment being optionally implicit.
> >
> > > Also, I'd like to be able to declare something like
> > >
> > > has 'foo' => ( is=>'rw', delegate=> sub { Foo->instance
> }, handles
> > > =>[qw/x y z/] )
> > >
> > > Where, if no value is passed in to foo() on construction,
> > the accessor created for foo() will always trigger the
> > delegate sub but will not store anything in the object in the
> > way default does.
> > >
> > >
> > > I tried this ..
> > >
> > > has 'foo' => ( is=>'rw', isa=>'Object', handles=> [qw/meth1 meth2
> > > meth3/]);
> > >
> > > around 'foo' => sub {
> > > my ($next,$self,@args) = @_;
> > > if (@args) {
> > > return $self->$next(@args);
> > > } else {
> > > return $self->$next() || Foo->instance(); } };
> > >
> > > But got error:
> > >
> > > Cannot delegate meth1 to meth1 because the value of foo is
> > not defined...
> > >
> > >
> > > Is there some way to do this?
> >
> > Uh ... not if I'm understanding what you're asking for properly.
> >
> > You want an attribute accessor to sometimes store and Object,
> > and sometimes just call a Class Method on some random class
> > if the attribute isn't set? You'll have to write that yourself:
> >
> > has foo => ( is => 'rw', predicate => '_has_foo', handles =>
> > [qw(one two three)] );
> >
> > around [qw(one two three)] => sub {
> > my ($next, $self) = (shift, shift);
> > return Foo->instance->$next(@_) unless $self->_has_foo;
> > return $self->$next(@_);
> > };
> >
> > You could probably wrap this up in a MooseX module with some
> > sugar if you find your using it a lot, but I don't understand
> > why you'd want to do that in the first place.
> >
> > -Chris
> >
--------------------------------------------------------
NOTICE: If received in error, please destroy and notify sender. Sender does not
intend to waive confidentiality or privilege. Use of this email is prohibited
when received in error.
