roman has asked for the wisdom of the Perl Monks concerning the following question:

I have a subclass extending parent class method via inner() and augment

package C1;
use Moose;

sub html {
    my $this = shift;
    return '<html>' . '<body>' . inner() . '</body>' . '</html>';
}

package C2;
use Moose;

extends 'C1';

augment html => sub { return 'C2'; };

[download]
warn C2->new->html;


# yields
# <html><body>C2</body></html>

[download]
I want to add another augmentable method, which content is not mandatory, i.e. I don't want to supply augment in every subclass. 
package C1;
use Moose;

sub html {
    my $this = shift;
    return
          '<html>'
        . $this->head
        . '<body>'
        . inner()
        . '</body>'
        . '</html>';
}

sub head { return '<head>' . (inner() || '') . '</head>'; }

package C2;
use Moose;

extends 'C1';

augment html => sub { return 'C2'; };

[download]

But if I don't supply the content of head method in subclass then the content of html method is used:

warn C2->new->html;

# yields
# <html><head>C2</head><body>C2</body></html>

[download]

So is it possible to use more than one augmentable method, with some of them having "optional" content?

Thanks for any reply including those: "You should not do this, ..."

Roman

Replies are listed 'Best First'.
Re: Moose - two augmented methods in one class
by tobyink (Canon) on Jan 09, 2012 at 14:50 UTC

    I don't really have any opinion on whether or not you should be doing this, but...

    package C1;
use Moose;

sub html {
    my $this = shift;
    return
          '<html>'
        . $this->head
        . '<body>'
        . inner()
        . '</body>'
        . '</html>';
}

sub head
{
    my $self = shift;
    my $child_implementation = $self->meta->get_method('head');
    my $has_child_implementation = blessed($child_implementation)
        && $child_implementation->isa('Moose::Meta::Method::Augmented'
+);
    
    return '<head>' . ($has_child_implementation ? inner() : '') . '</
+head>';
}

package C2;
use Moose;

extends 'C1';

augment html => sub { return 'C2'; };

package main;
warn C2->new->html;

    [download]
[reply]
[d/l]

      Replying to myself... you might want to factor out some of that augmentation detection code if you're going to be doing this a lot...

      package AugmentationDetective;
use Moose::Role;

sub is_augmented
{
  my ($self, $method_name) = @_;
  my $method = $self->meta->get_method($method_name);
  return blessed($method)
     && $method->isa('Moose::Meta::Method::Augmented');
}

package C1;
use Moose;
with 'AugmentationDetective';

sub html
{
  my $this = shift;
  return
      '<html>'
    . $this->head
    . '<body>'
    . inner()
    . '</body>'
    . '</html>';
}

sub head
{
  my $self = shift;
  return '<head>'.($self->is_augmented('head')?inner():'').'</head>';
}

package C2;
use Moose;
extends 'C1';
augment html => sub { return 'C2'; };

package main;
warn C2->new->html;

      [download]
[reply]
[d/l]

      Update: ignore this, tobyink is right, I didn't pay enough attention to the question

      This cumbersome check is not really required. inner is no-op if there's no augment: 

      use 5.010;
use strict;
use warnings;

{
    package C1;
    use Moose;
    sub test { return "<C1>".(inner()//'')."</C1>"; }
}

{
    package C2;
    use Moose;
    extends 'C1';
}

my $c2 = C2->new;
say $c2->test;
__END__
<C1></C1>

      [download]
[reply]
[d/l]
[select]

        Actually, in the example, it does seem necessary, as it seems to hit onto a barely documented area of Moose behaviour bug according to several people in #moose in irc.perl.org. The html method defined in the superclass, calls head defined in the invocant. head isn't augmented in the subclass, so the head method defined in the superclass is used directly. This calls inner which searches up the callstack for an augmented method. While we'd want it to find head, that method is not augmented in the subclass, so it finds html instead, inadvertently using the wrong augmentation.

        Try the code from the original question and you'll see.

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom