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