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