examples/LazyClass.pod

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