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