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 'Class::MOP::Class' => (
  95       ':attribute_metaclass' => 'LazyClass::Attribute'
  96   );
  97
  98   BinaryTree->meta->add_attribute('$:node' => (
  99       accessor => 'node',
 100       init_arg => ':node'
 101   ));
 102
 103   BinaryTree->meta->add_attribute('$:left' => (
 104       reader  => 'left',
 105       default => sub { BinaryTree->new() }
 106   ));
 107
 108   BinaryTree->meta->add_attribute('$:right' => (
 109       reader  => 'right',
 110       default => sub { BinaryTree->new() }
 111   ));
 112
 113   sub new  {
 114       my $class = shift;
 115       $class->meta->new_object(@_);
 116   }
 117
 118   # ... later in code
 119
 120   my $btree = BinaryTree->new();
 121   # ... $btree is an empty hash, no keys are initialized yet
 122
 123 =head1 DESCRIPTION
 124
 125 This is an example metclass in which all attributes are created
 126 lazily. This means that no entries are made in the instance HASH
 127 until the last possible moment.
 128
 129 The example above of a binary tree is a good use for such a
 130 metaclass because it allows the class to be space efficient
 131 without complicating the programing of it. This would also be
 132 ideal for a class which has a large amount of attributes,
 133 several of which are optional.
 134
 135 =head1 AUTHOR
 136
 137 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 138
 139 =head1 COPYRIGHT AND LICENSE
 140
 141 Copyright 2006 by Infinity Interactive, Inc.
 142
 143 L<http://www.iinteractive.com>
 144
 145 This library is free software; you can redistribute it and/or modify
 146 it under the same terms as Perl itself.
 147
 148 =cut