File: Recipe6.pod

package info (click to toggle)
libmoose-perl 1.09-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 3,004 kB
  • ctags: 1,472
  • sloc: perl: 25,387; makefile: 2
file content (149 lines) | stat: -rw-r--r-- 3,678 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149

=pod

=head1 NAME

Moose::Cookbook::Basics::Recipe6 - The augment/inner example

=head1 SYNOPSIS

  package Document::Page;
  use Moose;

  has 'body' => ( is => 'rw', isa => 'Str', default => sub {''} );

  sub create {
      my $self = shift;
      $self->open_page;
      inner();
      $self->close_page;
  }

  sub append_body {
      my ( $self, $appendage ) = @_;
      $self->body( $self->body . $appendage );
  }

  sub open_page  { (shift)->append_body('<page>') }
  sub close_page { (shift)->append_body('</page>') }

  package Document::PageWithHeadersAndFooters;
  use Moose;

  extends 'Document::Page';

  augment 'create' => sub {
      my $self = shift;
      $self->create_header;
      inner();
      $self->create_footer;
  };

  sub create_header { (shift)->append_body('<header/>') }
  sub create_footer { (shift)->append_body('<footer/>') }

  package TPSReport;
  use Moose;

  extends 'Document::PageWithHeadersAndFooters';

  augment 'create' => sub {
      my $self = shift;
      $self->create_tps_report;
      inner();
  };

  sub create_tps_report {
      (shift)->append_body('<report type="tps"/>');
  }

  # <page><header/><report type="tps"/><footer/></page>
  my $report_xml = TPSReport->new->create;

=head1 DESCRIPTION

This recipe shows how the C<augment> method modifier works. This
modifier reverses the normal subclass to parent method resolution
order. With an C<augment> modifier the I<least> specific method is
called first. Each successive call to C<inner> descends the
inheritance tree, ending at the most specific subclass.

The C<augment> modifier lets you design a parent class that can be
extended in a specific way. The parent provides generic wrapper
functionality, and the subclasses fill in the details.

In the example above, we've created a set of document classes, with
the most specific being the C<TPSReport> class.

We start with the least specific class, C<Document::Page>. Its create
method contains a call to C<inner()>:

  sub create {
      my $self = shift;
      $self->open_page;
      inner();
      $self->close_page;
  }

The C<inner> function is exported by C<Moose>, and is like C<super>
for augmented methods. When C<inner> is called, Moose finds the next
method in the chain, which is the C<augment> modifier in
C<Document::PageWithHeadersAndFooters>. You'll note that we can call
C<inner> in our modifier:

  augment 'create' => sub {
      my $self = shift;
      $self->create_header;
      inner();
      $self->create_footer;
  };

This finds the next most specific modifier, in the C<TPSReport> class.

Finally, in the C<TPSReport> class, the chain comes to an end:

  augment 'create' => sub {
      my $self = shift;
      $self->create_tps_report;
      inner();
  };

We do call the C<inner> function one more time, but since there is no
more specific subclass, this is a no-op. Making this call means we can
easily subclass C<TPSReport> in the future.

=head1 CONCLUSION

The C<augment> modifier is a powerful tool for creating a set of
nested wrappers. It's not something you will need often, but when you
do, it is very handy.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

Dave Rolsky E<lt>autarch@urth.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2007-2009 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=begin testing

my $tps_report = TPSReport->new;
isa_ok( $tps_report, 'TPSReport' );

is(
    $tps_report->create,
    q{<page><header/><report type="tps"/><footer/></page>},
    '... got the right TPS report'
);

=end testing

=cut