lib/Moose/Cookbook/Legacy/Labeled_AttributeMetaclass.pm

   1 package Moose::Cookbook::Meta::Labeled_AttributeMetaclass;
   2
   3 # ABSTRACT: A meta-attribute, attributes with labels
   4
   5 __END__
   6
   7
   8 =pod
   9
  10 =head1 SYNOPSIS
  11
  12   package MyApp::Meta::Attribute::Labeled;
  13   use Moose;
  14   extends 'Moose::Meta::Attribute';
  15
  16   has label => (
  17       is        => 'rw',
  18       isa       => 'Str',
  19       predicate => 'has_label',
  20   );
  21
  22   package Moose::Meta::Attribute::Custom::Labeled;
  23   sub register_implementation {'MyApp::Meta::Attribute::Labeled'}
  24
  25   package MyApp::Website;
  26   use Moose;
  27
  28   has url => (
  29       metaclass => 'Labeled',
  30       is        => 'rw',
  31       isa       => 'Str',
  32       label     => "The site's URL",
  33   );
  34
  35   has name => (
  36       is  => 'rw',
  37       isa => 'Str',
  38   );
  39
  40   sub dump {
  41       my $self = shift;
  42
  43       my $meta = $self->meta;
  44
  45       my $dump = '';
  46
  47       for my $attribute ( map { $meta->get_attribute($_) }
  48           sort $meta->get_attribute_list ) {
  49
  50           if (   $attribute->isa('MyApp::Meta::Attribute::Labeled')
  51               && $attribute->has_label ) {
  52               $dump .= $attribute->label;
  53           }
  54           else {
  55               $dump .= $attribute->name;
  56           }
  57
  58           my $reader = $attribute->get_read_method;
  59           $dump .= ": " . $self->$reader . "\n";
  60       }
  61
  62       return $dump;
  63   }
  64
  65   package main;
  66
  67   my $app = MyApp::Website->new( url => "http://google.com", name => "Google" );
  68
  69 =head1 SUMMARY
  70
  71 B<WARNING: Subclassing metaclasses (as opposed to providing metaclass traits)
  72 is strongly discouraged. This recipe is provided solely for reference when
  73 encountering older code that does this.>
  74
  75 In this recipe, we begin to delve into the wonder of meta-programming.
  76 Some readers may scoff and claim that this is the arena of only the
  77 most twisted Moose developers. Absolutely not! Any sufficiently
  78 twisted developer can benefit greatly from going more meta.
  79
  80 Our goal is to allow each attribute to have a human-readable "label"
  81 attached to it. Such labels would be used when showing data to an end
  82 user. In this recipe we label the C<url> attribute with "The site's
  83 URL" and create a simple method showing how to use that label.
  84
  85 The proper, modern way to extend attributes (using a role instead of a
  86 subclass) is described in L<Moose::Cookbook::Meta::Recipe3>, but that recipe
  87 assumes you've read and at least tried to understand this one.
  88
  89 =head1 META-ATTRIBUTE OBJECTS
  90
  91 All the attributes of a Moose-based object are actually objects
  92 themselves.  These objects have methods and attributes. Let's look at
  93 a concrete example.
  94
  95   has 'x' => ( isa => 'Int', is => 'ro' );
  96   has 'y' => ( isa => 'Int', is => 'rw' );
  97
  98 Internally, the metaclass for C<Point> has two
  99 L<Moose::Meta::Attribute>. There are several methods for getting
 100 meta-attributes out of a metaclass, one of which is
 101 C<get_attribute_list>. This method is called on the metaclass object.
 102
 103 The C<get_attribute_list> method returns a list of attribute names. You can
 104 then use C<get_attribute> to get the L<Moose::Meta::Attribute> object itself.
 105
 106 Once you have this meta-attribute object, you can call methods on it like this:
 107
 108   print $point->meta->get_attribute('x')->type_constraint;
 109      => Int
 110
 111 To add a label to our attributes there are two steps. First, we need a
 112 new attribute metaclass that can store a label for an
 113 attribute. Second, we need to create attributes that use that
 114 attribute metaclass.
 115
 116 =head1 RECIPE REVIEW
 117
 118 We start by creating a new attribute metaclass.
 119
 120   package MyApp::Meta::Attribute::Labeled;
 121   use Moose;
 122   extends 'Moose::Meta::Attribute';
 123
 124 We can subclass a Moose metaclass in the same way that we subclass
 125 anything else.
 126
 127   has label => (
 128       is        => 'rw',
 129       isa       => 'Str',
 130       predicate => 'has_label',
 131   );
 132
 133 Again, this is standard Moose code.
 134
 135 Then we need to register our metaclass with Moose:
 136
 137   package Moose::Meta::Attribute::Custom::Labeled;
 138   sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }
 139
 140 This is a bit of magic that lets us use a short name, "Labeled", when
 141 referring to our new metaclass.
 142
 143 That was the whole attribute metaclass.
 144
 145 Now we start using it.
 146
 147   package MyApp::Website;
 148   use Moose;
 149   use MyApp::Meta::Attribute::Labeled;
 150
 151 We have to load the metaclass to use it, just like any Perl class.
 152
 153 Finally, we use it for an attribute:
 154
 155   has url => (
 156       metaclass => 'Labeled',
 157       is        => 'rw',
 158       isa       => 'Str',
 159       label     => "The site's URL",
 160   );
 161
 162 This looks like a normal attribute declaration, except for two things,
 163 the C<metaclass> and C<label> parameters. The C<metaclass> parameter
 164 tells Moose we want to use a custom metaclass for this (one)
 165 attribute. The C<label> parameter will be stored in the meta-attribute
 166 object.
 167
 168 The reason that we can pass the name C<Labeled>, instead of
 169 C<MyApp::Meta::Attribute::Labeled>, is because of the
 170 C<register_implementation> code we touched on previously.
 171
 172 When you pass a metaclass to C<has>, it will take the name you provide
 173 and prefix it with C<Moose::Meta::Attribute::Custom::>. Then it calls
 174 C<register_implementation> in the package. In this case, that means
 175 Moose ends up calling
 176 C<Moose::Meta::Attribute::Custom::Labeled::register_implementation>.
 177
 178 If this function exists, it should return the I<real> metaclass
 179 package name. This is exactly what our code does, returning
 180 C<MyApp::Meta::Attribute::Labeled>. This is a little convoluted, and
 181 if you don't like it, you can always use the fully-qualified name.
 182
 183 We can access this meta-attribute and its label like this:
 184
 185   $website->meta->get_attribute('url')->label()
 186
 187   MyApp::Website->meta->get_attribute('url')->label()
 188
 189 We also have a regular attribute, C<name>:
 190
 191   has name => (
 192       is  => 'rw',
 193       isa => 'Str',
 194   );
 195
 196 This is a regular Moose attribute, because we have not specified a new
 197 metaclass.
 198
 199 Finally, we have a C<dump> method, which creates a human-readable
 200 representation of a C<MyApp::Website> object. It will use an
 201 attribute's label if it has one.
 202
 203   sub dump {
 204       my $self = shift;
 205
 206       my $meta = $self->meta;
 207
 208       my $dump = '';
 209
 210       for my $attribute ( map { $meta->get_attribute($_) }
 211           sort $meta->get_attribute_list ) {
 212
 213           if (   $attribute->isa('MyApp::Meta::Attribute::Labeled')
 214               && $attribute->has_label ) {
 215               $dump .= $attribute->label;
 216           }
 217
 218 This is a bit of defensive code. We cannot depend on every
 219 meta-attribute having a label. Even if we define one for every
 220 attribute in our class, a subclass may neglect to do so. Or a
 221 superclass could add an attribute without a label.
 222
 223 We also check that the attribute has a label using the predicate we
 224 defined. We could instead make the label C<required>. If we have a
 225 label, we use it, otherwise we use the attribute name:
 226
 227           else {
 228               $dump .= $attribute->name;
 229           }
 230
 231           my $reader = $attribute->get_read_method;
 232           $dump .= ": " . $self->$reader . "\n";
 233       }
 234
 235       return $dump;
 236   }
 237
 238 The C<get_read_method> is part of the L<Moose::Meta::Attribute>
 239 API. It returns the name of a method that can read the attribute's
 240 value, I<when called on the real object> (don't call this on the
 241 meta-attribute).
 242
 243 =head1 CONCLUSION
 244
 245 You might wonder why you'd bother with all this. You could just
 246 hardcode "The Site's URL" in the C<dump> method. But we want to avoid
 247 repetition. If you need the label once, you may need it elsewhere,
 248 maybe in the C<as_form> method you write next.
 249
 250 Associating a label with an attribute just makes sense! The label is a
 251 piece of information I<about> the attribute.
 252
 253 It's also important to realize that this was a trivial example. You
 254 can make much more powerful metaclasses that I<do> things, as opposed
 255 to just storing some more information. For example, you could
 256 implement a metaclass that expires attributes after a certain amount
 257 of time:
 258
 259    has site_cache => (
 260        metaclass     => 'TimedExpiry',
 261        expires_after => { hours => 1 },
 262        refresh_with  => sub { get( $_[0]->url ) },
 263        isa           => 'Str',
 264        is            => 'ro',
 265    );
 266
 267 The sky's the limit!
 268
 269 =begin testing
 270
 271 my $app = MyApp::Website->new( url => "http://google.com", name => "Google" );
 272 is(
 273     $app->dump, q{name: Google
 274 The site's URL: http://google.com
 275 }, '... got the expected dump value'
 276 );
 277
 278 =end testing
 279
 280 =cut
 281