examples/LazyClass.pod

   1
   2 package # hide the package from PAUSE
   3     LazyClass::Attribute;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Carp 'confess';
   9
  10 our $VERSION = '0.04';
  11
  12 use base 'Class::MOP::Attribute';
  13
  14 sub initialize_instance_slot {
  15     my ($self, $class, $meta_instance, $params) = @_;
  16     # if the attr has an init_arg, use that, otherwise,
  17     # use the attributes name itself as the init_arg
  18     my $init_arg = $self->init_arg();
  19     # try to fetch the init arg from the %params ...
  20     my $val;
  21     $val = $params->{$init_arg} if exists $params->{$init_arg};
  22     # now add this to the instance structure
  23     # only if we have found a value at all
  24     $meta_instance->add_slot($self->name, $val) if defined $val;
  25 }
  26
  27
  28 sub generate_accessor_method {
  29     my ($self, $attr_name) = @_;
  30     sub {
  31         if (scalar(@_) == 2) {
  32             $_[0]->{$attr_name} = $_[1];
  33         }
  34         else {
  35             if (!exists $_[0]->{$attr_name}) {
  36                 my $attr = $self->associated_class->get_attribute($attr_name);
  37                 $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;
  38             }
  39             $_[0]->{$attr_name};
  40         }
  41     };
  42 }
  43
  44 sub generate_reader_method {
  45     my ($self, $attr_name) = @_;
  46     sub {
  47         confess "Cannot assign a value to a read-only accessor" if @_ > 1;
  48         if (!exists $_[0]->{$attr_name}) {
  49             my $attr = $self->associated_class->get_attribute($attr_name);
  50             $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;
  51         }
  52         $_[0]->{$attr_name};
  53     };
  54 }
  55
  56 1;
  57
  58 __END__
  59
  60 =pod
  61
  62 =head1 NAME
  63
  64 LazyClass - An example metaclass with lazy initialization
  65
  66 =head1 SYNOPSIS
  67
  68   package BinaryTree;
  69
  70   use metaclass 'Class::MOP::Class' => (
  71       ':attribute_metaclass' => 'LazyClass::Attribute'
  72   );
  73
  74   BinaryTree->meta->add_attribute('$:node' => (
  75       accessor => 'node',
  76       init_arg => ':node'
  77   ));
  78
  79   BinaryTree->meta->add_attribute('$:left' => (
  80       reader  => 'left',
  81       default => sub { BinaryTree->new() }
  82   ));
  83
  84   BinaryTree->meta->add_attribute('$:right' => (
  85       reader  => 'right',
  86       default => sub { BinaryTree->new() }
  87   ));
  88
  89   sub new  {
  90       my $class = shift;
  91       $class->meta->new_object(@_);
  92   }
  93
  94   # ... later in code
  95
  96   my $btree = BinaryTree->new();
  97   # ... $btree is an empty hash, no keys are initialized yet
  98
  99 =head1 DESCRIPTION
 100
 101 This is an example metclass in which all attributes are created
 102 lazily. This means that no entries are made in the instance HASH
 103 until the last possible moment.
 104
 105 The example above of a binary tree is a good use for such a
 106 metaclass because it allows the class to be space efficient
 107 without complicating the programing of it. This would also be
 108 ideal for a class which has a large amount of attributes,
 109 several of which are optional.
 110
 111 =head1 AUTHOR
 112
 113 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 114
 115 =head1 COPYRIGHT AND LICENSE
 116
 117 Copyright 2006 by Infinity Interactive, Inc.
 118
 119 L<http://www.iinteractive.com>
 120
 121 This library is free software; you can redistribute it and/or modify
 122 it under the same terms as Perl itself.
 123
 124 =cut